packages feed

xmonad-contrib 0.15 → 0.18.2

raw patch · 353 files changed

Files

CHANGES.md view
@@ -1,689 +1,2356 @@ # Change Log / Release Notes -## unknown--## 0.15--### Breaking Changes--  * `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`-    The layout will no longer perform refreshes inside of its message handling.-    If you have been relying on it to in your xmonad.hs, you will need to start-    sending its messages in a manner that properly handles refreshing, e.g. with-    `sendMessage`.--### New Modules--  * `XMonad.Util.Purex`--    Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from-    the `XConf` and modifications to the `XState` are fundamentally pure ---    contrary to the current treatment of such actions in most xmonad code. Pure-    modifications to the `WindowSet` can be readily composed, but due to the-    need for those modifications to be properly handled by `windows`, other pure-    changes to the `XState` cannot be interleaved with those changes to the-    `WindowSet` without superfluous refreshes, hence breaking composability.--    This module aims to rectify that situation by drawing attention to it and-    providing `PureX`: a pure type with the same monadic interface to state as-    `X`. The `XLike` typeclass enables writing actions generic over the two-    monads; if pure, existing `X` actions can be generalised with only a change-    to the type signature. Various other utilities are provided, in particular-    the `defile` function which is needed by end-users.--### Bug Fixes and Minor Changes--  * Add support for GHC 8.6.1.--  * `XMonad.Actions.MessageHandling`-    Refresh-performing functions updated to better reflect the new `sendMessage`.--## 0.14--### Breaking Changes--  * `XMonad.Layout.Spacing`--    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed-    of four sides each with its own border width. The screen and window borders-    are now separate and can be independently toggled on/off. The screen border-    examines the window/rectangle list resulting from 'runLayout' rather than-    the stack, which makes it compatible with layouts such as the builtin-    `Full`. The child layout will always be called with the screen border. If-    only a single window is displayed (and `smartBorder` enabled), it will be-    expanded into the original layout rectangle. Windows that are displayed but-    not part of the stack, such as those created by 'XMonad.Layout.Decoration',-    will be shifted out of the way, but not scaled (not possible for windows-    created by XMonad). This isn't perfect, so you might want to disable-    `Spacing` on such layouts.--  * `XMonad.Util.SpawnOnce`--    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks-      to shift spawned windows to a specific workspace.--  * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier--  * `XMonad.Actions.GridSelect`--    - Added field `gs_bordercolor` to `GSConfig` to specify border color.--  * `XMonad.Layout.Minimize`--     Though the interface it offers is quite similar, this module has been-     almost completely rewritten. The new `XMonad.Actions.Minimize` contains-     several functions that allow interaction with minimization window state.-     If you are using this module, you must upgrade your configuration to import-     `X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of-     sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has-     been completely deprecated, and its functions have no effect.--  * `XMonad.Prompt.Unicode`--    - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a-      filepath to the `UnicodeData.txt` file containing unicode data.--  * `XMonad.Actions.PhysicalScreens`--    `getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter-    of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default-    value are:--     - `def`(same as verticalScreenOrderer) will keep previous behavior-     - `verticalScreenOrderer`-     - `horizontalScreenOrderer`--    One can build his custom ScreenOrderer using:-     - `screenComparatorById` (allow to order by Xinerama id)-     - `screenComparatorByRectangle` (allow to order by screen coordonate)-     - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)--  * `XMonad.Util.WorkspaceCompare`--    `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in-    `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)--  * `XMonad.Hooks.EwmhDesktops`--    - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific-      remapping of all visible windows to the active workspace (#216).-    - Handle workspace renames that might be occuring in the custom function-      that is provided to ewmhDesktopsLogHookCustom.--  * `XMonad.Hooks.DynamicLog`--    - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and-      `xmobarRaw`.--  * `XMonad.Layout.NoBorders`--    The layout now maintains a list of windows that never have borders, and a-    list of windows that always have borders. Use `BorderMessage` to manage-    these lists and the accompanying event hook (`borderEventHook`) to remove-    destroyed windows from them. Also provides the `hasBorder` manage hook.--    Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and-    `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`.  See-    the documentation for more information.--    The type signature of `hiddens` was changed to accept a new `Rectangle`-    parameter representing the bounds of the parent layout, placed after the-    `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`-    will need to update their configuration. For example, replace "`hiddens amb-    wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make-    use of the new parameter with "`hiddens amb wset lr mst wrs =`".--  * `XMonad.Actions.MessageFeedback`--    - Follow the naming conventions of `XMonad.Operations`. Functions returning-      `X ()` are named regularly (previously these ended in underscore) while-      those returning `X Bool` are suffixed with an uppercase 'B'.-    - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and-      `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`-      (renamed from `send`).-    - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of-      type `SomeMessage -> X Bool`, which means you are no longer constrained-      to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.-    - The `send*Messages*` family of funtions allows for sequencing arbitrary-      sets of messages with minimal refresh. It makes little sense for these-      functions to support custom message dispatchers.-    - Remain backwards compatible. Maintain deprecated aliases of all renamed-      functions:-      - `send`          -> `sendMessageWithNoRefreshToCurrentB`-      - `sendSM`        -> `sendSomeMessageWithNoRefreshToCurrentB`-      - `sendSM_`       -> `sendSomeMessageWithNoRefreshToCurrent`-      - `tryInOrder`    -> `tryInOrderWithNoRefreshToCurrentB`-      - `tryInOrder_`   -> `tryInOrderWithNoRefreshToCurrent`-      - `tryMessage`    -> `tryMessageWithNoRefreshToCurrentB`-      - `tryMessage_`   -> `tryMessageWithNoRefreshToCurrent`--### New Modules--  * `XMonad.Layout.MultiToggle.TabBarDecoration`--    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to-    dynamically toggle `XMonad.Layout.TabBarDecoration`.--  * `XMonad.Layout.StateFull`--    Provides `StateFull`: a stateful form of `Full` that does not misbehave when-    floats are focused, and the `FocusTracking` layout transformer by means of-    which `StateFull` is implemented. `FocusTracking` simply holds onto the last-    true focus it was given and continues to use it as the focus for the-    transformed layout until it sees another. It can be used to improve the-    behaviour of a child layout that has not been given the focused window.--  * `XMonad.Actions.SwapPromote`--    Module for tracking master window history per workspace, and associated-    functions for manipulating the stack using such history.--  * `XMonad.Actions.CycleWorkspaceByScreen`--    A new module that allows cycling through previously viewed workspaces in the-    order they were viewed most recently on the screen where cycling is taking-    place.--    Also provides the `repeatableAction` helper function which can be used to-    build actions that can be repeated while a modifier key is held down.--  * `XMonad.Prompt.FuzzyMatch`--    Provides a predicate `fuzzyMatch` that is much more lenient in matching-    completions in `XMonad.Prompt` than the default prefix match.  Also provides-    a function `fuzzySort` that allows sorting the fuzzy matches by "how well"-    they match.--  * `XMonad.Utils.SessionStart`--    A new module that allows to query if this is the first time xmonad is-    started of the session, or a xmonad restart.--    Currently needs manual setting of the session start flag. This could be-    automated when this moves to the core repository.--  * `XMonad.Layout.MultiDishes`--    A new layout based on Dishes, however it accepts additional configuration-    to allow multiple windows within a single stack.--  * `XMonad.Util.Rectangle`--    A new module for handling pixel rectangles.--  * `XMonad.Layout.BinaryColumn`--    A new module which provides a simple grid layout, halving the window-    sizes of each window after master.--    This is similar to Column, but splits the window in a way-    that maintains window sizes upon adding & removing windows as well as the-    option to specify a minimum window size.--### Bug Fixes and Minor Changes--  * `XMonad.Layout.Grid`--    Fix as per issue #223; Grid will no longer calculate more columns than there-    are windows.--  * `XMonad.Hooks.FadeWindows`--    Added support for GHC version 8.4.x by adding a Semigroup instance for-    Monoids--  * `XMonad.Hooks.WallpaperSetter`--    Added support for GHC version 8.4.x by adding a Semigroup instance for-    Monoids--  * `XMonad.Hooks.Mosaic`--    Added support for GHC version 8.4.x by adding a Semigroup instance for-    Monoids--  * `XMonad.Actions.Navigation2D`--    Added `sideNavigation` and a parameterised variant, providing a navigation-    strategy with fewer quirks for tiled layouts using X.L.Spacing.--  * `XMonad.Layout.Fullscreen`--    The fullscreen layouts will now not render any window that is totally-    obscured by fullscreen windows.--  * `XMonad.Layout.Gaps`--    Extended the sendMessage interface with `ModifyGaps` to allow arbitrary-    modifications to the `GapSpec`.--  * `XMonad.Layout.Groups`--    Added a new `ModifyX` message type that allows the modifying-    function to return values in the `X` monad.--  * `XMonad.Actions.Navigation2D`--    Generalised (and hence deprecated) hybridNavigation to hybridOf.--  * `XMonad.Layout.LayoutHints`--    Preserve the window order of the modified layout, except for the focused-    window that is placed on top. This fixes an issue where the border of the-    focused window in certain situations could be rendered below borders of-    unfocused windows. It also has a lower risk of interfering with the-    modified layout.--  * `XMonad.Layout.MultiColumns`--    The focused window is placed above the other windows if they would be made to-    overlap due to a layout modifier. (As long as it preserves the window order.)--  * `XMonad.Actions.GridSelect`--    - The vertical centring of text in each cell has been improved.--  * `XMonad.Actions.SpawnOn`--    - Bind windows spawns by child processes of the original window to the same-      workspace as the original window.--  * `XMonad.Util.WindowProperties`--    - Added the ability to test if a window has a tag from-      `XMonad.Actions.TagWindows`--  * `XMonad.Layout.Magnifier`--    - Handle `IncMasterN` messages.--  * `XMonad.Util.EZConfig`--    - Can now parse Latin1 keys, to better accommodate users with-      non-US keyboards.--  * `XMonad.Actions.Submap`--    Establish pointer grab to avoid freezing X, when button press occurs after-    submap key press.  And terminate submap at button press in the same way,-    as we do for wrong key press.--  * `XMonad.Hooks.SetWMName`--    Add function `getWMName`.--  * `XMonad.Hooks.ManageHelpers`--    Make type of ManageHook combinators more general.--  * `XMonad.Prompt`--    Export `insertString`.--  * `XMonad.Prompt.Window`--    - New function: `windowMultiPrompt` for using `mkXPromptWithModes`-      with window prompts.--  * `XMonad.Hooks.WorkspaceHistory`--    - Now supports per screen history.--  * `XMonad.Layout.ComboP`--    - New `PartitionWins` message to re-partition all windows into the-      configured sub-layouts.  Useful when window properties have-      changed and you want to re-sort windows into the appropriate-      sub-layout.--  * `XMonad.Actions.Minimize`--    - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform-      actions with both the last and first minimized windows easily.--  * `XMonad.Config.Gnome`--    - Update logout key combination (modm+shift+Q) to work with modern--  * `XMonad.Prompt.Pass`--    - New function `passTypePrompt` which uses `xdotool` to type in a password-      from the store, bypassing the clipboard.-    - Now handles password labels with spaces and special characters inside-      them.--  * `XMonad.Prompt.Unicode`--    - Persist unicode data cache across XMonad instances due to-      `ExtensibleState` now used instead of `unsafePerformIO`.-    - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the-      Unicode character via `xdotool` instead of copying it to the paste buffer.-    - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`-      acts as a generic function to pass the selected Unicode character to any-      program.--  * `XMonad.Prompt.AppendFile`--    - New function `appendFilePrompt'` which allows for transformation of the-      string passed by a user before writing to a file.--  * `XMonad.Hooks.DynamicLog`--    - Added a new function `dzenWithFlags` which allows specifying the arguments-    passed to `dzen2` invocation. The behaviour of current `dzen` function is-    unchanged.--  * `XMonad.Util.Dzen`--    - Now provides functions `fgColor` and `bgColor` to specify foreground and-    background color, `align` and `slaveAlign` to set text alignment, and-    `lineCount` to enable a second (slave) window that displays lines beyond-    the initial (title) one.--  * `XMonad.Hooks.DynamicLog`--    - Added optional `ppVisibleNoWindows` to differentiate between empty-      and non-empty visible workspaces in pretty printing.--  * `XMonad.Actions.DynamicWorkspaceOrder`--    - Added `updateName` and `removeName` to better control ordering when-      workspace names are changed or workspaces are removed.--  * `XMonad.Config.Azerty`--    * Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY-      keyboards, which are slightly different from the French ones in the top-      row.--## 0.13 (February 10, 2017)--### Breaking Changes--  * The type of `completionKey` (of `XPConfig` record) has been-    changed from `KeySym` to `(KeyMask, KeySym)`. The default value-    for this is still bound to the `Tab` key.--  * New constructor `CenteredAt Rational Rational` added for-    `XMonad.Prompt.XPPosition`.--  * `XMonad.Prompt` now stores its history file in the XMonad cache-    directory in a file named `prompt-history`.--### New Modules--  * `XMonad.Layout.SortedLayout`--    A new LayoutModifier that sorts a given layout by a list of-    properties. The order of properties in the list determines-    the order of windows in the final layout. Any unmatched windows-    go to the end of the order.--  * `XMonad.Prompt.Unicode`--    A prompt to search a unicode character by its name, and put it into the-    clipboard.--  * `XMonad.Util.Ungrab`--    Release xmonad's keyboard and pointer grabs immediately, so-    screen grabbers and lock utilities, etc. will work. Replaces-    the short sleep hackaround.--  * `XMonad.Util.Loggers.NamedScratchpad`--    A collection of Loggers (see `XMonad.Util.Loggers`) for NamedScratchpads-    (see `XMonad.Util.NamedScratchpad`).--  * `XMonad.Util.NoTaskbar`--    Utility function and `ManageHook` to mark a window to be ignored by-    EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since-    you will usually be taken to the `NSP` workspace by them.--### Bug Fixes and Minor Changes--  * `XMonad.Hooks.ManageDocks`,--    - Fix a very annoying bug where taskbars/docs would be-      covered by windows.--    - Also fix a bug that caused certain Gtk and Qt application to-      have issues displaying menus and popups.--  * `XMonad.Layout.LayoutBuilder`--    Merge all functionality from `XMonad.Layout.LayoutBuilderP` into-    `XMonad.Layout.LayoutBuilder`.--  * `XMonad.Actions.WindowGo`--    - Fix `raiseNextMaybe` cycling between 2 workspaces only.--  * `XMonad.Actions.UpdatePointer`--    - Fix bug when cursor gets stuck in one of the corners.--  * `XMonad.Actions.DynamicProjects`--    - Switching away from a dynamic project that contains no windows-      automatically deletes that project's workspace.--      The project itself was already being deleted, this just deletes-      the workspace created for it as well.--    - Added function to change the working directory (`changeProjectDirPrompt`)--    - All of the prompts are now multiple mode prompts.  Try using the-      `changeModeKey` in a prompt and see what happens!--## 0.12 (December 14, 2015)--### Breaking Changes--  * `XMonad.Actions.UpdatePointer.updatePointer` arguments were-    changed. This allows including aspects of both of the-    `TowardsCentre` and `Relative` methods. To keep the same behavior,-    replace the entry in the left column with the entry on the right:--    | < 0.12                              |   >= 0.12                        |-    |-------------------------------------|----------------------------------|-    | `updatePointer Nearest`             | `updatePointer (0.5, 0.5) (1,1)` |-    | `updatePointer (Relative x y)`      | `updatePointer (x,y) (0,0)`      |-    | `updatePointer (TowardsCentre x y)` | `updatePointer (0.5,0.5) (x,y)`  |--### New Modules--  * `XMonad.Actions.AfterDrag`--    Perform an action after the current mouse drag is completed.--  * `XMonad.Actions.DynamicProjects`--    Imbues workspaces with additional features so they can be treated-    as individual project areas.--  * `XMonad.Actions.LinkWorkspaces`--    Provides bindings to add and delete links between workspaces. It-    is aimed at providing useful links between workspaces in a-    multihead setup. Linked workspaces are viewed at the same time.--  * `XMonad.Config.Bepo`--    This module fixes some of the keybindings for the francophone-    among you who use a BEPO keyboard layout. Based on-    `XMonad.Config.Azerty`--  * `XMonad.Config.Dmwit`--    Daniel Wagner's configuration.--  * `XMonad.Config.Mate`--    This module provides a config suitable for use with the MATE-    desktop environment.--  * `XMonad.Config.Prime`--    A draft of a brand new config syntax for xmonad.--  * `XMonad.Hooks.DynamicProperty`--    Module to apply a `ManageHook` to an already-mapped window when a-    property changes. This would commonly be used to match browser-    windows by title, since the final title will only be set after (a)-    the window is mapped, (b) its document has been loaded, (c) all-    load-time scripts have run.--  * `XMonad.Hooks.ManageDebug`--    A `manageHook` and associated `logHook` for debugging `ManageHook`s.-    Simplest usage: wrap your xmonad config in the `debugManageHook`-    combinator.  Or use `debugManageHookOn` for a triggerable version,-    specifying the triggering key sequence in `XMonad.Util.EZConfig`-    syntax. Or use the individual hooks in whatever way you see fit.--  * `XMonad.Hooks.WallpaperSetter`--    Log hook which changes the wallpapers depending on visible-    workspaces.--  * `XMonad.Hooks.WorkspaceHistory`--    Keeps track of workspace viewing order.--  * `XMonad.Layout.AvoidFloats`--    Find a maximum empty rectangle around floating windows and use-    that area to display non-floating windows.--  * `XMonad.Layout.BinarySpacePartition`--    Layout where new windows will split the focused window in half,-    based off of BSPWM.--  * `XMonad.Layout.Dwindle`--    Three layouts: The first, `Spiral`, is a reimplementation of-    `XMonad.Layout.Spiral.spiral` with, at least to me, more intuitive-    semantics.  The second, `Dwindle`, is inspired by a similar layout-    in awesome and produces the same sequence of decreasing window-    sizes as Spiral but pushes the smallest windows into a screen-    corner rather than the centre.  The third, `Squeeze` arranges all-    windows in one row or in one column, with geometrically decreasing-    sizes.--  * `XMonad.Layout.Hidden`--    Similar to `XMonad.Layout.Minimize` but completely removes windows-    from the window set so `XMonad.Layout.BoringWindows` isn't-    necessary.  Perfect companion to `XMonad.Layout.BinarySpacePartition`-    since it can be used to move windows to another part of the BSP tree.--  * `XMonad.Layout.IfMax`--    Provides `IfMax` layout, which will run one layout if there are-    maximum `N` windows on workspace, and another layout, when number-    of windows is greater than `N`.--  * `XMonad.Layout.PerScreen`--    Configure layouts based on the width of your screen; use your-    favorite multi-column layout for wide screens and a full-screen-    layout for small ones.--  * `XMonad.Layout.Stoppable`--    This module implements a special kind of layout modifier, which when-    applied to a layout, causes xmonad to stop all non-visible processes.-    In a way, this is a sledge-hammer for applications that drain power.-    For example, given a web browser on a stoppable workspace, once the-    workspace is hidden the web browser will be stopped.--  * `XMonad.Prompt.ConfirmPrompt`--    A module for setting up simple confirmation prompts for-    keybindings.--  * `XMonad.Prompt.Pass`--    This module provides 3 `XMonad.Prompt`s to ease passwords-    manipulation (generate, read, remove) via [pass][].--  * `XMonad.Util.RemoteWindows`--    This module implements a proper way of finding out whether the-    window is remote or local.--  * `XMonad.Util.SpawnNamedPipe`--    A module for spawning a pipe whose `Handle` lives in the xmonad state.--  * `XMonad.Util.WindowState`--    Functions for saving per-window data.--### Miscellaneous Changes--  * Fix issue #9: `XMonad.Prompt.Shell` `searchPredicate` is ignored,-    defaults to `isPrefixOf`--  * Fix moveHistory when alwaysHighlight is enabled--  * `XMonad.Actions.DynamicWorkspaceGroups` now exports `addRawWSGroup`--  * Side tabs were added to the tabbed layout--  * `XMonad/Layout/IndependentScreens` now exports `marshallSort`--  * `XMonad/Hooks/UrgencyHook` now exports `clearUrgency`--  * Exceptions are now caught when finding commands on `PATH` in `Prompt.Shell`--  * Switched to `Data.Default` wherever possible--  * `XMonad.Layout.IndependentScreens` now exports `whenCurrentOn`--  * `XMonad.Util.NamedActions` now exports `addDescrKeys'`--  * EWMH `DEMANDS_ATTENTION` support added to `UrgencyHook`--  * New `useTransientFor` modifier in `XMonad.Layout.TrackFloating`--  * Added the ability to remove arbitrary workspaces--## 0.9 (October 26, 2009)--### Updates that Require Changes in `xmonad.hs`--  * `XMonad.Hooks.EwmhDesktops` no longer uses `layoutHook`, the-    `ewmhDesktopsLayout` modifier has been removed from-    xmonad-contrib. It uses `logHook`, `handleEventHook`, and-    `startupHook` instead and provides a convenient function `ewmh` to-    add EWMH support to a `defaultConfig`.--  * Most `DynamicLog` users can continue with configs unchanged, but-    users of the quickbar functions `xmobar` or `dzen` will need to-    change `xmonad.hs`: their types have changed to allow easier-    composition with other `XConfig` modifiers. The `dynamicLogDzen`-    and `dynamicLogXmobar` functions have been removed.--  * `WindowGo` or `safeSpawn` users may need to change command lines-    due to `safeSpawn` changes.--  * People explicitly referencing the "SP" scratchpad workspace should-    change it to "NSP" which is also used by the new-    `Util.NamedScratchpad` module.--  * (Optional) People who explicitly use `swapMaster` in key or mouse-    bindings should change it to `shiftMaster`. It's the current-    default used where `swapMaster` had been used previously. It works-    better than `swapMaster` when using floating and tiled windows-    together on the same workspace.--## See Also--<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>--[pass]: http://www.passwordstore.org/+## 0.18.2 (March 7, 2026)++### Breaking Changes++  * Drop support for GHC 8.6++### New Modules++  * `XMonad.Util.StickyWindows`++    - Stick windows on screens so they follow you across desktops.++### Bug Fixes and Minor Changes++  * `XMonad.Actions.WindowBringer`++    - Make sure functions that internally use their `…Args` versions+      pass on the default `dmenu` arguments.++      These are also now exported as `defaultDMenuArgs` for users using+      the `…Args` versions but want to augment instead of replacing the+      default `dmenu` arguments.++      For users, the visible change will be that `bringMenu` and `copyMenu`+      now behave identically to `gotoMenu`, as expected, instead of being+      case sensitive. Users who might have been relying on the incorrect+      behavior should replace `*Menu` with `*MenuArgs []`.++  * `XMonad.Util.XSelection`++    - Added `getClipboard` to query the X clipboard.+      Also added `getSecondarySelection`.++  * `XMonad.Util.EZConfig`++    - Added `XF86WLAN` and `Menu` to the list of supported special keys.++  * `XMonad.Actions.DynamicProjects`++    - No longer autodelete projects when `switchProject` is called from+      an empty workspace. This also fixes a bug where static workspaces+      would be deleted when switching to a dynamic project.+    - Improved documentation on how to close a project.++  * `XMonad.Hooks.Rescreen`++    - Allow overriding the `rescreen` operation itself. Additionally, the+      `XMonad.Actions.PhysicalScreens` module now provides an alternative+      implementation of `rescreen` that avoids reshuffling the workspaces if+      the number of screens doesn't change and only their locations do (which+      is especially common if one uses `xrandr --setmonitor` to split an+      ultra-wide display in two).++    - Added an optional delay when waiting for events to settle. This may be+      used to avoid flicker and unnecessary workspace reshuffling if multiple+      `xrandr` commands are used to reconfigure the display layout.++  * `XMonad.Layout.NoBorders`++    - It's no longer necessary to use `borderEventHook` to garbage collect+      `alwaysHidden`/`neverHidden` lists. The layout listens to+      `DestroyWindowEvent` messages instead, which are broadcast to layouts+      since xmonad v0.17.0.++  * `XMonad.Hooks.EwmhDesktops`++    - Added a customization option for the action that gets executed when+      a client sends a **_NET_CURRENT_DESKTOP** request. It is now possible+      to change it using the `setEwmhSwitchDesktopHook`.+    - Added a customization option for mapping hidden workspaces to screens+      when setting the **_NET_DESKTOP_VIEWPORT**. This can be done using+      the `setEwmhHiddenWorkspaceToScreenMapping`.++    - Added support for **_NET_WM_STATE_{ABOVE,BELOW}** to place windows+      correctly.++  * `XMonad.Layout.IndependentScreens`++    - Added `focusWorkspace` for focusing workspaces on the screen that they+      belong to.+    - Added `doFocus'` hook as an alternative for `doFocus` when using+      IndependentScreens.+    - Added `screenOnMonitor` for getting the active screen for a monitor.++  * `XMonad.Util.NamedScratchPad`++    - Fix unintended window hiding in `nsSingleScratchpadPerWorkspace`.+      Only hide the previously active scratchpad.++  * `XMonad.Actions.Search`++    - Added `multiChar`, `combineChar`, and `prefixAwareChar` as+      slightly generalised versions of `prefixAware` and `(!>)` that+      allow specifying the character that separates a search engine's+      prefix with the query when combining engines.++    - Added the `ecosia` search engine.++  * `XMonad.Hooks.ManageDocks`++    - Added `onAllDocks` to run an action on all recognised docks.++## 0.18.1 (August 20, 2024)++### Breaking Changes++  * `XMonad.Hooks.StatusBars`++    - Move status bar functions from the `IO` to the `X` monad to+      allow them to look up information from `X`, like the screen+      width. Existing configurations may need to use `io` from+      `XMonad.Core` or `liftIO` from `Control.Monad.IO.Class` in+      order to lift any existing `IO StatusBarConfig` values into+      `X StatusBarConfig` values.++  * `XMonad.Prompt`++    - Added an additional `XPConfig` argument to `historyCompletion` and+      `historyCompletionP`. Calls along the lines of `historyCompletionP+      myFunc` should be changed to `historyCompletionP myConf myFunc`.+      If not `myConf` is lying around, `def` can be used instead.++  * `XMonad.Actions.GridSelect`++    - Added the `gs_cancelOnEmptyClick` field to `GSConfig`, which makes+      mouse clicks into "empty space" cancel the current grid-select.+      Users explicitly defining their own `GSConfig` record will have to+      add this to their definitions. Additionally, the field defaults to+      `True`—to retain the old behaviour, set it to `False`.++### New Modules++  * `XMonad.Actions.Profiles`++    - Group workspaces by similarity. Useful when one has lots+      of workspaces and uses only a couple per unit of work.++  * `XMonad.Hooks.FloatConfigureReq`++    - Customize handling of floating windows' move/resize/restack requests+      (ConfigureRequest). Useful as a workaround for some misbehaving client+      applications (Steam, rxvt-unicode, anything that tries to restore+      absolute position of floats).++  * `XMonad.Layout.Columns`++    - Organize windows in columns. This layout allows to move/resize windows in+      every directions.++  * `XMonad.Prompt.WindowBringer`++    - Added `copyMenu`, a convenient way to copy a window to the current workspace.++### Bug Fixes and Minor Changes++  * Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined.++  * `XMonad.Util.EZConfig`++    - Fixed `checkKeymap` warning that all keybindings are duplicates.++  * `XMonad.Hooks.ManageHelpers`++    - Added `isNotification` predicate to check for windows with+      `_NET_WM_WINDOW_TYPE` property of `_NET_WM_WINDOW_TYPE_NOTIFICATION`.++  * `XMonad.Prompt.OrgMode`++    - Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.++  * `XMonad.Prompt`++    - The history file is not extraneously read and written anymore if+      the `historySize` is set to 0.++  * `XMonad.Hooks.EwmhDesktops`++    - Requests for unmanaged windows no longer cause a refresh. This avoids+      flicker and also fixes disappearing menus in the Steam client and+      possibly a few other client applications.++      (See also `XMonad.Hooks.FloatConfigureReq` and/or `XMonad.Util.Hacks`+      for additional Steam client workarounds.)++  * `XMonad.Actions.Submap`++    - Added `visualSubmapSorted` to enable sorting of the keymap+      descriptions.++  * `XMonad.Hooks.ScreenCorners`++    - Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and+      `SCRight`. Now both corners and edges are supported.++  * `XMonad.Actions.WindowNavigation`++    - Improve navigation in presence of floating windows.+    - Handle window switching when in `Full` layout.++### Other changes++## 0.18.0 (February 3, 2024)++### Breaking Changes++  * Deprecated `XMonad.Layout.Cross` due to bitrot; refer to+    `XMonad.Layout.Circle` and `XMonad.Layout.ThreeColumns` for+    alternatives.++  * Deprecated the `XMonad.Layout.StateFull` module and+    `XMonad.Layout.TrackFloating.(t|T)rackFloating` in favour of+    `XMonad.Layout.FocusTracking`.++  * Dropped support for GHC 8.4.++  * `XMonad.Util.ExclusiveScratchpads`++    - Deprecated the module in favour of the (new) exclusive scratchpad+      functionality of `XMonad.Util.NamedScratchpad`.++  * `XMonad.Actions.CycleWorkspaceByScreen`++    - The type of `repeatableAction` has changed, and it's deprecated in+      favour of `X.A.Repeatable.repeatable`.++  * `XMonad.Hooks.DynamicProperty`++    - Deprecated the module in favour of the more aptly named+      `XMonad.Hooks.OnPropertyChange`.++  * `XMonad.Util.Scratchpad`:++    - Deprecated the module; use `XMonad.Util.NamedScratchpad` instead.++  * `XMonad.Actions.Navigation2D`++    - Removed deprecated function `hybridNavigation`.++  * `XMonad.Layout.Spacing`++    - Removed deprecated functions `SpacingWithEdge`, `SmartSpacing`,+      `SmartSpacingWithEdge`, `ModifySpacing`, `setSpacing`, and+      `incSpacing`.++  * `XMonad.Actions.MessageFeedback`++    - Removed deprecated functions `send`, `sendSM`, `sendSM_`,+      `tryInOrder`, `tryInOrder_`, `tryMessage`, and `tryMessage_`.++  * `XMonad.Prompt.Window`++    - Removed deprecated functions `windowPromptGoto`,+      `windowPromptBring`, and `windowPromptBringCopy`.++  * `XMonad.Hooks.ICCCMFocus`++    - Removed deprecated module.  This was merged into xmonad.++  * `XMonad.Layout.LayoutBuilderP`++    - Removed deprecated module; use `XMonad.Layout.LayoutBuilder`+      instead.++  * `XMonad.Hooks.RestoreMinimized`++    - Removed deprecated module; use `XMonad.Hooks.Minimize` instead.++  * `XMonad.Layout.Named`++    - Deprecated the entire module, use `XMonad.Layout.Renamed` (which newly+      provides `named` for convenience) instead.++  * `XMonad.Actions.SinkAll`++    - Deprecated the entire module, use `XMonad.Actions.WithAll`+      instead.++  * `XMonad.Layout.Circle`:++    - Deprecated the entire module, use the `circle` function from+      `XMonad.Layout.CircleEx` instead.++  * `XMonad.Hooks.EwmhDesktops`++    - `_NET_CLIENT_LIST_STACKING` puts windows in the current workspace at the+      top in bottom-to-top order, followed by visible workspaces, followed by+      invisible workspaces.  Within visible and invisible groups, workspaces are+      ordered lexicographically, as before.  Currently focused window will+      always be the topmost, meaning the last in the list.++  * `XMonad.Util.NamedScratchpad`++    - Added `nsSingleScratchpadPerWorkspace`—a logHook to allow only one+      active scratchpad per workspace.++  * `XMonad.Util.EZConfig`++    - The function `readKeySequence` now returns a non-empty list if it+      succeeded.++  * Deprecate `XMonad.Util.Ungrab`; it was moved to `XMonad.Operations`+    in core.++### New Modules++  * `XMonad.Layout.CenterMainFluid`+    - A three column layout with main column in the center and two stack+      column surrounding it. Master window will be on center column and+      spaces on the sides are reserved.++  * `XMonad.Layout.FocusTracking`.++    - Replaces `X.L.StateFull` and half of `X.L.TrackFloating`.++  * `XMonad.Actions.MostRecentlyUsed`++    - Tab through windows by recency of use. Based on the Alt+Tab behaviour+      common outside of xmonad.++  * `XMonad.Util.History`++    - Track history in *O(log n)* time. Provides `History`, a variation on a+      LIFO stack with a uniqueness property. In order to achieve the desired+      asymptotics, the data type is implemented as an ordered Map.++  * `XMonad.Actions.Repeatable`++    - Actions you'd like to repeat. Factors out the shared logic of+      `X.A.CycleRecentWS`, `X.A.CycleWorkspaceByScreen` and `X.A.CycleWindows`.++  * `XMonad.Hooks.OnPropertyChange`:++    - A new module replicating the functionality of+      `XMonad.Hooks.DynamicProperty`, but with more discoverable names.++  * `XMonad.Actions.ToggleFullFloat`:++    - Fullscreen (float) a window while remembering its original state.+      There's both an action to be bound to a key, and hooks that plug into+      `XMonad.Hooks.EwmhDesktops`.++  * `XMonad.Layout.CircleEx`:++    - A new window layout, similar to X.L.Circle, but with more+      possibilities for customisation.++  * `XMonad.Layout.DecorationEx`:++    - A new, more extensible, mechanism for window decorations, and some+      standard types of decorations, including usual bar on top of window,+      tabbed decorations and dwm-like decorations.++### Bug Fixes and Minor Changes++  * `XMonad.Layout.Magnifier`++    - Added `magnifyxy` to allow for different magnification in the+      horizontal and vertical directions. Added `magnifierxy`,+      `magnifierxy'`, `magnifierxyOff`, and `magnifierxyOff'` as+      particular combinators.++  * `XMonad.Util.Loggers`++    - Added `logClassname`, `logClassnames`, `logClassnames'`,+      `logClassnameOnScreen`, `logClassnamesOnScreen`, `logClassnamesOnScreen'`,+      and `ClassnamesFormat`. These are all equivalents of their `Title`+      counterparts, allowing logging the window classname instead.++  * `XMonad.Hooks.StatusBar.PP`++    - `dynamicLogString` now forces its result and produces an error string if+      it throws an exception. Use `dynamicLogString'` if for some reason you+      need the old behavior.++  * `XMonad.Util.EZConfig`++    - Added `remapKeysP`, which remaps keybindings from one binding to+      another.++    - Made `additionalKeys{,P}`, `removeKeys{,P}`, `remapKeysP`, and+      `{additional,remove}MouseBindings` `infixl 4` so they can more easily+      be concatenated with `(++)`.++  * `XMonad.Util.NamedScratchpad`++    - Added `addExclusives`, `resetFocusedNSP`, `setNoexclusive`,+      `resizeNoexclusive`, and `floatMoveNoexclusive` in order to augment+      named scratchpads with the exclusive scratchpad functionality of+      `XMonad.Util.ExclusiveScratchpads`.++  * `XMonad.Layout.BorderResize`++    - Added `borderResizeNear` as a variant of `borderResize` that can+      control how many pixels near a border resizing still works.++  * `XMonad.Util.Run`++    - It is now ensured that all arguments of `execute` and `eval` are+      quoted.  Likewise, `executeNoQuote` is added as a version of+      `execute` that does not do that.++    - Added `findFile` as a shorthand to call `find-file`.++    - Added `list` and `saveExcursion` to the list of Emacs commands.++    - Added `toList` to easily lift a `String` to an `X Input`.++    - Added `>&&>` and `>||>` to glue together different inputs.++  * `XMonad.Util.Parser`++    - Added the `gather`, `count`, `between`, `option`, `optionally`,+      `skipMany`, `skipMany1`, `chainr`, `chainr1`, `chainl`, `chainl1`,+      and `manyTill` functions, in order to achieve feature parity with+      `Text.ParserCombinators.ReadP`.++  * `XMonad.Actions.FloatKeys`++    - Added `directionMoveWindow` and `directionMoveWindow` as more+      alternatives to the existing functions.++  * `XMonad.Hooks.InsertPosition`++    - Added `setupInsertPosition` as a combinator alternative to+      `insertPosition`.++  * `XMonad.Actions.Navigation2D`++    - Added `sideNavigation` as a fallback to the default tiling strategy,+      in case `lineNavigation` can't find a window.  This benefits+      especially users who use `XMonad.Layout.Spacing`.++  * `XMonad.Prompt.OrgMode`++    - Added `orgPromptRefile` and `orgPromptRefileTo` for interactive+      and targeted refiling of the entered note into some existing tree+      of headings, respectively.++    - Allowed the time specification in `HHMM` format.++  * `XMonad.Actions.Search`++    - Added `aur`, `flora`, `ncatlab`, `protondb`, `rosettacode`, `sourcehut`,+      `steam`, `voidpgks_x86_64`, `voidpgks_x86_64_musl`, `arXiv`,+      `clojureDocs`, `cratesIo`, `rustStd`, `noogle`, `nixos`, `homeManager`,+      and `zbmath` search engines.++  * `XMonad.Layout.ResizableThreeColumns`++    - Fixed an issue where the bottom right window would not respond to+      `MirrorShrink` and `MirrorExpand` messages.++  * `XMonad.Hooks.EwmhDesktops`++    - Added `disableEwmhManageDesktopViewport` to avoid setting the+      `_NET_DESKTOP_VIEWPORT` property, as it can lead to issues with+      some status bars (see this+      [polybar issue](https://github.com/polybar/polybar/issues/2603)).++    - Added `setEwmhFullscreenHooks` to override the default fullfloat/sink+      behaviour of `_NET_WM_STATE_FULLSCREEN` requests. See also+      `XMonad.Actions.ToggleFullFloat` for a float-restoring implementation of+      fullscreening.++    - Added `ewmhDesktops(Maybe)ManageHook` that places windows in their+      preferred workspaces. This is useful when restoring a browser session+      after a restart.++  * `XMonad.Hooks.StatusBar`++    - Added `startAllStatusBars` to start the configured status bars.++  * `XMonad.Util.NamedActions`++    - Changed `addDescrKeys` and `addDescrKeys'` to not discard the+      keybindings in the current config.++  * `XMonad.Prompt`++    - The `emacsLikeXPKeymap` and `vimLikeXPKeymap` keymaps now treat+      `C-m` the same as `Return`.++    - Added `prevCompletionKey` to `XPConfig`, facilitating the ability+      to cycle through the completions backwards. This is bound to+      `S-<TAB>` by default.++    - The `vimLikeXPKeymap` now accepts the prompt upon pressing enter+      in normal mode.++  * `XMonad.Actions.Prefix`++    - Added `orIfPrefixed`, a combinator to decide upon an action based+      on whether any prefix argument was given.++  * `XMonad.Actions.WorkspaceNames`++    - Enabled prompt completion (from history) in `renameWorkspace`.++  * `XMonad.Prompt.Pass`++    - Added `passOTPTypePrompt` to type out one-time-passwords via+      `xdotool`.++  * `XMonad.Util.Stack`++    - Added `zipperFocusedAtFirstOf` to differentiate two lists into a+      zipper.++## 0.17.1 (September 3, 2022)++### Breaking Changes++  * `XMonad.Util.EZConfig`++    - The functions `parseKey`, `parseKeyCombo`, and `parseKeySequence`+      now return a `Parser` (from `XMonad.Util.Parser`) instead of a+      `ReadP`.++  * `XMonad.Config.{Arossato,Dmwit,Droundy,Monad,Prime,Saegesser,Sjanssen}`++    - Deprecated all of these modules.  The user-specific configuration+      modules may still be found [on the+      website](https://xmonad.org/configurations.html)++  * `XMonad.Util.NamedScratchpad`++    - Scratchpads are now only based on the argument given to+      `namedScratchpadManageHook`; all other scratchpad arguments are,+      while still present, ignored.  Users passing all of their+      scratchpads to functions like `namedScratchpadAction` (as is shown+      in the module's documentation) should _not_ notice any difference+      in behaviour.++  * `XMonad.Util.DynamicScratchpads`++    - Deprecated the module; use the new dynamic scratchpad+      functionality of `XMonad.Util.NamedScratchpad` instead.++  * `XMonad.Hooks.UrgencyHook`++    - Deprecated `urgencyConfig`; use `def` from the new `Default`+      instance of `UrgencyConfig` instead.++### New Modules++  * `XMonad.Actions.PerLayoutKeys`++    Customizes a keybinding on a per-layout basis. Based on PerWorkspaceKeys.++  * `XMonad.Layout.CenteredIfSingle`++    Layout modifier that, if only a single window is on screen, places that window+    in the middle of the screen.++  * `XMonad.Util.ActionQueue`++    Put XMonad actions in the queue to be executed every time the+    `logHook` (or, alternatively, a hook of your choice) runs.++  * `XMonad.Hooks.BorderPerWindow`++    While XMonad provides config to set all window borders at the same+    width, this extension lets user set border width for a specific window+    using a ManageHook.++  * `XMonad.Util.Parser`++    A wrapper around the 'ReadP' parser combinator, providing behaviour+    that's closer to the more popular parser combinator libraries.++  * `XMonad.Hooks.StatusBar.WorkspaceScreen`++    In multi-head setup, it might be useful to have screen information of the+    visible workspaces combined with the workspace name, for example in a status+    bar. This module provides utility functions to do just that.++  * `XMonad.Hooks.ShowWName`++    Flashes the name of the current workspace when switching to it.+    Like `XMonad.Layout.ShowWName`, but as a logHook.++  * `XMonad.Actions.RepeatAction`++    A module for adding a keybinding to repeat the last action, similar+    to Vim's `.` or Emacs's `dot-mode`.++  * `XMonad.Util.Grab`++    Utilities for making grabbing and ungrabbing keys more convenient.++  * `XMonad.Hooks.Modal`++    This module implements modal keybindings for xmonad.++  * `XMonad.Layout.SideBorderDecoration`++    This module allows for having a configurable border position around+    windows; i.e., it can move the border to either cardinal direction.++### Bug Fixes and Minor Changes++  * `XMonad.Prompt.Pass`++    - Added new versions of the `pass` functions that allow user-specified+      prompts.++  * `XMonad.Prompt.AppendFile`++    - Use `XMonad.Prelude.mkAbsolutePath` to force names to be relative to the+      home directory and support `~/` prefixes.++  * `XMonad.Prompt.OrgMode`++    - Fixed the date parsing issue such that entries with a format of+      `todo +d 12 02 2024` work.++    - Added the ability to specify alphabetic (`#A`, `#B`, and `#C`)+      [priorities](https://orgmode.org/manual/Priorities.html) at the end of+      the input note.++  * `XMonad.Prompt.Unicode`++    - Fixed the display of non-ASCII characters in the description of Unicode+      characters++  * `XMonad.Prompt`++    - Added `transposeChars` to interchange the characters around the+      point and bound it to `C-t` in the Emacs XPKeymaps.++    - Added xft-based font fallback support.  This may be used by+      appending other fonts to the given string:+      `xft:iosevka-11,FontAwesome-9`.  Note that this requires+      `xmonad-contrib` to be compiled with `X11-xft` version 0.3.4 or+      higher.++  * `XMonad.Hooks.WindowSwallowing`++    - Fixed windows getting lost when used in conjunction with+      `smartBorders` and a single window.++    - No longer needs `pstree` to detect child/parent relationships.++    - Fixed some false positives in child/parent relationship detection.++  * `XMonad.Actions.SpawnOn`++    - Fixed parsing of `/proc/*/stat` to correctly handle complex process names.++  * `XMonad.Util.EZConfig`++    - Added support for Modifier Keys `KeySym`s for Emacs-like `additionalKeysP`.++  * `XMonad.Hooks.ManageHelpers`++    - Flipped how `(^?)`, `(~?)`, and `($?)` work to more accurately+      reflect how one uses these operators.++    - Added `isMinimized`++  * `XMonad.Actions.WindowNavigation`++    -  Fixed navigation getting "stuck" in certain situations for+       widescreen resolutions.++  * `XMonad.Layout.BinarySpacePartition`++    - Hidden windows are now ignored by the layout so that hidden windows in+      the stack don't offset position calculations in the layout.++  * `XMonad.Layout.MagicFocus`++    - The focused window will always be at the master area in the stack being+      passed onto the modified layout, even when focus leaves the workspace+      using the modified layout.++  * `XMonad.Actions.TreeSelect`++    - Added xft-based font fallback support.  This may be used by+      appending other fonts to the given string:+      `xft:iosevka-11,FontAwesome-9`.  Note that this requires+      `xmonad-contrib` to be compiled with `X11-xft` version 0.3.4 or+      higher.++  * `XMonad.Actions.FloatKeys`++    - Changed type signature of `keysMoveWindow` from `D -> Window -> X ()`+      to `ChangeDim -> Window -> X ()` to allow negative numbers without compiler warnings.++  * `XMonad.Util.Hacks`++    - Added `trayerPaddingXmobarEventHook` (plus generic variants for other+      trays/panels) to communicate trayer resize events to XMobar so that+      padding space may be reserved on xmobar for the tray.  Requires `xmobar`+      version 0.40 or higher.++  * `XMonad.Layout.VoidBorders`++    - Added new layout modifier `normalBorders` which can be used for+      resetting borders back in layouts where you want borders after calling+      `voidBorders`.++  * `XMonad.Prelude`++    - Added `keymaskToString` and `keyToString` to show a key mask and a+      key in the style of `XMonad.Util.EZConfig`.++    - Added `WindowScreen`, which is a type synonym for the specialized `Screen`+      type, that results from the `WindowSet` definition in `XMonad.Core`.++    - Modified `mkAbsolutePath` to support a leading environment variable, so+      things like `$HOME/NOTES` work. If you want more general environment+      variable support, comment on [this+      PR](https://github.com/xmonad/xmonad-contrib/pull/744)++  * `XMonad.Util.XUtils`++    - Added `withSimpleWindow`, `showSimpleWindow`, `WindowConfig`, and+      `WindowRect` in order to simplify the handling of simple popup+      windows.++  * `XMonad.Actions.Submap`++    - Added `visualSubmap` to visualise the available keys and their+      actions when inside a submap.++  * `XMonad.Prompt`, `XMonad.Actions.TreeSelect`, `XMonad.Actions.GridSelect`++    - Key bindings now behave similarly to xmonad core:+      State of mouse buttons and XKB layout groups is ignored.+      Translation of key codes to symbols ignores modifiers, so `Shift-Tab` is+      now just `(shiftMap, xK_Tab)` instead of `(shiftMap, xK_ISO_Left_Tab)`.++  * `XMonad.Util.NamedScratchpad`++    - Added support for dynamic scratchpads in the form of+      `dynamicNSPAction` and `toggleDynamicNSP`.++  * `XMonad.Hooks.EwmhDesktops`++    - Added support for `_NET_DESKTOP_VIEWPORT`, which is required by+      some status bars.++  * `XMonad.Util.Run`++    - Added an EDSL—particularly geared towards programs like terminals+      or Emacs—to spawn processes from XMonad in a compositional way.++  * `XMonad.Hooks.UrgencyHook`++    - Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`.++### Other changes++  * Migrated the sample build scripts from the deprecated `xmonad-testing` repo to+    `scripts/build`. This will be followed by a documentation update in the `xmonad`+    repo.++## 0.17.0 (October 27, 2021)++### Breaking Changes++  * All modules that export bitmap fonts as their default++    - If xmonad is compiled with XFT support (the default), use an XFT+      font instead.  The previous default expected an X11 misc font+      (PCF), which is not supported in pango 1.44 anymore and thus some+      distributions have stopped shipping these.++      This fixes the silent `user error (createFontSet)`; this would+      break the respective modules.++  * `XMonad.Prompt`++    - Now `mkComplFunFromList` and `mkComplFunFromList'` take an+      additional `XPConfig` argument, so that they can take into+      account the given `searchPredicate`.++    - A `complCaseSensitivity` field has been added to `XPConfig`, indicating+      whether case-sensitivity is desired when performing completion.++    - `historyCompletion` and `historyCompletionP` now both have an `X`+      constraint (was: `IO`), due to changes in how the xmonad core handles XDG+      directories.++    - The prompt window now sets a `WM_CLASS` property.  This allows+      other applications, like compositors, to properly match on it.++  * `XMonad.Hooks.EwmhDesktops`++    - It is no longer recommended to use `fullscreenEventHook` directly.+      Instead, use `ewmhFullscreen` which additionally advertises fullscreen+      support in `_NET_SUPPORTED` and fixes fullscreening of applications that+      explicitly check it, e.g. mupdf-gl, sxiv, …++      `XMonad.Layout.Fullscreen.fullscreenSupport` now advertises it as well,+      and no configuration changes are required in this case.++    - Deprecated `ewmhDesktopsLogHookCustom` and `ewmhDesktopsEventHookCustom`;+      these are now replaced by a composable `XMonad.Util.ExtensibleConf`-based+      interface. Users are advised to just use the `ewmh` XConfig combinator+      and customize behaviour using the provided `addEwmhWorkspaceSort`,+      `addEwmhWorkspaceRename` functions, or better still, use integrations+      provided by modules such as `XMonad.Actions.WorkspaceNames`.++      This interface now additionally allows customization of what happens+      when clients request window activation. This can be used to ignore+      activation of annoying applications, to mark windows as urgent instead+      of focusing them, and more. There's also a new `XMonad.Hooks.Focus`+      module extending the ManageHook EDSL with useful combinators.++    - Ordering of windows that are set to `_NET_CLIENT_LIST` and `_NET_CLIENT_LIST_STACKING`+      was changed to be closer to the spec. From now these two lists will have+      differently sorted windows.++    - `_NET_WM_STATE_DEMANDS_ATTENTION` was added to the list of supported+      hints (as per `_NET_SUPPORTED`). This hint has long been understood by+      `UrgencyHook`. This enables certain applications (e.g. kitty terminal+      emulator) that check whether the hint is supported to use it.++  * All modules still exporting a `defaultFoo` constructor++    - All of these were now removed. You can use the re-exported `def` from+      `Data.Default` instead.++  * `XMonad.Hooks.Script`++    - `execScriptHook` now has an `X` constraint (was: `MonadIO`), due to changes+      in how the xmonad core handles XDG directories.++  * `XMonad.Actions.WorkspaceNames`++    - The type of `getWorkspaceNames` was changed to fit into the new `ppRename`+      field of `PP`.++  * `XMonad.Hooks.StatusBar`, `XMonad.Hooks.StatusBar.PP` (previously+    `XMonad.Hooks.DynamicLog`) and `XMonad.Util.Run`++    - `spawnPipe` no longer uses binary mode handles but defaults to the+      current locale encoding instead.++      `dynamicLogString`, the output of which usually goes directly into such+      a handle, no longer encodes its output in UTF-8, but returns a normal+      `String` of Unicode codepoints instead.++      When these two are used together, everything should continue to work as+      it always has, but in isolation behaviour might change.++      (To get the old `spawnPipe` behaviour, `spawnPipeWithNoEncoding` can now+      be used, and `spawnPipeWithUtf8Encoding` was added as well to force+      UTF-8 regardless of locale. These shouldn't normally be necessary, though.)++    - `xmonadPropLog` and `xmonadPropLog'` now encode the String in UTF-8.+      Again, no change when used together with `dynamicLogString`, but other+      uses of these in user configs might need to be adapted.++  * `XMonad.Actions.TopicSpace`++    - Deprecated the `maxTopicHistory` field, as well as the+      `getLastFocusedTopics` and `setLastFocusedTopic` functions.  It is+      now recommended to directly use `XMonad.Hooks.WorkspaceHistory`+      instead.++    - Added `TopicItem`, as well as the helper functions `topicNames`,+      `tiActions`, `tiDirs`, `noAction`, and `inHome` for a more+      convenient specification of topics.++  * `XMonad.Actions.CycleRecentWS`++    - Changed the signature of `recentWS` to return a `[WorkspaceId]`+      instead of a `[WindowSet]`, while `cycleWindowSets` and+      `toggleWindowSets` now take a function `WindowSet ->+      [WorkspaceId]` instead of one to `[WindowSet]` as their first+      argument.  This fixes the interplay between this module and any+      layout that stores state.++  * `XMonad.Layout.LayoutCombinators`++    - Moved the alternative `(|||)` function and `JumpToLayout` to the+      xmonad core.  They are re-exported by the module, but do not add any+      new functionality.  `NewSelect` now exists as a deprecated type+      alias to `Choose`.++    - Removed the `Wrap` and `NextLayoutNoWrap` data constructors.++  - `XMonad.Actions.CycleWS`++    - Deprecated `EmptyWS`, `HiddenWS`, `NonEmptyWS`, `HiddenNonEmptyWS`,+      `HiddenEmptyWS`, `AnyWS` and `WSTagGroup`.++  - `XMonad.Actions.GridSelect`++    - `colorRangeFromClassName` now uses different hash function,+      so colors of inactive window tiles will be different (but still inside+      the provided color range).++  * `XMonad.Actions.Search`++    - Removed outdated `isohunt` search engine.++    - Updated URLs for `codesearch`, `openstreetmap`, and `thesaurus`+      search engines.++    - Added `github` search engine.++### New Modules++  * `XMonad.Layout.FixedAspectRatio`++    Layout modifier for user provided per-window aspect ratios.++  * `XMonad.Hooks.TaffybarPagerHints`++    Add a module that exports information about XMonads internal state that is+    not available through EWMH that is used by the taffybar status bar.++  * `XMonad.Hooks.StatusBar.PP`++    Originally contained inside `XMonad.Hooks.DynamicLog`, this module provides the+    pretty-printing abstraction and utilities, used primarly with `logHook`.++    Below are changes from `XMonad.Hooks.DynamicLog`, that now are included in+    this module:++    - Added `shortenLeft` function, like existing `shorten` but shortens by+      truncating from left instead of right. Useful for showing directories.++    - Added `shorten'` and `shortenLeft'` functions with customizable overflow+      markers.++    - Added `filterOutWsPP` for filtering out certain workspaces from being+      displayed.++    - Added `xmobarBorder` for creating borders around strings and+      `xmobarFont` for selecting an alternative font.++    - Added `ppRename` to `PP`, which makes it possible for extensions like+      `workspaceNamesPP`, `marshallPP` and/or `clickablePP` (which need to+      access the original `WorkspaceId`) to compose intuitively.++    - Added `ppPrinters`, `WSPP` and `fallbackPrinters` as a generalization of+      the `ppCurrent`, `ppVisible`… sextet, which makes it possible for+      extensions like `copiesPP` (which acts as if there was a+      `ppHiddenWithCopies`) to compose intuitively.++  * `XMonad.Hooks.StatusBar`++    This module provides a new interface that replaces `XMonad.Hooks.DynamicLog`,+    by providing composoble status bars. Supports property-based as well+    as pipe-based status bars.++  * `XMonad.Util.Hacks`++    A collection of hacks and fixes that should be easily acessible to users:++    - `windowedFullscreenFix` fixes fullscreen behaviour of chromium based+      applications when using windowed fullscreen.++    - `javaHack` helps when dealing with Java applications that might not work+      well with xmonad.++    - `trayerAboveXmobarEventHook` reliably stacks trayer on top of xmobar and+      below other windows++  * `XMonad.Util.ActionCycle`++    A module providing a simple way to implement "cycling" `X` actions,+    useful for things like alternating toggle-style keybindings.++  * `XMonad.Actions.RotateSome`++    Functions for rotating some elements around the stack while keeping others+    anchored in place. Useful in combination with layouts that dictate window+    visibility based on stack position, such as `XMonad.Layout.LimitWindows`.++    Export `surfaceNext` and `surfacePrev` actions, which treat the focused window+    and any hidden windows as a ring that can be rotated through the focused position.++    Export `rotateSome`, a pure function that rotates some elements around a stack+    while keeping others anchored in place.++  * `XMonad.Actions.Sift`++    Provide `siftUp` and `siftDown` actions, which behave like `swapUp` and `swapDown`+    but handle the wrapping case by exchanging the windows at either end of the stack+    instead of rotating the stack.++  * `XMonad.Hooks.DynamicIcons`++    Dynamically augment workspace names logged to a status bar via DynamicLog+    based on the contents (windows) of the workspace.++  * `XMonad.Hooks.WindowSwallowing`++    HandleEventHooks that implement window swallowing or sublayouting:+    Hide parent windows like terminals when opening other programs (like image viewers) from within them,+    restoring them once the child application closes.++  * `XMonad.Actions.TiledWindowDragging`++    An action that allows you to change the position of windows by dragging them around.++  * `XMonad.Layout.ResizableThreeColumns`++    A layout based on `XMonad.Layout.ThreeColumns` but with each slave window's+    height resizable.++  * `XMonad.Layout.TallMastersCombo`++    A layout combinator that support Shrink, Expand, and IncMasterN just as+    the `Tall` layout, and also support operations of two master windows:+    a main master, which is the original master window;+    a sub master, the first window of the second pane.+    This combinator can be nested, and has a good support for using+    `XMonad.Layout.Tabbed` as a sublayout.++  * `XMonad.Actions.PerWindowKeys`++    Create actions that run on a `Query Bool`, usually associated with+    conditions on a window, basis. Useful for creating bindings that are+    excluded or exclusive for some windows.++  * `XMonad.Util.DynamicScratchpads`++    Declare any window as a scratchpad on the fly. Once declared, the+    scratchpad behaves like `XMonad.Util.NamedScratchpad`.++  * `XMonad.Prompt.Zsh`++    A version of `XMonad.Prompt.Shell` that lets you use completions supplied by+    zsh.++  * `XMonad.Util.ClickableWorkspaces`++    Provides `clickablePP`, which when applied to the `PP` pretty-printer used by+    `XMonad.Hooks.StatusBar.PP`, will make the workspace tags clickable in XMobar+    (for switching focus).++  * `XMonad.Layout.VoidBorders`++    Provides a modifier that semi-permanently (requires manual intervention)+    disables borders for windows from the layout it modifies.++  * `XMonad.Hooks.Focus`++    Extends ManageHook EDSL to work on focused windows and current workspace.++  * `XMonad.Config.LXQt`++    This module provides a config suitable for use with the LXQt desktop+    environment.++  * `XMonad.Prompt.OrgMode`++    A prompt for interacting with [org-mode](https://orgmode.org/).  It+    can be used to quickly save TODOs, NOTEs, and the like with the+    additional capability to schedule/deadline a task, or use the+    primary selection as the contents of the note.++  * `XMonad.Util.ExtensibleConf`++    Extensible and composable configuration for contrib modules. Allows+    contrib modules to store custom configuration values inside `XConfig`.+    This lets them create custom hooks, ensure they hook into xmonad core only+    once, and possibly more.++  * `XMonad.Hooks.Rescreen`++    Custom hooks for screen (xrandr) configuration changes. These can be used+    to restart/reposition status bars or systrays automatically after xrandr,+    as well as to actually invoke xrandr or autorandr when an output is+    (dis)connected.++  * `XMonad.Actions.EasyMotion`++    A new module that allows selection of visible screens using a key chord.+    Inspired by [vim-easymotion](https://github.com/easymotion/vim-easymotion). See the animation+    in the vim-easymotion repo to get some idea of the functionality of this+    EasyMotion module.++### Bug Fixes and Minor Changes++  * Add support for GHC 9.0.1.++  * `XMonad.Actions.WithAll`++    - Added `killOthers`, which kills all unfocused windows on the+      current workspace.++  * `XMonad.Prompt.XMonad`++    - Added `xmonadPromptCT`, which allows you to create an XMonad+      prompt with a custom title.++  * `XMonad.Actions.DynamicWorkspaceGroups`++    - Add support for `XMonad.Actions.TopicSpace` through `viewTopicGroup` and+      `promptTopicGroupView`.++  * `XMonad.Actions.TreeSelect`++    - Fix swapped green/blue in foreground when using Xft.++    - The spawned tree-select window now sets a `WM_CLASS` property.+      This allows other applications, like compositors, to properly+      match on it.++  * `XMonad.Layout.Fullscreen`++    - Add fullscreenSupportBorder which uses smartBorders to remove+      window borders when the window is fullscreen.++  * `XMonad.Config.Mate`++    - Split out the logout dialog and add a shutdown dialog. The default behavior+      remains the same but there are now `mateLogout` and `mateShutdown` actions+      available.++    - Add mod-d keybinding to open the Mate main menu.++  * `XMonad.Actions.DynamicProjects`++    - The `changeProjectDirPrompt` function respects the `complCaseSensitivity` field+      of `XPConfig` when performing directory completion.++    - `modifyProject` is now exported.++  * `XMonad.Layout.WorkspaceDir`++    - The `changeDir` function respects the `complCaseSensitivity` field of `XPConfig`+      when performing directory completion.++    - `Chdir` message is exported, so it's now possible to change the+      directory programmaticaly, not just via a user prompt.++  * `XMonad.Prompt.Directory`++    - Added `directoryMultipleModes'`, like `directoryMultipleModes` with an additional+     `ComplCaseSensitivity` argument.++    - Directory completions are now sorted.++    - The `Dir` constructor now takes an additional `ComplCaseSensitivity`+      argument to indicate whether directory completion is case sensitive.++  * `XMonad.Prompt.FuzzyMatch`++    - `fuzzySort` will now accept cases where the input is not a subsequence of+      every completion.++  * `XMonad.Prompt.Shell`++    - Added `getShellCompl'`, like `getShellCompl` with an additional `ComplCaseSensitivity`+      argument.++    - Added `compgenDirectories` and `compgenFiles` to get the directory/filename completion+      matches returned by the compgen shell builtin.++    - Added `safeDirPrompt`, which is like `safePrompt`, but optimized+      for the use-case of a program that needs a file as an argument.++  * `XMonad.Prompt.Unicode`++    - Reworked internally to call `spawnPipe` (asynchronous) instead of+      `runProcessWithInput` (synchronous), which fixes `typeUnicodePrompt`.++    - Now respects `searchPredicate` and `sorter` from user-supplied `XPConfig`.++  * `XMonad.Hooks.DynamicLog`++    - Added `xmobarProp`, for property-based alternative to `xmobar`.++    - Add the -dock argument to the dzen spawn arguments++    - The API for this module is frozen: this is now a compatibility wrapper.++    - References for this module are updated to point to `X.H.StatusBar` or+      `X.H.StatusBar.PP`++  * `XMonad.Layout.BoringWindows`++    - Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions.++    - Added `markBoringEverywhere` function, to mark the currently+      focused window boring on all layouts, when using `XMonad.Actions.CopyWindow`.++  * `XMonad.Util.NamedScratchpad`++     - Added two new exported functions to the module:+         - `customRunNamedScratchpadAction`+             (provides the option to customize the `X ()` action the scratchpad is launched by)+         - `spawnHereNamedScratchpadAction`+             (uses `XMonad.Actions.SpawnOn.spawnHere` to initially start the scratchpad on the workspace it was launched on)++     - Deprecated `namedScratchpadFilterOutWorkspace` and+       `namedScratchpadFilterOutWorkspacePP`.  Use+       `XMonad.Util.WorkspaceCompare.filterOutWs` respectively+       `XMonad.Hooks.DynamicLog.filterOutWsPP` instead.++     - Exported the `scratchpadWorkspaceTag`.++     - Added a new logHook `nsHideOnFocusLoss` for hiding scratchpads+       when they lose focus.++  * `XMonad.Prompt.Window`++    - Added `allApplications` function which maps application executable+      names to its underlying window.++    - Added a `WithWindow` constructor to `WindowPrompt` to allow executing+      actions of type `Window -> X ()` on the chosen window.++  * `XMonad.Prompt.WindowBringer`++    - Added `windowAppMap` function which maps application executable+      names to its underlying window.++    - A new field `windowFilter` was added to the config, which allows the user+      to provide a function which will decide whether each window should be+      included in the window bringer menu.++  * `XMonad.Actions.Search`++    - The `hoogle` function now uses the new URL `hoogle.haskell.org`.++    - Added `promptSearchBrowser'` function to only suggest previous searches of+      the selected search engine (instead of all search engines).++  * `XMonad.Layout.MouseResizableTile`++    - When we calculate dragger widths, we first try to get the border width of+      the focused window, before failing over to using the initial `borderWidth`.++  * `XMonad.Actions.CycleRecentWS`++    - Added `cycleRecentNonEmptyWS` function which behaves like `cycleRecentWS`+      but is constrainded to non-empty workspaces.++    - Added `toggleRecentWS` and `toggleRecentNonEmptyWS` functions which toggle+      between the current and most recent workspace, and continue to toggle back+      and forth on repeated presses, rather than cycling through other workspaces.++    - Added `recentWS` function which allows the recency list to be filtered with+      a user-provided predicate.++  * `XMonad.Layout.Hidden`++    - Export `HiddenWindows` type constructor.++    - Export `popHiddenWindow` function restoring a specific window.++  * `XMonad.Hooks.ManageDocks`++    - Export `AvoidStruts` constructor++    - Restored compatibility with pre-0.13 configs by making the startup hook+      unnecessary for correct functioning (strut cache is initialized on-demand).++      This is a temporary measure, however. The individual hooks are now+      deprecated in favor of the `docks` combinator, `xmonad --recompile` now+      reports deprecation warnings, and the hooks will be removed soon.++    - Fixed ignoring of strut updates from override-redirect windows, which is+      default for xmobar.++      Previously, if one wanted xmobar to reposition itself after xrandr+      changes and have xmonad handle that repositioning, one would need to+      configure xmobar with `overrideRedirect = False`, which would disable+      lowering on start and thus cause other problems. This is no longer+      necessary.++  * `XMonad.Hooks.ManageHelpers`++    - Export `doSink`++    - Added `doLower` and `doRaise`++    - Added `shiftToSame` and `clientLeader` which allow a hook to be created+      that shifts a window to the workspace of other windows of the application+      (using either the `WM_CLIENT_LEADER` or `_NET_WM_PID` property).++    - Added `windowTag`++    - Added `(^?)`, `(~?)` and `($?)` operators as infix versions of `isPrefixOf`, `isInfixOf`+      and `isSuffixOf` working with `ManageHook`s.++  * `XMonad.Util.EZConfig`++    - Added support for XF86Bluetooth.++  * `XMonad.Util.Loggers`++    - Make `battery` and `loadAvg` distro-independent.++    - Added `logTitleOnScreen`, `logCurrentOnScreen` and `logLayoutOnScreen`+      as screen-specific variants of `logTitle`, `logCurrent` and `logLayout`.++    - Added `logWhenActive` to have loggers active only when a certain+      screen is active.++    - Added `logConst` to log a constant `String`, and `logDefault` (infix: `.|`)+      to combine loggers.++    - Added `logTitles` to log all window titles (focused and unfocused+      ones) on the focused workspace, as well as `logTitlesOnScreen` as+      a screen-specific variant thereof.++    - Added `logTitles'` and `logTitleOnScreen'`.  These act like+      `logTitles` and `logTitlesOnScreen` but use a record as an input+      to enable logging for more window types.  For example, currently+      urgent windows are additionally supported.++  * `XMonad.Layout.Minimize`++    - Export `Minimize` type constructor.++  * `XMonad.Actions.WorkspaceNames`++    - Added `workspaceNamesEwmh` which makes workspace names visible to+      external pagers.++  * `XMonad.Util.PureX`++    - Added `focusWindow` and `focusNth` which don't refresh (and thus+      possibly flicker) when they happen to be a no-op.++    - Added `shiftWin` as a refresh tracking version of `W.shiftWin`.++  * Several `LayoutClass` instances now have an additional `Typeable`+    constraint which may break some advanced configs. The upside is that we+    can now add `Typeable` to `LayoutClass` in `XMonad.Core` and make it+    possible to introspect the current layout and its modifiers.++  * `XMonad.Actions.TopicSpace`++    - `switchTopic` now correctly updates the last used topics.++    - `setLastFocusedTopic` will now check whether we have exceeded the+      `maxTopicHistory` and prune the topic history as necessary, as well as+      cons the given topic onto the list __before__ filtering it.++    - Added `switchNthLastFocusedExclude`, which works like+      `switchNthLastFocused` but is able to exclude certain topics.++    - Added `switchTopicWith`, which works like `switchTopic`, but one is able+      to give `setLastFocusedTopic` a custom filtering function as well.++    - Instead of a hand-rolled history, use the one from+      `XMonad.Hooks.WorkspaceHistory`.++    - Added the screen-aware functions `getLastFocusedTopicsByScreen` and+      `switchNthLastFocusedByScreen`.++  * `XMonad.Hooks.WorkspaceHistory`++    - Added `workspaceHistoryModify` to modify the workspace history with a pure+      function.++    - Added `workspaceHistoryHookExclude` for excluding certain+      workspaces to ever enter the history.++  * `XMonad.Util.DebugWindow`++    - Fixed a bottom in `debugWindow` when used on windows with UTF8 encoded titles.++  * `XMonad.Config.Xfce`++    - Set `terminal` to `xfce4-terminal`.++  * `XMonad.Hooks.WorkspaceCompare`++    - Added `filterOutWs` for workspace filtering.++  * `XMonad.Prompt`++    - Accommodate completion of multiple words even when `alwaysHighlight` is+      enabled.++    - Made the history respect words that were "completed" by `alwaysHighlight`+      upon confirmation of the selection by the user.++    - Fixed a crash when focusing a new window while the prompt was up+      by allowing pointer events to pass through the custom prompt event+      loop.++    - The prompt now cycles through its suggestions if one hits the ends+      of the suggestion list and presses `TAB` again.++    - Added `maxComplColumns` field to `XPConfig`, to limit the number of+      columns in the completion window.++    - Redefine `ComplCaseSensitivity` to a proper sum type as opposed to+      a `newtype` wrapper around `Bool`.++  * `XMonad.Actions.TreeSelect`++    - Fixed a crash when focusing a new window while the tree select+      window was up by allowing pointer events to pass through the+      custom tree select event loop.++  * `XMonad.Layout.NoBorders`++    - Fixed handling of floating window borders in multihead setups that was+      broken since 0.14.++    - Added `OnlyFloat` constructor to `Ambiguity` to unconditionally+      remove all borders on floating windows.++  * `XMonad.Hooks.UrgencyHook`++    - It's now possible to clear urgency of selected windows only using the+      newly exported `clearUrgents'` function. Also, this and `clearUrgents`+      now clear the `_NET_WM_STATE_DEMANDS_ATTENTION` bit as well.++    - Added a variant of `filterUrgencyHook` that takes a generic `Query Bool`+      to select which windows should never be marked urgent.++    - Added `askUrgent` and a `doAskUrgent` manage hook helper for marking+      windows as urgent from inside of xmonad. This can be used as a less+      intrusive action for windows requesting focus.++  * `XMonad.Hooks.ServerMode`++    - To make it easier to use, the `xmonadctl` client is now included in+      `scripts/`.++  * `XMonad.Layout.TrackFloating`++    - Fixed a bug that prevented changing focus on inactive workspaces.++  * `XMonad.Layout.Magnifier`++    - Added `magnifierczOff` and `magnifierczOff'` for custom-size+      magnifiers that start out with magnifying disabled.++    - Added `magnify` as a more general combinator, including the+      ability to postpone magnifying until there are a certain number of+      windows on the workspace.++  * `XMonad.Layout.Renamed`++    - Added `KeepWordsLeft` and `KeepWordsRight` for keeping certain number of+      words in left or right direction in layout description.++  * `XMonad.Hooks.WallpaperSetter`++    - Added `defWPNamesPng`, which works like `defWPNames` but maps+      `ws-name` to `ws-name.png` instead of `ws-name.jpg`.++    - Added `defWPNamesJpg` as an alias to `defWPNames` and deprecated+      the latter.++  * `XMonad.Layout.SubLayouts`++    - Floating windows are no longer moved to the end of the window stack.++  * `XMonad.Layout.BinarySpacePartition`++    - Add the ability to increase/decrease the window size by a custom+      rational number. E.g: `sendMessage $ ExpandTowardsBy L 0.02`++  * `XMonad.Layout.Decoration`++    - The decoration window now sets a `WM_CLASS` property.  This allows+      other applications, like compositors, to properly match on it.++  * `XMonad.Layout.IndependentScreens`++    - Fixed a bug where `marshallPP` always sorted workspace names+      lexically.  This changes the default behaviour of `marshallPP`—the+      given `ppSort` now operates in the _physical_ workspace names.+      The documentation of `marshallSort` contains an example of how to+      get the old behaviour, where `ppSort` operates in virtual names,+      back.++    - Added `workspacesOn` for filtering workspaces on the current screen.++    - Added `withScreen` to specify names for a given single screen.++    - Added new aliases `PhysicalWindowSpace` and `VirtualWindowSpace`+      for a `WindowSpace` for easier to read function signatures.++    - Added a few useful utility functions related to simplify using the+      module; namely `workspaceOnScreen`, `focusWindow'`, `focusScreen`,+      `nthWorkspace`, and `withWspOnScreen`.++    - Fixed wrong type-signature of `onCurrentScreen`.++  * `XMonad.Actions.CopyWindow`++    - Added `copiesPP` to make a `PP` aware of copies of the focused+      window.++  - `XMonad.Actions.CycleWS`++    - Added `:&:`, `:|:` and `Not` data constructors to `WSType` to logically+      combine predicates.++    - Added `hiddenWS`, `emptyWS` and `anyWS` to replace deprecated+      constructors.++    - Added `ingoringWSs` as a `WSType` predicate to skip workspaces having a+      tag in a given list.++  - `XMonad.Actions.DynamicWorkspaceOrder`++    - Added `swapWithCurrent` and `swapOrder` to the list of exported names.++  - `XMonad.Actions.Submap`, `XMonad.Util.Ungrab`:++    - Fixed issue with keyboard/pointer staying grabbed when a blocking action+      like `runProcessWithInput` was invoked.++  - `XMonad.Actions.UpdateFocus`++    - Added `focusUnderPointer`, that updates the focus based on pointer+      position, an inverse of `X.A.UpdatePointer`, which moves the mouse+      pointer to match the focused window). Together these can be used to+      ensure focus stays in sync with mouse.++  - `XMonad.Layout.MultiToggle`++    - Added `isToggleActive` for querying the toggle state of transformers.+      Useful to show the state in a status bar.++  * `XMonad.Layout.Spacing`++    - Removed deprecations for `spacing`, `spacingWithEdge`,+      `smartSpacing`, and `smartSpacingWithEdge`.++  * `XMonad.Actions.DynamicWorkspaces`++    - Fixed a system freeze when using `X.A.CopyWindow.copy` in+      combination with `removeWorkspace`.++    - `withWorkspace` now honors the users `searchPredicate`, for+      example `fuzzyMatch` from `Prompt.FuzzyMatch`.++## 0.16++### Breaking Changes++  * `XMonad.Layout.Decoration`+    - Added `Theme` record fields for controlling decoration border width for active/inactive/urgent windows.+  * `XMonad.Prompt`++    - Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and+      `vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt+      actions.+    - Prompt supports dynamic colors. Colors are now specified by the `XPColor`+      type in `XPState` while `XPConfig` colors remain unchanged for backwards+      compatibility.+    - Fixes `showCompletionOnTab`.+    - The behavior of `moveWord` and `moveWord'` has changed; brought in line+      with the documentation and now internally consistent. The old keymaps+      retain the original behavior; see the documentation to do the same your+      XMonad configuration.+  * `XMonad.Util.Invisble`+    - Requires `MonadFail` for `Read` instance++### New Modules++  * `XMonad.Layout.TwoPanePersistent`++    A layout that is like TwoPane but keeps track of the slave window that is+    currently beside the master. In TwoPane, the default behavior when the master+    is focused is to display the next window in the stack on the slave pane. This+    is a problem when a different slave window is selected without changing the stack+    order.++  * `XMonad.Util.ExclusiveScratchpads`++    Named scratchpads that can be mutually exclusive: This new module extends the+    idea of named scratchpads such that you can define "families of scratchpads"+    that are exclusive on the same screen. It also allows to remove this+    constraint of being mutually exclusive with another scratchpad.++  * `XMonad.Actions.Prefix`++    A module that allows the user to use an Emacs-style prefix+    argument (raw or numeric).++### Bug Fixes and Minor Changes++  * `XMonad.Layout.Tabbed`++    tabbedLeft and tabbedRight will set their tabs' height and width according to decoHeight/decoWidth++  * `XMonad.Prompt`++    Added `sorter` to `XPConfig` used to sort the possible completions by how+    well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).++    Fixes a potential bug where an error during prompt execution would+    leave the window open and keep the keyboard grabbed. See issue+    [#180](https://github.com/xmonad/xmonad-contrib/issues/180).++    Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where+    using tab to wrap around the completion rows would fail when maxComplRows is+    restricting the number of rows of output.++  * `XMonad.Prompt.Pass`++    Added 'passOTPPrompt' to support getting OTP type password. This require+    pass-otp (https://github.com/tadfisher/pass-otp) has been setup in the running+    machine.++    Added 'passGenerateAndCopyPrompt', which both generates a new password and+    copies it to the clipboard.  These two actions are commonly desirable to+    take together, e.g. when establishing a new account.++    Made password prompts traverse symlinks when gathering password names for+    autocomplete.++  * `XMonad.Actions.DynamicProjects`++    Make the input directory read from the prompt in `DynamicProjects`+    absolute wrt the current directory.++    Before this, the directory set by the prompt was treated like a relative+    directory. This means that when you switch from a project with directory+    `foo` into a project with directory `bar`, xmonad actually tries to `cd`+    into `foo/bar`, instead of `~/bar` as expected.++  * `XMonad.Actions.DynamicWorkspaceOrder`++    Add a version of `withNthWorkspace` that takes a `[WorkspaceId] ->+    [WorkspaceId]` transformation to apply over the list of workspace tags+    resulting from the dynamic order.++  * `XMonad.Actions.GroupNavigation`++    Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy+    cycling between all windows on all visible workspaces.+++  * `XMonad.Hooks.WallpaperSetter`++    Preserve the aspect ratio of wallpapers that xmonad sets. When previous+    versions would distort images to fit the screen size, it will now find a+    best fit by cropping instead.++  * `XMonad.Util.Themes`++    Add adwaitaTheme and adwaitaDarkTheme to match their respective+    GTK themes.++  * 'XMonad.Layout.BinarySpacePartition'++    Add a new `SplitShiftDirectional` message that allows moving windows by+    splitting its neighbours.++  * `XMonad.Prompt.FuzzyMatch`++    Make fuzzy sort show shorter strings first.++## 0.15++### Breaking Changes++  * `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`+    The layout will no longer perform refreshes inside of its message handling.+    If you have been relying on it to in your xmonad.hs, you will need to start+    sending its messages in a manner that properly handles refreshing, e.g. with+    `sendMessage`.++### New Modules++  * `XMonad.Util.Purex`++    Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from+    the `XConf` and modifications to the `XState` are fundamentally pure --+    contrary to the current treatment of such actions in most xmonad code. Pure+    modifications to the `WindowSet` can be readily composed, but due to the+    need for those modifications to be properly handled by `windows`, other pure+    changes to the `XState` cannot be interleaved with those changes to the+    `WindowSet` without superfluous refreshes, hence breaking composability.++    This module aims to rectify that situation by drawing attention to it and+    providing `PureX`: a pure type with the same monadic interface to state as+    `X`. The `XLike` typeclass enables writing actions generic over the two+    monads; if pure, existing `X` actions can be generalised with only a change+    to the type signature. Various other utilities are provided, in particular+    the `defile` function which is needed by end-users.++### Bug Fixes and Minor Changes++  * Add support for GHC 8.6.1.++  * `XMonad.Actions.MessageHandling`+    Refresh-performing functions updated to better reflect the new `sendMessage`.++## 0.14++### Breaking Changes++  * `XMonad.Layout.Spacing`++    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed+    of four sides each with its own border width. The screen and window borders+    are now separate and can be independently toggled on/off. The screen border+    examines the window/rectangle list resulting from 'runLayout' rather than+    the stack, which makes it compatible with layouts such as the builtin+    `Full`. The child layout will always be called with the screen border. If+    only a single window is displayed (and `smartBorder` enabled), it will be+    expanded into the original layout rectangle. Windows that are displayed but+    not part of the stack, such as those created by 'XMonad.Layout.Decoration',+    will be shifted out of the way, but not scaled (not possible for windows+    created by XMonad). This isn't perfect, so you might want to disable+    `Spacing` on such layouts.++  * `XMonad.Util.SpawnOnce`++    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks+      to shift spawned windows to a specific workspace.++  * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier++  * `XMonad.Actions.GridSelect`++    - Added field `gs_bordercolor` to `GSConfig` to specify border color.++  * `XMonad.Layout.Minimize`++     Though the interface it offers is quite similar, this module has been+     almost completely rewritten. The new `XMonad.Actions.Minimize` contains+     several functions that allow interaction with minimization window state.+     If you are using this module, you must upgrade your configuration to import+     `X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of+     sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has+     been completely deprecated, and its functions have no effect.++  * `XMonad.Prompt.Unicode`++    - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a+      filepath to the `UnicodeData.txt` file containing unicode data.++  * `XMonad.Actions.PhysicalScreens`++    `getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter+    of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default+    value are:++     - `def`(same as verticalScreenOrderer) will keep previous behavior+     - `verticalScreenOrderer`+     - `horizontalScreenOrderer`++    One can build his custom ScreenOrderer using:+     - `screenComparatorById` (allow to order by Xinerama id)+     - `screenComparatorByRectangle` (allow to order by screen coordonate)+     - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)++  * `XMonad.Util.WorkspaceCompare`++    `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in+    `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)++  * `XMonad.Hooks.EwmhDesktops`++    - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific+      remapping of all visible windows to the active workspace (#216).+    - Handle workspace renames that might be occuring in the custom function+      that is provided to ewmhDesktopsLogHookCustom.++  * `XMonad.Hooks.DynamicLog`++    - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and+      `xmobarRaw`.++  * `XMonad.Layout.NoBorders`++    The layout now maintains a list of windows that never have borders, and a+    list of windows that always have borders. Use `BorderMessage` to manage+    these lists and the accompanying event hook (`borderEventHook`) to remove+    destroyed windows from them. Also provides the `hasBorder` manage hook.++    Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and+    `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`.  See+    the documentation for more information.++    The type signature of `hiddens` was changed to accept a new `Rectangle`+    parameter representing the bounds of the parent layout, placed after the+    `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`+    will need to update their configuration. For example, replace "`hiddens amb+    wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make+    use of the new parameter with "`hiddens amb wset lr mst wrs =`".++  * `XMonad.Actions.MessageFeedback`++    - Follow the naming conventions of `XMonad.Operations`. Functions returning+      `X ()` are named regularly (previously these ended in underscore) while+      those returning `X Bool` are suffixed with an uppercase 'B'.+    - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and+      `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`+      (renamed from `send`).+    - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of+      type `SomeMessage -> X Bool`, which means you are no longer constrained+      to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.+    - The `send*Messages*` family of funtions allows for sequencing arbitrary+      sets of messages with minimal refresh. It makes little sense for these+      functions to support custom message dispatchers.+    - Remain backwards compatible. Maintain deprecated aliases of all renamed+      functions:+      - `send`          -> `sendMessageWithNoRefreshToCurrentB`+      - `sendSM`        -> `sendSomeMessageWithNoRefreshToCurrentB`+      - `sendSM_`       -> `sendSomeMessageWithNoRefreshToCurrent`+      - `tryInOrder`    -> `tryInOrderWithNoRefreshToCurrentB`+      - `tryInOrder_`   -> `tryInOrderWithNoRefreshToCurrent`+      - `tryMessage`    -> `tryMessageWithNoRefreshToCurrentB`+      - `tryMessage_`   -> `tryMessageWithNoRefreshToCurrent`++### New Modules++  * `XMonad.Layout.MultiToggle.TabBarDecoration`++    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to+    dynamically toggle `XMonad.Layout.TabBarDecoration`.++  * `XMonad.Hooks.RefocusLast`++    Provides hooks and actions that keep track of recently focused windows on a+    per workspace basis and automatically refocus the last window on loss of the+    current (if appropriate as determined by user specified criteria).++  * `XMonad.Layout.StateFull`++    Provides `StateFull`: a stateful form of `Full` that does not misbehave when+    floats are focused, and the `FocusTracking` layout transformer by means of+    which `StateFull` is implemented. `FocusTracking` simply holds onto the last+    true focus it was given and continues to use it as the focus for the+    transformed layout until it sees another. It can be used to improve the+    behaviour of a child layout that has not been given the focused window.++  * `XMonad.Actions.SwapPromote`++    Module for tracking master window history per workspace, and associated+    functions for manipulating the stack using such history.++  * `XMonad.Actions.CycleWorkspaceByScreen`++    A new module that allows cycling through previously viewed workspaces in the+    order they were viewed most recently on the screen where cycling is taking+    place.++    Also provides the `repeatableAction` helper function which can be used to+    build actions that can be repeated while a modifier key is held down.++  * `XMonad.Prompt.FuzzyMatch`++    Provides a predicate `fuzzyMatch` that is much more lenient in matching+    completions in `XMonad.Prompt` than the default prefix match.  Also provides+    a function `fuzzySort` that allows sorting the fuzzy matches by "how well"+    they match.++  * `XMonad.Utils.SessionStart`++    A new module that allows to query if this is the first time xmonad is+    started of the session, or a xmonad restart.++    Currently needs manual setting of the session start flag. This could be+    automated when this moves to the core repository.++  * `XMonad.Layout.MultiDishes`++    A new layout based on Dishes, however it accepts additional configuration+    to allow multiple windows within a single stack.++  * `XMonad.Util.Rectangle`++    A new module for handling pixel rectangles.++  * `XMonad.Layout.BinaryColumn`++    A new module which provides a simple grid layout, halving the window+    sizes of each window after master.++    This is similar to Column, but splits the window in a way+    that maintains window sizes upon adding & removing windows as well as the+    option to specify a minimum window size.++### Bug Fixes and Minor Changes++  * `XMonad.Layout.Grid`++    Fix as per issue #223; Grid will no longer calculate more columns than there+    are windows.++  * `XMonad.Hooks.FadeWindows`++    Added support for GHC version 8.4.x by adding a Semigroup instance for+    Monoids++  * `XMonad.Hooks.WallpaperSetter`++    Added support for GHC version 8.4.x by adding a Semigroup instance for+    Monoids++  * `XMonad.Hooks.Mosaic`++    Added support for GHC version 8.4.x by adding a Semigroup instance for+    Monoids++  * `XMonad.Actions.Navigation2D`++    Added `sideNavigation` and a parameterised variant, providing a navigation+    strategy with fewer quirks for tiled layouts using X.L.Spacing.++  * `XMonad.Layout.Fullscreen`++    The fullscreen layouts will now not render any window that is totally+    obscured by fullscreen windows.++  * `XMonad.Layout.Gaps`++    Extended the sendMessage interface with `ModifyGaps` to allow arbitrary+    modifications to the `GapSpec`.++  * `XMonad.Layout.Groups`++    Added a new `ModifyX` message type that allows the modifying+    function to return values in the `X` monad.++  * `XMonad.Actions.Navigation2D`++    Generalised (and hence deprecated) hybridNavigation to hybridOf.++  * `XMonad.Layout.LayoutHints`++    Preserve the window order of the modified layout, except for the focused+    window that is placed on top. This fixes an issue where the border of the+    focused window in certain situations could be rendered below borders of+    unfocused windows. It also has a lower risk of interfering with the+    modified layout.++  * `XMonad.Layout.MultiColumns`++    The focused window is placed above the other windows if they would be made to+    overlap due to a layout modifier. (As long as it preserves the window order.)++  * `XMonad.Actions.GridSelect`++    - The vertical centring of text in each cell has been improved.++  * `XMonad.Actions.SpawnOn`++    - Bind windows spawns by child processes of the original window to the same+      workspace as the original window.++  * `XMonad.Util.WindowProperties`++    - Added the ability to test if a window has a tag from+      `XMonad.Actions.TagWindows`++  * `XMonad.Layout.Magnifier`++    - Handle `IncMasterN` messages.++  * `XMonad.Util.EZConfig`++    - Can now parse Latin1 keys, to better accommodate users with+      non-US keyboards.++  * `XMonad.Actions.Submap`++    Establish pointer grab to avoid freezing X, when button press occurs after+    submap key press.  And terminate submap at button press in the same way,+    as we do for wrong key press.++  * `XMonad.Hooks.SetWMName`++    Add function `getWMName`.++  * `XMonad.Hooks.ManageHelpers`++    - Make type of ManageHook combinators more general.+    - New manage hook `doSink` for sinking windows (as upposed to the `doFloat` manage hook)++  * `XMonad.Prompt`++    Export `insertString`.++  * `XMonad.Prompt.Window`++    - New function: `windowMultiPrompt` for using `mkXPromptWithModes`+      with window prompts.++  * `XMonad.Hooks.WorkspaceHistory`++    - Now supports per screen history.++  * `XMonad.Layout.ComboP`++    - New `PartitionWins` message to re-partition all windows into the+      configured sub-layouts.  Useful when window properties have+      changed and you want to re-sort windows into the appropriate+      sub-layout.++  * `XMonad.Actions.Minimize`++    - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform+      actions with both the last and first minimized windows easily.++  * `XMonad.Config.Gnome`++    - Update logout key combination (modm+shift+Q) to work with modern++  * `XMonad.Prompt.Pass`++    - New function `passTypePrompt` which uses `xdotool` to type in a password+      from the store, bypassing the clipboard.+    - New function `passEditPrompt` for editing a password from the+      store.+    - Now handles password labels with spaces and special characters inside+      them.++  * `XMonad.Prompt.Unicode`++    - Persist unicode data cache across XMonad instances due to+      `ExtensibleState` now used instead of `unsafePerformIO`.+    - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the+      Unicode character via `xdotool` instead of copying it to the paste buffer.+    - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`+      acts as a generic function to pass the selected Unicode character to any+      program.++  * `XMonad.Prompt.AppendFile`++    - New function `appendFilePrompt'` which allows for transformation of the+      string passed by a user before writing to a file.++  * `XMonad.Hooks.DynamicLog`++    - Added a new function `dzenWithFlags` which allows specifying the arguments+    passed to `dzen2` invocation. The behaviour of current `dzen` function is+    unchanged.++  * `XMonad.Util.Dzen`++    - Now provides functions `fgColor` and `bgColor` to specify foreground and+    background color, `align` and `slaveAlign` to set text alignment, and+    `lineCount` to enable a second (slave) window that displays lines beyond+    the initial (title) one.++  * `XMonad.Hooks.DynamicLog`++    - Added optional `ppVisibleNoWindows` to differentiate between empty+      and non-empty visible workspaces in pretty printing.++  * `XMonad.Actions.DynamicWorkspaceOrder`++    - Added `updateName` and `removeName` to better control ordering when+      workspace names are changed or workspaces are removed.++  * `XMonad.Config.Azerty`++    * Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY+      keyboards, which are slightly different from the French ones in the top+      row.++## 0.13 (February 10, 2017)++### Breaking Changes++  * The type of `completionKey` (of `XPConfig` record) has been+    changed from `KeySym` to `(KeyMask, KeySym)`. The default value+    for this is still bound to the `Tab` key.++  * New constructor `CenteredAt Rational Rational` added for+    `XMonad.Prompt.XPPosition`.++  * `XMonad.Prompt` now stores its history file in the XMonad cache+    directory in a file named `prompt-history`.++  * `XMonad.Hooks.ManageDocks` now requires an additional startup hook to be+    added to configuration in addition to the other 3 hooks, otherwise docks+    started before xmonad are covered by windows. It's recommended to use the+    newly introduced `docks` function to add all necessary hooks to xmonad+    config.++### New Modules++  * `XMonad.Layout.SortedLayout`++    A new LayoutModifier that sorts a given layout by a list of+    properties. The order of properties in the list determines+    the order of windows in the final layout. Any unmatched windows+    go to the end of the order.++  * `XMonad.Prompt.Unicode`++    A prompt to search a unicode character by its name, and put it into the+    clipboard.++  * `XMonad.Util.Ungrab`++    Release xmonad's keyboard and pointer grabs immediately, so+    screen grabbers and lock utilities, etc. will work. Replaces+    the short sleep hackaround.++  * `XMonad.Util.Loggers.NamedScratchpad`++    A collection of Loggers (see `XMonad.Util.Loggers`) for NamedScratchpads+    (see `XMonad.Util.NamedScratchpad`).++  * `XMonad.Util.NoTaskbar`++    Utility function and `ManageHook` to mark a window to be ignored by+    EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since+    you will usually be taken to the `NSP` workspace by them.++### Bug Fixes and Minor Changes++  * `XMonad.Hooks.ManageDocks`++    - Fix a very annoying bug where taskbars/docs would be+      covered by windows.++    - Also fix a bug that caused certain Gtk and Qt application to+      have issues displaying menus and popups.++  * `XMonad.Layout.LayoutBuilder`++    Merge all functionality from `XMonad.Layout.LayoutBuilderP` into+    `XMonad.Layout.LayoutBuilder`.++  * `XMonad.Actions.WindowGo`++    - Fix `raiseNextMaybe` cycling between 2 workspaces only.++  * `XMonad.Actions.UpdatePointer`++    - Fix bug when cursor gets stuck in one of the corners.++  * `XMonad.Actions.DynamicProjects`++    - Switching away from a dynamic project that contains no windows+      automatically deletes that project's workspace.++      The project itself was already being deleted, this just deletes+      the workspace created for it as well.++    - Added function to change the working directory (`changeProjectDirPrompt`)++    - All of the prompts are now multiple mode prompts.  Try using the+      `changeModeKey` in a prompt and see what happens!++## 0.12 (December 14, 2015)++### Breaking Changes++  * `XMonad.Actions.UpdatePointer.updatePointer` arguments were+    changed. This allows including aspects of both of the+    `TowardsCentre` and `Relative` methods. To keep the same behavior,+    replace the entry in the left column with the entry on the right:++    | < 0.12                              |   >= 0.12                        |+    |-------------------------------------|----------------------------------|+    | `updatePointer Nearest`             | `updatePointer (0.5, 0.5) (1,1)` |+    | `updatePointer (Relative x y)`      | `updatePointer (x,y) (0,0)`      |+    | `updatePointer (TowardsCentre x y)` | `updatePointer (0.5,0.5) (x,y)`  |++### New Modules++  * `XMonad.Actions.AfterDrag`++    Perform an action after the current mouse drag is completed.++  * `XMonad.Actions.DynamicProjects`++    Imbues workspaces with additional features so they can be treated+    as individual project areas.++  * `XMonad.Actions.LinkWorkspaces`++    Provides bindings to add and delete links between workspaces. It+    is aimed at providing useful links between workspaces in a+    multihead setup. Linked workspaces are viewed at the same time.++  * `XMonad.Config.Bepo`++    This module fixes some of the keybindings for the francophone+    among you who use a BEPO keyboard layout. Based on+    `XMonad.Config.Azerty`++  * `XMonad.Config.Dmwit`++    Daniel Wagner's configuration.++  * `XMonad.Config.Mate`++    This module provides a config suitable for use with the MATE+    desktop environment.++  * `XMonad.Config.Prime`++    A draft of a brand new config syntax for xmonad.++  * `XMonad.Hooks.DynamicProperty`++    Module to apply a `ManageHook` to an already-mapped window when a+    property changes. This would commonly be used to match browser+    windows by title, since the final title will only be set after (a)+    the window is mapped, (b) its document has been loaded, (c) all+    load-time scripts have run.++  * `XMonad.Hooks.ManageDebug`++    A `manageHook` and associated `logHook` for debugging `ManageHook`s.+    Simplest usage: wrap your xmonad config in the `debugManageHook`+    combinator.  Or use `debugManageHookOn` for a triggerable version,+    specifying the triggering key sequence in `XMonad.Util.EZConfig`+    syntax. Or use the individual hooks in whatever way you see fit.++  * `XMonad.Hooks.WallpaperSetter`++    Log hook which changes the wallpapers depending on visible+    workspaces.++  * `XMonad.Hooks.WorkspaceHistory`++    Keeps track of workspace viewing order.++  * `XMonad.Layout.AvoidFloats`++    Find a maximum empty rectangle around floating windows and use+    that area to display non-floating windows.++  * `XMonad.Layout.BinarySpacePartition`++    Layout where new windows will split the focused window in half,+    based off of BSPWM.++  * `XMonad.Layout.Dwindle`++    Three layouts: The first, `Spiral`, is a reimplementation of+    `XMonad.Layout.Spiral.spiral` with, at least to me, more intuitive+    semantics.  The second, `Dwindle`, is inspired by a similar layout+    in awesome and produces the same sequence of decreasing window+    sizes as Spiral but pushes the smallest windows into a screen+    corner rather than the centre.  The third, `Squeeze` arranges all+    windows in one row or in one column, with geometrically decreasing+    sizes.++  * `XMonad.Layout.Hidden`++    Similar to `XMonad.Layout.Minimize` but completely removes windows+    from the window set so `XMonad.Layout.BoringWindows` isn't+    necessary.  Perfect companion to `XMonad.Layout.BinarySpacePartition`+    since it can be used to move windows to another part of the BSP tree.++  * `XMonad.Layout.IfMax`++    Provides `IfMax` layout, which will run one layout if there are+    maximum `N` windows on workspace, and another layout, when number+    of windows is greater than `N`.++  * `XMonad.Layout.PerScreen`++    Configure layouts based on the width of your screen; use your+    favorite multi-column layout for wide screens and a full-screen+    layout for small ones.++  * `XMonad.Layout.Stoppable`++    This module implements a special kind of layout modifier, which when+    applied to a layout, causes xmonad to stop all non-visible processes.+    In a way, this is a sledge-hammer for applications that drain power.+    For example, given a web browser on a stoppable workspace, once the+    workspace is hidden the web browser will be stopped.++  * `XMonad.Prompt.ConfirmPrompt`++    A module for setting up simple confirmation prompts for+    keybindings.++  * `XMonad.Prompt.Pass`++    This module provides 3 `XMonad.Prompt`s to ease passwords manipulation+    (generate, read, remove) via [pass](http://www.passwordstore.org/).++  * `XMonad.Util.RemoteWindows`++    This module implements a proper way of finding out whether the+    window is remote or local.++  * `XMonad.Util.SpawnNamedPipe`++    A module for spawning a pipe whose `Handle` lives in the xmonad state.++  * `XMonad.Util.WindowState`++    Functions for saving per-window data.++### Miscellaneous Changes++  * Fix issue #9: `XMonad.Prompt.Shell` `searchPredicate` is ignored,+    defaults to `isPrefixOf`++  * Fix moveHistory when alwaysHighlight is enabled++  * `XMonad.Actions.DynamicWorkspaceGroups` now exports `addRawWSGroup`++  * Side tabs were added to the tabbed layout++  * `XMonad/Layout/IndependentScreens` now exports `marshallSort`++  * `XMonad/Hooks/UrgencyHook` now exports `clearUrgency`++  * Exceptions are now caught when finding commands on `PATH` in `Prompt.Shell`++  * Switched to `Data.Default` wherever possible++  * `XMonad.Layout.IndependentScreens` now exports `whenCurrentOn`++  * `XMonad.Util.NamedActions` now exports `addDescrKeys'`++  * EWMH `DEMANDS_ATTENTION` support added to `UrgencyHook`++  * New `useTransientFor` modifier in `XMonad.Layout.TrackFloating`++  * Added the ability to remove arbitrary workspaces++## 0.9 (October 26, 2009)++### Updates that Require Changes in `xmonad.hs`++  * `XMonad.Hooks.EwmhDesktops` no longer uses `layoutHook`, the+    `ewmhDesktopsLayout` modifier has been removed from+    xmonad-contrib. It uses `logHook`, `handleEventHook`, and+    `startupHook` instead and provides a convenient function `ewmh` to+    add EWMH support to a `defaultConfig`.++  * Most `DynamicLog` users can continue with configs unchanged, but+    users of the quickbar functions `xmobar` or `dzen` will need to+    change `xmonad.hs`: their types have changed to allow easier+    composition with other `XConfig` modifiers. The `dynamicLogDzen`+    and `dynamicLogXmobar` functions have been removed.++  * `WindowGo` or `safeSpawn` users may need to change command lines+    due to `safeSpawn` changes.++  * People explicitly referencing the "SP" scratchpad workspace should+    change it to "NSP" which is also used by the new+    `Util.NamedScratchpad` module.++  * (Optional) People who explicitly use `swapMaster` in key or mouse+    bindings should change it to `shiftMaster`. It's the current+    default used where `swapMaster` had been used previously. It works+    better than `swapMaster` when using floating and tiled windows+    together on the same workspace.++## See Also++<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
LICENSE view
@@ -1,27 +1,26 @@-Copyright (c) The Xmonad Community+Copyright (c) The Xmonad Community. All rights reserved. -All rights reserved.+Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met: -Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright-   notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright-   notice, this list of conditions and the following disclaimer in the-   documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.+1. Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer. -THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+may be used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,43 +1,82 @@-# xmonad-contrib: Third Party Extensions to the xmonad Window Manager+<p align="center">+  <a href="https://xmonad.org/"><img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150></a>+</p>+<p align="center">+  <a href="https://hackage.haskell.org/package/xmonad-contrib"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad-contrib?logo=haskell"></a>+  <a href="https://github.com/xmonad/xmonad-contrib/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad-contrib"></a>+  <a href="https://haskell.org/"><img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell"></a>+  <br>+  <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/stack.yml?label=Stack&logo=githubactions&logoColor=white"></a>+  <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/haskell-ci.yml?label=Cabal&logo=githubactions&logoColor=white"></a>+  <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/nix.yml?label=Nix&logo=githubactions&logoColor=white"></a>+  <br>+  <a href="https://github.com/sponsors/xmonad"><img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors"></a>+  <a href="https://opencollective.com/xmonad"><img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective"></a>+  <br>+  <a href="https://web.libera.chat/#xmonad"><img alt="Chat on #xmonad@irc.libera.chat" src="https://img.shields.io/badge/%23%20chat-on%20libera-brightgreen"></a>+  <a href="https://matrix.to/#/#xmonad:matrix.org"><img alt="Chat on #xmonad:matrix.org" src="https://img.shields.io/matrix/xmonad:matrix.org?logo=matrix"></a>+</p> -[![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)-[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib)+# xmonad-contrib -You need the ghc compiler and xmonad window manager installed in-order to use these extensions.+**Community-maintained extensions for the [XMonad][web:xmonad] window manager.** -For installation and configuration instructions, please see the-[xmonad website][xmonad], the documents included with the-[xmonad source distribution][xmonad-git], and the-[online haddock documentation][xmonad-docs].+[xmonad core][gh:xmonad] is minimal, stable, yet extensible.+[xmonad-contrib][gh:xmonad-contrib] is home to hundreds of additional tiling+algorithms and extension modules. The two combined make for a powerful X11+window-manager with endless customization possibilities. They are, quite+literally, libraries for creating your own window manager. -## Getting or Updating XMonadContrib+## Installation -  * Latest release: <https://hackage.haskell.org/package/xmonad-contrib>+For installation and configuration instructions, please see: -  * Git version: <https://github.com/xmonad/xmonad-contrib>+ * [downloading and installing xmonad][web:download]+ * [installing latest xmonad snapshot from git][web:install]+ * [configuring xmonad][web:tutorial] -(To use git xmonad-contrib you must also use the-[git version of xmonad][xmonad-git].)+If you run into any trouble, consult our [documentation][web:documentation] or+ask the [community][web:community] for help.  ## Contributing -Haskell code contributed to this repo should live under the-appropriate subdivision of the `XMonad` namespace (currently includes-`Actions`, `Config`, `Hooks`, `Layout`, `Prompt`, and `Util`). For-example, to use the Grid layout, one would import:+We welcome all forms of contributions: -    XMonad.Layout.Grid+ * [bug reports and feature ideas][gh:xmonad-contrib:issues]+   (also to [xmonad][gh:xmonad:issues])+ * [bug fixes, new features, new extensions][gh:xmonad-contrib:pulls]+   (also to [xmonad][gh:xmonad:pulls])+ * documentation fixes and improvements: [xmonad][gh:xmonad],+   [xmonad-contrib][gh:xmonad-contrib], [xmonad-web][gh:xmonad-web]+ * helping others in the [community][web:community]+ * financial support: [GitHub Sponsors][gh:xmonad:sponsors],+   [Open Collective][opencollective:xmonad] -For further details, see the [documentation][developing] for the-`XMonad.Doc.Developing` module, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)  and the [xmonad website][xmonad].+Please do read the [CONTRIBUTING][gh:xmonad:contributing] document for more+information about bug reporting and code contributions. For a brief overview+of the architecture and code conventions, see the [documentation for the+`XMonad.Doc.Developing` module][doc:developing]. If in doubt, [talk to+us][web:community].  ## License -Code submitted to the contrib repo is licensed under the same license as-xmonad itself, with copyright held by the authors.- -[xmonad]: http://xmonad.org-[xmonad-git]: https://github.com/xmonad/xmonad-[xmonad-docs]: http://hackage.haskell.org/package/xmonad-[developing]: http://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Doc-Developing.html+Code submitted to the xmonad-contrib repo is licensed under the same license+as xmonad core itself, with copyright held by the authors.++[doc:developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html+[gh:xmonad-contrib:issues]: https://github.com/xmonad/xmonad-contrib/issues+[gh:xmonad-contrib:pulls]: https://github.com/xmonad/xmonad-contrib/pulls+[gh:xmonad-contrib]: https://github.com/xmonad/xmonad-contrib+[gh:xmonad-web]: https://github.com/xmonad/xmonad-web+[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md+[gh:xmonad:issues]: https://github.com/xmonad/xmonad/issues+[gh:xmonad:pulls]: https://github.com/xmonad/xmonad/pulls+[gh:xmonad:sponsors]: https://github.com/sponsors/xmonad+[gh:xmonad]: https://github.com/xmonad/xmonad+[opencollective:xmonad]: https://opencollective.com/xmonad+[web:community]: https://xmonad.org/community.html+[web:documentation]: https://xmonad.org/documentation.html+[web:download]: https://xmonad.org/download.html+[web:install]: https://xmonad.org/INSTALL.html+[web:tutorial]: https://xmonad.org/TUTORIAL.html+[web:xmonad]: https://xmonad.org/
XMonad/Actions/AfterDrag.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.AfterDrag+-- Description :  Allows you to add actions dependent on the current mouse drag. -- Copyright   :  (c) 2014 Anders Engstrom <ankaan@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -19,10 +20,11 @@                 ifClick') where  import XMonad-import System.Time +import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)+ -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.AfterDrag --@@ -53,7 +55,7 @@ --   A drag is considered a click if it is completed within 300 ms. ifClick   :: X ()   -- ^ The action to take if the dragging turned out to be a click.-  -> X () +  -> X () ifClick action = ifClick' 300 action (return ())  -- | Take an action if the current dragging is completed within a certain time (in milliseconds.)@@ -61,11 +63,11 @@   :: Int    -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.)   -> X ()   -- ^ The action to take if the dragging turned out to be a click.   -> X ()   -- ^ The action to take if the dragging turned out to not be a click.-  -> X () +  -> X () ifClick' ms click drag = do-  start <- io $ getClockTime-  afterDrag $ do -    stop <- io $ getClockTime-    if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) }+  start <- io getCurrentTime+  afterDrag $ do+    stop <- io getCurrentTime+    if diffUTCTime stop start <= (fromIntegral ms / 10^(3 :: Integer) :: NominalDiffTime)       then click       else drag
XMonad/Actions/BluetileCommands.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.BluetileCommands+-- Description :  Interface with the [Bluetile](https://hackage.haskell.org/package/bluetile) tiling window manager. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -24,12 +25,11 @@  import XMonad import qualified XMonad.StackSet as W-import XMonad.Layout.LayoutCombinators import System.Exit  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Hooks.ServerMode -- >    import XMonad.Actions.BluetileCommands@@ -43,7 +43,7 @@  workspaceCommands :: Int -> X [(String, X ())] workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return-                            [(("greedyView" ++ show i),+                            [( "greedyView" ++ show i,                                 activateScreen sid >> windows (W.greedyView i))                                 | i <- spaces ] @@ -66,7 +66,7 @@                          ]  quitCommands :: [(String, X ())]-quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))+quitCommands = [ ("quit bluetile", io exitSuccess)                , ("quit bluetile and start metacity", restart "metacity" False)                ]
XMonad/Actions/Commands.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.Commands+-- Description :  Run internal xmonad commands using a dmenu menu. -- Copyright   :  (c) David Glasser 2007 -- License     :  BSD3 --@@ -32,11 +33,11 @@  import qualified Data.Map as M import System.Exit-import Data.Maybe+import XMonad.Prelude  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.Commands --@@ -56,23 +57,23 @@ -- bindings!) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a --   list of pairs. commandMap :: [(String, X ())] -> M.Map String (X ())-commandMap c = M.fromList c+commandMap = M.fromList  -- | Generate a list of commands to switch to\/send windows to workspaces. workspaceCommands :: X [(String, X ())] workspaceCommands = asks (workspaces . config) >>= \spaces -> return-                            [((m ++ show i), windows $ f i)+                            [( m ++ show i, windows $ f i)                                 | i <- spaces                                 , (f, m) <- [(view, "view"), (shift, "shift")] ]  -- | Generate a list of commands dealing with multiple screens. screenCommands :: [(String, X ())]-screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))+screenCommands = [( m ++ show sc, screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))                       | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes                       , (f, m) <- [(view, "screen"), (shift, "screen-to-")]                  ]@@ -100,7 +101,7 @@         , ("swap-down"           , windows swapDown                                 )         , ("swap-master"         , windows swapMaster                               )         , ("sink"                , withFocused $ windows . sink                     )-        , ("quit-wm"             , io $ exitWith ExitSuccess                        )+        , ("quit-wm"             , io exitSuccess                                   )         ]  -- | Given a list of command\/action pairs, prompt the user to choose a
XMonad/Actions/ConstrainedResize.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.ConstrainedResize+-- Description :  Constrain the aspect ratio of a floating window. -- Copyright   :  (c) Dougal Stanton -- License     :  BSD3-style (see LICENSE) --@@ -25,7 +26,7 @@  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import qualified XMonad.Actions.ConstrainedResize as Sqr --@@ -43,9 +44,8 @@  -- | Resize (floating) window with optional aspect ratio constraints. mouseResizeWindow :: Window -> Bool -> X ()-mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     sh <- io $ getWMNormalHints d w     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))     mouseDrag (\ex ey -> do@@ -53,5 +53,6 @@                      y = ey - fromIntegral (wa_y wa)                      sz = if c then (max x y, max x y) else (x,y)                  io $ resizeWindow d w `uncurry`-                    applySizeHintsContents sh sz)+                    applySizeHintsContents sh sz+                 float w)               (float w)
XMonad/Actions/CopyWindow.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.CopyWindow+-- Description :  Duplicate a window on multiple workspaces. -- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -18,22 +20,24 @@                                  -- * Usage                                  -- $usage                                  copy, copyToAll, copyWindow, runOrCopy-                                 , killAllOtherCopies, kill1+                                 , killAllOtherCopies, kill1, taggedWindows, copiesOfOn                                  -- * Highlight workspaces containing copies in logHook                                  -- $logHook-                                 , wsContainingCopies+                                 , wsContainingCopies, copiesPP                                 ) where  import XMonad+import XMonad.Prelude import Control.Arrow ((&&&)) import qualified Data.List as L  import XMonad.Actions.WindowGo+import XMonad.Hooks.StatusBar.PP (PP(..), WS(..), isHidden) import qualified XMonad.StackSet as W  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CopyWindow --@@ -73,22 +77,28 @@ -- >  , ((modm .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- $logHook--- To distinguish workspaces containing copies of the focused window use--- something like: ----- > sampleLogHook h = do--- >    copies <- wsContainingCopies--- >    let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws--- >                 | otherwise = pad ws--- >    dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h}--- >--- > main = do--- >    h <- spawnPipe "xmobar"--- >    xmonad def { logHook = sampleLogHook h }+-- To distinguish workspaces containing copies of the focused window, use 'copiesPP'.+-- 'copiesPP' takes a pretty printer and makes it aware of copies of the focused window.+-- It can be applied when creating a 'XMonad.Hooks.StatusBar.StatusBarConfig'.+--+-- A sample config looks like this:+--+-- > mySB = statusBarProp "xmobar" (copiesPP (pad . xmobarColor "red" "black") xmobarPP)+-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def +-- | Take a pretty printer and make it aware of copies by using the provided function+-- to show hidden workspaces that contain copies of the focused window.+copiesPP :: (WorkspaceId -> String) -> PP -> X PP+copiesPP wtoS pp = do+    copies <- wsContainingCopies+    let check WS{..} = W.tag wsWS `elem` copies+    let printer = (asks (isHidden <&&> check) >>= guard) $> wtoS+    return pp{ ppPrinters = printer <|> ppPrinters pp }+ -- | Copy the focused window to a workspace. copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd copy n s | Just w <- W.peek s = copyWindow w n s@@ -96,7 +106,7 @@  -- | Copy the focused window to all workspaces. copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd-copyToAll s = foldr copy s $ map W.tag (W.workspaces s)+copyToAll s = foldr (copy . W.tag) s (W.workspaces s)  -- | Copy an arbitrary window to a workspace. copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd@@ -104,10 +114,10 @@     where copy' s = if n `W.tagMember` s                     then W.view (W.currentTag s) $ insertUp' w $ W.view n s                     else s-          insertUp' a s = W.modify (Just $ W.Stack a [] [])+          insertUp' a = W.modify (Just $ W.Stack a [] [])                           (\(W.Stack t l r) -> if a `elem` t:l++r                                              then Just $ W.Stack t l r-                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s+                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r)))   -- | runOrCopy will run the provided shell command unless it can@@ -142,9 +152,9 @@                                                    W.view (W.currentTag ss) .                                                    delFromAllButCurrent w     where-      delFromAllButCurrent w ss = foldr ($) ss $-                                  map (delWinFromWorkspace w . W.tag) $-                                  W.hidden ss ++ map W.workspace (W.visible ss)+      delFromAllButCurrent w ss = foldr (delWinFromWorkspace w . W.tag)+                                  ss+                                  (W.hidden ss ++ map W.workspace (W.visible ss))       delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))        viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
XMonad/Actions/CycleRecentWS.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.CycleRecentWS+-- Description :  Cycle through most recently used workspaces. -- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -19,21 +24,37 @@                                 -- * Usage                                 -- $usage                                 cycleRecentWS,-                                cycleWindowSets+                                cycleRecentNonEmptyWS,+                                cycleWindowSets,+                                toggleRecentWS,+                                toggleRecentNonEmptyWS,+                                toggleWindowSets,+                                recentWS,++#ifdef TESTING+                                unView,+#endif ) where +import XMonad.Actions.Repeatable (repeatableSt)+ import XMonad hiding (workspaces)-import XMonad.StackSet+import XMonad.Prelude (void, when)+import XMonad.StackSet hiding (filter, modify) +import Control.Arrow ((&&&))+import Data.Function (on)+import Control.Monad.State (lift)+ -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleRecentWS -- > -- >   , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Cycle through most recent workspaces with repeated presses of a key, while --   a modifier key is held down. The recency of workspaces previewed while browsing@@ -47,39 +68,91 @@               -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.                           --   If it's the same as the nextWorkspace key, it is effectively ignored.               -> X ()-cycleRecentWS = cycleWindowSets options- where options w = map (view `flip` w) (recentTags w)-       recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]+cycleRecentWS = cycleWindowSets $ recentWS (const True)  -cycref :: [a] -> Int -> a-cycref l i = l !! (i `mod` length l)+-- | Like 'cycleRecentWS', but restricted to non-empty workspaces.+cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.+                                  --   As soon as one of them is released, the final switch is made.+                      -> KeySym   -- ^ Key used to switch to next (less recent) workspace.+                      -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.+                                  --   If it's the same as the nextWorkspace key, it is effectively ignored.+                      -> X ()+cycleRecentNonEmptyWS = cycleWindowSets $ recentWS (not . null . stack) --- | Cycle through a finite list of WindowSets with repeated presses of a key, while++-- | Switch to the most recent workspace. The stack of most recently used workspaces+-- is updated, so repeated use toggles between a pair of workspaces.+toggleRecentWS :: X ()+toggleRecentWS = toggleWindowSets $ recentWS (const True)+++-- | Like 'toggleRecentWS', but restricted to non-empty workspaces.+toggleRecentNonEmptyWS :: X ()+toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack)+++-- | Given a predicate @p@ and the current 'WindowSet' @w@, create a+-- list of workspaces to choose from. They are ordered by recency and+-- have to satisfy @p@.+recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.+         -> WindowSet             -- ^ The current WindowSet+         -> [WorkspaceId]+recentWS p w = map tag+             $ filter p+             $ map workspace (visible w)+               ++ hidden w+               ++ [workspace (current w)]++-- | Cycle through a finite list of workspaces with repeated presses of a key, while --   a modifier key is held down. For best effects use the same modkey+key combination --   as the one used to invoke this action.-cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from-                -> [KeySym]                   -- ^ A list of modifier keys used when invoking this action.-                                              --   As soon as one of them is released, the final WindowSet is chosen and the action exits.-                -> KeySym                     -- ^ Key used to preview next WindowSet from the list of generated options-                -> KeySym                     -- ^ Key used to preview previous WindowSet from the list of generated options.-                                              --   If it's the same as nextOption key, it is effectively ignored.+cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from+                -> [KeySym]                     -- ^ A list of modifier keys used when invoking this action.+                                                --   As soon as one of them is released, the final workspace is chosen and the action exits.+                -> KeySym                       -- ^ Key used to preview next workspace from the list of generated options+                -> KeySym                       -- ^ Key used to preview previous workspace from the list of generated options.+                                                --   If it's the same as nextOption key, it is effectively ignored.                 -> X () cycleWindowSets genOptions mods keyNext keyPrev = do+  (options, unView') <- gets $ (genOptions &&& unView) . windowset+  let+    preview = do+      i <- get+      lift $ windows (view (options !! (i `mod` n)) . unView')+      where n = length options+  void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if+    | s == keyNext -> modify succ >> preview+    | s == keyPrev -> modify pred >> preview+    | otherwise    -> pure ()++-- | Given an old and a new 'WindowSet', which is __exactly__ one+-- 'view' away from the old one, restore the workspace order of the+-- former inside of the latter.  This respects any new state that the+-- new 'WindowSet' may have accumulated.+unView :: forall i l a s sd. (Eq i, Eq s)+       => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd+unView w0 w1 = fixOrderH . fixOrderV . view' (currentTag w0) $ w1+ where+  view' = if screen (current w0) == screen (current w1) then greedyView else view+  fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs }+              | otherwise = w+  fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs }+              | otherwise = w+  pfxV = commonPrefix `on` fmap (tag . workspace)+  pfxH = commonPrefix `on` fmap tag++  insertAt :: Int -> x -> [x] -> [x]+  insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r++  commonPrefix :: Eq x => [x] -> [x] -> Int+  commonPrefix a b = length $ takeWhile id $ zipWith (==) a b++-- | Given some function that generates a list of workspaces from a+-- given 'WindowSet', switch to the first generated workspace.+toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()+toggleWindowSets genOptions = do   options <- gets $ genOptions . windowset-  XConf {theRoot = root, display = d} <- ask-  let event = allocaXEvent $ \p -> do-                maskEvent d (keyPressMask .|. keyReleaseMask) p-                KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p-                s <- keycodeToKeysym d c 0-                return (t, s)-  let setOption n = do windows $ const $ options `cycref` n-                       (t, s) <- io event-                       case () of-                         () | t == keyPress   && s == keyNext  -> setOption (n+1)-                            | t == keyPress   && s == keyPrev  -> setOption (n-1)-                            | t == keyRelease && s `elem` mods -> return ()-                            | otherwise                        -> setOption n-  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime-  setOption 0-  io $ ungrabKeyboard d currentTime+  case options of+    []  -> return ()+    o:_ -> windows (view o)
XMonad/Actions/CycleSelectedLayouts.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.CycleSelectedLayouts+-- Description :  Cycle through the given subset of layouts. -- Copyright   :  (c) Roman Cheplyaka -- License     :  BSD3-style (see LICENSE) --@@ -18,34 +19,29 @@     cycleThroughLayouts) where  import XMonad-import Data.List (findIndex)-import Data.Maybe (fromMaybe)-import XMonad.Layout.LayoutCombinators (JumpToLayout(..))+import XMonad.Prelude (elemIndex, fromMaybe) import qualified XMonad.StackSet as S  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: ----- > import XMonad hiding ((|||))--- > import XMonad.Layout.LayoutCombinators ((|||))+-- > import XMonad -- > import XMonad.Actions.CycleSelectedLayouts -- -- >   , ((modm,  xK_t ),   cycleThroughLayouts ["Tall", "Mirror Tall"])------ Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators,--- rather than the Select defined in xmonad core.  cycleToNext :: (Eq a) => [a] -> a -> Maybe a cycleToNext lst a = do     -- not beautiful but simple and readable-    ind <- findIndex (a==) lst+    ind <- elemIndex a lst     return $ lst !! if ind == length lst - 1 then 0 else ind+1  -- | If the current layout is in the list, cycle to the next layout. Otherwise, --   apply the first layout from list. cycleThroughLayouts :: [String] -> X ()-cycleThroughLayouts lst = do+cycleThroughLayouts []         = pure ()+cycleThroughLayouts lst@(x: _) = do     winset <- gets windowset     let ld = description . S.layout . S.workspace . S.current $ winset-    let newld = fromMaybe (head lst) (cycleToNext lst ld)+    let newld = fromMaybe x (cycleToNext lst ld)     sendMessage $ JumpToLayout newld
XMonad/Actions/CycleWS.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.CycleWS+-- Description :  Cycle through workspaces. -- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>, --                    Nelson Elhage <nelhage@mit.edu> (`toggleWS' function) -- License     :  BSD3-style (see LICENSE)@@ -18,13 +19,13 @@ -- -- Note that this module now subsumes the functionality of the former -- @XMonad.Actions.RotView@.  Former users of @rotView@ can simply replace--- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.+-- @rotView True@ with @moveTo Next (Not emptyWS)@, and so on. -- -- If you want to exactly replicate the action of @rotView@ (cycling -- through workspace in order lexicographically by tag, instead of in -- the order specified in the config), it can be implemented as: ----- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1+-- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) (Not emptyWS) 1 -- >                 windows . greedyView $ t -- >   where bToDir True  = Next -- >         bToDir False = Prev@@ -63,6 +64,11 @@                                , Direction1D(..)                               , WSType(..)+                              , emptyWS+                              , hiddenWS+                              , anyWS+                              , wsTagGroup+                              , ignoringWSs                                , shiftTo                               , moveTo@@ -78,9 +84,7 @@                               ) where -import Data.List ( find, findIndex )-import Data.Maybe ( isNothing, isJust )-+import XMonad.Prelude (find, findIndex, isJust, isNothing, liftM2) import XMonad hiding (workspaces) import qualified XMonad.Hooks.WorkspaceHistory as WH import XMonad.StackSet hiding (filter)@@ -88,7 +92,7 @@ import XMonad.Util.WorkspaceCompare  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWS -- >@@ -112,13 +116,13 @@ -- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'. -- For example: ----- >   , ((modm     , xK_f), moveTo Next EmptyWS)  -- find a free workspace+-- >   , ((modm     , xK_f), moveTo Next emptyWS)  -- find a free workspace -- >   , ((modm .|. controlMask, xK_Right),        -- a crazy keybinding!--- >         do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2+-- >         do t <- findWorkspace getSortByXineramaRule Next (Not emptyWS) 2 -- >            windows . view $ t                                         ) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- When using the toggle functions, in order to ensure that the workspace -- to which you switch is the previously viewed workspace, use the@@ -201,8 +205,7 @@ lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId) lastViewedHiddenExcept skips = do     hs <- gets $ map tag . flip skipTags skips . hidden . windowset-    vs <- WH.workspaceHistory-    return $ choose hs (find (`elem` hs) vs)+    choose hs . find (`elem` hs) <$> WH.workspaceHistory     where choose []    _           = Nothing           choose (h:_) Nothing     = Just h           choose _     vh@(Just _) = vh@@ -213,8 +216,8 @@ shiftBy :: Int -> X () shiftBy d = wsBy d >>= windows . shift -wsBy :: Int -> X (WorkspaceId)-wsBy = findWorkspace getSortByIndex Next AnyWS+wsBy :: Int -> X WorkspaceId+wsBy = findWorkspace getSortByIndex Next anyWS  {- $taketwo @@ -223,7 +226,7 @@  For example, ->   moveTo Next EmptyWS+>   moveTo Next emptyWS  will move to the first available workspace with no windows, and @@ -234,6 +237,13 @@  -} +{-# DEPRECATED EmptyWS             "Use emptyWS instead." #-}+{-# DEPRECATED HiddenWS            "Use hiddenWS instead." #-}+{-# DEPRECATED NonEmptyWS          "Use Not emptyWS instead." #-}+{-# DEPRECATED HiddenNonEmptyWS    "Use hiddenWS :&: Not emptyWS instead." #-}+{-# DEPRECATED HiddenEmptyWS       "Use hiddenWS :&: emptyWS instead." #-}+{-# DEPRECATED AnyWS               "Use anyWS instead." #-}+{-# DEPRECATED WSTagGroup          "Use wsTagGroup instead." #-} -- | What type of workspaces should be included in the cycle? data WSType = EmptyWS     -- ^ cycle through empty workspaces             | NonEmptyWS  -- ^ cycle through non-empty workspaces@@ -248,6 +258,11 @@             | WSIs (X (WindowSpace -> Bool))                           -- ^ cycle through workspaces satisfying                           --   an arbitrary predicate+            | WSType :&: WSType -- ^ cycle through workspaces satisfying both+                                --   predicates.+            | WSType :|: WSType -- ^ cycle through workspaces satisfying one of+                                --   the predicates.+            | Not WSType -- ^ cycle through workspaces not satisfying the predicate  -- | Convert a WSType value to a predicate on workspaces. wsTypeToPred :: WSType -> X (WindowSpace -> Bool)@@ -262,11 +277,47 @@                                  hi <- wsTypeToPred HiddenWS                                  return (\w -> hi w && ne w) wsTypeToPred AnyWS      = return (const True)-wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset+wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset                                    return $ (cur ==).groupName                                    where groupName = takeWhile (/=sep).tag-wsTypeToPred (WSIs p)   = p+wsTypeToPred (WSIs p ) = p+wsTypeToPred (p :&: q) = liftM2 (&&) <$> wsTypeToPred p <*> wsTypeToPred q+wsTypeToPred (p :|: q) = liftM2 (||) <$> wsTypeToPred p <*> wsTypeToPred q+wsTypeToPred (Not p  ) = fmap not <$> wsTypeToPred p +-- | Cycle through empty workspaces+emptyWS :: WSType+emptyWS = WSIs . return $ isNothing . stack++-- | Cycle through non-visible workspaces+hiddenWS :: WSType+hiddenWS = WSIs $ do+  hs <- gets (map tag . hidden . windowset)+  return $ (`elem` hs) . tag++-- | Cycle through all workspaces+anyWS :: WSType+anyWS = WSIs . return $ const True++-- | Cycle through workspaces that are not in the given list. This could, for+--   example, be used for skipping the workspace reserved for+--   "XMonad.Util.NamedScratchpad":+--+-- >  moveTo Next $ hiddenWS :&: Not emptyWS :&: ignoringWSs [scratchpadWorkspaceTag]+--+ignoringWSs :: [WorkspaceId] -> WSType+ignoringWSs ts = WSIs . return $ (`notElem` ts) . tag++-- | Cycle through workspaces in the same group, the+--   group name is all characters up to the first+--   separator character or the end of the tag+wsTagGroup :: Char -> WSType+wsTagGroup sep = WSIs $ do+  cur <- groupName . workspace . current <$> gets windowset+  return $ (cur ==) . groupName+  where groupName = takeWhile (/= sep) . tag++ -- | View the next workspace in the given direction that satisfies --   the given condition. moveTo :: Direction1D -> WSType -> X ()@@ -299,7 +350,7 @@ findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)   where     maybeNegate Next d = d-    maybeNegate Prev d = (-d)+    maybeNegate Prev d = -d  findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId findWorkspaceGen _ _ 0 = gets (currentTag . windowset)@@ -309,7 +360,7 @@     ws     <- gets windowset     let cur     = workspace (current ws)         sorted  = sort (workspaces ws)-        pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a+        pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a         ws'     = filter wsPred pivoted         mCurIx  = findWsIndex cur ws'         d'      = if d > 0 then d - 1 else d@@ -321,7 +372,7 @@     return $ tag next  findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int-findWsIndex ws wss = findIndex ((== tag ws) . tag) wss+findWsIndex ws = findIndex ((== tag ws) . tag)  -- | View next screen nextScreen :: X ()@@ -349,7 +400,7 @@ >         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]  -}-screenBy :: Int -> X (ScreenId)+screenBy :: Int -> X ScreenId screenBy d = do ws <- gets windowset                 --let ss = sortBy screen (screens ws)                 let now = screen (current ws)
XMonad/Actions/CycleWindows.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ViewPatterns, MultiWayIf #-}+ -------------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.CycleWindows+-- Description  : Cycle windows while maintaining focus in place. -- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com> -- License      : BSD3-style (see LICENSE) --@@ -47,18 +50,21 @@         -- $pointer          -- * Generic list rotations-        -- $generic         rotUp, rotDown ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W+import qualified Data.List.NonEmpty as NE import XMonad.Actions.RotSlaves+import XMonad.Actions.Repeatable (repeatableSt)  import Control.Arrow (second)+import Control.Monad.Trans (lift)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWindows -- >    -- config@@ -74,7 +80,7 @@ -- -- Also, if you use focus follows mouse, you will want to read the section -- on updating the mouse pointer below.  For detailed instructions on--- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".+-- editing your key bindings, see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. {- $pointer With FocusFollowsMouse == True, the focus is updated after binding actions, possibly focusing a window you didn't intend to focus. Most@@ -116,7 +122,7 @@                                --   If it's the same as the first key, it is effectively ignored.                     -> X () cycleRecentWindows = cycleStacks' stacks where-    stacks s = map (shiftToFocus' `flip` s) (wins s)+    stacks s = map (`shiftToFocus'` s) (wins s)     wins (W.Stack t l r) = t : r ++ reverse l  @@ -134,27 +140,19 @@                                     -> KeySym    -- ^ Key used to select a \"previous\" stack.                                     -> X () cycleStacks' filteredPerms mods keyNext keyPrev = do-    XConf {theRoot = root, display = d} <- ask-    stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset--    let evt = allocaXEvent $-                  \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p-                           KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p-                           s <- keycodeToKeysym d c 0-                           return (t, s)-        choose n (t, s)-              | t == keyPress   && s == keyNext  = io evt >>= choose (n+1)-              | t == keyPress   && s == keyPrev  = io evt >>= choose (n-1)-              | t == keyPress   && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)-              | t == keyRelease && s `elem` mods = return ()-              | otherwise                        = doStack n >> io evt >>= choose n-        doStack n = windows . W.modify' . const $ stacks `cycref` n--    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime-    io evt >>= choose 1-    io $ ungrabKeyboard d currentTime-  where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite-        numKeyToN = subtract 48 . read . show+  stacks <- gets $ maybe [] filteredPerms+                 . W.stack . W.workspace . W.current . windowset+  let+    preview = do+      i <- get+      lift . windows . W.modify' . const $ stacks !! (i `mod` n)+      where n = length stacks+  void $ repeatableSt 0 mods keyNext $ \t s -> if+    | t == keyPress && s == keyNext          -> modify succ+    | t == keyPress && s == keyPrev          -> modify pred+    | t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s)+    | otherwise                              -> preview+  where numKeyToN = subtract 48 . read . show  -- | Given a stack element and a stack, shift or insert the element (window) --   at the currently focused position.@@ -178,7 +176,7 @@ rotOpposite' (W.Stack t l r) = W.Stack t' l' r'   where rrvl = r ++ reverse l         part = (length rrvl + 1) `div` 2-        (l',t':r') =  second reverse . splitAt (length l) $+        (l', notEmpty -> t' :| r') = second reverse . splitAt (length l) $                                 reverse (take part rrvl ++ t : drop part rrvl)  @@ -204,8 +202,8 @@ rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotFocused' _ s@(W.Stack _ [] []) = s rotFocused' f   (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus-    where (t':rs') = f (t:rs)-rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s              -- otherwise+    where (notEmpty -> t' :| rs') = f (t:rs)+rotFocused' f s@W.Stack{} = rotSlaves' f s                    -- otherwise   -- $unfocused@@ -219,17 +217,8 @@  -- | The unfocused rotation on a stack. rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a-rotUnfocused' _ s@(W.Stack _ [] []) = s-rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s                 -- Master has focus-rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise-    where  (master:revls)  = reverse ls+rotUnfocused' _ s@(W.Stack _ []        []) = s+rotUnfocused' f s@(W.Stack _ []        _ ) = rotSlaves' f s                 -- Master has focus+rotUnfocused' f   (W.Stack t ls@(l:ll) rs) = W.Stack t (reverse revls') rs' -- otherwise+    where  (master :| revls) = NE.reverse (l :| ll)            (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)---- $generic--- Generic list rotations such that @rotUp [1..4]@ is equivalent to--- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are--- @id@ for null or singleton lists.-rotUp :: [a] -> [a]-rotUp   l = drop 1 l ++ take 1 l-rotDown :: [a] -> [a]-rotDown = reverse . rotUp . reverse
XMonad/Actions/CycleWorkspaceByScreen.hs view
@@ -1,7 +1,7 @@- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.CycleWorkspaceByScreen+-- Description :  Cycle workspaces in a screen-aware fashion. -- Copyright   :  (c) 2017 Ivan Malison -- License     :  BSD3-style (see LICENSE) --@@ -23,39 +23,38 @@   , repeatableAction   ) where -import           Control.Monad import           Data.IORef-import           Data.List-import           Data.Maybe -import           Graphics.X11.Xlib.Extras- import           XMonad+import           XMonad.Prelude import           XMonad.Hooks.WorkspaceHistory+import           XMonad.Actions.Repeatable (repeatable) import qualified XMonad.StackSet as W  -- $usage--- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory ----- To use, add something like the following to your keybindings--- , ((mod4Mask,  xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)--repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()-repeatableAction mods pressHandler = do-  XConf {theRoot = root, display = d} <- ask-  let getNextEvent = io $ allocaXEvent $ \p ->-                 do-                   maskEvent d (keyPressMask .|. keyReleaseMask) p-                   KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p-                   s <- io $ keycodeToKeysym d c 0-                   return (t, s)-      handleEvent (t, s)-        | t == keyRelease && s `elem` mods = return ()-        | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent+-- To use this module, first import it as well as+-- "XMonad.Hooks.WorkspaceHistory":+--+-- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook)+-- > import XMonad.Actions.CycleWorkspaceByScreen+--+-- Then add 'workspaceHistoryHook' to your @logHook@ like this:+--+-- > main :: IO ()+-- > main = xmonad $ def+-- >    { ...+-- >    , logHook = workspaceHistoryHook >> ...+-- >    }+--+-- Finally, define a new keybinding for cycling (seen) workspaces per+-- screen:+--+-- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p) -  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime-  getNextEvent >>= handleEvent-  io $ ungrabKeyboard d currentTime+{-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-}+repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X ()+repeatableAction = repeatable  handleKeyEvent :: EventType                -> KeySym@@ -74,7 +73,16 @@ runFirst matchers eventType key =   fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers -cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()+-- | Like 'XMonad.Actions.CycleRecentWS.cycleRecentWS', but only cycle+-- through the most recent workspaces on the given screen.+cycleWorkspaceOnScreen+  :: ScreenId -- ^ The screen to cycle on.+  -> [KeySym] -- ^ A list of modifier keys used when invoking this+              --   action; as soon as one of them is released, the final+              --   switch is made.+  -> KeySym   -- ^ Key used to switch to next workspace.+  -> KeySym   -- ^ Key used to switch to previous workspace.+  -> X () cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do   startingHistory <- workspaceHistoryByScreen   currentWSIndex <- io $ newIORef 1@@ -83,18 +91,19 @@         current <- readIORef currentWSIndex         modifyIORef           currentWSIndex-          ((`mod` (length cycleWorkspaces)) . (+ increment))+          ((`mod` length cycleWorkspaces) . (+ increment))         return $ cycleWorkspaces !! current-      focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)+      focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView) -  focusIncrement 1 -- Do the first workspace cycle-  repeatableAction mods $+  repeatable mods nextKey $     runFirst       [ handleKeyEvent keyPress nextKey $ focusIncrement 1       , handleKeyEvent keyPress prevKey $ focusIncrement (-1)       ]   return () +-- | Like 'cycleWorkspaceOnScreen', but supply the currently focused+-- screen as the @screenId@. cycleWorkspaceOnCurrentScreen   :: [KeySym] -> KeySym -> KeySym -> X () cycleWorkspaceOnCurrentScreen mods n p =
XMonad/Actions/DeManage.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.DeManage+-- Description :  Cease management of a window without unmapping it. -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -38,7 +39,7 @@ import XMonad  -- $usage--- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@:+-- To use demanage, add this import to your @xmonad.hs@: -- -- >     import XMonad.Actions.DeManage --@@ -47,7 +48,7 @@ -- > , ((modm,               xK_d     ), withFocused demanage) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Stop managing the currently focused window. demanage :: Window -> X ()
XMonad/Actions/DwmPromote.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.DwmPromote+-- Description :  DWM-like swap function for xmonad. -- Copyright   :  (c) Miikka Koskinen 2007 -- License     :  BSD3-style (see LICENSE) --@@ -24,10 +25,13 @@  import XMonad import XMonad.StackSet+import XMonad.Prelude +import qualified Data.List.NonEmpty as NE+ -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.DwmPromote --@@ -36,7 +40,7 @@ -- >   , ((modm,               xK_Return), dwmpromote) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Swap the focused window with the master window. If focus is in --   the master, swap it with the next window in the stack. Focus@@ -44,6 +48,6 @@ dwmpromote :: X () dwmpromote = windows $ modify' $              \c -> case c of-                   Stack _ [] []     -> c-                   Stack t [] (x:rs) -> Stack x [] (t:rs)-                   Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls+                   Stack _ []     []     -> c+                   Stack t []     (r:rs) -> Stack r [] (t:rs)+                   Stack t (l:ls) rs     -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls)
XMonad/Actions/DynamicProjects.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- -------------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.DynamicProjects+-- Description :  Treat workspaces as individual project areas. -- Copyright   :  (c) Peter J. Jones -- License     :  BSD3-style (see LICENSE) --@@ -39,18 +38,14 @@        , lookupProject        , currentProject        , activateProject+       , modifyProject        ) where  ---------------------------------------------------------------------------------import Control.Applicative ((<|>))-import Control.Monad (when, unless)-import Data.Char (isSpace)-import Data.List (sort, union, stripPrefix) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map-import Data.Maybe (fromMaybe, isNothing)-import Data.Monoid ((<>))-import System.Directory (setCurrentDirectory, getHomeDirectory)+import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)+import XMonad.Prelude import XMonad import XMonad.Actions.DynamicWorkspaces import XMonad.Prompt@@ -74,7 +69,9 @@ -- the working directory to the one configured for the matching -- project.  If the workspace doesn't have any windows, the project's -- start-up hook is executed.  This allows you to launch applications--- or further configure the workspace/project.+-- or further configure the workspace/project. To close a project,+-- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces",+-- such as @removeWorkspace@ or @removeWorkspaceByTag@. -- -- When using the @switchProjectPrompt@ function, workspaces are -- created as needed.  This means you can create new project spaces@@ -114,11 +111,11 @@ -- -- And finally, configure some optional key bindings: ----- >  , ((modm, xK_space), switchProjectPrompt)--- >  , ((modm, xK_slash), shiftToProjectPrompt)+-- >  , ((modm, xK_space), switchProjectPrompt def)+-- >  , ((modm, xK_slash), shiftToProjectPrompt def) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -------------------------------------------------------------------------------- type ProjectName  = String@@ -130,14 +127,14 @@   { projectName      :: !ProjectName    -- ^ Workspace name.   , projectDirectory :: !FilePath       -- ^ Working directory.   , projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.-  } deriving Typeable+  }  -------------------------------------------------------------------------------- -- | Internal project state. data ProjectState = ProjectState   { projects        :: !ProjectTable   , previousProject :: !(Maybe WorkspaceId)-  } deriving Typeable+  }  -------------------------------------------------------------------------------- instance ExtensionClass ProjectState where@@ -145,24 +142,24 @@  -------------------------------------------------------------------------------- -- Internal types for working with XPrompt.-data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]+data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName] data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode  instance XPrompt ProjectPrompt where-  showXPrompt (ProjectPrompt submode _) =+  showXPrompt (ProjectPrompt _ submode _) =     case submode of       SwitchMode -> "Switch or Create Project: "       ShiftMode  -> "Send Window to Project: "       RenameMode -> "New Project Name: "       DirMode    -> "Change Project Directory: " -  completionFunction (ProjectPrompt RenameMode _) = return . (:[])-  completionFunction (ProjectPrompt DirMode _) =-    let xpt = directoryMultipleModes "" (const $ return ())+  completionFunction (ProjectPrompt _ RenameMode _) = return . (:[])+  completionFunction (ProjectPrompt c DirMode _) =+    let xpt = directoryMultipleModes' (complCaseSensitivity c) "" (const $ return ())     in completionFunction xpt-  completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns+  completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns -  modeAction (ProjectPrompt SwitchMode _) buf auto = do+  modeAction (ProjectPrompt _ SwitchMode _) buf auto = do     let name = if null auto then buf else auto     ps <- XS.gets projects @@ -171,18 +168,19 @@       Nothing | null name -> return ()               | otherwise -> switchProject (defProject name) -  modeAction (ProjectPrompt ShiftMode _) buf auto = do+  modeAction (ProjectPrompt _ ShiftMode _) buf auto = do     let name = if null auto then buf else auto     ps <- XS.gets projects     shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps -  modeAction (ProjectPrompt RenameMode _) name _ =+  modeAction (ProjectPrompt _ RenameMode _) name _ =     when (not (null name) && not (all isSpace name)) $ do       renameWorkspaceByName name       modifyProject (\p -> p { projectName = name }) -  modeAction (ProjectPrompt DirMode _) buf auto = do-    let dir = if null auto then buf else auto+  modeAction (ProjectPrompt _ DirMode _) buf auto = do+    let dir' = if null auto then buf else auto+    dir <- io $ makeAbsolute dir'     modifyProject (\p -> p { projectDirectory = dir })  --------------------------------------------------------------------------------@@ -230,11 +228,13 @@ -------------------------------------------------------------------------------- -- | Find a project based on its name. lookupProject :: ProjectName -> X (Maybe Project)-lookupProject name = Map.lookup name `fmap` XS.gets projects+lookupProject name = Map.lookup name <$> XS.gets projects  -------------------------------------------------------------------------------- -- | Fetch the current project (the one being used for the currently--- active workspace).+-- active workspace). If the workspace doesn't have a project, a+-- default project is returned, using the workspace name as the+-- project name. currentProject :: X Project currentProject = do   name <- gets (W.tag . W.workspace . W.current . windowset)@@ -259,20 +259,7 @@ -------------------------------------------------------------------------------- -- | Switch to the given project. switchProject :: Project -> X ()-switchProject p = do-  oldws <- gets (W.workspace . W.current . windowset)-  oldp <- currentProject--  let name = W.tag oldws-      ws   = W.integrate' (W.stack oldws)--  -- If the project we are switching away from has no windows, and-  -- it's a dynamic project, remove it from the configuration.-  when (null ws && isNothing (projectStartHook oldp)) $ do-    removeWorkspaceByTag name -- also remove the old workspace-    XS.modify (\s -> s {projects = Map.delete name $ projects s})--  appendWorkspace (projectName p)+switchProject p = appendWorkspace (projectName p)  -------------------------------------------------------------------------------- -- | Prompt for a project name and then switch to it.  Automatically@@ -326,11 +313,11 @@ -- | Prompt for a project name. projectPrompt :: [ProjectMode] -> XPConfig -> X () projectPrompt submodes c = do-  ws <- map W.tag `fmap` gets (W.workspaces . windowset)+  ws <- map W.tag <$> gets (W.workspaces . windowset)   ps <- XS.gets projects    let names = sort (Map.keys ps `union` ws)-      modes = map (\m -> XPT $ ProjectPrompt m names) submodes+      modes = map (\m -> XPT $ ProjectPrompt c m names) submodes    mkXPromptWithModes modes c
XMonad/Actions/DynamicWorkspaceGroups.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.DynamicWorkspaceGroups+-- Description :  Dynamically manage workspace groups in multi-head setups. -- Copyright   :  (c) Brent Yorgey 2009 -- License     :  BSD-style (see LICENSE) --@@ -34,20 +33,25 @@     , promptWSGroupForget      , WSGPrompt+     -- * TopicSpace Integration+     -- $topics+    , viewTopicGroup+    , promptTopicGroupView     ) where -import Data.List (find) import Control.Arrow ((&&&)) import qualified Data.Map as M  import XMonad+import XMonad.Prelude (find, for_) import qualified XMonad.StackSet as W  import XMonad.Prompt import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Actions.TopicSpace  -- $usage--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaceGroups --@@ -63,14 +67,14 @@  type WSGroupId = String -data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }-  deriving (Typeable, Read, Show)+newtype WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }+  deriving (Read, Show)  withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage withWSG f = WSG . f . unWSG  instance ExtensionClass WSGroupStorage where-  initialValue = WSG $ M.empty+  initialValue = WSG M.empty   extensionType = PersistentExtension  -- | Add a new workspace group of the given name, mapping to an@@ -85,9 +89,7 @@ addWSGroup name wids = withWindowSet $ \w -> do   let wss  = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w       wmap = mapM (strength . (flip lookup wss &&& id)) wids-  case wmap of-    Just ps -> addRawWSGroup name ps-    Nothing -> return ()+  for_ wmap (addRawWSGroup name)  where strength (ma, b) = ma >>= \a -> return (a,b)  -- | Give a name to the current workspace group.@@ -103,20 +105,23 @@  -- | View the workspace group with the given name. viewWSGroup :: WSGroupId -> X ()-viewWSGroup name = do+viewWSGroup = viewGroup (windows . W.greedyView)++-- | Internal function for viewing a group.+viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()+viewGroup fview name = do   WSG m <- XS.get-  case M.lookup name m of-    Just grp -> mapM_ (uncurry viewWS) grp-    Nothing -> return ()+  for_ (M.lookup name m) $+    mapM_ (uncurry (viewWS fview)) --- | View the given workspace on the given screen.-viewWS :: ScreenId -> WorkspaceId -> X ()-viewWS sid wid = do+-- | View the given workspace on the given screen, using the provided function.+viewWS :: (WorkspaceId -> X ())  -> ScreenId -> WorkspaceId -> X ()+viewWS fview sid wid = do   mw <- findScreenWS sid   case mw of     Just w -> do       windows $ W.view w-      windows $ W.greedyView wid+      fview wid     Nothing -> return ()  -- | Find the workspace which is currently on the given screen.@@ -124,16 +129,20 @@ findScreenWS sid = withWindowSet $   return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens -data WSGPrompt = WSGPrompt String+newtype WSGPrompt = WSGPrompt String  instance XPrompt WSGPrompt where   showXPrompt (WSGPrompt s) = s  -- | Prompt for a workspace group to view. promptWSGroupView :: XPConfig -> String -> X ()-promptWSGroupView xp s = do+promptWSGroupView = promptGroupView viewWSGroup++-- | Internal function for making a prompt to view a workspace group+promptGroupView :: (WSGroupId -> X ()) -> XPConfig -> String -> X ()+promptGroupView fview xp s = do   gs <- fmap (M.keys . unWSG) XS.get-  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) fview  -- | Prompt for a name for the current workspace group. promptWSGroupAdd :: XPConfig -> String -> X ()@@ -144,4 +153,25 @@ promptWSGroupForget :: XPConfig -> String -> X () promptWSGroupForget xp s = do   gs <- fmap (M.keys . unWSG) XS.get-  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) forgetWSGroup++-- $topics+-- You can use this module with "XMonad.Actions.TopicSpace" — just replace+-- 'promptWSGroupView' with 'promptTopicGroupView':+--+-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")+-- >    , ("M-y g", promptTopicGroupView myTopicConfig myXPConfig "Go to group: ")+-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")+--+-- It's also a good idea to replace 'spawn' with+-- 'XMonad.Actions.SpawnOn.spawnOn' or 'XMonad.Actions.SpawnOn.spawnHere' in+-- your topic actions, so everything is spawned where it should be.++-- | Prompt for a workspace group to view, treating the workspaces as topics.+promptTopicGroupView :: TopicConfig -> XPConfig -> String -> X ()+promptTopicGroupView = promptGroupView . viewTopicGroup++-- | View the workspace group with the given name, treating the workspaces as+-- topics.+viewTopicGroup :: TopicConfig -> WSGroupId -> X ()+viewTopicGroup = viewGroup . switchTopic
XMonad/Actions/DynamicWorkspaceOrder.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.DynamicWorkspaceOrder+-- Description :  Remember a dynamically updateable ordering on workspaces. -- Copyright   :  (c) Brent Yorgey 2009 -- License     :  BSD-style (see LICENSE) --@@ -12,7 +11,7 @@ -- -- Remember a dynamically updateable ordering on workspaces, together -- with tools for using this ordering with "XMonad.Actions.CycleWS"--- and "XMonad.Hooks.DynamicLog".+-- and "XMonad.Hooks.StatusBar.PP". -- ----------------------------------------------------------------------------- @@ -23,6 +22,8 @@       getWsCompareByOrder     , getSortByOrder     , swapWith+    , swapWithCurrent+    , swapOrder     , updateName     , removeName @@ -30,6 +31,7 @@     , moveToGreedy     , shiftTo +    , withNthWorkspace'     , withNthWorkspace      ) where@@ -43,11 +45,11 @@  import qualified Data.Map as M import qualified Data.Set as S-import Data.Maybe (fromJust, fromMaybe)+import XMonad.Prelude (fromJust, fromMaybe) import Data.Ord (comparing)  -- $usage--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO --@@ -66,10 +68,10 @@ -- order of workspaces must be updated to use the auxiliary ordering. -- -- To change the order in which workspaces are displayed by--- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your--- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:+-- "XMonad.Hooks.StatusBar.PP", use 'getSortByOrder' in your+-- 'XMonad.Hooks.StatusBar.PP.ppSort' field, for example: ----- >   ... dynamicLogWithPP $ byorgeyPP {+-- >   myPP = ... byorgeyPP { -- >     ... -- >     , ppSort = DO.getSortByOrder -- >     ...@@ -88,8 +90,8 @@ -- tweak as desired.  -- | Extensible state storage for the workspace order.-data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }-  deriving (Typeable, Read, Show)+newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }+  deriving (Read, Show)  instance ExtensionClass WSOrderStorage where   initialValue = WSO Nothing@@ -150,7 +152,8 @@ swapOrder w1 w2 = do   io $ print (w1,w2)   WSO (Just m) <- XS.get-  let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]+  let i1 = fromJust (w1 `M.lookup` m)+  let i2 = fromJust (w2 `M.lookup` m)   XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))   windows id  -- force a status bar update @@ -183,13 +186,19 @@ shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift) --- | Do something with the nth workspace in the dynamic order.  The---   callback is given the workspace's tag as well as the 'WindowSet'---   of the workspace itself.-withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()-withNthWorkspace job wnum = do+-- | Do something with the nth workspace in the dynamic order after+--   transforming it.  The callback is given the workspace's tag as well+--   as the 'WindowSet' of the workspace itself.+withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()+withNthWorkspace' tr job wnum = do   sort <- getSortByOrder-  ws <- gets (map W.tag . sort . W.workspaces . windowset)+  ws <- gets (tr . map W.tag . sort . W.workspaces . windowset)   case drop wnum ws of     (w:_) -> windows $ job w     []    -> return ()++-- | Do something with the nth workspace in the dynamic order.  The+--   callback is given the workspace's tag as well as the 'WindowSet'+--   of the workspace itself.+withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()+withNthWorkspace = withNthWorkspace' id
XMonad/Actions/DynamicWorkspaces.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.DynamicWorkspaces+-- Description :  Provides bindings to add and delete workspaces. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -35,19 +34,17 @@                                          WorkspaceIndex                                        ) where +import XMonad.Prelude (find, isNothing, nub, when) import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter, modify, delete) import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )-import XMonad.Prompt ( XPConfig, mkXPrompt )+import XMonad.Prompt ( XPConfig, mkComplFunFromList', mkXPrompt ) import XMonad.Util.WorkspaceCompare ( getSortByIndex )-import Data.List (find)-import Data.Maybe (isNothing)-import Control.Monad (when) import qualified Data.Map.Strict as Map import qualified XMonad.Util.ExtensibleState as XS  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaces -- > import XMonad.Actions.CopyWindow(copy)@@ -78,7 +75,7 @@ -- >    zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..]) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. See also the documentation for -- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.  type WorkspaceTag = String@@ -88,8 +85,8 @@  -- | Internal dynamic project state that stores a mapping between --   workspace indexes and workspace tags.-data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}-  deriving (Typeable, Read, Show)+newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}+  deriving (Read, Show)  instance ExtensionClass DynamicWorkspaceState where   initialValue = DynamicWorkspaceState Map.empty@@ -108,11 +105,7 @@   maybe (return ()) (windows . job) wtag     where       ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)-      ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap---mkCompl :: [String] -> String -> IO [String]-mkCompl l s = return $ filter (\x -> take (length s) x == s) l+      ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap  withWorkspace :: XPConfig -> (String -> X ()) -> X () withWorkspace c job = do ws <- gets (workspaces . windowset)@@ -120,21 +113,21 @@                          let ts = map tag $ sort ws                              job' t | t `elem` ts = job t                                     | otherwise = addHiddenWorkspace t >> job t-                         mkXPrompt (Wor "") c (mkCompl ts) job'+                         mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job'  renameWorkspace :: XPConfig -> X () renameWorkspace conf = workspacePrompt conf renameWorkspaceByName  renameWorkspaceByName :: String -> X () renameWorkspaceByName w = do old  <- gets (currentTag . windowset)-			     windows $ \s -> let sett wk = wk { tag = w }-						 setscr scr = scr { workspace = sett $ workspace scr }-						 sets q = q { current = setscr $ current q }+                             windows $ \s -> let sett wk = wk { tag = w }+                                                 setscr scr = scr { workspace = sett $ workspace scr }+                                                 sets q = q { current = setscr $ current q }                                              in sets $ removeWorkspace' w s-			     updateIndexMap old w-  where updateIndexMap old new = do+                             updateIndexMap old w+  where updateIndexMap oldIM newIM = do           wmap <- XS.gets workspaceIndexMap-          XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == old then new else t) wmap}+          XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == oldIM then newIM else t) wmap}  toNthWorkspace :: (String -> X ()) -> Int -> X () toNthWorkspace job wnum = do sort <- getSortByIndex@@ -241,20 +234,20 @@                return $ maybe True (isNothing . stack) mws  addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd-addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }+addHiddenWorkspace' add newtag l s@StackSet{ hidden = ws } = s { hidden = add (Workspace newtag l Nothing) ws }  -- | Remove the hidden workspace with the given tag from the StackSet, if --   it exists. All the windows in that workspace are moved to the current --   workspace.-removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd-removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })-                                   , hidden = hs })+removeWorkspace' :: (Eq i, Eq a) => i -> StackSet i l a sid sd -> StackSet i l a sid sd+removeWorkspace' torem s@StackSet{ current = scr@Screen { workspace = wc }+                                 , hidden  = hs }     = let (xs, ys) = break ((== torem) . tag) hs       in removeWorkspace'' xs ys    where meld Nothing Nothing = Nothing          meld x Nothing = x          meld Nothing x = x-         meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)+         meld (Just x) (Just y) = differentiate . nub $ integrate x ++ integrate y          removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }                                          , hidden = xs ++ ys }          removeWorkspace'' _  _      = s
+ XMonad/Actions/EasyMotion.hs view
@@ -0,0 +1,391 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.EasyMotion+-- Description :  Focus a visible window using a key chord.+-- Copyright   :  (c) Matt Kingston <mattkingston@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  mattkingston@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides functionality to use key chords to focus a visible window. Overlays a unique key chord+-- (a string) above each visible window and allows the user to select a window by typing that+-- chord.+-- Inspired by <https://github.com/easymotion/vim-easymotion vim-easymotion>.+-- Thanks to <https://github.com/larkery Tom Hinton> for some feature inspiration and window+-- sorting code.+--+-----------------------------------------------------------------------------++module XMonad.Actions.EasyMotion ( -- * Usage+                                   -- $usage+                                   selectWindow++                                   -- * Configuration+                                 , EasyMotionConfig(..)+                                 , ChordKeys(..)+                                 , def++                                   -- * Creating overlays+                                 , fullSize+                                 , fixedSize+                                 , textSize+                                 , proportional+                                 , bar+                                 ) where++import           XMonad+import           XMonad.Prelude+import qualified XMonad.StackSet          as W+import           XMonad.Util.Font         (releaseXMF, initXMF, Align(AlignCenter), XMonadFont(..), textExtentsXMF)+import           XMonad.Util.XUtils       (createNewWindow, paintAndWrite, deleteWindow, showWindow)++import           Control.Arrow            ((&&&))+import qualified Data.Map.Strict as M     (Map, elems, map, mapWithKey)++-- $usage+--+-- You can use this module's basic functionality with the following in your+-- @xmonad.hs@:+--+-- >    import XMonad.Actions.EasyMotion (selectWindow)+--+-- To customise+--+-- >    import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..))+--+-- Then add a keybinding and an action to the 'selectWindow' function.+-- In this case @M-f@ to focus the selected window:+--+-- >    , ((modm, xK_f), selectWindow def >>= (`whenJust` windows . W.focusWindow))+--+-- Similarly, to kill a window with @M-f@:+--+-- >    , ((modm, xK_f), selectWindow def >>= (`whenJust` killWindow))+--+-- See 'EasyMotionConfig' for all configuration options. A short summary follows.+--+-- Default chord keys are @s,d,f,j,k,l@. To customise these and display options assign+-- different values to 'def' (the default configuration):+--+-- >    , ((modm, xK_f), (selectWindow def{sKeys = AnyKeys [xK_f, xK_d]}) >>= (`whenJust` windows . W.focusWindow))+--+-- You must supply at least two different keys in the 'sKeys' list. Keys provided earlier in the list+-- will be used preferentially—therefore, keys you would like to use more frequently should be+-- earlier in the list.+--+-- To map different sets of keys to different screens. The following configuration maps keys @fdsa@+-- to screen 0 and @hjkl@ to screen 1. Keys provided earlier in the list will be used preferentially.+-- Providing the same key for multiple screens is possible but will break down in some scenarios.+--+-- >    import qualified Data.Map.Strict as StrictMap (fromList)+-- >    emConf :: EasyMotionConfig+-- >    emConf = def { sKeys = PerScreenKeys $ StrictMap.fromList [(0, [xK_f, xK_d, xK_s, xK_a]), (1, [xK_h, xK_j, xK_k, xK_l])] }+-- >    -- key bindings+-- >    , ((modm, xK_f), selectWindow emConf >>= (`whenJust` windows . W.focusWindow))+--+-- To customise the font:+--+-- >    , ((modm, xK_f), (selectWindow def{emFont = "xft: Sans-40"}) >>= (`whenJust` windows . W.focusWindow))+--+-- The 'emFont' field provided is supplied directly to the 'initXMF' function. The default is+-- @"xft:Sans-100"@. Some example options:+--+-- >    "xft: Sans-40"+-- >    "xft: Arial-100"+-- >    "xft: Cambria-80"+--+-- Customise the overlay by supplying a function to 'overlayF'. The signature is+-- @'Position' -> 'Rectangle' -> 'Rectangle'@. The parameters are the height in pixels of+-- the selection chord and the rectangle of the window to be overlaid. Some are provided:+--+-- >    import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..), proportional, bar, fullSize)+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = proportional 0.3  }) >>= (`whenJust` windows . W.focusWindow))+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = bar 0.5           }) >>= (`whenJust` windows . W.focusWindow))+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = fullSize          }) >>= (`whenJust` windows . W.focusWindow))+-- >    , ((modm, xK_f), (selectWindow def{ overlayF = fixedSize 300 350 }) >>= (`whenJust` windows . W.focusWindow))++-- TODO:+--  - An overlay function that creates an overlay a proportion of the width XOR height of the+--    window it's over, and with a fixed w/h proportion? E.g. overlay-height = 0.3 *+--    target-window-height; overlay-width = 0.5 * overlay-height.+--  - An overlay function that creates an overlay of a fixed w,h, aligned mid,mid, or parametrised+--    alignment?+--  - Parametrise chord generation?+--  - W.shift example; bring window from other screen to current screen? Only useful if we don't+--    show chords on current workspace.+--  - Use stringToKeysym, keysymToKeycode, keycodeToKeysym, keysymToString to take a string from+--    the user?+--  - Think a bit more about improving functionality with floating windows.+--    - currently, floating window z-order is not respected+--    - could ignore floating windows+--    - may be able to calculate the visible section of a floating window, and display the chord in+--      that space+--  - Provide an option to prepend the screen key to the easymotion keys (i.e. w,e,r)?+--  - overlay alpha+--  - Delay after selection so the user can see what they've chosen? Min-delay: 0 seconds. If+--    there's a delay, perhaps keep the other windows covered briefly to naturally draw the user's+--    attention to the window they've selected? Or briefly highlight the border of the selected+--    window?+--  - Option to cover windows that will not be selected by the current chord, such that it's+--    slightly more obvious where to maintain focus.+--  - Something unpleasant happens when the user provides only two keys (let's say f, d) for+--    chords. When they have five windows open, the following chords are generated: ddd, ddf, dfd,+--    dff, fdd. When 'f' is pressed, all chords disappear unexpectedly because we know there are no+--    other valid options. The user expects to press 'fdd'. This is an optimisation in software but+--    pretty bad for usability, as the user continues firing keys into their+--    now-unexpectedly-active window. And is of course only one concrete example of a more general+--    problem.+--    Short-term solution:+--      - Keep displaying the chord until the user has fully entered it+--    Fix:+--      - Show the shortest possible chords++-- | Associates a user window, an overlay window created by this module and a rectangle+--   circumscribing these windows+data OverlayWindow =+  OverlayWindow { win     :: !Window           -- ^ The window managed by xmonad+                , attrs   :: !WindowAttributes -- ^ Window attributes for @win@+                , overlay :: !Window           -- ^ Our window used to display the overlay+                , rect    :: !Rectangle        -- ^ The rectangle of @overlay@+                }++-- | An overlay window and the chord used to select it+data Overlay =+  Overlay { overlayWin :: !OverlayWindow    -- ^ The window managed by xmonad+          , chord      :: ![KeySym]         -- ^ The chord we'll display in the overlay+          }+++-- | Maps keys to windows. 'AnyKeys' maps keys to windows regardless which screen they're on.+--   'PerScreenKeys' maps keys to screens to windows. See @Usage@ for more examples.+data ChordKeys = AnyKeys       ![KeySym]+               | PerScreenKeys !(M.Map ScreenId [KeySym])++-- | Configuration options for EasyMotion.+--+--   All colors are hex strings, e.g. "#000000"+--+--   If the number of windows for which chords are required exceeds 'maxChordLen', chords+--   will simply not be generated for these windows. In this way, single-key selection may be+--   preferred over the ability to select any window.+--+--   'cancelKey', @xK_BackSpace@ and any duplicates will be removed from 'sKeys' if included.+--   See @Usage@ for examples of 'sKeys'.+data EasyMotionConfig =+  EMConf { txtCol      :: !String                               -- ^ Color of the text displayed+         , bgCol       :: !String                               -- ^ Color of the window overlaid+         , overlayF    :: !(Position -> Rectangle -> Rectangle) -- ^ Function to generate overlay rectangle+         , borderCol   :: !String                               -- ^ Color of the overlay window borders+         , sKeys       :: !ChordKeys                            -- ^ Keys to use for window selection+         , cancelKey   :: !KeySym                               -- ^ Key to use to cancel selection+         , emFont      :: !String                               -- ^ Font for selection characters (passed to 'initXMF')+         , borderPx    :: !Int                                  -- ^ Width of border in pixels+         , maxChordLen :: !Int                                  -- ^ Maximum chord length. Use 0 for no maximum.+         }++instance Default EasyMotionConfig where+  def =+    EMConf { txtCol      = "#ffffff"+           , bgCol       = "#000000"+           , overlayF    = proportional (0.3::Double)+           , borderCol   = "#ffffff"+           , sKeys       = AnyKeys [xK_s, xK_d, xK_f, xK_j, xK_k, xK_l]+           , cancelKey   = xK_q+           , borderPx    = 1+           , maxChordLen = 0+#ifdef XFT+           , emFont      = "xft:Sans-100"+#else+           , emFont      = "-misc-fixed-*-*-*-*-200-*-*-*-*-*-*-*"+#endif+           }++-- | Create overlay windows of the same size as the window they select+fullSize :: Position -> Rectangle -> Rectangle+fullSize _ = id++-- | Create overlay windows a proportion of the size of the window they select+proportional :: RealFrac f => f -> Position -> Rectangle -> Rectangle+proportional f th r = Rectangle { rect_width  = newW+                                , rect_height = newH+                                , rect_x      = rect_x r + fi (rect_width r - newW) `div` 2+                                , rect_y      = rect_y r + fi (rect_height r - newH) `div` 2 }+ where+  newH = max (fi th) (round $ f * fi (rect_height r))+  newW = newH++-- | Create fixed-size overlay windows+fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle+fixedSize w h th r = Rectangle { rect_width  = rw+                               , rect_height = rh+                               , rect_x      = rect_x r + fi (rect_width r - rw) `div` 2+                               , rect_y      = rect_y r + fi (rect_height r - rh) `div` 2 }+ where+  rw = max (fi w) (fi th)+  rh = max (fi h) (fi th)++-- | Create overlay windows the minimum size to contain their key chord+textSize :: Position -> Rectangle -> Rectangle+textSize th r = Rectangle { rect_width  = fi th+                          , rect_height = fi th+                          , rect_x      = rect_x r + (fi (rect_width r) - fi th) `div` 2+                          , rect_y      = rect_y r + (fi (rect_height r) - fi th) `div` 2 }++-- | Create overlay windows the full width of the window they select, the minimum height to contain+--   their chord, and a proportion of the distance from the top of the window they select+bar :: RealFrac f => f -> Position -> Rectangle -> Rectangle+bar f th r = Rectangle { rect_width  = rect_width r+                       , rect_height = fi th+                       , rect_x      = rect_x r+                       , rect_y      = rect_y r + round (f' * (fi (rect_height r) - fi th)) }+ where+   -- clamp f in [0,1] as other values will appear to lock up xmonad as the overlay will be+   -- displayed off-screen+   f' = min 0.0 $ max f 1.0++-- | Handles overlay display and window selection. Called after config has been sanitised.+handleSelectWindow :: EasyMotionConfig -> X (Maybe Window)+handleSelectWindow EMConf { sKeys = AnyKeys [] } = return Nothing+handleSelectWindow c = do+  f <- initXMF $ emFont c+  th <- (\(asc, dsc) -> asc + dsc + 2) <$> textExtentsXMF f (concatMap keysymToString (allKeys . sKeys $ c))+  XConf { theRoot = rw, display = dpy } <- ask+  XState { mapped = mappedWins, windowset = ws } <- get+  -- build overlays depending on key configuration+  overlays :: [Overlay] <- case sKeys c of+    AnyKeys ks -> buildOverlays ks <$> sortedOverlayWindows+     where+      visibleWindows :: [Window]+      visibleWindows = toList mappedWins+      sortedOverlayWindows :: X [OverlayWindow]+      sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows th visibleWindows+    PerScreenKeys m ->+      fmap concat+        $ sequence+        $ M.elems+        $ M.mapWithKey (\sid ks -> buildOverlays ks <$> sortedOverlayWindows sid) m+     where+      screenById :: ScreenId -> Maybe WindowScreen+      screenById sid = find ((== sid) . W.screen) (W.screens ws)+      visibleWindowsOnScreen :: ScreenId -> [Window]+      visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace+      sortedOverlayWindows :: ScreenId -> X [OverlayWindow]+      sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows th (visibleWindowsOnScreen sid)+  status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime+  if status == grabSuccess+    then do+      resultWin <- handleKeyboard dpy (displayOverlay f) (cancelKey c) overlays []+      io $ ungrabKeyboard dpy currentTime+      mapM_ (deleteWindow . overlay . overlayWin) overlays+      io $ sync dpy False+      releaseXMF f+      case resultWin of+        -- focus the selected window+        Selected o -> return . Just . win . overlayWin $ o+        -- return focus correctly+        _ -> whenJust (W.peek ws) (windows . W.focusWindow) $> Nothing+    else releaseXMF f $> Nothing+ where+  allKeys :: ChordKeys -> [KeySym]+  allKeys (AnyKeys ks) = ks+  allKeys (PerScreenKeys m) = concat $ M.elems m++  buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]+  buildOverlays = appendChords (maxChordLen c)++  buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]+  buildOverlayWindows th = fmap (fromMaybe [] . sequenceA)+                         . traverse (buildOverlayWin th)++  sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]+  sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)++  makeRect :: WindowAttributes -> Rectangle+  makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa))++  buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow)+  buildOverlayWin th w = safeGetWindowAttributes w >>= \case+    Nothing     -> pure Nothing+    Just wAttrs -> do+      let r = overlayF c th $ makeRect wAttrs+      o <- createNewWindow r Nothing "" True+      return . Just $ OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }++  -- | Display an overlay with the provided formatting+  displayOverlay :: XMonadFont -> Overlay -> X ()+  displayOverlay f Overlay { overlayWin = OverlayWindow { rect = r, overlay = o }, chord = ch } = do+    showWindow o+    paintAndWrite o f (fi (rect_width r)) (fi (rect_height r)) (fi (borderPx c)) (bgCol c) (borderCol c) (txtCol c) (bgCol c) [AlignCenter] [concatMap keysymToString ch]++-- | Display overlay windows and chords for window selection+selectWindow :: EasyMotionConfig -> X (Maybe Window)+selectWindow conf =+  handleSelectWindow conf { sKeys = sanitiseKeys (sKeys conf) }+ where+  -- make sure the key lists don't contain: backspace, our cancel key, or duplicates+  sanitise :: [KeySym] -> [KeySym]+  sanitise = nub . filter (`notElem` [xK_BackSpace, cancelKey conf])+  sanitiseKeys :: ChordKeys -> ChordKeys+  sanitiseKeys cKeys =+    case cKeys of+      AnyKeys ks -> AnyKeys . sanitise $ ks+      PerScreenKeys m -> PerScreenKeys $ M.map sanitise m++-- | Take a list of overlays lacking chords, return a list of overlays with key chords+appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay]+appendChords _ [] _ = []+appendChords maxUserSelectedLen ks overlayWins =+  zipWith Overlay overlayWins chords+ where+  chords = replicateM chordLen ks+  -- the minimum necessary chord length to assign a unique chord to each visible window+  minCoverLen = -((-(length overlayWins)) `div` length ks)+  -- if the user has specified a max chord length we use this even if it will not cover all+  -- windows, as they may prefer to focus windows with fewer keys over the ability to focus any+  -- window+  chordLen = if maxUserSelectedLen <= 0 then minCoverLen else min minCoverLen maxUserSelectedLen++-- | A three-state result for handling user-initiated selection cancellation, successful selection,+--   or backspace.+data HandleResult = Exit | Selected Overlay | Backspace++-- | Handle key press events for window selection.+handleKeyboard :: Display -> (Overlay -> X()) -> KeySym -> [Overlay] -> [Overlay] -> X HandleResult+handleKeyboard _ _ _ [] _ = return Exit+handleKeyboard dpy drawFn cancel selected deselected = do+  redraw+  ev <- io $ allocaXEvent $ \e -> do+    maskEvent dpy (keyPressMask .|. keyReleaseMask .|. buttonPressMask) e+    getEvent e+  if | ev_event_type ev == keyPress -> do+         s <- io $ keycodeToKeysym dpy (ev_keycode ev) 0+         if | s == cancel -> return Exit+            | s == xK_BackSpace -> return Backspace+            | isNextOverlayKey s -> handleNextOverlayKey s+            | otherwise -> handleKeyboard dpy drawFn cancel selected deselected+     | ev_event_type ev == buttonPress -> do+         -- See XMonad.Prompt Note [Allow ButtonEvents]+         io $ allowEvents dpy replayPointer currentTime+         handleKeyboard dpy drawFn cancel selected deselected+     | otherwise -> handleKeyboard dpy drawFn cancel selected deselected+ where+  redraw = mapM (mapM_ drawFn) [selected, deselected]+  retryBackspace x =+    case x of+      Backspace -> redraw >> handleKeyboard dpy drawFn cancel selected deselected+      _ -> return x+  isNextOverlayKey keySym = isJust (find ((== Just keySym) . listToMaybe .chord) selected)+  handleNextOverlayKey keySym =+    case fg of+      [x] -> return $ Selected x+      _   -> handleKeyboard dpy drawFn cancel (trim fg) (clear bg) >>= retryBackspace+   where+    (fg, bg) = partition ((== Just keySym) . listToMaybe . chord) selected+    trim = map (\o -> o { chord = drop 1 $ chord o })+    clear = map (\o -> o { chord = [] })
XMonad/Actions/FindEmptyWorkspace.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.FindEmptyWorkspace+-- Description :  Find an empty workspace. -- Copyright   :  (c) Miikka Koskinen 2007 -- License     :  BSD3-style (see LICENSE) --@@ -18,15 +19,13 @@     viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace   ) where -import Data.List-import Data.Maybe ( isNothing )-+import XMonad.Prelude import XMonad import XMonad.StackSet  -- $usage ----- To use, import this module into your @~\/.xmonad\/xmonad.hs@:+-- To use, import this module into your @xmonad.hs@: -- -- >   import XMonad.Actions.FindEmptyWorkspace --@@ -39,7 +38,7 @@ -- will tag the current window to an empty workspace and view it. -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Find the first hidden empty workspace in a StackSet. Returns -- Nothing if all workspaces are in use. Function searches currently
XMonad/Actions/FlexibleManipulate.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.FlexibleManipulate+-- Description :  Move and resize floating windows without warping the mouse. -- Copyright   :  (c) Michael Sloan -- License     :  BSD3-style (see LICENSE) --@@ -23,11 +24,12 @@ ) where  import XMonad+import XMonad.Prelude ((<&>), fi) import qualified Prelude as P-import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)+import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($))  -- $usage--- First, add this import to your @~\/.xmonad\/xmonad.hs@:+-- First, add this import to your @xmonad.hs@: -- -- > import qualified XMonad.Actions.FlexibleManipulate as Flex --@@ -78,43 +80,36 @@ -- | Given an interpolation function, implement an appropriate window --   manipulation action. mouseWindow :: (Double -> Double) -> Window -> X ()-mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do+    let wpos  = (fi (wa_x wa), fi (wa_y wa))+        wsize = (fi (wa_width wa), fi (wa_height wa))     sh <- io $ getWMNormalHints d w-    pointer <- io $ queryPointer d w >>= return . pointerPos+    pointer <- io $ queryPointer d w <&> pointerPos      let uv = (pointer - wpos) / wsize         fc = mapP f uv         mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle         atl = ((1, 1) - fc) * mul         abr = fc * mul-    mouseDrag (\ex ey -> io $ do+    mouseDrag (\ex ey -> do         let offset = (fromIntegral ex, fromIntegral ey) - pointer             npos = wpos + offset * atl             nbr = (wpos + wsize) + offset * abr             ntl = minP (nbr - (32, 32)) npos    --minimum size             nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)-        moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth-        return ())+        io $ moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth+        float w)         (float w)      float w    where     pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt-    winAttrs :: WindowAttributes -> [Pnt]-    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] - -- I'd rather I didn't have to do this, but I hate writing component 2d math type Pnt = (Double, Double) -pairUp :: [a] -> [(a,a)]-pairUp [] = []-pairUp [_] = []-pairUp (x:y:xs) = (x, y) : (pairUp xs)- mapP :: (a -> b) -> (a, a) -> (b, b) mapP f (x, y) = (f x, f y) zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)@@ -132,4 +127,3 @@ (*) = zipP (P.*) (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a) (/) = zipP (P./)-
XMonad/Actions/FlexibleResize.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.FlexibleResize+-- Description :  Resize floating windows from any corner. -- Copyright   :  (c) Lukas Mai -- License     :  BSD3-style (see LICENSE) --@@ -20,11 +21,11 @@ ) where  import XMonad-import XMonad.Util.XUtils (fi)+import XMonad.Prelude (fi) import Foreign.C.Types  -- $usage--- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:+-- To use, first import this module into your @xmonad.hs@ file: -- -- > import qualified XMonad.Actions.FlexibleResize as Flex --@@ -49,29 +50,32 @@   :: Rational -- ^ The size of the area where only one edge is resized.   -> Window   -- ^ The window to resize.   -> X ()-mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     sh <- io $ getWMNormalHints d w     (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w     let-        [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height]+        pos_x  = fi $ wa_x wa+        pos_y  = fi $ wa_y wa+        width  = fi $ wa_width wa+        height = fi $ wa_height wa         west  = findPos ix width         north = findPos iy height         (cx, fx, gx) = mkSel west  width  pos_x         (cy, fy, gy) = mkSel north height pos_y     io $ warpPointer d none w 0 0 0 0 cx cy     mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey)-                            io $ moveResizeWindow d w (fx nw) (fy nh) nw nh)+                            io $ moveResizeWindow d w (fx nw) (fy nh) nw nh+                            float w)               (float w)     where     findPos :: CInt -> Position -> Maybe Bool-    findPos m s = if p < 0.5 - edge/2-                  then Just True-                  else if p < 0.5 + edge/2-                       then Nothing-                       else Just False-                  where p = fi m / fi s+    findPos m s+      | p < 0.5 - edge/2 = Just True+      | p < 0.5 + edge/2 = Nothing+      | otherwise = Just False+      where+          p = fi m / fi s     mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)     mkSel b k p = case b of                       Just True ->  (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
XMonad/Actions/FloatKeys.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.FloatKeys+-- Description  :  Move and resize floating windows. -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de> -- License      : BSD --@@ -18,13 +19,18 @@                 keysMoveWindowTo,                 keysResizeWindow,                 keysAbsResizeWindow,-                P, G,+                directionMoveWindow,+                directionResizeWindow,+                Direction2D(..),+                P, G, ChangeDim                 ) where  import XMonad+import XMonad.Prelude (fi)+import XMonad.Util.Types  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.FloatKeys --@@ -36,17 +42,44 @@ -- >  , ((modm .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) -- >  , ((modm,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) --+-- Using "XMonad.Util.EZConfig" syntax, we can easily build keybindings+-- where @M-\<arrow-keys\>@ moves the currently focused window and+-- @M-S-\<arrow-keys\>@ resizes it using 'directionMoveWindow' and+-- 'directionResizeWindow':+--+-- > [ ("M-" <> m <> k, withFocused $ f i)+-- > | (i, k) <- zip [U, D, R, L] ["<Up>", "<Down>", "<Right>", "<Left>"]+-- > , (f, m) <- [(directionMoveWindow 10, ""), (directionResizeWindow 10, "S-")]+-- > ]+-- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. +-- | @directionMoveWindow delta dir win@ moves the window @win@ by+--   @delta@ pixels in direction @dir@.+directionMoveWindow :: Int -> Direction2D -> Window -> X ()+directionMoveWindow delta dir win = case dir of+  U -> keysMoveWindow (0, -delta) win+  D -> keysMoveWindow (0, delta)  win+  R -> keysMoveWindow (delta, 0)  win+  L -> keysMoveWindow (-delta, 0) win++-- | @directionResizeWindow delta dir win@ resizes the window @win@ by+--   @delta@ pixels in direction @dir@.+directionResizeWindow :: Int -> Direction2D -> Window -> X ()+directionResizeWindow delta dir win = case dir of+  U -> keysResizeWindow (0, -delta) (0, 0) win+  D -> keysResizeWindow (0, delta)  (0, 0) win+  R -> keysResizeWindow (delta, 0)  (0, 0) win+  L -> keysResizeWindow (-delta, 0) (0, 0) win+ -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the --   right and @dy@ pixels down.-keysMoveWindow :: D -> Window -> X ()-keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w-    io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx))-                        (fromIntegral (fromIntegral (wa_y wa) + dy))+keysMoveWindow :: ChangeDim -> Window -> X ()+keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do+    io $ moveWindow d w (fi (fi (wa_x wa) + dx))+                        (fi (fi (wa_y wa) + dy))     float w  -- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative@@ -60,15 +93,15 @@ -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen -- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner keysMoveWindowTo :: P -> G -> Window -> X ()-keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w-    io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa)))-                        (y - round (gy * fromIntegral (wa_height wa)))+keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do+    io $ moveWindow d w (x - round (gx * fi (wa_width wa)))+                        (y - round (gy * fi (wa_height wa)))     float w  type G = (Rational, Rational) type P = (Position, Position)+type ChangeDim = (Int, Int)  -- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@ --   and the height by @dy@, leaving the window-relative point @(gx,@@ -80,7 +113,7 @@ -- > keysResizeWindow (10, 0) (0, 1%2)    -- does the same, unless sizeHints are applied -- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side -- > keysResizeWindow (-10, -10) (0, 1)   -- shrink the window in direction of the bottom-left corner-keysResizeWindow :: D -> G -> Window -> X ()+keysResizeWindow :: ChangeDim -> G -> Window -> X () keysResizeWindow = keysMoveResize keysResizeWindow'  -- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@@@ -90,34 +123,34 @@ --   For example: -- -- > keysAbsResizeWindow (10, 10) (0, 0)   -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.-keysAbsResizeWindow :: D -> D -> Window -> X ()+keysAbsResizeWindow :: ChangeDim -> D -> Window -> X () keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow' -keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)+keysAbsResizeWindow' :: SizeHints -> P -> D -> ChangeDim -> D -> (P,D) keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))     where-        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)+        -- The width and height of a window are positive and thus+        -- converting to 'Dimension' should be safe.+        (nw, nh) = applySizeHintsContents sh (fi w + dx, fi h + dy)         nx :: Rational-        nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w+        nx = fi (ax * w + nw * (fi x - ax)) / fi w         ny :: Rational-        ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h+        ny = fi (ay * h + nh * (fi y - ay)) / fi h -keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)+keysResizeWindow' :: SizeHints -> P -> D -> ChangeDim -> G -> (P,D) keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))     where-        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)-        nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw-        ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh+        (nw, nh) = applySizeHintsContents sh (fi w + dx, fi h + dy)+        nx = round $ fi x + gx * fi w - gx * fi nw+        ny = round $ fi y + gy * fi h - gy * fi nh  keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()-keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     sh <- io $ getWMNormalHints d w-    let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)-        wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa)+    let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)+        wa_pos = (fi $ wa_x wa, fi $ wa_y wa)         (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize     io $ resizeWindow d w `uncurry` wn_dim     io $ moveWindow d w `uncurry` wn_pos     float w-
XMonad/Actions/FloatSnap.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.FloatSnap+-- Description :  Snap to other windows or the edge of the screen while moving or resizing. -- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -27,9 +28,7 @@                 ifClick') where  import XMonad-import Control.Applicative((<$>))-import Data.List (sort)-import Data.Maybe (listToMaybe,fromJust,isNothing)+import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when) import qualified XMonad.StackSet as W import qualified Data.Set as S @@ -38,7 +37,7 @@ import XMonad.Actions.AfterDrag  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.FloatSnap --@@ -54,7 +53,7 @@ -- >        , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- And possibly add appropriate mouse bindings, for example: --@@ -93,17 +92,17 @@     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.     -> Window    -- ^ The window to move and resize.     -> X ()-snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do-    wa <- io $ getWindowAttributes d w+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     (_, _, _, px, py, _, _, _) <- io $ queryPointer d w-    let x = (fromIntegral px - wx wa)/(ww wa)-        y = (fromIntegral py - wy wa)/(wh wa)-        ml = if x <= (0.5 - middle/2) then [L] else []-        mr = if x >  (0.5 + middle/2) then [R] else []-        mu = if y <= (0.5 - middle/2) then [U] else []-        md = if y >  (0.5 + middle/2) then [D] else []+    let x = (fromIntegral px - wx wa)/ww wa+        y = (fromIntegral py - wy wa)/wh wa+        ml = [L | x <= (0.5 - middle/2)]+        mr = [R | x >  (0.5 + middle/2)]+        mu = [U | y <= (0.5 - middle/2)]+        md = [D | y >  (0.5 + middle/2)]         mdir = ml++mr++mu++md-        dir = if mdir == []+        dir = if null mdir               then [L,R,U,D]               else mdir     snapMagicResize dir collidedist snapdist w@@ -120,19 +119,17 @@     -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.     -> Window      -- ^ The window to move and resize.     -> X ()-snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w-+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     (xbegin,xend) <- handleAxis True d wa     (ybegin,yend) <- handleAxis False d wa -    let xbegin' = if L `elem` dir then xbegin else (wx wa)-        xend'   = if R `elem` dir then xend   else (wx wa + ww wa)-        ybegin' = if U `elem` dir then ybegin else (wy wa)-        yend'   = if D `elem` dir then yend   else (wy wa + wh wa)+    let xbegin' = if L `elem` dir then xbegin else wx wa+        xend'   = if R `elem` dir then xend   else wx wa + ww wa+        ybegin' = if U `elem` dir then ybegin else wy wa+        yend'   = if D `elem` dir then yend   else wy wa + wh wa -    io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')+    io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin')     io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')     float w     where@@ -152,13 +149,13 @@                             (Nothing,Nothing) -> wpos wa                 end = if fs                       then wpos wa + wdim wa-                      else case (if mfl==(Just begin) then Nothing else mfl,mfr) of+                      else case (if mfl==Just begin then Nothing else mfl,mfr) of                           (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr                           (Just fl,Nothing) -> fl                           (Nothing,Just fr) -> fr                           (Nothing,Nothing) -> wpos wa + wdim wa-                begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)-                end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)+                begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else wpos wa+                end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else wpos wa + wdim wa             return (begin',end')             where                 (wpos, wdim, _, _) = constructors horiz@@ -170,10 +167,8 @@     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.     -> Window    -- ^ The window to move.     -> X ()-snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w-+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     nx <- handleAxis True d wa     ny <- handleAxis False d wa @@ -194,8 +189,8 @@                                     (Just fl,Nothing) -> fl                                     (Nothing,Just fr) -> fr                                     (Nothing,Nothing) -> wpos wa-                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)-                          in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)+                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else f - wdim wa+                          in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa             where                 (wpos, wdim, _, _) = constructors horiz @@ -211,9 +206,8 @@ snapMove D = doSnapMove False False  doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()-doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w      let (mb,mf) = if rev then (bl,fl)@@ -251,9 +245,8 @@ snapShrink = snapResize False  snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()-snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w-    wa <- io $ getWindowAttributes d w+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d ->+  withWindowAttributes d w $ \wa -> do     mr <- case dir of               L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w                       return $ case (if grow then mg else ms) of@@ -274,9 +267,8 @@      case mr of         Nothing -> return ()-        Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)-                                                      io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)-                                              else return ()+        Just (nx,ny,nw,nh) -> when (nw>0 && nh>0) $ do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)+                                                       io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)     float w     where         wx = fromIntegral.wa_x@@ -291,8 +283,8 @@     screen <- W.current <$> gets windowset     let sr = screenRect $ W.screenDetail screen         wl = W.integrate' . W.stack $ W.workspace screen-    gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]-    wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)+    gr <- ($ sr) <$> calcGap (S.fromList [minBound .. maxBound])+    wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl)      return ( neighbours (back wa sr gr wla) (wpos wa)            , neighbours (front wa sr gr wla) (wpos wa + wdim wa)@@ -306,8 +298,8 @@          back wa sr gr wla = dropWhile (< rpos sr) $                             takeWhile (< rpos sr + rdim sr) $-                            sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):-                                   foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla+                            sort $ rpos sr:rpos gr:(rpos gr + rdim gr):+                                   foldr (\a as -> wpos a:(wpos a + wdim a + wborder a + wborder wa):as) [] wla          front wa sr gr wla = dropWhile (<= rpos sr) $                              takeWhile (<= rpos sr + rdim sr) $@@ -321,8 +313,8 @@          collides wa oa = case collidedist of                              Nothing -> True-                             Just dist -> (  refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist-                                          && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )+                             Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist+                                       && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa   constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
XMonad/Actions/FocusNth.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.FocusNth+-- Description  : Focus the nth window of the current workspace. -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de> -- License      : BSD --@@ -17,11 +20,12 @@                  focusNth,focusNth',                  swapNth,swapNth') where -import XMonad.StackSet import XMonad+import XMonad.Prelude+import XMonad.StackSet  -- $usage--- Add the import to your @~\/.xmonad\/xmonad.hs@:+-- Add the import to your @xmonad.hs@: -- -- > import XMonad.Actions.FocusNth --@@ -32,15 +36,15 @@ -- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Give focus to the nth window of the current workspace. focusNth :: Int -> X () focusNth = windows . modify' . focusNth'  focusNth' :: Int -> Stack a -> Stack a-focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s-                              | otherwise = listToStack n (integrate s)+focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs+              | otherwise = s  -- | Swap current window with nth. Focus stays in the same position swapNth :: Int -> X ()@@ -49,14 +53,5 @@ swapNth' :: Int -> Stack a -> Stack a swapNth' n s@(Stack c l r)   | (n < 0) || (n > length l + length r) || (n == length l) = s-  | n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r-  | otherwise    = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)-                                                                          --listToStack :: Int -> [a] -> Stack a-listToStack n l = Stack t ls rs- where-    (t:rs)    = drop n l-    ls        = reverse (take n l)--+  | n < length l = let (nl, notEmpty -> nc :| nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r+  | otherwise    = let (nl, notEmpty -> nc :| nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
XMonad/Actions/GridSelect.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.GridSelect+-- Description :  Display items in a 2D grid and select from it with the keyboard or the mouse. -- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org> -- License     :  BSD-style (see LICENSE) --@@ -28,7 +29,6 @@     -- * Configuration     GSConfig(..),     def,-    defaultGSConfig,     TwoDPosition,     buildDefaultGSConfig, @@ -48,6 +48,7 @@     fromClassName,     stringColorizer,     colorRangeFromClassName,+    stringToRatio,      -- * Navigation Mode assembly     TwoD,@@ -79,16 +80,14 @@     -- * Types     TwoDState,     ) where-import Data.Maybe+import Control.Arrow ((***)) import Data.Bits-import Data.Char import Data.Ord (comparing)-import Control.Applicative import Control.Monad.State-import Control.Arrow import Data.List as L import qualified Data.Map as M import XMonad hiding (liftX)+import XMonad.Prelude import XMonad.Util.Font import XMonad.Prompt (mkUnmanagedWindow) import XMonad.StackSet as W@@ -96,24 +95,25 @@ import XMonad.Util.NamedWindows import XMonad.Actions.WindowBringer (bringWindow) import Text.Printf-import System.Random (mkStdGen, genRange, next)+import System.Random (mkStdGen, randomR) import Data.Word (Word8)+import qualified Data.List.NonEmpty as NE  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.GridSelect -- -- Then add a keybinding, e.g. ----- >    , ((modm, xK_g), goToSelected defaultGSConfig)+-- >    , ((modm, xK_g), goToSelected def) -- -- This module also supports displaying arbitrary information in a grid and letting -- the user select from it. E.g. to spawn an application from a given list, you -- can use the following: ----- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])+-- >   , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])  -- $commonGSConfig --@@ -123,9 +123,9 @@ -- > {-# LANGUAGE NoMonomorphismRestriction #-} -- > import XMonad -- > ...--- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }+-- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 } ----- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'+-- An example where 'buildDefaultGSConfig' is used instead of 'def' -- in order to specify a custom colorizer is @gsconfig2@ (found in -- "XMonad.Actions.GridSelect#Colorizers"): --@@ -143,8 +143,8 @@ -- -- Then you can bind to: ----- >     ,((modm, xK_g), goToSelected  $ gsconfig2 myWinColorizer)--- >     ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer)+-- >     ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer)+-- >     ,((modm, xK_p), spawnSelected (gsconfig2 defaultColorizer) ["xterm","gvim"])  -- $keybindings --@@ -203,10 +203,13 @@       gs_colorizer :: a -> Bool -> X (String, String),       gs_font :: String,       gs_navigate :: TwoD a (Maybe a),+      -- ^ Customize key bindings for a GridSelect       gs_rearranger :: Rearranger a,       gs_originFractX :: Double,       gs_originFractY :: Double,-      gs_bordercolor :: String+      gs_bordercolor :: String,+      gs_cancelOnEmptyClick :: Bool+      -- ^ When True, click on empty space will cancel GridSelect }  -- | That is 'fromClassName' if you are selecting a 'Window', or@@ -222,18 +225,14 @@ instance HasColorizer String where     defaultColorizer = stringColorizer -instance HasColorizer a where+instance {-# OVERLAPPABLE #-} HasColorizer a where     defaultColorizer _ isFg =         let getColor = if isFg then focusedBorderColor else normalBorderColor-        in asks $ flip (,) "black" . getColor . config+        in asks $ (, "black") . getColor . config  instance HasColorizer a => Default (GSConfig a) where     def = buildDefaultGSConfig defaultColorizer -{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}-defaultGSConfig :: HasColorizer a => GSConfig a-defaultGSConfig = def- type TwoDPosition = (Integer, Integer)  type TwoDElementMap a = [(TwoDPosition,(String,a))]@@ -264,7 +263,7 @@     -- Sorts the elementmap     sortedElements = orderElementmap searchString filteredElements     -- Case Insensitive version of isInfixOf-    needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)+    needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack     upper = map toUpper  @@ -290,11 +289,7 @@   newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }-    deriving (Monad,Functor,MonadState (TwoDState a))--instance Applicative (TwoD a) where-    (<*>) = ap-    pure = return+    deriving (Functor, Applicative, Monad, MonadState (TwoDState a))  liftX ::  X a1 -> TwoD a a1 liftX = TwoD . lift@@ -308,17 +303,17 @@   -- tr = top right   --  r = ur ++ 90 degree clock-wise rotation of ur   let tr = [ (x,n-x) | x <- [0..n-1] ]-      r  = tr ++ (map (\(x,y) -> (y,-x)) tr)-  in r ++ (map (negate *** negate) r)+      r  = tr ++ map (\(x,y) -> (y,-x)) tr+  in r ++ map (negate *** negate) r -diamond :: (Enum a, Num a, Eq a) => [(a, a)]-diamond = concatMap diamondLayer [0..]+diamond :: (Enum a, Num a, Eq a) => Stream (a, a)+diamond = fromList $ concatMap diamondLayer [0..]  diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)] diamondRestrict x y originX originY =   L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .   map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .-  take 1000 $ diamond+  takeS 1000 $ diamond  findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst)@@ -339,7 +334,7 @@     drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)   stext <- shrinkWhile (shrinkIt shrinkText)            (\n -> do size <- liftIO $ textWidthXMF dpy font n-                     return $ size > (fromInteger (cw-(2*cp))))+                     return $ size > fromInteger (cw-(2*cp)))            text   -- calculate the offset to vertically centre the text based on the ascender and descender   (asc,desc) <- liftIO $ textExtentsXMF font stext@@ -392,18 +387,25 @@     mapM_ updateElement elementmap  stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)-stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop+stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop     | t == buttonRelease = do-        s @  TwoDState { td_paneX = px, td_paneY = py,-                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get+        s@TwoDState{ td_paneX = px+                   , td_paneY = py+                   , td_gsconfig = GSConfig{ gs_cellheight = ch+                                           , gs_cellwidth = cw+                                           , gs_cancelOnEmptyClick = cancelOnEmptyClick+                                           }+                   } <- get         let gridX = (fi x - (px - cw) `div` 2) `div` cw             gridY = (fi y - (py - ch) `div` 2) `div` ch         case lookup (gridX,gridY) (td_elementmap s) of              Just (_,el) -> return (Just el)-             Nothing -> contEventloop+             Nothing     -> if cancelOnEmptyClick+                            then return Nothing+                            else contEventloop     | otherwise = contEventloop -stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop+stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop  stdHandle _ contEventloop = contEventloop @@ -416,10 +418,11 @@                              ev <- getEvent e                              if ev_event_type ev == keyPress                                then do-                                  (ks,s) <- lookupString $ asKeyEvent e+                                  (_, s) <- lookupString $ asKeyEvent e+                                  ks <- keycodeToKeysym d (ev_keycode ev) 0                                   return $ do-                                      mask <- liftX $ cleanMask (ev_state ev)-                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)+                                      mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)+                                      keyhandler (ks, s, mask)                                else                                   return $ stdHandle ev me @@ -435,7 +438,7 @@ select :: TwoD a (Maybe a) select = do   s <- get-  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)+  return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)  -- | Closes gridselect returning no element. cancel :: TwoD a (Maybe a)@@ -450,7 +453,7 @@       oldPos = td_curpos s   when (isJust newSelectedEl && newPos /= oldPos) $ do     put s { td_curpos = newPos }-    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])+    updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl])  -- | Moves the cursor by the offsets specified move :: (Integer, Integer) -> TwoD a ()@@ -550,7 +553,7 @@           ,((0,xK_Up)         , move (0,-1) >> navNSearch)           ,((0,xK_Tab)        , moveNext >> navNSearch)           ,((shiftMask,xK_Tab), movePrev >> navNSearch)-          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)+          ,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> navNSearch)           ]         -- The navigation handler ignores unknown key symbols, therefore we const         navNSearchDefaultHandler (_,s,_) = do@@ -564,7 +567,7 @@   let searchKeyMap = M.fromList [            ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)           ,((0,xK_Return)   , returnNavigation)-          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)+          ,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> me)           ]       searchDefaultHandler (_,s,_) = do           transformSearchString (++ s)@@ -576,8 +579,8 @@ -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a) hsv2rgb (h,s,v) =-    let hi = (div h 60) `mod` 6 :: Integer-        f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a+    let hi = div h 60 `mod` 6 :: Integer+        f = ((fromInteger h/60) - fromInteger hi) :: Fractional a => a         q = v * (1-f)         p = v * (1-s)         t = v * (1-(1-f)*s)@@ -594,19 +597,19 @@ stringColorizer :: String -> Bool -> X (String, String) stringColorizer s active =     let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer-        (r,g,b) = hsv2rgb ((seed 83) `mod` 360,-                           (fromInteger ((seed 191) `mod` 1000))/2500+0.4,-                           (fromInteger ((seed 121) `mod` 1000))/2500+0.4)+        (r,g,b) = hsv2rgb (seed 83 `mod` 360,+                           fromInteger (seed 191 `mod` 1000)/2500+0.4,+                           fromInteger (seed 121 `mod` 1000)/2500+0.4)     in if active          then return ("#faff69", "black")-         else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")+         else return ("#" ++ concatMap (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b], "white")  -- | Colorize a window depending on it's className. fromClassName :: Window -> Bool -> X (String, String) fromClassName w active = runQuery className w >>= flip defaultColorizer active  twodigitHex :: Word8 -> String-twodigitHex a = printf "%02x" a+twodigitHex = printf "%02x"  -- | A colorizer that picks a color inside a range, -- and depending on the window's class.@@ -635,15 +638,12 @@  -- | Generates a Double from a string, trying to -- achieve a random distribution.--- We create a random seed from the sum of all characters+-- We create a random seed from the hash of all characters -- in the string, and use it to generate a ratio between 0 and 1 stringToRatio :: String -> Double stringToRatio "" = 0-stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s-                      range = (\(a, b) -> b - a) $ genRange gen-                      randomInt = foldr1 combine $ replicate 20 next-                      combine f1 f2 g = let (_, g') = f1 g in f2 g'-                  in fi (fst $ randomInt gen) / fi range+stringToRatio s = let gen = mkStdGen $ foldl' (\t c -> t * 31 + fromEnum c) 0 s+                  in fst $ randomR (0, 1) gen  -- | Brings up a 2D grid of elements in the center of the screen, and one can -- select an element with cursors keys. The selected element is returned.@@ -658,18 +658,18 @@     liftIO $ mapWindow dpy win     liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)     status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime-    io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime+    void $ io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime     font <- initXMF (gs_font gsconfig)     let screenWidth = toInteger $ rect_width scr         screenHeight = toInteger $ rect_height scr-    selectedElement <- if (status == grabSuccess) then do+    selectedElement <- if status == grabSuccess then do                             let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double                                 restrictX = floor $ restriction screenWidth gs_cellwidth                                 restrictY = floor $ restriction screenHeight gs_cellheight-                                originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX-                                originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY+                                originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX+                                originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY                                 coords = diamondRestrict restrictX restrictY originPosX originPosY-                                s = TwoDState { td_curpos = (head coords),+                                s = TwoDState { td_curpos = NE.head (notEmpty coords),                                                 td_availSlots = coords,                                                 td_elements = elements,                                                 td_gsconfig = gsconfig,@@ -680,7 +680,7 @@                                                 td_searchString = "",                                                 td_elementmap = [] }                             m <- generateElementmap s-                            evalTwoD (updateAllElements >> (gs_navigate gsconfig))+                            evalTwoD (updateAllElements >> gs_navigate gsconfig)                                      (s { td_elementmap = m })                       else                           return Nothing@@ -702,24 +702,21 @@ withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X () withSelectedWindow callback conf = do     mbWindow <- gridselectWindow conf-    case mbWindow of-        Just w -> callback w-        Nothing -> return ()+    for_ mbWindow callback  windowMap :: X [(String,Window)] windowMap = do     ws <- gets windowset-    wins <- mapM keyValuePair (W.allWindows ws)-    return wins- where keyValuePair w = flip (,) w `fmap` decorateName' w+    mapM keyValuePair (W.allWindows ws)+ where keyValuePair w = (, w) <$> decorateName' w  decorateName' :: Window -> X String decorateName' w = do-  fmap show $ getName w+  show <$> getName w  -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" True  -- | Brings selected window to the current workspace. bringSelected :: GSConfig Window -> X ()@@ -770,7 +767,7 @@ -- -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace) -- >--- > gridselectWorkspace' defaultGSConfig+-- > gridselectWorkspace' def -- >                          { gs_navigate   = navNSearch -- >                          , gs_rearranger = searchStringRearrangerGenerator id -- >                          }@@ -789,7 +786,7 @@ -- already present). searchStringRearrangerGenerator :: (String -> a) -> Rearranger a searchStringRearrangerGenerator f =-    let r "" xs                       = return $ xs-        r s  xs | s `elem` map fst xs = return $ xs+    let r "" xs                       = return xs+        r s  xs | s `elem` map fst xs = return xs                 | otherwise           = return $ xs ++ [(s, f s)]     in r
XMonad/Actions/GroupNavigation.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}-+{-# language DeriveGeneric, DeriveAnyClass #-} ---------------------------------------------------------------------- -- | -- Module      : XMonad.Actions.GroupNavigation+-- Description : Cycle through groups of windows across workspaces. -- Copyright   : (c) nzeh@cs.dal.ca -- License     : BSD3-style (see LICENSE) --@@ -16,7 +16,7 @@ -- query. -- -- Also provides a method for jumping back to the most recently used--- window in any given group.+-- window in any given group, and predefined groups. -- ---------------------------------------------------------------------- @@ -27,24 +27,33 @@                                       , nextMatchOrDo                                       , nextMatchWithThis                                       , historyHook++                                        -- * Utilities+                                        -- $utilities+                                      , isOnAnyVisibleWS                                       ) where -import Control.Monad.Reader-import Data.Foldable as Fold-import Data.Map as Map-import Data.Sequence as Seq-import Data.Set as Set+import Control.Monad.Reader (ask, asks)+import Control.Monad.State (gets)+import Control.DeepSeq+import Data.Map ((!))+import qualified Data.Map as Map+import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>))+import qualified Data.Sequence as Seq+import qualified Data.Set as Set import Graphics.X11.Types-import Prelude hiding (concatMap, drop, elem, filter, null, reverse)+import GHC.Generics+import Prelude hiding (drop, elem, filter, null, reverse) import XMonad.Core import XMonad.ManageHook import XMonad.Operations (windows, withFocused)+import XMonad.Prelude (elem, foldl', (>=>)) import qualified XMonad.StackSet as SS import qualified XMonad.Util.ExtensibleState as XS  {- $usage -Import the module into your @~\/.xmonad\/xmonad.hs@:+Import the module into your @xmonad.hs@:  > import XMonad.Actions.GroupNavigation @@ -120,14 +129,14 @@                              >=> maybe act (windows . SS.focusWindow)  -- Returns the list of windows ordered by workspace as specified in--- ~/.xmonad/xmonad.hs+-- @xmonad.hs@. orderedWindowList :: Direction -> X (Seq Window)-orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get+orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get orderedWindowList dir     = withWindowSet $ \ss -> do   wsids <- asks (Seq.fromList . workspaces . config)   let wspcs = orderedWorkspaceList ss wsids       wins  = dirfun dir-              $ Fold.foldl' (><) Seq.empty+              $ foldl' (><) Seq.empty               $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs       cur   = SS.peek ss   return $ maybe wins (rotfun wins) cur@@ -136,13 +145,13 @@     dirfun _        = id     rotfun wins x   = rotate $ rotateTo (== x) wins --- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs+-- Returns the ordered workspace list as specified in @xmonad.hs@. orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'     where       wspcs      = SS.workspaces ss-      wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs-      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids+      wspcsMap   = foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs+      wspcs'     = fmap (wspcsMap !) wsids       isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)  --- History navigation, requires a layout modifier -------------------@@ -150,7 +159,7 @@ -- The state extension that holds the history information data HistoryDB = HistoryDB (Maybe Window) -- currently focused window                            (Seq Window)   -- previously focused windows-               deriving (Read, Show, Typeable)+               deriving (Read, Show, Generic, NFData)  instance ExtensionClass HistoryDB where @@ -160,33 +169,18 @@ -- | Action that needs to be executed as a logHook to maintain the -- focus history of all windows as the WindowSet changes. historyHook :: X ()-historyHook = XS.get >>= updateHistory >>= XS.put+historyHook = (XS.put $!) . force =<< updateHistory =<< XS.get  -- Updates the history in response to a WindowSet change updateHistory :: HistoryDB -> X HistoryDB-updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do+updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss ->   let newcur   = SS.peek ss       wins     = Set.fromList $ SS.allWindows ss-      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)-  return $ HistoryDB newcur (del newcur newhist)+      newhist  = Seq.filter (`Set.member` wins) (ins oldcur oldhist)+  in pure $ HistoryDB newcur (del newcur newhist)   where     ins x xs = maybe xs (<| xs) x-    del x xs = maybe xs (\x' -> flt (/= x') xs) x----- Two replacements for Seq.filter and Seq.breakl available only in---- containers-0.3.0.0, which only ships with ghc 6.12.  Once we---- decide to no longer support ghc < 6.12, these should be replaced---- with Seq.filter and Seq.breakl.--flt :: (a -> Bool) -> Seq a -> Seq a-flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty--brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)-brkl p xs = flip Seq.splitAt xs-            $ snd-            $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs-  where-    l = Seq.length xs+    del x xs = maybe xs (\x' -> Seq.filter (/= x') xs) x  --- Some sequence helpers -------------------------------------------- @@ -200,7 +194,7 @@ -- Rotates the sequence until an element matching the given condition -- is at the beginning of the sequence. rotateTo :: (a -> Bool) -> Seq a -> Seq a-rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs+rotateTo cond xs = let (lxs, rxs) = Seq.breakl cond xs in rxs >< lxs  --- A monadic find --------------------------------------------------- @@ -216,3 +210,21 @@       if isMatch         then return (Just x')         else findM qry xs'+++-- $utilities+-- #utilities#+-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',+-- and 'nextMatchWithThis'.++-- | A query that matches all windows on visible workspaces. This is+-- useful for configurations with multiple screens, and matches even+-- invisible windows.+isOnAnyVisibleWS :: Query Bool+isOnAnyVisibleWS = do+  w <- ask+  ws <- liftX $ gets windowset+  let allVisible = concatMap (maybe [] SS.integrate . SS.stack . SS.workspace) (SS.current ws:SS.visible ws)+      visibleWs = w `elem` allVisible+      unfocused = Just w /= SS.peek ws+  return $ visibleWs && unfocused
XMonad/Actions/KeyRemap.hs view
@@ -1,7 +1,7 @@- {-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.KeyRemap+-- Description :  Remap Keybinding on the fly. -- Copyright   :  (c) Christian Dietrich -- License     :  BSD-style (as xmonad) --@@ -27,14 +27,13 @@   ) where  import XMonad+import XMonad.Prelude import XMonad.Util.Paste-import Data.List  import qualified XMonad.Util.ExtensibleState as XS-import Control.Monad  -data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)+newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Show)  instance ExtensionClass KeymapTable where    initialValue = KeymapTable []@@ -125,8 +124,8 @@ buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())] buildKeyRemapBindings keyremaps =   [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]-  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)-        bindings = nub (map (\binding -> fst binding) mappings)+  where mappings = concatMap (\(KeymapTable table) -> table) keyremaps+        bindings = nub (map fst mappings)   -- Here come the Keymappings@@ -138,7 +137,7 @@ dvorakProgrammerKeyRemap :: KeymapTable dvorakProgrammerKeyRemap =   KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |-               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]+               (maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey]   where      layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]@@ -149,8 +148,6 @@      layoutDvorakShift = map getShift layoutDvorak     layoutDvorakKey   = map getKey layoutDvorak-    getKey  char = let Just index = elemIndex char layoutUs-                    in layoutUsKey !! index-    getShift char = let Just index = elemIndex char layoutUs-                    in layoutUsShift !! index+    getKey   char = fromJust $ (layoutUsKey   !?) =<< elemIndex char layoutUs+    getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs     charToMask char = if [char] == "0" then 0 else shiftMask
XMonad/Actions/Launcher.hs view
@@ -1,5 +1,6 @@ {- | Module      :  XMonad.Actions.Launcher+Description :  A set of prompts for XMonad. Copyright   :  (C) 2012 Carlos López-Camey License     :  None; public domain @@ -18,10 +19,9 @@   , launcherPrompt ) where -import           Data.List       (find, findIndex, isPrefixOf, tails) import qualified Data.Map        as M-import           Data.Maybe      (isJust) import           XMonad          hiding (config)+import           XMonad.Prelude import           XMonad.Prompt import           XMonad.Util.Run @@ -62,15 +62,15 @@ instance XPrompt CalculatorMode where   showXPrompt CalcMode = "calc %s> "   commandToComplete CalcMode = id --send the whole string to `calc`-  completionFunction CalcMode = \s -> if (length s == 0) then return [] else do-    fmap lines $ runProcessWithInput "calc" [s] ""+  completionFunction CalcMode s = if null s then return [] else+    lines <$> runProcessWithInput "calc" [s] ""   modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard  -- | Uses the program `hoogle` to search for functions instance XPrompt HoogleMode where   showXPrompt _ = "hoogle %s> "   commandToComplete _ = id-  completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]+  completionFunction (HMode pathToHoogleBin' _) s = completionFunctionWith pathToHoogleBin' ["--count","8",s]   -- This action calls hoogle again to find the URL corresponding to the autocompleted item   modeAction (HMode pathToHoogleBin'' browser') query result = do     completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]@@ -88,7 +88,7 @@  -- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command. completionFunctionWith :: String -> [String] -> IO [String]-completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""+completionFunctionWith cmd args = lines <$> runProcessWithInput cmd args ""  -- | Creates a prompt with the given modes launcherPrompt :: XPConfig -> [XPMode] -> X()
XMonad/Actions/LinkWorkspaces.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.LinkWorkspaces+-- Description : Bindings to add and delete links between workspaces. -- Copyright   :  (c) Jan-David Quesel <quesel@gmail.org> -- License     :  BSD3-style (see LICENSE) --@@ -14,7 +15,6 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable  #-} module XMonad.Actions.LinkWorkspaces (                                          -- * Usage                                          -- $usage@@ -27,6 +27,7 @@                                        ) where  import XMonad+import XMonad.Prelude (for_) import qualified XMonad.StackSet as W import XMonad.Layout.IndependentScreens(countScreens) import qualified XMonad.Util.ExtensibleState as XS (get, put)@@ -35,7 +36,7 @@     ( insert, delete, Map, lookup, empty, filter )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.LinkWorkspaces --@@ -57,9 +58,9 @@ -- >       , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data MessageConfig = MessageConfig {  messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())+data MessageConfig = MessageConfig {  messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()                     , foreground :: [Char]                     , alertedForeground :: [Char]                     , background :: [Char]@@ -75,8 +76,8 @@ noMessageFn _ _ _ _ = return () :: X ()  -- | Stuff for linking workspaces-data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)-instance ExtensionClass WorkspaceMap +newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show)+instance ExtensionClass WorkspaceMap     where initialValue = WorkspaceMap M.empty           extensionType = PersistentExtension @@ -85,12 +86,12 @@  -- | Switch to the given workspace in a non greedy way, stop if we reached the first screen -- | we already did switching on-switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> (Maybe ScreenId) -> X ()+switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> Maybe ScreenId -> X () switchWS' switchFn message workspace stopAtScreen = do   ws <- gets windowset   nScreens <- countScreens   let now = W.screen (W.current ws)-  let next = ((now + 1) `mod` nScreens)+  let next = (now + 1) `mod` nScreens   switchFn workspace   case stopAtScreen of     Nothing -> sTM now next (Just now)@@ -99,21 +100,21 @@  -- | Switch to the workspace that matches the current one, executing switches for that workspace as well. -- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.-switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId -    -> ScreenId -> (Maybe ScreenId) -> X ()+switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId+    -> ScreenId -> Maybe ScreenId -> X () switchToMatching f message t now next stopAtScreen = do     WorkspaceMap matchings <- XS.get :: X WorkspaceMap-    case (M.lookup t matchings) of+    case M.lookup t matchings of         Nothing -> return () :: X()         Just newWorkspace -> do-            onScreen' (f newWorkspace stopAtScreen) FocusCurrent next +            onScreen' (f newWorkspace stopAtScreen) FocusCurrent next             messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))  -- | Insert a mapping between t1 and t2 or remove it was already present toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X () toggleMatching message t1 t2 = do     WorkspaceMap matchings <- XS.get :: X WorkspaceMap-    case (M.lookup t1 matchings) of+    case M.lookup t1 matchings of         Nothing -> setMatching message t1 t2 matchings         Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings     return ()@@ -142,7 +143,7 @@ removeAllMatchings message = do    ws <- gets windowset    let now = W.screen (W.current ws)-   XS.put $ WorkspaceMap $ M.empty+   XS.put $ WorkspaceMap M.empty    messageFunction message now (alertedForeground message) (background message) "All links removed!"  -- | remove all matching regarding a given workspace@@ -163,7 +164,6 @@     let now = W.screen (W.current ws)     let next = (now + 1) `mod` nScreens     if next == first then return () else do -- this is also the case if there is only one screen-        case (W.lookupWorkspace next ws) of-            Nothing -> return ()-            Just name -> toggleMatching message (W.currentTag ws) (name)+        for_ (W.lookupWorkspace next ws)+             (toggleMatching message (W.currentTag ws))         onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
XMonad/Actions/MessageFeedback.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.MessageFeedback+-- Description :  An alternative @sendMessage@. -- Copyright    : (c) --   Quentin Moser <moserq@gmail.com> --                    2018 Yclept Nemo -- License      : BSD3@@ -41,26 +42,18 @@        -- ** Aliases     , sm--      -- * Backwards Compatibility-      -- $backwardsCompatibility-    , send, sendSM, sendSM_-    , tryInOrder, tryInOrder_-    , tryMessage, tryMessage_     ) where  import XMonad               ( Window ) import XMonad.Core          ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )-import XMonad.StackSet      ( Workspace, current, workspace, layout, tag ) import XMonad.Operations    ( updateLayout, windowBracket, modifyWindowSet )+import XMonad.Prelude+import XMonad.StackSet      ( Workspace, current, workspace, layout, tag ) -import Data.Maybe           ( isJust )-import Control.Monad        ( void ) import Control.Monad.State  ( gets )-import Control.Applicative  ( (<$>), liftA2 )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.MessageFeedback --@@ -108,7 +101,7 @@ -- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'. sendSomeMessageB :: SomeMessage -> X Bool sendSomeMessageB m = windowBracket id $ do-    w  <- workspace . current <$> gets windowset+    w  <- gets ((workspace . current) . windowset)     ml <- handleMessage (layout w) m `catchX` return Nothing     whenJust ml $ \l ->         modifyWindowSet $ \ws -> ws { current = (current ws)@@ -140,7 +133,7 @@ -- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh). sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool sendSomeMessageWithNoRefreshToCurrentB m-    =   (gets $ workspace . current . windowset)+    =   gets (workspace . current . windowset)     >>= sendSomeMessageWithNoRefreshB m  -- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the@@ -231,46 +224,3 @@ -- | Convenience shorthand for 'SomeMessage'. sm :: Message a => a -> SomeMessage sm = SomeMessage------------------------------------------------------------------------------------- Backwards Compatibility:----------------------------------------------------------------------------------{-# DEPRECATED send "Use sendMessageB instead." #-}-{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}-{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}-{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}-{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}-{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}-{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}---- $backwardsCompatibility--- The following functions exist solely for compatibility with pre-0.14--- releases.---- | See 'sendMessageWithNoRefreshToCurrentB'.-send :: Message a => a -> X Bool-send = sendMessageWithNoRefreshToCurrentB---- | See 'sendSomeMessageWithNoRefreshToCurrentB'.-sendSM :: SomeMessage -> X Bool-sendSM = sendSomeMessageWithNoRefreshToCurrentB---- | See 'sendSomeMessageWithNoRefreshToCurrent'.-sendSM_ :: SomeMessage -> X ()-sendSM_ = sendSomeMessageWithNoRefreshToCurrent---- | See 'tryInOrderWithNoRefreshToCurrentB'.-tryInOrder :: [SomeMessage] -> X Bool-tryInOrder = tryInOrderWithNoRefreshToCurrentB---- | See 'tryInOrderWithNoRefreshToCurrent'.-tryInOrder_ :: [SomeMessage] -> X ()-tryInOrder_ = tryInOrderWithNoRefreshToCurrent---- | See 'tryMessageWithNoRefreshToCurrentB'.-tryMessage :: (Message a, Message b) => a -> b -> X Bool-tryMessage = tryMessageWithNoRefreshToCurrentB---- | See 'tryMessageWithNoRefreshToCurrent'.-tryMessage_ :: (Message a, Message b) => a -> b -> X ()-tryMessage_ = tryMessageWithNoRefreshToCurrent
XMonad/Actions/Minimize.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.Minimize+-- Description :  Actions for minimizing and maximizing windows. -- Copyright   :  (c) Bogdan Sinitsyn (2016) -- License     :  BSD3-style (see LICENSE) --@@ -11,7 +12,7 @@ -- Adds actions for minimizing and maximizing windows -- -- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your--- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from+-- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from -- this module -- -- Possible keybindings:@@ -35,6 +36,7 @@   ) where  import XMonad+import XMonad.Prelude (fromMaybe, join, listToMaybe) import qualified XMonad.StackSet as W  import qualified XMonad.Layout.BoringWindows as BW@@ -43,22 +45,23 @@ import XMonad.Util.WindowProperties (getProp32)  import Foreign.C.Types (CLong)-import Control.Applicative((<$>))-import Control.Monad (join)-import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.List as L import qualified Data.Map as M  -- $usage -- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows":+-- -- > import XMonad.Actions.Minimize -- > import XMonad.Layout.Minimize -- > import qualified XMonad.Layout.BoringWindows as BW -- -- Then apply 'minimize' and 'boringWindows' to your layout hook and use some -- actions from this module:+-- -- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever }+-- -- Example keybindings:+-- -- >        , ((modm,               xK_m     ), withFocused minimizeWindow      ) -- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindow) @@ -120,7 +123,7 @@ -- | Perform an action with first minimized window on current workspace --   or do nothing if there is no minimized windows on current workspace withFirstMinimized :: (Window -> X ()) -> X ()-withFirstMinimized action = withFirstMinimized' (flip whenJust action)+withFirstMinimized action = withFirstMinimized' (`whenJust` action)  -- | Like withFirstMinimized but the provided action is always invoked with a --   'Maybe Window', that will be nothing if there is no first minimized window.@@ -130,7 +133,7 @@ -- | Perform an action with last minimized window on current workspace --   or do nothing if there is no minimized windows on current workspace withLastMinimized :: (Window -> X ()) -> X ()-withLastMinimized action = withLastMinimized' (flip whenJust action)+withLastMinimized action = withLastMinimized' (`whenJust` action)  -- | Like withLastMinimized but the provided action is always invoked with a --   'Maybe Window', that will be nothing if there is no last minimized window.
+ XMonad/Actions/MostRecentlyUsed.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.MostRecentlyUsed+-- Description :  Tab through windows by recency of use.+-- Copyright   :  (c) 2022 L. S. Leary+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  @LSLeary (on github)+-- Stability   :  unstable+-- Portability :  unportable+--+-- Based on the Alt+Tab behaviour common outside of xmonad.+--+-----------------------------------------------------------------------------++-- --< Imports & Exports >-- {{{++module XMonad.Actions.MostRecentlyUsed (++  -- * Usage+  -- $usage++  -- * Interface+  configureMRU,+  mostRecentlyUsed,+  withMostRecentlyUsed,+  Location(..),++  ) where++-- base+import Data.List.NonEmpty (nonEmpty)+import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)+import Control.Monad.IO.Class (MonadIO)++-- mtl+import Control.Monad.Trans (lift)+import Control.Monad.State (get, put, gets)++-- containers+import qualified Data.Map.Strict as M++-- xmonad+import XMonad+  ( Window, KeySym, keyPress, io+  , Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window)+  )+import XMonad.Core+  ( X, XConfig(..), windowset, WorkspaceId, ScreenId+  , ExtensionClass(..), StateExtension(..)+  , waitingUnmap+  )+import XMonad.Operations (screenWorkspace)+import qualified XMonad.StackSet as W++-- xmonad-contrib+import qualified XMonad.Util.ExtensibleConf  as XC+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.PureX+  (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)+import XMonad.Util.History (History, origin, event, erase, ledger)+import XMonad.Actions.Repeatable (repeatableSt)+import XMonad.Prelude++-- }}}++-- --< Core Data Types: WindowHistory & Location >-- {{{++data WindowHistory = WinHist+  { busy :: !Bool+  , hist :: !(History Window Location)+  } deriving (Show, Read)++instance ExtensionClass WindowHistory where+  initialValue = WinHist+    { busy = False+    , hist = origin+    }+  extensionType = PersistentExtension++data Location = Location+  { workspace :: !WorkspaceId+  , screen    :: !ScreenId+  } deriving (Show, Read, Eq, Ord)++-- }}}++-- --< Interface >-- {{{++-- $usage+--+-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed'+-- to work.+--+-- > main :: IO ()+-- > main = xmonad . configureMRU . ... $ def+-- >   { ...+-- >   }+--+-- Once that's done, it can be used normally in keybinds:+--+-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab)+--+-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not+-- always the case, depending on how your system is configured.++-- | Configure xmonad to support 'mostRecentlyUsed'.+configureMRU :: XConfig l -> XConfig l+configureMRU = XC.once f (MRU ()) where+  f cnf = cnf+    { logHook         = logHook         cnf <> logWinHist+    , handleEventHook = handleEventHook cnf <> winHistEH+    }+newtype MRU = MRU () deriving Semigroup++-- | An action to browse through the history of focused windows, taking+--   another step back with each tap of the key.+mostRecentlyUsed+  :: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the+              --   action is bound.+  -> KeySym   -- ^ The 'KeySym' corresponding to the key to which the action+              --   is bound.+  -> X ()+mostRecentlyUsed mods key = do+  (toUndo, undo) <- undoer+  let undoably curThing withThing thing = curThing >>= \cur ->+        when (cur /= thing) $ withThing thing >> toUndo (withThing cur)+  withMostRecentlyUsed mods key $ \win Location{workspace,screen} ->+    handlingRefresh $ do+      undo+      undoably curScreenId viewScreen screen+      undoably curTag      greedyView workspace+      mi <- gets (W.findTag win . windowset)+      for_ mi $ \i -> do+        undoably curTag greedyView i+        mfw <- peek+        for_ mfw $ \fw -> do+          undoably (pure fw) focusWindow win+  where+    undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a)+    undoer = do+      ref <- io . newIORef $ pure mempty+      let toUndo = io . modifyIORef ref . liftA2 (<>)+          undo   = join (io $ readIORef ref)+                <* io (writeIORef ref $ pure mempty)+      pure (toUndo, undo)+    viewScreen :: ScreenId -> X Any+    viewScreen scr = screenWorkspace scr >>= foldMap view++-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what+--   is done with each window you tab through (the default being to visit its+--   previous 'Location' and give it focus).+withMostRecentlyUsed+  :: [KeySym]                     -- ^ The 'KeySym's corresponding to the+                                  --   modifier to which the action is bound.+  -> KeySym                       -- ^ The 'KeySym' corresponding to the key to+                                  --   which the action is bound.+  -> (Window -> Location -> X ()) -- ^ The function applied to each window.+  -> X ()+withMostRecentlyUsed mods tab preview = do+  wh@WinHist{busy,hist} <- XS.get+  unless busy $ do+    XS.put wh{ busy = True }++    for_ (nonEmpty $ ledger hist) $ \ne -> do+      mfw <- gets (W.peek . windowset)+      let iSt = case cycleS ne of+            (w, _) :~ s | mfw == Just w -> s+            s                           -> s+      repeatableSt iSt mods tab $ \t s ->+        when (t == keyPress && s == tab) (pop >>= lift . uncurry preview)++    XS.modify $ \ws@WinHist{} -> ws{ busy = False }+    logWinHist+  where+    pop = do+      h :~ t <- get+      put t $> h++-- }}}++-- --< Raw Config >-- {{{++logWinHist :: X ()+logWinHist = do+  wh@WinHist{busy,hist} <- XS.get+  unless busy $ do+    cs <- gets (W.current . windowset)+    let cws = W.workspace cs+    for_ (W.stack cws) $ \st -> do+      let location = Location{ workspace = W.tag cws, screen = W.screen cs }+      XS.put wh{ hist = event (W.focus st) location hist }++winHistEH :: Event -> X All+winHistEH ev = All True <$ case ev of+  UnmapEvent{ ev_send_event = synth, ev_window = w } -> do+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)+    when (synth || e == 0) (collect w)+  DestroyWindowEvent{                ev_window = w } -> collect w+  _                                                  -> pure ()+  where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist }++-- }}}
XMonad/Actions/MouseGestures.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.MouseGestures+-- Description :  Support for simple mouse gestures. -- Copyright   :  (c) Lukas Mai -- License     :  BSD3-style (see LICENSE) --@@ -21,18 +22,17 @@     mkCollect ) where +import XMonad.Prelude import XMonad import XMonad.Util.Types (Direction2D(..))  import Data.IORef import qualified Data.Map as M import Data.Map (Map)-import Data.Maybe-import Control.Monad  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.MouseGestures -- > import qualified XMonad.StackSet as W@@ -79,17 +79,11 @@ gauge hook op st nx ny = do     let np = (nx, ny)     stx <- io $ readIORef st-    let-        (~(Just od), pivot) = case stx of-            Nothing -> (Nothing, op)-            Just (d, zp) -> (Just d, zp)-        cont = do-            guard $ significant np pivot-            return $ do-                let d' = dir pivot np-                when (isNothing stx || od /= d') $ hook d'-                io $ writeIORef st (Just (d', np))-    fromMaybe (return ()) cont+    let pivot = maybe op snd stx+    when (significant np pivot) $ do+        let d' = dir pivot np+        when ((fst <$> stx) /= Just d') $ hook d'+        io $ writeIORef st (Just (d', np))     where     significant a b = delta a b >= 10 @@ -111,7 +105,7 @@ mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X () mouseGesture tbl win = do     (mov, end) <- mkCollect-    mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->+    mouseGestureH (void . mov) $ end >>= \gest ->         case M.lookup gest tbl of             Nothing -> return ()             Just f -> f win
XMonad/Actions/MouseResize.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.MouseResize+-- Description :  A layout modifier to resize windows with the mouse. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -36,7 +37,7 @@ -- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness". -- -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Actions.MouseResize -- > import XMonad.Layout.WindowArranger@@ -49,14 +50,14 @@ -- -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  mouseResize :: l a -> ModifiedLayout MouseResize l a mouseResize = ModifiedLayout (MR []) -data MouseResize a = MR [((a,Rectangle),Maybe a)]+newtype MouseResize a = MR [((a,Rectangle),Maybe a)] instance Show (MouseResize a) where show        _ = "" instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)] @@ -68,7 +69,7 @@         where           wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs           initState    = mapM createInputWindow wrs'-          processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'+          processState = mapM_ (deleteInputWin . snd) st >> mapM createInputWindow wrs'            inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 @@ -105,7 +106,7 @@ handleResize _ _ = return ()  createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)-createInputWindow ((w,r),mr) = do+createInputWindow ((w,r),mr) =   case mr of     Just tr  -> withDisplay $ \d -> do                   tw <- mkInputWindow d tr
XMonad/Actions/Navigation2D.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Navigation2D+-- Description :  Directional navigation of windows and screens. -- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca> -- License     :  BSD3-style (see LICENSE) --@@ -39,14 +40,12 @@                                    , withNavigation2DConfig                                    , Navigation2DConfig(..)                                    , def-                                   , defaultNavigation2DConfig                                    , Navigation2D                                    , lineNavigation                                    , centerNavigation                                    , sideNavigation                                    , sideNavigationWithBias                                    , hybridOf-                                   , hybridNavigation                                    , fullScreenRect                                    , singleWindowRect                                    , switchLayer@@ -58,16 +57,16 @@                                    , Direction2D(..)                                    ) where -import Control.Applicative import qualified Data.List as L import qualified Data.Map as M-import Data.Maybe-import Data.Ord (comparing)+import Control.Arrow (second)+import XMonad.Prelude import XMonad hiding (Screen) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.EZConfig (additionalKeys, additionalKeysP) import XMonad.Util.Types+import qualified Data.List.NonEmpty as NE  -- $usage -- #Usage#@@ -86,7 +85,7 @@ -- layers and allows customization of the navigation strategy for the tiled -- layer based on the layout currently in effect. ----- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with (a subset of) the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Navigation2D --@@ -99,8 +98,16 @@ -- >                              False -- >               $ def ----- Alternatively, you can use navigation2DP:+-- /NOTE/: the @def@ argument to 'navigation2D' contains the strategy+-- that decides which windows actually get selected.  While the default+-- behaviour tries to keep them into account, if you use modules that+-- influence tiling in some way, like "XMonad.Layout.Spacing" or+-- "XMonad.Layout.Gaps", you should think about using a different+-- strategy, if you find the default behaviour to be unnatural.  Check+-- out the [finer points](#g:Finer_Points) below for more information. --+-- Alternatively to 'navigation2D', you can use 'navigation2DP':+-- -- > main = xmonad $ navigation2DP def -- >                               ("<Up>", "<Left>", "<Down>", "<Right>") -- >                               [("M-",   windowGo  ),@@ -109,7 +116,7 @@ -- >               $ def -- -- That's it. If instead you'd like more control, you can combine--- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP:+-- 'withNavigation2DConfig' and 'additionalNav2DKeys' or 'additionalNav2DKeysP': -- -- > main = xmonad $ withNavigation2DConfig def -- >               $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)@@ -163,7 +170,7 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- $finer_points -- #Finer_Points#@@ -180,9 +187,19 @@ -- values in the above example to 'True'.  You could also decide you want -- wrapping only for a subset of the operations and no wrapping for others. ----- By default, all layouts use the 'defaultTiledNavigation' strategy specified--- in the 'Navigation2DConfig' (by default, line navigation is used).  To--- override this behaviour for some layouts, add a pair (\"layout name\",+-- By default, all layouts use the 'defaultTiledNavigation' strategy+-- specified in the 'Navigation2DConfig' (by default, line navigation is+-- used).  Many more navigation strategies are available; some may feel+-- more natural, depending on the layout and user:+--+--   * 'lineNavigation'+--   * 'centerNavigation'+--   * 'sideNavigation'+--   * 'sideNavigationWithBias'+--+-- There is also the ability to combine two strategies with 'hybridOf'.+--+-- To override the default behaviour for some layouts, add a pair (\"layout name\", -- navigation strategy) to the 'layoutNavigation' list in the -- 'Navigation2DConfig', where \"layout name\" is the string reported by the -- layout's description method (normally what is shown as the layout name in@@ -328,7 +345,7 @@ -- and push it to the right until it intersects with at least one other window. -- Of those windows, one with a point that is the closest to the centre of the -- line (+1) is selected. This is probably the most intuitive strategy for the--- tiled layer when using XMonad.Layout.Spacing.+-- tiled layer when using "XMonad.Layout.Spacing". sideNavigation :: Navigation2D sideNavigation = N 1 (doSideNavigationWithBias 1) @@ -360,10 +377,6 @@   where     applyToBoth f g a b c = f a b c <|> g a b c -{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}-hybridNavigation :: Navigation2D-hybridNavigation = hybridOf lineNavigation centerNavigation- -- | Stores the configuration of directional navigation. The 'Default' instance -- uses line navigation for the tiled layer and for navigation between screens, -- and center navigation for the float layer.  No custom navigation strategies@@ -386,10 +399,10 @@                                                        -- function calculates a rectangle for a given unmapped                                                        -- window from the screen it is on and its window ID.                                                        -- See <#Finer_Points> for how to use this.-  } deriving Typeable+  }  -- | Shorthand for the tedious screen type-type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail+type Screen = WindowScreen  -- | Convenience function for enabling Navigation2D with typical keybindings. -- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from@@ -434,7 +447,7 @@ -- mapping from key prefix to action, and a bool to indicate if wrapping should -- occur, and returns a function from XConfig to XConfig. Example: ----- >  additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig+-- >  additionalNav2DKeysP ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->                         Bool -> XConfig l -> XConfig l additionalNav2DKeysP (u, l, d, r) modifiers wrap =@@ -451,12 +464,8 @@                                                           >> XS.put conf2d                                             } -{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}-defaultNavigation2DConfig :: Navigation2DConfig-defaultNavigation2DConfig = def- instance Default Navigation2DConfig where-    def                   = Navigation2DConfig { defaultTiledNavigation = lineNavigation+    def                   = Navigation2DConfig { defaultTiledNavigation = hybridOf lineNavigation sideNavigation                                                , floatNavigation        = centerNavigation                                                , screenNavigation       = lineNavigation                                                , layoutNavigation       = []@@ -482,7 +491,7 @@ -- navigation should wrap around (e.g., from the left edge of the leftmost -- screen to the right edge of the rightmost screen). windowGo :: Direction2D -> Bool -> X ()-windowGo dir wrap = actOnLayer thisLayer+windowGo dir = actOnLayer thisLayer                                ( \ conf cur wins -> windows                                  $ doTiledNavigation conf dir W.focusWindow cur wins                                )@@ -492,7 +501,6 @@                                ( \ conf cur wspcs -> windows                                  $ doScreenNavigation conf dir W.view cur wspcs                                )-                               wrap  -- | Swaps the current window with the next window in the given direction and in -- the same layer as the current window.  (In the floating layer, all that@@ -501,7 +509,7 @@ -- window's screen but retains its position and size relative to the screen.) -- The second argument indicates wrapping (see 'windowGo'). windowSwap :: Direction2D -> Bool -> X ()-windowSwap dir wrap = actOnLayer thisLayer+windowSwap dir = actOnLayer thisLayer                                  ( \ conf cur wins -> windows                                    $ doTiledNavigation conf dir swap cur wins                                  )@@ -509,32 +517,28 @@                                    $ doFloatNavigation conf dir swap cur wins                                  )                                  ( \ _ _ _ -> return () )-                                 wrap  -- | Moves the current window to the next screen in the given direction.  The -- second argument indicates wrapping (see 'windowGo'). windowToScreen :: Direction2D -> Bool -> X ()-windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows+windowToScreen dir = actOnScreens ( \ conf cur wspcs -> windows                                          $ doScreenNavigation conf dir W.shift cur wspcs                                        )-                                       wrap  -- | Moves the focus to the next screen in the given direction.  The second -- argument indicates wrapping (see 'windowGo'). screenGo :: Direction2D -> Bool -> X ()-screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows+screenGo dir = actOnScreens ( \ conf cur wspcs -> windows                                    $ doScreenNavigation conf dir W.view cur wspcs                                  )-                                 wrap  -- | Swaps the workspace on the current screen with the workspace on the screen -- in the given direction.  The second argument indicates wrapping (see -- 'windowGo'). screenSwap :: Direction2D -> Bool -> X ()-screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows+screenSwap dir = actOnScreens ( \ conf cur wspcs -> windows                                      $ doScreenNavigation conf dir W.greedyView cur wspcs                                    )-                                   wrap  -- | Maps each window to a fullscreen rect.  This may not be the same rectangle the -- window maps to under the Full layout or a similar layout if the layout@@ -626,11 +630,8 @@  -- | Determines whether a given window is mapped isMapped :: Window -> X Bool-isMapped win  =  withDisplay-              $  \dpy -> io-              $  (waIsUnmapped /=)-              .  wa_map_state-             <$> getWindowAttributes dpy win+isMapped = fmap (maybe False ((waIsUnmapped /=) .  wa_map_state))+         . safeGetWindowAttributes  ---------------------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------------------@@ -654,7 +655,7 @@   where     ctr     = centerOf rect     winctrs = filter ((cur /=) . fst)-            $ map (\(w, r) -> (w, centerOf r)) winrects+            $ map (second centerOf) winrects     closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2                                    | otherwise                   = wc1 @@ -674,8 +675,7 @@     nav     = maximum             $ map ( fromMaybe (defaultTiledNavigation conf)                   . flip L.lookup (layoutNavigation conf)-                  )-            $ layouts+                  ) layouts  -- | Implements navigation for the float layer doFloatNavigation :: Navigation2DConfig@@ -720,7 +720,7 @@      -- The list of windows that are candidates to receive focus.     winrects'     = filter dirFilter-                  $ filter ((cur /=) . fst)+                  . filter ((cur /=) . fst)                   $ winrects      -- Decides whether a given window matches the criteria to be a candidate to@@ -761,9 +761,8 @@     -- center rotated so the right cone becomes the relevant cone.     -- The windows are ordered in the order they should be preferred     -- when they are otherwise tied.-    winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))-            $ stackTransform-            $ winrects+    winctrs = map (second (dirTransform . centerOf))+            $ stackTransform winrects      -- Give preference to windows later in the stack for going left or up and to     -- windows earlier in the stack for going right or down.  (The stack order@@ -785,8 +784,7 @@      -- All the points that coincide with the current center and succeed it     -- in the (appropriately ordered) window stack.-    onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr-             -- tail should be safe here because cur should be in onCtr+    onCtr' = L.drop 1 $ L.dropWhile ((cur /=) . fst) onCtr      -- All the points that do not coincide with the current center and which     -- lie in the (rotated) right cone.@@ -821,7 +819,7 @@   Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a doSideNavigationWithBias bias dir (cur, rect)   = fmap fst . listToMaybe-  . L.sortBy (comparing dist) . foldr acClosest []+  . L.sortOn dist . foldr acClosest []   . filter (`toRightOf` (cur, transform rect))   . map (fmap transform)   where@@ -836,8 +834,7 @@     rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)      -- Apply the above function until d becomes synonymous with R (wolog).-    rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]-                  in  foldr (const $ (.) rHalfPiCC) id l+    rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC      transform = rotateToR dir . translate . toSR @@ -849,7 +846,7 @@     -- Greedily accumulate the windows tied for the leftmost left side.     acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l                                    | x1 r >  x1 r' =          l-    acClosest (w, r) _                             = (w, r) : []+    acClosest (w, r) _                             = [(w, r)]      -- Given a (_, SideRect), calculate how far it is from the y=bias line.     dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0@@ -870,7 +867,7 @@     visws    = map W.workspace scrs      -- The focused windows of the visible workspaces-    focused  = mapMaybe (\ws -> W.focus <$> W.stack ws) visws+    focused  = mapMaybe (fmap W.focus . W.stack) visws      -- The window lists of the visible workspaces     wins     = map (W.integrate' . W.stack) visws@@ -887,22 +884,18 @@     -- Reconstruct the workspaces' window stacks to reflect the swap.     newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins     newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws-    newwinset = winset { W.current = head newscrs-                       , W.visible = tail newscrs+    newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen.+                       , W.visible = drop 1 newscrs                        }  -- | Calculates the center of a rectangle centerOf :: Rectangle -> (Position, Position) centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2) --- | Shorthand for integer conversions-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral- -- | Functions to choose the subset of windows to operate on thisLayer, otherLayer :: a -> a -> a-thisLayer  = curry fst-otherLayer = curry snd+thisLayer  = const+otherLayer _ x = x  -- | Returns the list of visible workspaces and their screen rects visibleWorkspaces :: WindowSet -> Bool -> [WSRect]@@ -939,8 +932,8 @@   where     min_x = fi $ minimum $ map rect_x rects     min_y = fi $ minimum $ map rect_y rects-    max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width  r)) rects-    max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects+    max_x = fi $ maximum $ map (\r -> rect_x r + fi (rect_width  r)) rects+    max_y = fi $ maximum $ map (\r -> rect_y r + fi (rect_height r)) rects     rects = map snd $ visibleWorkspaces winset False  @@ -950,16 +943,16 @@ sortedScreens winset = L.sortBy cmp                      $ W.screens winset   where-    cmp s1 s2 | x1 < x2   = LT-              | x1 > x2   = GT-              | y1 < x2   = LT-              | y1 > y2   = GT+    cmp s1 s2 | x < x'   = LT+              | x > x'   = GT+              | y < x'   = LT+              | y > y'   = GT               | otherwise = EQ       where-        (x1, y1) = centerOf (screenRect . W.screenDetail $ s1)-        (x2, y2) = centerOf (screenRect . W.screenDetail $ s2)+        (x , y ) = centerOf (screenRect . W.screenDetail $ s1)+        (x', y') = centerOf (screenRect . W.screenDetail $ s2)   -- | Calculates the L1-distance between two points. lDist :: (Position, Position) -> (Position, Position) -> Int-lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)+lDist (x, y) (x', y') = abs (fi $ x - x') + abs (fi $ y - y')
XMonad/Actions/NoBorders.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.NoBorders+-- Description :  Helper functions for dealing with window borders. -- Copyright   :  (c) Lukas Mai -- License     :  BSD3-style (see LICENSE) --@@ -26,8 +27,7 @@ toggleBorder :: Window -> X () toggleBorder w = do     bw <- asks (borderWidth . config)-    withDisplay $ \d -> io $ do-        cw <- wa_border_width `fmap` getWindowAttributes d w-        if cw == 0+    withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $+        if wa_border_width wa == 0             then setWindowBorderWidth d w bw             else setWindowBorderWidth d w 0
XMonad/Actions/OnScreen.hs view
@@ -1,157 +1,187 @@------------------------------------------------------------------------------ -- | -- Module      :  XMonad.Actions.OnScreen--- Copyright   :  (c) 2009 Nils Schweinsberg+-- Description :  Control workspaces on different screens (in xinerama mode).+-- Copyright   :  (c) 2009-2025 Nils Schweinsberg -- License     :  BSD3-style (see LICENSE) ----- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>+-- Maintainer  :  Nils Schweinsberg <mail@nils.cc> -- Stability   :  unstable -- Portability :  unportable -- -- Control workspaces on different screens (in xinerama mode).-----------------------------------------------------------------------------------module XMonad.Actions.OnScreen (-    -- * Usage+module XMonad.Actions.OnScreen+  ( -- * Usage     -- $usage-      onScreen-    , onScreen'-    , Focus(..)-    , viewOnScreen-    , greedyViewOnScreen-    , onlyOnScreen-    , toggleOnScreen-    , toggleGreedyOnScreen-    ) where+    onScreen,+    onScreen',+    Focus (..),+    viewOnScreen,+    greedyViewOnScreen,+    onlyOnScreen,+    toggleOnScreen,+    toggleGreedyOnScreen,+  )+where  import XMonad+import XMonad.Prelude (empty, fromMaybe, guard) import XMonad.StackSet hiding (new) -import Control.Monad (guard)--- import Control.Monad.State.Class (gets)-import Data.Maybe (fromMaybe)-- -- | Focus data definitions-data Focus = FocusNew                       -- ^ always focus the new screen-           | FocusCurrent                   -- ^ always keep the focus on the current screen-           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack-           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack-+data Focus+  = -- | always focus the new screen+    FocusNew+  | -- | always keep the focus on the current screen+    FocusCurrent+  | -- | always focus tag i on the new stack+    FocusTag WorkspaceId+  | -- | focus tag i only if workspace with tag i is visible on the old stack+    FocusTagVisible WorkspaceId  -- | Run any function that modifies the stack on a given screen. This function -- will also need to know which Screen to focus after the function has been -- run.-onScreen :: (WindowSet -> WindowSet) -- ^ function to run-         -> Focus                    -- ^ what to do with the focus-         -> ScreenId                 -- ^ screen id-         -> WindowSet                -- ^ current stack-         -> WindowSet+onScreen ::+  -- | function to run+  (WindowSet -> WindowSet) ->+  -- | what to do with the focus+  Focus ->+  -- | screen id+  ScreenId ->+  -- | current stack+  WindowSet ->+  WindowSet onScreen f foc sc st = fromMaybe st $ do-    ws <- lookupWorkspace sc st--    let fStack      = f $ view ws st+  ws <- lookupWorkspace sc st -    return $ setFocus foc st fStack+  let fStack = f $ view ws st +  return $ setFocus foc st fStack  -- set focus for new stack-setFocus :: Focus-         -> WindowSet -- ^ old stack-         -> WindowSet -- ^ new stack-         -> WindowSet-setFocus FocusNew _ new             = new-setFocus FocusCurrent old new        =-    case lookupWorkspace (screen $ current old) new of-         Nothing -> new-         Just i -> view i new-setFocus (FocusTag i) _ new         = view i new+setFocus ::+  Focus ->+  -- | old stack+  WindowSet ->+  -- | new stack+  WindowSet ->+  WindowSet+setFocus FocusNew _ new = new+setFocus FocusCurrent old new =+  case lookupWorkspace (screen $ current old) new of+    Nothing -> new+    Just i -> view i new+setFocus (FocusTag i) _ new = view i new setFocus (FocusTagVisible i) old new =-    if i `elem` map (tag . workspace) (visible old)-       then setFocus (FocusTag i) old new-       else setFocus FocusCurrent old new+  if i `elem` map (tag . workspace) (visible old)+    then setFocus (FocusTag i) old new+    else setFocus FocusCurrent old new  -- | A variation of @onScreen@ which will take any @X ()@ function and run it -- on the given screen. -- Warning: This function will change focus even if the function it's supposed -- to run doesn't succeed.-onScreen' :: X ()       -- ^ X function to run-          -> Focus      -- ^ focus-          -> ScreenId   -- ^ screen id-          -> X ()+onScreen' ::+  -- | X function to run+  X () ->+  -- | focus+  Focus ->+  -- | screen id+  ScreenId ->+  X () onScreen' x foc sc = do-    st <- gets windowset-    case lookupWorkspace sc st of-         Nothing -> return ()-         Just ws -> do-             windows $ view ws-             x-             windows $ setFocus foc st-+  st <- gets windowset+  case lookupWorkspace sc st of+    Nothing -> return ()+    Just ws -> do+      windows $ view ws+      x+      windows $ setFocus foc st  -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to -- switch focus to the workspace @i@.-viewOnScreen :: ScreenId    -- ^ screen id-             -> WorkspaceId -- ^ index of the workspace-             -> WindowSet   -- ^ current stack-             -> WindowSet+viewOnScreen ::+  -- | screen id+  ScreenId ->+  -- | index of the workspace+  WorkspaceId ->+  -- | current stack+  WindowSet ->+  WindowSet viewOnScreen sid i =-    onScreen (view i) (FocusTag i) sid+  onScreen (view i) (FocusTag i) sid  -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@ -- to switch the current workspace with workspace @i@.-greedyViewOnScreen :: ScreenId    -- ^ screen id-                   -> WorkspaceId -- ^ index of the workspace-                   -> WindowSet   -- ^ current stack-                   -> WindowSet+greedyViewOnScreen ::+  -- | screen id+  ScreenId ->+  -- | index of the workspace+  WorkspaceId ->+  -- | current stack+  WindowSet ->+  WindowSet greedyViewOnScreen sid i =-    onScreen (greedyView i) (FocusTagVisible i) sid+  onScreen (greedyView i) (FocusTagVisible i) sid  -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.-onlyOnScreen :: ScreenId    -- ^ screen id-             -> WorkspaceId -- ^ index of the workspace-             -> WindowSet   -- ^ current stack-             -> WindowSet+onlyOnScreen ::+  -- | screen id+  ScreenId ->+  -- | index of the workspace+  WorkspaceId ->+  -- | current stack+  WindowSet ->+  WindowSet onlyOnScreen sid i =-    onScreen (view i) FocusCurrent sid+  onScreen (view i) FocusCurrent sid  -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view-toggleOnScreen :: ScreenId    -- ^ screen id-               -> WorkspaceId -- ^ index of the workspace-               -> WindowSet   -- ^ current stack-               -> WindowSet+toggleOnScreen ::+  -- | screen id+  ScreenId ->+  -- | index of the workspace+  WorkspaceId ->+  -- | current stack+  WindowSet ->+  WindowSet toggleOnScreen sid i =-    onScreen (toggleOrView' view i) FocusCurrent sid+  onScreen (toggleOrView' view i) FocusCurrent sid  -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView-toggleGreedyOnScreen :: ScreenId    -- ^ screen id-                     -> WorkspaceId -- ^ index of the workspace-                     -> WindowSet   -- ^ current stack-                     -> WindowSet+toggleGreedyOnScreen ::+  -- | screen id+  ScreenId ->+  -- | index of the workspace+  WorkspaceId ->+  -- | current stack+  WindowSet ->+  WindowSet toggleGreedyOnScreen sid i =-    onScreen (toggleOrView' greedyView i) FocusCurrent sid-+  onScreen (toggleOrView' greedyView i) FocusCurrent sid  -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip-toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet)   -- ^ function to run-              -> WorkspaceId                               -- ^ tag to look for-              -> WindowSet                                 -- ^ current stackset-              -> WindowSet+toggleOrView' ::+  -- | function to run+  (WorkspaceId -> WindowSet -> WindowSet) ->+  -- | tag to look for+  WorkspaceId ->+  -- | current stackset+  WindowSet ->+  WindowSet toggleOrView' f i st = fromMaybe (f i st) $ do-    let st' = hidden st-    -- make sure we actually have to do something-    guard $ i == (tag . workspace $ current st)-    guard $ not (null st')-    -- finally, toggle!-    return $ f (tag . head $ st') st-+  let st' = hidden st+  -- make sure we actually have to do something+  guard $ i == (tag . workspace $ current st)+  case st' of+    [] -> empty+    (h : _) -> return $ f (tag h) st -- finally, toggle!  -- $usage -- -- This module provides an easy way to control, what you see on other screens in -- xinerama mode without having to focus them. Put this into your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Actions.OnScreen --@@ -185,4 +215,4 @@ -- where 0 is the first screen and \"1\" the workspace with the tag \"1\". -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
+ XMonad/Actions/PerLayoutKeys.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.PerLayoutKeys+-- Description :  Define key-bindings on per-layout basis.+-- Copyright   :  (c) brandon s allbery kf8nh 2022, Roman Cheplyaka, 2008+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  brandon s allbery kf8ng <allbery.b@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Define key-bindings on per-layout basis.+--+-----------------------------------------------------------------------------++module XMonad.Actions.PerLayoutKeys (+                                 -- * Usage+                                 -- $usage+                                 chooseActionByLayout,+                                 bindByLayout+                                ) where++import XMonad+import XMonad.StackSet as S++-- $usage+--+-- You can use this module with the following in your @xmonad.hs@:+--+-- >  import XMonad.Actions.PerLayoutKeys+--+-- >   ,((0, xK_F2), bindByLayout [("Tall", spawn "rxvt"), ("Mirror Tall", spawn "xeyes"), ("", spawn "xmessage hello")])+--+-- For detailed instructions on editing your key bindings, see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.++-- | Uses supplied function to decide which action to run depending on current layout name.+chooseActionByLayout :: (String->X()) -> X()+chooseActionByLayout f = withWindowSet (f . description . S.layout. S.workspace . S.current)++-- | If current layout is listed, run appropriate action (only the first match counts!)+-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied.+bindByLayout :: [(String, X())] -> X()+bindByLayout bindings = chooseActionByLayout chooser where+    chooser l = case lookup l bindings of+        Just action -> action+        Nothing -> case lookup "" bindings of+            Just action -> action+            Nothing -> return ()
+ XMonad/Actions/PerWindowKeys.hs view
@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.PerWindowKeys+-- Description :  Define key-bindings on a per-window basis.+-- Copyright   :  (c) Wilson Sales, 2019+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Wilson Sales <spoonm@spoonm.org>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Define key-bindings on a per-window basis.+--+-----------------------------------------------------------------------------++module XMonad.Actions.PerWindowKeys (+                                    -- * Usage+                                    -- $usage+                                    bindAll,+                                    bindFirst+                                   ) where++import XMonad++-- $usage+--+-- You can use this module with the following in your @xmonad.hs@:+--+-- >  import XMonad.Actions.PerWindowKeys+--+-- >   ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)])+--+-- >   ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)])+--+-- If you want an action that will always run, but also want to do something for+-- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True,+-- alwaysDoThisAction)]@.+--+-- Similarly, if you want a default action to be run if all the others failed,+-- you can use @'bindFirst' [(query1, action1), ..., (pure True,+-- doThisIfTheOthersFail)]@.+--+-- For detailed instructions on editing your key bindings, see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.++-- | Run an action if a Query holds true. Doesn't stop at the first one that+-- does, however, and could potentially run all actions.+bindAll :: [(Query Bool, X ())] -> X ()+bindAll = mapM_ choose where+  choose (mh,action) = withFocused $ \w -> whenX (runQuery mh w) action++-- | Run the action paired with the first Query that holds true.+bindFirst :: [(Query Bool, X ())] -> X ()+bindFirst = withFocused . chooseOne++chooseOne :: [(Query Bool, X ())] -> Window -> X ()+chooseOne [] _ = return ()+chooseOne ((mh,a):bs) w = do+  c <- runQuery mh w+  if c then a+       else chooseOne bs w
XMonad/Actions/PerWorkspaceKeys.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.PerWorkspaceKeys+-- Description :  Define key-bindings on per-workspace basis. -- Copyright   :  (c) Roman Cheplyaka, 2008 -- License     :  BSD3-style (see LICENSE) --@@ -24,14 +25,14 @@  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >  import XMonad.Actions.PerWorkspaceKeys -- -- >   ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")]) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Uses supplied function to decide which action to run depending on current workspace name. chooseAction :: (String->X()) -> X()@@ -46,4 +47,3 @@         Nothing -> case lookup "" bindings of             Just action -> action             Nothing -> return ()-
XMonad/Actions/PhysicalScreens.hs view
@@ -1,7 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ParallelListComp #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.PhysicalScreens+-- Description  : Manipulate screens ordered by physical location instead of ID. -- Copyright    : (c) Nelson Elhage <nelhage@mit.edu> -- License      : BSD --@@ -27,14 +30,15 @@                                       , getScreenIdAndRectangle                                       , screenComparatorById                                       , screenComparatorByRectangle+                                      , rescreen                                       ) where -import XMonad+import Data.List.NonEmpty (nonEmpty)+import XMonad hiding (rescreen)+import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|)))+import qualified Data.List.NonEmpty as NE import qualified XMonad.StackSet as W -import Data.List (sortBy,findIndex)-import Data.Function (on)- {- $usage  This module allows you name Xinerama screens from XMonad using their@@ -47,7 +51,7 @@ The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom and then left-to-right. -Example usage in your @~\/.xmonad\/xmonad.hs@ file:+Example usage in your @xmonad.hs@ file:  > import XMonad.Actions.PhysicalScreens > import Data.Default@@ -66,17 +70,17 @@ >     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]  For detailed instructions on editing your key bindings, see-"XMonad.Doc.Extending#Editing_key_bindings".+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -}  -- | The type of the index of a screen by location newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) -getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)+getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle) getScreenIdAndRectangle screen = (W.screen screen, rect) where   rect = screenRect $ W.screenDetail screen --- | Translate a physical screen index to a "ScreenId"+-- | Translate a physical screen index to a 'ScreenId' getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId) getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset                                                   let screens = W.current w : W.visible w@@ -89,8 +93,8 @@ viewScreen :: ScreenComparator -> PhysicalScreen -> X () viewScreen sc p = do i <- getScreen sc p                      whenJust i $ \s -> do-                     w <- screenWorkspace s-                     whenJust w $ windows . W.view+                         w <- screenWorkspace s+                         whenJust w $ windows . W.view  -- | Send the active window to a given physical screen sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()@@ -131,7 +135,7 @@ getNeighbour (ScreenComparator cmpScreen) d =   do w <- gets windowset      let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w-         curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss+         curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss          pos = (curPos + d) `mod` length ss      return $ ss !! pos @@ -147,3 +151,53 @@ -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X () onPrevNeighbour sc = neighbourWindows sc (-1)++-- | An alternative to 'XMonad.Operations.rescreen' that avoids reshuffling+-- the workspaces if the number of screens doesn't change and only their+-- locations do. Useful for users of @xrandr --setmonitor@.+--+-- See 'XMonad.Hooks.Rescreen.setRescreenWorkspacesHook', which lets you+-- replace the builtin rescreen handler.+rescreen :: ScreenComparator -> X ()+rescreen (ScreenComparator cmpScreen) = withDisplay (fmap nonEmpty . getCleanedScreenInfo) >>= \case+    Nothing -> trace "getCleanedScreenInfo returned []"+    Just xinescs -> windows $ rescreen' xinescs+  where+    rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet+    rescreen' xinescs ws+      | NE.length xinescs == length (W.visible ws) + 1 = rescreenSameLength xinescs ws+      | otherwise = rescreenCore xinescs ws++    -- the 'XMonad.Operations.rescreen' implementation from core as a fallback+    rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet+    rescreenCore (xinesc :| xinescs) ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } =+        let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)+            a = W.Screen (W.workspace v) 0 (SD xinesc)+            as = zipWith3 W.Screen xs [1..] $ map SD xinescs+        in  ws{ W.current = a+              , W.visible = as+              , W.hidden  = ys }++    -- sort both existing screens and the screens we just got from xinerama+    -- using cmpScreen, and then replace the rectangles in the WindowSet,+    -- keeping the order of current/visible workspaces intact+    rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet+    rescreenSameLength xinescs ws =+        ws{ W.current = (W.current ws){ W.screenDetail = SD newCurrentRect }+          , W.visible = [ w{ W.screenDetail = SD r } | w <- W.visible ws | r <- newVisibleRects ]+          }+      where+        undoSort =+            NE.map fst $+            NE.sortBy (cmpScreen `on` (getScreenIdAndRectangle . snd)) $+            NE.zip ((0 :: Int) :| [1..]) $ -- add indices to undo the sort later+            W.current ws :| W.visible ws+        newCurrentRect :| newVisibleRects =+            NE.map snd $ NE.sortWith fst $ NE.zip undoSort $ -- sort back into current:visible order+            NE.map snd $ NE.sortBy cmpScreen $ NE.zip (0 :| [1..]) xinescs++    -- TODO:+    -- If number of screens before and after isn't the same, we might still+    -- try to match locations and avoid changing the workspace for those that+    -- didn't move, while making sure that the current workspace is still+    -- visible somewhere.
XMonad/Actions/Plane.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.Plane+-- Description :  Navigate through workspaces in a bidimensional manner. -- Copyright   :  (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>, --                    Leonardo Serra <leoserra@minaslivre.org> -- License     :  BSD3-style (see LICENSE)@@ -38,17 +39,15 @@     )     where -import Control.Monad-import Data.List-import Data.Map hiding (split)-import Data.Maybe+import Data.Map (Map, fromList) +import XMonad.Prelude hiding (fromList) import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Run  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.Plane -- > import Data.Map (union)@@ -60,7 +59,7 @@ -- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Direction to go in the plane. data Direction =  ToLeft | ToUp | ToRight | ToDown deriving Enum
+ XMonad/Actions/Prefix.hs view
@@ -0,0 +1,222 @@+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Prefix+-- Description :  Use an Emacs-style prefix argument for commands.+-- Copyright   :  (c) Matus Goljer <matus.goljer@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Matus Goljer <matus.goljer@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module that allows the user to use a prefix argument (raw or numeric).+--+-----------------------------------------------------------------------------++module XMonad.Actions.Prefix+       (+      -- * Usage+      -- $usage++      -- * Installation+      -- $installation++         PrefixArgument(..)+       , usePrefixArgument+       , useDefaultPrefixArgument+       , withPrefixArgument+       , isPrefixRaw+       , isPrefixNumeric+       , orIfPrefixed+       , ppFormatPrefix+       ) where++import qualified Data.Map as M++import XMonad.Prelude+import XMonad+import XMonad.Util.ExtensibleState as XS+import XMonad.Util.Paste (sendKey)+import XMonad.Actions.Submap (submapDefaultWithKey)+import XMonad.Util.EZConfig (readKeySequence)+import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty ((<|))++{- $usage++This module implements Emacs-style prefix argument.  The argument+comes in two flavours, 'Raw' and 'Numeric'.++To initiate the "prefix mode" you hit the prefix keybinding (default+C-u).  This sets the Raw argument value to 1.  Repeatedly hitting this+key increments the raw value by 1.  The Raw argument is usually used+as a toggle, changing the behaviour of the function called in some way.++An example might be calling "mpc add" to add new song to the playlist,+but with C-u we also clean up the playlist beforehand.++When in the "Raw mode", you can hit numeric keys 0..9 (with no+modifier) to enter a "Numeric argument".  Numeric argument represents+a natural number.  Hitting numeric keys in sequence produces the+decimal number that would result from typing them.  That is, the+sequence C-u 4 2 sets the Numeric argument value to the number 42.++If you have a function which understands the prefix argument, for example:++>    addMaybeClean :: PrefixArgument -> X ()+>    addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add <file>"+>    addMaybeClean _ = spawn "mpc add <file>"++you can turn it into an X action with the function 'withPrefixArgument'.++Binding it in your config++>    ((modm, xK_a), withPrefixArgument addMaybeClean)++Hitting MOD-a will add the @\<file\>@ to the playlist while C-u MOD-a will+clear the playlist and then add the file.++You can of course use an anonymous action, like so:++>    ((modm, xK_a), withPrefixArgument $ \prefix -> do+>        case prefix of ...+>    )++If the prefix key is followed by a binding which is unknown to XMonad,+the prefix along with that binding is sent to the active window.++There is one caveat: when you use an application which has a nested+C-u binding, for example C-c C-u in Emacs org-mode, you have to hit+C-g (or any other non-recognized key really) to get out of the "xmonad+grab" and let the C-c C-u be sent to the application.++-}++{- $installation++The simplest way to enable this is to use 'useDefaultPrefixArgument'++>    xmonad $ useDefaultPrefixArgument $ def { .. }++The default prefix argument is C-u.  If you want to customize the+prefix argument, 'usePrefixArgument' can be used:++>    xmonad $ usePrefixArgument "M-u" $ def { .. }++where the key is entered in Emacs style (or "XMonad.Util.EZConfig"+style) notation.  The letter `M` stands for your chosen modifier.  The+function defaults to C-u if the argument could not be parsed.+-}++data PrefixArgument = Raw Int | Numeric Int | None+                      deriving (Read, Show)+instance ExtensionClass PrefixArgument where+  initialValue = None+  extensionType = PersistentExtension++-- | Run 'job' in the 'X' monad and then execute 'cleanup'.  In case+-- of exception, 'cleanup' is executed anyway.+--+-- Return the return value of 'job'.+finallyX :: X a -> X a -> X a+finallyX job cleanup = catchX (job >>= \r -> cleanup >> return r) cleanup++-- | Set up Prefix.  Defaults to C-u when given an invalid key.+--+-- See usage section.+usePrefixArgument :: LayoutClass l Window+                  => String+                  -> XConfig l+                  -> XConfig l+usePrefixArgument prefix conf =+  conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf }+ where+  binding = case readKeySequence conf prefix of+    Just (key :| []) -> key+    _                -> (controlMask, xK_u)++-- | Set Prefix up with default prefix key (C-u).+useDefaultPrefixArgument :: LayoutClass l Window+                         => XConfig l+                         -> XConfig l+useDefaultPrefixArgument = usePrefixArgument "C-u"++handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X ()+handlePrefixArg events = do+  ks <- asks keyActions+  logger <- asks (logHook . config)+  flip finallyX (XS.put None >> logger) $ do+    prefix <- XS.get+    case prefix of+      Raw a -> XS.put $ Raw (a + 1)+      None -> XS.put $ Raw 1+      _ -> return ()+    logger+    submapDefaultWithKey defaultKey ks+  where defaultKey key@(m, k) =+          if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask+          then do+            prefix <- XS.get+            let x = fromJust (Prelude.lookup k keyToNum)+            case prefix of+              Raw _ -> XS.put $ Numeric x+              Numeric a -> XS.put $ Numeric $ a * 10 + x+              None -> return () -- should never happen+            handlePrefixArg (key <| events)+          else do+            prefix <- XS.get+            mapM_ (uncurry sendKey) $ case prefix of+              Raw a -> replicate a (NE.head events) ++ [key]+              _ -> reverse (key : toList events)+        keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]++-- | Turn a prefix-aware X action into an X-action.+--+-- First, fetch the current prefix, then pass it as argument to the+-- original function.  You should use this to "run" your commands.+withPrefixArgument :: (PrefixArgument -> X a) -> X a+withPrefixArgument = (>>=) XS.get++-- | Test if 'PrefixArgument' is 'Raw' or not.+isPrefixRaw :: PrefixArgument -> Bool+isPrefixRaw (Raw _) = True+isPrefixRaw _ = False++-- | Test if 'PrefixArgument' is 'Numeric' or not.+isPrefixNumeric :: PrefixArgument -> Bool+isPrefixNumeric (Numeric _) = True+isPrefixNumeric _ = False++-- | Execute the first action, unless any prefix argument is given,+-- in which case the second action is chosen instead.+--+-- > action1 `orIfPrefixed` action2+orIfPrefixed :: X a -> X a -> X a+orIfPrefixed xa xb = withPrefixArgument $ bool xa xb . isPrefixRaw++-- | Format the prefix using the Emacs convetion for use in a+-- statusbar, like xmobar.+--+-- To add this formatted prefix to printer output, you can set it up+-- like so+--+-- > myPrinter :: PP+-- > myPrinter = def { ppExtras = [ppFormatPrefix] }+--+-- And then add to your status bar using "XMonad.Hooks.StatusBar":+--+-- > mySB = statusBarProp "xmobar" myPrinter+-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def+--+-- Or, directly in your 'logHook' configuration+--+-- > logHook = dynamicLogWithPP myPrinter+ppFormatPrefix :: X (Maybe String)+ppFormatPrefix = do+  prefix <- XS.get+  return $ case prefix of+    Raw n -> Just $ foldr1 (\a b -> a ++ " " ++ b) $ replicate n "C-u"+    Numeric n -> Just $ "C-u " ++ show n+    None -> Nothing
+ XMonad/Actions/Profiles.hs view
@@ -0,0 +1,545 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DerivingVia   #-}+++--------------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Profiles+-- Description :  Group your workspaces by similarity.+-- Copyright   :  (c) Mislav Zanic+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Mislav Zanic <mislavzanic3@gmail.com>+-- Stability   :  experimental+-- Portability :  unportable+--+--------------------------------------------------------------------------------++module XMonad.Actions.Profiles+  ( -- * Overview+    -- $overview++    -- * Usage+    -- $usage++    -- * Types+    ProfileId+  , Profile(..)+  , ProfileConfig(..)++  -- * Hooks+  , addProfiles+  , addProfilesWithHistory++  -- * Switching profiles+  , switchToProfile++  -- * Workspace navigation and keybindings+  , wsFilter+  , bindOn++  -- * Loggers and pretty printers+  , excludeWSPP+  , profileLogger++  -- * Prompts+  , switchProfilePrompt+  , addWSToProfilePrompt+  , removeWSFromProfilePrompt+  , switchProfileWSPrompt+  , shiftProfileWSPrompt++  -- * Utilities+  , currentProfile+  , profileIds+  , previousProfile+  , profileHistory+  , allProfileWindows+  , profileWorkspaces+  )where++--------------------------------------------------------------------------------+import Data.Map.Strict (Map)+import Data.List+import qualified Data.Map.Strict as Map++import Control.DeepSeq++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W++import XMonad.Actions.CycleWS++import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Loggers (Logger)+import XMonad.Prompt.Window (XWindowMap)+import XMonad.Actions.WindowBringer (WindowBringerConfig(..))+import XMonad.Actions.OnScreen (greedyViewOnScreen)+import XMonad.Hooks.Rescreen (addAfterRescreenHook)+import XMonad.Hooks.DynamicLog (PP(ppRename))+import XMonad.Prompt ++--------------------------------------------------------------------------------+-- $overview+-- This module allows you to group your workspaces into 'Profile's based on certain similarities.+-- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace"+-- which states that you can look at a topic/workspace as a+-- single unit of work instead of multiple related units of work.+-- This comes in handy if you have lots of workspaces with windows open and need only to+-- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that+-- require your attention by not displaying, or allowing you to switch to the rest of the workspaces.+-- The best example is having a profile for development and a profile for leisure activities.++--------------------------------------------------------------------------------+-- $usage+-- To use @Profiles@ you need to add it to your XMonad configuration+-- and configure your profiles.+--  +-- First you'll need to handle the imports.+--  +-- > import XMonad.Actions.Profiles +-- > import XMonad.Util.EZConfig -- for keybindings+-- > import qualified XMonad.StackSet as W+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation+--+-- Next you'll need to define your profiles.+--+-- > myStartingProfile :: ProfileId+-- > myStartingProfile = "Work"+-- >+-- > myProfiles :: [Profile]+-- > myProfiles =+-- >  [ Profile { profileId = "Home"+-- >            , profileWS = [ "www"+-- >                          , "rss"+-- >                          , "vid"+-- >                          , "vms"+-- >                          , "writing"+-- >                          , "notes"+-- >                          ]+-- >            }+-- >  , Profile { profileId = "Work"+-- >            , profileWS = [ "www"+-- >                          , "slack"+-- >                          , "dev"+-- >                          , "k8s"+-- >                          , "notes"+-- >                          ]+-- >            }+-- >  ]+-- +-- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and +-- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces.+--+-- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are+-- sensible keybindings for switching workspaces, you'll need to use+-- 'bindOn' to have different keybindings per profile.+-- Here, we'll use "XMonad.Util.EZConfig" syntax:+-- +-- > myKeys :: [(String, X())]+-- > myKeys = +-- >   [ ("M-p",  switchProfilePrompt   xpConfig)+-- >   , ("M-g",  switchProfileWSPrompt xpConfig)+-- >   , ("M1-j", DO.moveTo Next wsFilter)+-- >   , ("M1-k", DO.moveTo Prev wsFilter)+-- >   ]+-- >   <>+-- >   [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i)+-- >   | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList+-- >   , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")]+-- >   ]+-- >   where+-- >     mby f wid = if wid == "" then return () else f wid+-- >     sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y))+-- >     tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles+-- +-- After that, you'll need to hook @Profiles@ into your XMonad config:+-- +-- > main = xmonad $ addProfiles def { profiles        = myProfiles+-- >                                 , startingProfile = myStartingProfile+-- >                                 }+-- >               $ def `additionalKeysP` myKeys+-- ++--------------------------------------------------------------------------------+type ProfileId  = String+type ProfileMap = Map ProfileId Profile++--------------------------------------------------------------------------------+-- | Profile representation.+data Profile = Profile+  { profileId :: !ProfileId     -- ^ Profile name.+  , profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.+  }++--------------------------------------------------------------------------------+-- | Internal profile state.+data ProfileState = ProfileState+  { profilesMap :: !ProfileMap+  , current     :: !(Maybe Profile)+  , previous    :: !(Maybe ProfileId)+  }++--------------------------------------------------------------------------------+-- | User config for profiles.+data ProfileConfig = ProfileConfig+  { workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.+  , profiles          :: ![Profile]     -- ^ A list of user-defined profiles.+  , startingProfile   :: !ProfileId     -- ^ Profile shown on startup.+  }++--------------------------------------------------------------------------------+instance Default ProfileConfig where+  def            = ProfileConfig { workspaceExcludes = []+                                 , profiles          = []+                                 , startingProfile   = ""+                                 }++--------------------------------------------------------------------------------+instance ExtensionClass ProfileState where+  initialValue = ProfileState Map.empty Nothing Nothing++--------------------------------------------------------------------------------+-- Internal type for history tracking.+-- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware.+-- Because of that, when switching to a previous workspace, you might switch to+-- a workspace+newtype ProfileHistory = ProfileHistory+  { history :: Map ProfileId [(ScreenId, WorkspaceId)]+  }+  deriving (Read, Show)+  deriving NFData via Map ProfileId [(Int, WorkspaceId)]++--------------------------------------------------------------------------------+instance ExtensionClass ProfileHistory where+  extensionType = PersistentExtension+  initialValue = ProfileHistory Map.empty++--------------------------------------------------------------------------------+newtype ProfilePrompt = ProfilePrompt String++--------------------------------------------------------------------------------+instance XPrompt ProfilePrompt where+  showXPrompt (ProfilePrompt x) = x++--------------------------------------------------------------------------------+defaultProfile :: Profile+defaultProfile = defaultProfile++--------------------------------------------------------------------------------+-- | Returns current profile.+currentProfile :: X ProfileId+currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get++--------------------------------------------------------------------------------+-- | Returns previous profile.+previousProfile :: X (Maybe ProfileId)+previousProfile = XS.gets previous++--------------------------------------------------------------------------------+-- | Returns the history of viewed workspaces per profile.+profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])+profileHistory = XS.gets history++--------------------------------------------------------------------------------+profileMap :: X ProfileMap+profileMap = XS.gets profilesMap++--------------------------------------------------------------------------------+-- | Returns ids of all profiles.+profileIds :: X [ProfileId]+profileIds = Map.keys <$> XS.gets profilesMap++--------------------------------------------------------------------------------+currentProfileWorkspaces :: X [WorkspaceId]+currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile++--------------------------------------------------------------------------------+-- | Hook profiles into XMonad. This function adds a startup hook that+-- sets up ProfileState. Also adds an afterRescreenHook for viewing correct+-- workspaces when adding new screens.+addProfiles :: ProfileConfig -> XConfig a -> XConfig a+addProfiles profConf conf = addAfterRescreenHook hook $ conf+  { startupHook = profileStartupHook' <> startupHook conf+  }+ where+   profileStartupHook' :: X()+   profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf)+   hook = currentProfile >>= switchWSOnScreens++--------------------------------------------------------------------------------+-- | Hooks profiles into XMonad and enables Profile history logging.+addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a+addProfilesWithHistory profConf conf = conf'+  { logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf+  }+  where+   conf' = addProfiles profConf conf++--------------------------------------------------------------------------------+profileHistoryHookExclude :: [WorkspaceId] -> X()+profileHistoryHookExclude ews = do+  cur <- gets $ W.current . windowset+  vis <- gets $ W.visible . windowset+  pws <- currentProfileWorkspaces+  p <- currentProfile++  updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis+  where+    workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins)+    filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace)++--------------------------------------------------------------------------------+updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()+updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update+  where+    update pws hs = force $ hs { history = doUpdate pws $ history hs }++    doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs++    f pws sid wid val = case val of+      Nothing -> pure [(sid, wid)]+      Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs++    filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]+    filterWS pws new = filter (\x -> snd x `elem` pws && x /= new)++--------------------------------------------------------------------------------+-- | Adds profiles to ProfileState and sets current profile using .++profilesStartupHook :: [Profile] -> ProfileId -> X ()+profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid+  where+    go :: ProfileState -> ProfileState+    go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}++    update :: ProfileMap -> ProfileMap+    update = Map.union (Map.fromList $ map entry ps)++    entry :: Profile -> (ProfileId, Profile)+    entry p = (profileId p, p)++    setCurrentProfile :: ProfileMap -> Maybe Profile+    setCurrentProfile s = case Map.lookup pid s of+      Nothing -> Just $ Profile pid []+      Just pn -> Just pn++--------------------------------------------------------------------------------+setPrevious :: ProfileId -> X()+setPrevious name = XS.modify update+  where+    update ps = ps { previous = doUpdate ps }+    doUpdate ps = case Map.lookup name $ profilesMap ps of+      Nothing -> previous ps+      Just p -> Just $ profileId p++--------------------------------------------------------------------------------+setProfile :: ProfileId -> X ()+setProfile p = currentProfile >>= setPrevious >> setProfile' p++--------------------------------------------------------------------------------+setProfile' :: ProfileId -> X ()+setProfile' name = XS.modify update+  where+    update ps = ps { current = doUpdate ps }+    doUpdate ps = case Map.lookup name $ profilesMap ps of+      Nothing -> current ps+      Just p -> Just p++--------------------------------------------------------------------------------+-- | Switch to a profile.+switchToProfile :: ProfileId -> X()+switchToProfile pid = setProfile pid >> switchWSOnScreens pid++--------------------------------------------------------------------------------+-- | Returns the workspace ids associated with a profile id.+profileWorkspaces :: ProfileId -> X [WorkspaceId]+profileWorkspaces pid = profileMap >>= findPWs+  where+    findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm++--------------------------------------------------------------------------------+-- | Prompt for adding a workspace id to a profile.+addWSToProfilePrompt :: XPConfig -> X()+addWSToProfilePrompt c = do+  ps <- profileIds+  mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f+  where+   f :: String -> X()+   f p = do+     vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset+     cur <- gets $ W.tag . W.workspace . W.current . windowset+     hid <- gets $ fmap W.tag . W.hidden . windowset+     let+       arr = cur:(vis <> hid)+       in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p)++--------------------------------------------------------------------------------+-- | Prompt for switching profiles.+switchProfilePrompt :: XPConfig -> X()+switchProfilePrompt c = do+  ps <- profileIds+  mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile+     +--------------------------------------------------------------------------------+-- | Prompt for switching workspaces.+switchProfileWSPrompt :: XPConfig -> X ()+switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces+  where+    mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto +    mbygoto wid = do+      pw <- profileWorkspaces =<< currentProfile+      unless (wid `notElem` pw) (windows . W.greedyView $ wid)++--------------------------------------------------------------------------------+-- | Prompt for shifting windows to a different workspace.+shiftProfileWSPrompt :: XPConfig -> X ()+shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces+  where+    mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift+    mbyshift wid = do+      pw <- profileWorkspaces =<< currentProfile+      unless (wid `notElem` pw) (windows . W.shift $ wid)++--------------------------------------------------------------------------------+addWSToProfile :: WorkspaceId -> ProfileId -> X()+addWSToProfile wid pid = XS.modify go+  where+   go :: ProfileState -> ProfileState+   go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}++   update :: ProfileMap -> ProfileMap+   update mp = case Map.lookup pid mp of+     Nothing -> mp+     Just p  -> if wid `elem` profileWS p then mp else Map.adjust f pid mp++   f :: Profile -> Profile+   f p = Profile pid (wid : profileWS p)++   update' :: Profile -> Maybe Profile+   update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp++--------------------------------------------------------------------------------+-- | Prompt for removing a workspace from a profile.+removeWSFromProfilePrompt :: XPConfig -> X()+removeWSFromProfilePrompt c = do+  ps <- profileIds+  mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f+  where+   f :: String -> X()+   f p = do+     arr <- profileWorkspaces p+     mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $+       \ws -> do+         cp <- currentProfile+         ws `removeWSFromProfile` p +         when (cp == p) $ currentProfile >>= switchWSOnScreens++--------------------------------------------------------------------------------+removeWSFromProfile :: WorkspaceId -> ProfileId -> X()+removeWSFromProfile wid pid = XS.modify go+  where+   go :: ProfileState -> ProfileState+   go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}++   update :: ProfileMap -> ProfileMap+   update mp = case Map.lookup pid mp of+     Nothing -> mp+     Just p  -> if wid `elem` profileWS p then Map.adjust f pid mp else mp++   f :: Profile -> Profile+   f p = Profile pid (delete wid $ profileWS p)++   update' :: Profile -> Maybe Profile+   update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp++--------------------------------------------------------------------------------+-- | Pretty printer for a bar. Prints workspace ids of current profile.+excludeWSPP :: PP -> X PP+excludeWSPP pp = modifyPP <$> currentProfileWorkspaces+  where+    modifyPP pws = pp { ppRename = ppRename pp . printTag pws }+    printTag pws tag = if tag `elem` pws then tag else ""++--------------------------------------------------------------------------------+-- | For cycling through workspaces associated with the current.+wsFilter :: WSType+wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag)++--------------------------------------------------------------------------------+-- Takes care of placing correct workspaces on their respective screens.+-- It does this by reducing the history of a Profile until it gets an array of length+-- equal to the number of screens with pairs that have unique workspace ids.+switchWSOnScreens :: ProfileId -> X()+switchWSOnScreens pid = do+  hist <- profileHistory+  vis <- gets $ W.visible . windowset+  cur <- gets $ W.current . windowset+  pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid)+  case Map.lookup pid hist of+    Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws+    Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws+  where+    f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]+    f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst)++    reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]+    reorderUniq = map (\(x,y) -> (y,x)) . uniq++    uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]+    uniq = Map.toList . Map.fromList++    viewWS fview sid wid = windows $ fview sid wid++    switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen)++    compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws+                                   | otherwise                 = switchScreens hist++    populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws)++--------------------------------------------------------------------------------+chooseAction :: (String -> X ()) -> X ()+chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f++--------------------------------------------------------------------------------+-- | Create keybindings per profile.+bindOn :: [(String, X ())] -> X ()+bindOn bindings = chooseAction chooser+  where+    chooser profile = case lookup profile bindings of+        Just action -> action+        Nothing -> case lookup "" bindings of+            Just action -> action+            Nothing -> return ()++--------------------------------------------------------------------------------+-- | Loggs currentProfile and all profiles with hidden workspaces+--   (workspaces that aren't shown on a screen but have windows).+profileLogger :: (String -> String) -> (String -> String) -> Logger+profileLogger formatFocused formatUnfocused = do+  hws <- gets $ W.hidden . windowset+  p <- currentProfile+  hm <- map fst+      . filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p)+      . Map.toList <$> profileHistory+  return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm+  where+    format p a = if a == p then formatFocused a else formatUnfocused a+    htags wins = W.tag <$> filter (isJust . W.stack) wins++--------------------------------------------------------------------------------+-- | @XWindowMap@ of all windows contained in a profile.+allProfileWindows :: XWindowMap+allProfileWindows = allProfileWindows' def++--------------------------------------------------------------------------------+allProfileWindows' :: WindowBringerConfig -> XWindowMap+allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do+  pws <- currentProfileWorkspaces+  windowSet <- gets windowset+  Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet)+   where keyValuePairs ws = let wins = W.integrate' (W.stack ws)+                           in mapM (keyValuePair ws) =<< filterM include wins+         keyValuePair ws w = (, w) <$> titler ws w
XMonad/Actions/Promote.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.Promote+-- Description :  Alternate promote function for xmonad. -- Copyright   :  (c) Miikka Koskinen 2007 -- License     :  BSD3-style (see LICENSE) --@@ -27,7 +28,7 @@  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.Promote --@@ -36,7 +37,7 @@ -- >   , ((modm,               xK_Return), promote) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Move the focused window to the master pane. All other windows --   retain their order. If focus is in the master, swap it with the
XMonad/Actions/RandomBackground.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.RandomBackground+-- Description :  Start terminals with a random background color. -- Copyright   :  (c) 2009 Anze Slosar --                translation to Haskell by Adam Vogt -- License     :  BSD3-style (see LICENSE)@@ -24,7 +25,6 @@ import XMonad(X, XConf(config), XConfig(terminal), io, spawn,               MonadIO, asks) import System.Random-import Control.Monad(liftM) import Numeric(showHex)  -- $usage@@ -55,7 +55,7 @@  -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@ randomBg' ::  (MonadIO m) => RandomColor -> m String-randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen+randomBg' (RGB l h) = io $ fmap (toHex . take 3 . randomRs (l,h)) newStdGen randomBg' (HSV s v) = io $ do     g <- newStdGen     let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g
+ XMonad/Actions/RepeatAction.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE LambdaCase #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.RepeatAction+-- Description :  Repeat the last performed action.+-- Copyright   :  (c) 2022 Martin Kozlovsky+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  <kozlovsky.m7@gmail.com>+-- Stability   :  unstable+-- Portability :  not portable+--+-- Ability to repeat the last action.+--+-----------------------------------------------------------------------------++module XMonad.Actions.RepeatAction (+  -- * Usage+  -- $usage+  rememberAction,+  rememberActions,+  repeatLast,+) where++import XMonad++import qualified XMonad.Util.ExtensibleState as XS++-- $usage+--+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Actions.RepeatAction+--+-- Then join a dedicated key to run the last action with the rest of your+-- key bindings using the 'rememberActions':+--+-- > rememberActions (modm, xK_period) [((modm, xK_c), kill), …]+--+-- It can be also used in the same way for "XMonad.Util.EZConfig":+--+-- > rememberActions "M-." [("M-c", kill), …]+--+-- For example, if you use 'XMonad.Util.EZConfig.additionalKeysP',+--+-- > main = xmonad $ … $ def+-- >   {+-- >     …+-- >   }+-- >  `additionalKeysP` myKeys+--+-- you would adjust the call to 'XMonad.Util.EZConfig.additionalKeysP'+-- like so:+--+-- > `additionalKeysP` (rememberActions "M-." myKeys)+--+-- For more detailed instructions on editing your key bindings, see+-- <https://xmonad.org/TUTORIAL.html the tutorial>.++newtype LastAction = LastAction { runLastAction :: X () }++instance ExtensionClass LastAction where+  initialValue = LastAction $ pure ()++-- | Transforms an action into an action that can be remembered and repeated.+rememberAction :: X () -> X ()+rememberAction x = userCode x >>= \case+  Nothing -> pure ()+  Just () -> XS.put (LastAction x)  -- Only remember action if nothing went wrong.++-- | Maps 'rememberAction' over a list of key bindings.+rememberActions' :: [(a, X ())] -> [(a, X ())]+rememberActions' = map (fmap rememberAction)++infixl 4 `rememberActions`+-- | Maps 'rememberAction' over a list of key bindings and adds a dedicated+-- key to repeat the last action.+rememberActions :: a -> [(a, X ())] -> [(a, X ())]+rememberActions key keyList = (key, repeatLast) : rememberActions' keyList++-- | Runs the last remembered action.+-- / Be careful not to include this action in the remembered actions! /+repeatLast :: X ()+repeatLast = XS.get >>= runLastAction
+ XMonad/Actions/Repeatable.hs view
@@ -0,0 +1,89 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Repeatable+-- Description :  Actions you'd like to repeat.+-- Copyright   :  (c) 2022 L. S. Leary+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  @LSLeary (on github)+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS",+-- "XMonad.Actions.CycleWorkspaceByScreen", "XMonad.Actions.CycleWindows" and+-- "XMonad.Actions.MostRecentlyUsed".+--+-- See the source of these modules for usage examples.+--+-----------------------------------------------------------------------------++module XMonad.Actions.Repeatable+  ( repeatable+  , repeatableSt+  , repeatableM+  ) where++-- mtl+import Control.Monad.State (StateT(..))++-- X11+import Graphics.X11.Xlib.Extras++-- xmonad+import XMonad+++-- | An action that temporarily usurps and responds to key press/release events,+--   concluding when one of the modifier keys is released.+repeatable+  :: [KeySym]                      -- ^ The list of 'KeySym's under the+                                   --   modifiers used to invoke the action.+  -> KeySym                        -- ^ The keypress that invokes the action.+  -> (EventType -> KeySym -> X ()) -- ^ The keypress handler.+  -> X ()+repeatable = repeatableM id++-- | A more general variant of 'repeatable' with a stateful handler,+--   accumulating a monoidal return value throughout the events.+repeatableSt+  :: Monoid a+  => s                                     -- ^ Initial state.+  -> [KeySym]                              -- ^ The list of 'KeySym's under the+                                           --   modifiers used to invoke the+                                           --   action.+  -> KeySym                                -- ^ The keypress that invokes the+                                           --   action.+  -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler.+  -> X (a, s)+repeatableSt iSt = repeatableM $ \m -> runStateT m iSt++-- | A more general variant of 'repeatable' with an arbitrary monadic handler,+--   accumulating a monoidal return value throughout the events.+repeatableM+  :: (MonadIO m, Monoid a)+  => (m a -> X b)                 -- ^ How to run the monad in 'X'.+  -> [KeySym]                     -- ^ The list of 'KeySym's under the+                                  --   modifiers used to invoke the action.+  -> KeySym                       -- ^ The keypress that invokes the action.+  -> (EventType -> KeySym -> m a) -- ^ The keypress handler.+  -> X b+repeatableM run mods key pressHandler = do+  XConf{ theRoot = root, display = d } <- ask+  run (repeatableRaw d root mods key pressHandler)++repeatableRaw+  :: (MonadIO m, Monoid a)+  => Display -> Window+  -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a+repeatableRaw d root mods key pressHandler = do+  io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime)+  handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime)+  where+    getNextEvent = io $ allocaXEvent $ \p -> do+      maskEvent d (keyPressMask .|. keyReleaseMask) p+      KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p+      s <- keycodeToKeysym d c 0+      return (t, s)+    handleEvent (t, s)+      | t == keyRelease && s `elem` mods = pure mempty+      | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent)
XMonad/Actions/RotSlaves.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.RotSlaves+-- Description  : Rotate all windows except the master window and keep the focus in place. -- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de> -- License      : BSD3-style (see LICENSE) --@@ -14,11 +17,16 @@ module XMonad.Actions.RotSlaves (         -- $usage         rotSlaves', rotSlavesUp, rotSlavesDown,-        rotAll', rotAllUp, rotAllDown+        rotAll', rotAllUp, rotAllDown,++        -- * Generic list rotations+        -- $generic+        rotUp, rotDown         ) where -import XMonad.StackSet import XMonad+import XMonad.StackSet+import XMonad.Prelude  -- $usage --@@ -35,28 +43,37 @@ -- TwoPane layout (see "XMonad.Layout.TwoPane"). -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Rotate the windows in the current stack, excluding the first one --   (master). rotSlavesUp,rotSlavesDown :: X ()-rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))-rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))+rotSlavesUp   = windows $ modify' (rotSlaves' rotUp)+rotSlavesDown = windows $ modify' (rotSlaves' rotDown)  -- | The actual rotation, as a pure function on the window stack. rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a rotSlaves' _ s@(Stack _ [] []) = s rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise-    where  (master:ws)     = integrate s-           (revls',t':rs') = splitAt (length ls) (master:(f ws))+    where  (notEmpty -> master :| ws)      = integrate s+           (revls', notEmpty -> t' :| rs') = splitAt (length ls) (master:f ws)  -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X ()-rotAllUp   = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))-rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))+rotAllUp   = windows $ modify' (rotAll' rotUp)+rotAllDown = windows $ modify' (rotAll' rotDown)  -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a rotAll' f s = Stack r (reverse revls) rs-    where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))+    where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s))++-- $generic+-- Generic list rotations such that @rotUp [1..4]@ is equivalent to+-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are+-- @id@ for null or singleton lists.+rotUp :: [a] -> [a]+rotUp   l = drop 1 l ++ take 1 l+rotDown :: [a] -> [a]+rotDown = reverse . rotUp . reverse
+ XMonad/Actions/RotateSome.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE ViewPatterns #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.RotateSome+-- Description :  Rotate some elements around the stack.+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>+-- Stability   :  stable+-- Portability :  unportable+--+-- Functions for rotating some elements around the stack while keeping others+-- anchored in place. Useful in combination with layouts that dictate window+-- visibility based on stack position, such as "XMonad.Layout.LimitWindows".+--+-----------------------------------------------------------------------------++module XMonad.Actions.RotateSome (+    -- * Usage+    -- $usage+    -- * Example+    -- $example+    surfaceNext,+    surfacePrev,+    rotateSome,+  ) where++import Control.Arrow ((***))+import XMonad.Prelude (NonEmpty(..), notEmpty, partition, sortOn, (\\))+import qualified Data.Map as M+import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)+import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)+import XMonad.Util.Stack (reverseS)++{- $usage+You can use this module with the following in your @xmonad.hs@:++> import XMonad.Actions.RotateSome++and add keybindings such as the following:++>   , ((modMask .|. controlMask, xK_n), surfaceNext)+>   , ((modMask .|. controlMask, xK_p), surfacePrev)++-}++{- $example+#Example#++Consider a workspace whose stack contains five windows A B C D E but whose+layout limits how many will actually be shown, showing only the first plus+two additional windows, starting with the third:++>  ┌─────┬─────┐+>  │     │  C  │+>  │  A  ├─────┤+>  │     │  D  │+>  └─────┴─────┘+>+>  A  B  C  D  E+>  _     ____++If C has focus and we'd like to replace it with one of the unshown windows,+'surfaceNext' will move the next unshown window, E, into the focused position:++>  ┌─────┬─────┐                ┌─────┬─────┐+>  │     │ *C* │                │     │ *E* │+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤+>  │     │  D  │                │     │  D  │+>  └─────┴─────┘                └─────┴─────┘+>+>  A  B *C* D  E                A  C *E* D  B+>  _     ____                   _     ____++This repositioned windows B C E by treating them as a sequence that can be+rotated through the focused stack position. Windows A and D remain anchored+to their original (visible) positions.++A second call to 'surfaceNext' moves B into focus:++>  ┌─────┬─────┐                ┌─────┬─────┐+>  │     │ *E* │                │     │ *B* │+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤+>  │     │  D  │                │     │  D  │+>  └─────┴─────┘                └─────┴─────┘+>+>  A  C *E* D  B                A  E *B* D  C+>  _     ____                   _     ____++A third call would complete the cycle, bringing C back into focus.++-}++-- |+-- Treating the focused window and any unshown windows as a ring that can be+-- rotated through the focused position, surface the next element in the ring.+surfaceNext :: X ()+surfaceNext = do+  ring <- surfaceRing+  windows . modify' $ rotateSome (`elem` ring)++-- | Like 'surfaceNext' in reverse.+surfacePrev :: X ()+surfacePrev = do+  ring <- surfaceRing+  windows . modify' $ reverseS . rotateSome (`elem` ring) . reverseS++-- |+-- Return a list containing the current focus plus any unshown windows. Note+-- that windows are shown if 'runLayout' provides them with a rectangle or if+-- they are floating.+surfaceRing :: X [Window]+surfaceRing = withWindowSet $ \wset -> do+  let Screen wsp _ sd = current wset++  case stack wsp >>= filter' (`M.notMember` floating wset) of+    Nothing -> pure []+    Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd)+  where+    go :: Stack Window -> [Window] -> [Window]+    go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown)++    layoutWindows :: WindowSpace -> Rectangle -> X [Window]+    layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect++-- | Like "XMonad.StackSet.filter" but won't move focus.+filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)+filter' p (Stack f ls rs)+  | p f       = Just $ Stack f (filter p ls) (filter p rs)+  | otherwise = Nothing++-- |+-- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate+-- @p@ as a ring that can be rotated, while all other elements remain anchored+-- in place.+rotateSome :: (a -> Bool) -> Stack a -> Stack a+rotateSome p (Stack t ls rs) =+  let+    -- Flatten the stack, index each element relative to the focused position,+    -- then partition into movable and anchored elements.+    (movables, anchors) =+      partition (p . snd) $+        zip+          [negate (length ls)..]+          (reverse ls ++ t : rs)++    -- Pair each movable element with the index of its next movable neighbor.+    -- Append anchored elements, along with their unchanged indices, and sort+    -- by index. Separate lefts (negative indices) from the rest, and grab the+    -- new focus from the head of the remaining elements.+    (ls', notEmpty -> t' :| rs') =+      (map snd *** map snd)+        . span ((< 0) . fst)+        . sortOn fst+        . (++) anchors+        $ zipWith (curry (fst *** snd)) movables (rotate movables)+  in+    Stack t' (reverse ls') rs'++rotate :: [a] -> [a]+rotate = uncurry (flip (++)) . splitAt 1
XMonad/Actions/Search.hs view
@@ -1,4 +1,6 @@-{- | Module      :  XMonad.Actions.Search+{- |+   Module      :  XMonad.Actions.Search+   Description :  Easily run Internet searches on web sites through xmonad.    Copyright   :  (C) 2007 Gwern Branwen    License     :  None; public domain @@ -18,6 +20,7 @@                                  searchEngineF,                                  promptSearch,                                  promptSearchBrowser,+                                 promptSearchBrowser',                                  selectSearch,                                  selectSearchBrowser,                                  isPrefixOf,@@ -27,33 +30,55 @@                                  (!>),                                  prefixAware,                                  namedEngine,+                                 multiChar,+                                 combineChar,+                                 prefixAwareChar, -                                 amazon,                                  alpha,+                                 amazon,+                                 arXiv,+                                 aur,+                                 clojureDocs,                                  codesearch,+                                 cratesIo,                                  deb,                                  debbts,                                  debpts,                                  dictionary,+                                 duckduckgo,+                                 ebay,+                                 ecosia,+                                 flora,+                                 github,                                  google,                                  hackage,+                                 homeManager,                                  hoogle,                                  images,                                  imdb,-                                 isohunt,                                  lucky,                                  maps,                                  mathworld,+                                 ncatlab,+                                 nixos,+                                 noogle,                                  openstreetmap,+                                 protondb,+                                 rosettacode,+                                 rustStd,                                  scholar,+                                 sourcehut,                                  stackage,+                                 steam,                                  thesaurus,+                                 vocabulary,+                                 voidpgks_x86_64,+                                 voidpgks_x86_64_musl,                                  wayback,                                  wikipedia,                                  wiktionary,                                  youtube,-                                 vocabulary,-                                 duckduckgo,+                                 zbmath,                                  multi,                                   -- * Use case: searching with a submap                                   -- $tip@@ -63,13 +88,12 @@                           ) where  import           Codec.Binary.UTF8.String (encode)-import           Data.Char                (isAlphaNum, isAscii)-import           Data.List                (isPrefixOf) import           Text.Printf import           XMonad                   (X (), liftIO) import           XMonad.Prompt            (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete),                                            getNextCompletion,                                            historyCompletionP, mkXPrompt)+import           XMonad.Prelude           (NonEmpty ((:|)), isAlphaNum, isAscii, isPrefixOf) import           XMonad.Prompt.Shell      (getBrowser) import           XMonad.Util.Run          (safeSpawn) import           XMonad.Util.XSelection   (getSelection)@@ -99,12 +123,20 @@     The currently available search engines are: +* 'alpha' -- Wolfram|Alpha query.+ * 'amazon' -- Amazon keyword search. -* 'alpha' -- Wolfram|Alpha query.+* 'arXiv' -- Open-access preprint archive. +* 'aur' -- Arch User Repository.++* 'clojureDocs' -- Documentation and examples repository for Clojure.+ * 'codesearch' -- Google Labs Code Search search. +* 'cratesIo' -- Rust crate registry.+ * 'deb'    -- Debian package search.  * 'debbts' -- Debian Bug Tracking System.@@ -113,41 +145,73 @@  * 'dictionary' -- dictionary.reference.com search. +* 'duckduckgo' -- DuckDuckGo search engine.++* 'ebay' -- Ebay keyword search.++* 'ecosia' -- Ecosia search engine.++* 'flora' -- Prettier Haskell package database.++* 'github' -- GitHub keyword search.+ * 'google' -- basic Google search.  * 'hackage' -- Hackage, the Haskell package database. -* 'hoogle' -- Hoogle, the Haskell libraries API search engine.+* 'homeManager' -- Search Nix's home-manager's options. -* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.+* 'hoogle' -- Hoogle, the Haskell libraries API search engine.  * 'images' -- Google images.  * 'imdb'   -- the Internet Movie Database. -* 'isohunt' -- isoHunt search.- * 'lucky' -- Google "I'm feeling lucky" search.  * 'maps'   -- Google maps.  * 'mathworld' -- Wolfram MathWorld search. +* 'ncatlab' -- Higer Algebra, Homotopy and Category Theory Wiki.++* 'nixos' -- Search NixOS packages and options.++* 'noogle' -- 'hoogle'-like Nix API search engine.+ * 'openstreetmap' -- OpenStreetMap free wiki world map. +* 'protondb' -- Steam Proton Game Database.++* 'rosettacode' -- Programming chrestomathy wiki.++* 'rustStd' -- Rust standard library documentation.+ * 'scholar' -- Google scholar academic search. -* 'thesaurus' -- thesaurus.reference.com search.+* 'sourcehut' -- Sourcehut projects search. +* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.++* 'steam' -- Steam games search.++* 'thesaurus' -- thesaurus.com search.++* 'vocabulary' -- Dictionary search.++* 'voidpgks_x86_64' -- Void Linux packages search for @x86_64@.++* 'voidpgks_x86_64_musl' -- Void Linux packages search for @x86_64-musl@.+ * 'wayback' -- the Wayback Machine.  * 'wikipedia' -- basic Wikipedia search. -* 'youtube' -- Youtube video search.+* 'wiktionary' -- Wiktionary search. -* 'vocabulary' -- Dictionary search+* 'youtube' -- Youtube video search. -* 'duckduckgo' -- DuckDuckGo search engine.+* 'zbmath' -- Open alternative to MathSciNet.  * 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google. @@ -191,7 +255,7 @@ > > searchList :: [(String, S.SearchEngine)] > searchList = [ ("g", S.google)->              , ("h", S.hoohle)+>              , ("h", S.hoogle) >              , ("w", S.wikipedia) >              ] @@ -210,7 +274,7 @@ Happy searching! -}  -- | A customized prompt indicating we are searching, and the name of the site.-data Search = Search Name+newtype Search = Search Name instance XPrompt Search where     showXPrompt (Search name)= "Search [" ++ name ++ "]: "     nextCompletion _ = getNextCompletion@@ -248,7 +312,7 @@    appends it to the base. You can easily define a new engine locally using    exported functions without needing to modify "XMonad.Actions.Search": -> myNewEngine = searchEngine "site" "http://site.com/search="+> myNewEngine = searchEngine "site" "https://site.com/search="     The important thing is that the site has a interface which accepts the escaped query    string as part of the URL. Alas, the exact URL to feed searchEngine varies@@ -257,21 +321,21 @@    Generally, examining the resultant URL of a search will allow you to reverse-engineer    it if you can't find the necessary URL already described in other projects such as Surfraw. -} searchEngine :: Name -> String -> SearchEngine-searchEngine name site = searchEngineF name (\s -> site ++ (escape s))+searchEngine name site = searchEngineF name (\s -> site ++ escape s)  {- | If your search engine is more complex than this (you may want to identify    the kind of input and make the search URL dependent on the input or put the query    inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.  > searchFunc :: String -> String-> searchFunc s | "wiki:"   `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)->              | "http://" `isPrefixOf` s = s->              | otherwise               = (use google) s+> searchFunc s | "wiki:"    `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ drop 1 $ snd $ break (==':') s)+>              | "https://" `isPrefixOf` s = s+>              | otherwise                 = (use google) s > myNewEngine = searchEngineF "mymulti" searchFunc     @searchFunc@ here searches for a word in wikipedia if it has a prefix    of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address-   directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine.+   directly if it starts with \"https:\/\/\" and otherwise uses the provided google search engine.    You can use other engines inside of your own through the 'use' function as shown above to make    complex searches. @@ -281,38 +345,58 @@ searchEngineF = SearchEngine  -- The engines.-amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,-  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,-  youtube, duckduckgo :: SearchEngine-amazon        = searchEngine "amazon"        "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="-alpha         = searchEngine "alpha"         "http://www.wolframalpha.com/input/?i="-codesearch    = searchEngine "codesearch"    "http://www.google.com/codesearch?q="-deb           = searchEngine "deb"           "http://packages.debian.org/"-debbts        = searchEngine "debbts"        "http://bugs.debian.org/"-debpts        = searchEngine "debpts"        "http://packages.qa.debian.org/"-dictionary    = searchEngine "dict"          "http://dictionary.reference.com/browse/"-google        = searchEngine "google"        "http://www.google.com/search?num=100&q="-hackage       = searchEngine "hackage"       "http://hackage.haskell.org/package/"-hoogle        = searchEngine "hoogle"        "http://www.haskell.org/hoogle/?q="-images        = searchEngine "images"        "http://images.google.fr/images?q="-imdb          = searchEngine "imdb"          "http://www.imdb.com/find?s=all&q="-isohunt       = searchEngine "isohunt"       "http://isohunt.com/torrents/?ihq="-lucky         = searchEngine "lucky"         "http://www.google.com/search?btnI&q="-maps          = searchEngine "maps"          "http://maps.google.com/maps?q="-mathworld     = searchEngine "mathworld"     "http://mathworld.wolfram.com/search/?query="-openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="-scholar       = searchEngine "scholar"       "http://scholar.google.com/scholar?q="-stackage      = searchEngine "stackage"      "www.stackage.org/lts/hoogle?q="-thesaurus     = searchEngine "thesaurus"     "http://thesaurus.reference.com/search?q="-wikipedia     = searchEngine "wiki"          "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="-wiktionary    = searchEngine "wikt"          "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="-youtube       = searchEngine "youtube"       "http://www.youtube.com/results?search_type=search_videos&search_query="-wayback       = searchEngineF "wayback"      ("http://web.archive.org/web/*/"++)-vocabulary    = searchEngine "vocabulary"    "http://www.vocabulary.com/search?q="+alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, ecosia, flora,+  github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb,+  rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback,+  wikipedia, wiktionary, youtube, zbmath :: SearchEngine+alpha         = searchEngine "alpha"         "https://www.wolframalpha.com/input/?i="+amazon        = searchEngine "amazon"        "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="+arXiv         = searchEngineF "arXiv"        (\s -> "https://arxiv.org/search/?query=" <> s <> "&searchtype=all")+aur           = searchEngine "aur"           "https://aur.archlinux.org/packages?&K="+clojureDocs   = searchEngine "clojureDocs"   "https://clojuredocs.org/search?q="+codesearch    = searchEngine "codesearch"    "https://developers.google.com/s/results/code-search?q="+cratesIo      = searchEngine  "cratesIo"     "https://crates.io/search?q="+deb           = searchEngine "deb"           "https://packages.debian.org/"+debbts        = searchEngine "debbts"        "https://bugs.debian.org/"+debpts        = searchEngine "debpts"        "https://packages.qa.debian.org/"+dictionary    = searchEngine "dict"          "https://dictionary.reference.com/browse/" duckduckgo    = searchEngine "duckduckgo"    "https://duckduckgo.com/?t=lm&q="+ebay          = searchEngine "ebay"          "https://www.ebay.com/sch/i.html?_nkw="+ecosia        = searchEngine "ecosia"        "https://www.ecosia.org/search?q="+flora         = searchEngine "flora"         "https://flora.pm/search?q="+github        = searchEngine "github"        "https://github.com/search?q="+google        = searchEngine "google"        "https://www.google.com/search?q="+hackage       = searchEngine "hackage"       "https://hackage.haskell.org/package/"+homeManager   = searchEngine "homeManager"   "https://mipmip.github.io/home-manager-option-search/?query="+hoogle        = searchEngine "hoogle"        "https://hoogle.haskell.org/?hoogle="+images        = searchEngine "images"        "https://images.google.fr/images?q="+imdb          = searchEngine "imdb"          "https://www.imdb.com/find?s=all&q="+lucky         = searchEngine "lucky"         "https://www.google.com/search?btnI&q="+maps          = searchEngine "maps"          "https://maps.google.com/maps?q="+mathworld     = searchEngine "mathworld"     "https://mathworld.wolfram.com/search/?query="+ncatlab       = searchEngine "ncatlab"       "https://ncatlab.org/nlab/search?query="+nixos         = searchEngine "nixos"         "https://search.nixos.org/packages?channel=unstable&from=0&size=200&sort=relevance&type=packages&query="+noogle        = searchEngineF "noogle"       (\s -> "https://noogle.dev/?search=" <> s <> "&page=1&to=any&from=any")+openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query="+protondb      = searchEngine "protondb"      "https://www.protondb.com/search?q="+rosettacode   = searchEngine "rosettacode"   "https://rosettacode.org/w/index.php?search="+rustStd       = searchEngine "rustStd"       "https://doc.rust-lang.org/std/index.html?search="+scholar       = searchEngine "scholar"       "https://scholar.google.com/scholar?q="+sourcehut     = searchEngine "sourcehut"     "https://sr.ht/projects?search="+stackage      = searchEngine "stackage"      "https://www.stackage.org/lts/hoogle?q="+steam         = searchEngine "steam"         "https://store.steampowered.com/search/?term="+thesaurus     = searchEngine "thesaurus"     "https://thesaurus.com/browse/"+vocabulary    = searchEngine "vocabulary"    "https://www.vocabulary.com/search?q="+voidpgks_x86_64      = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64&q="+voidpgks_x86_64_musl = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64-musl&q="+wayback       = searchEngineF "wayback"      ("https://web.archive.org/web/*/"++)+wikipedia     = searchEngine "wiki"          "https://en.wikipedia.org/wiki/Special:Search?go=Go&search="+wiktionary    = searchEngine "wikt"          "https://en.wiktionary.org/wiki/Special:Search?go=Go&search="+youtube       = searchEngine "youtube"       "https://www.youtube.com/results?search_type=search_videos&search_query="+zbmath        = searchEngine "zbmath"        "https://zbmath.org/?q="  multi :: SearchEngine-multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]+multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, ecosia, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google]  {- | This function wraps up a search engine and creates a new one, which works    like the argument, but goes directly to a URL if one is given rather than@@ -320,15 +404,31 @@  > myIntelligentGoogleEngine = intelligent google -   Now if you search for http:\/\/xmonad.org it will directly open in your browser-}+   Now if you search for https:\/\/xmonad.org it will directly open in your browser-} intelligent :: SearchEngine -> SearchEngine-intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))+intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s) --- | > removeColonPrefix "foo://bar" ~> "//bar"--- > removeColonPrefix "foo//bar" ~> "foo//bar"-removeColonPrefix :: String -> String-removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s+-- >>> rmChar ':' "foo://bar"+-- "//bar"+-- >>> rmChar 'z' "foo://bar"+-- "foo://bar"+rmChar :: Char -> String -> String+rmChar c s = if c `elem` s then drop 1 (dropWhile (c /=) s) else s +-- | Connect the given list of search engines into one. Selecting a search+-- engine works by its prefix, separated by the given separation character.+-- This is a generalisation of '(!>)' and 'prefixAware' with a custom+-- character that separates the prefix from the query. The first search engine+-- is the fallback; for example,+--+-- > multiChar ':' (google :| [wikipedia, mathworld])+--+-- is equivalent to+--+-- > wikipedia !> mathworld !> (prefixAware google)+multiChar :: Char -> NonEmpty SearchEngine -> SearchEngine+multiChar c (se :| ses) = foldr (combineChar c) (prefixAwareChar c se) ses+ {- | Connects a few search engines into one. If the search engines\' names are    \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query    is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases.@@ -341,15 +441,30 @@   \"mathworld:integral\" will search mathworld, and everything else will fall back to   google. The use of intelligent will make sure that URLs are opened directly. -} (!>) :: SearchEngine -> SearchEngine -> SearchEngine-(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)+(!>) = combineChar ':'+infixr 6 !> +-- | @combineChar c s s'@ combines the search engines @s@ and @s'@ into one,+-- where prefixes are separated by the character @c@. It works analogously to+-- '(!>)', only with a chosen separating character: @combineChar ':'@ is the+-- same as '(!>)'.+combineChar :: Char -> SearchEngine -> SearchEngine -> SearchEngine+combineChar c (SearchEngine name1 site1) (SearchEngine name2 site2) =+  searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++[c]) `isPrefixOf` s then site1 (rmChar c s) else site2 s)+ {- | Makes a search engine prefix-aware. Especially useful together with '!>'.    It will automatically remove the prefix from a query so that you don\'t end      up searching for google:xmonad if google is your fallback engine and you      explicitly add the prefix. -} prefixAware :: SearchEngine -> SearchEngine-prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s)+prefixAware = prefixAwareChar ':' +-- | Like 'prefixAware', but one gets to choose the character that separates+-- the prefix from the search query.+prefixAwareChar :: Char -> SearchEngine -> SearchEngine+prefixAwareChar c (SearchEngine name site) =+  SearchEngine name (\s -> if (name++[c]) `isPrefixOf` s then site (rmChar c s) else site s)+ {- | Changes search engine's name -} namedEngine :: Name -> SearchEngine -> SearchEngine namedEngine name (SearchEngine _ site) = searchEngineF name site@@ -358,8 +473,18 @@    Prompt's result, passes it to a given searchEngine and opens it in a given    browser. -} promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()-promptSearchBrowser config browser (SearchEngine name site) =-    mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site+promptSearchBrowser config browser (SearchEngine name site) = do+    hc <- historyCompletionP config ("Search [" `isPrefixOf`)+    mkXPrompt (Search name) config hc $ search browser site++{- | Like 'promptSearchBrowser', but only suggest previous searches for the+   given 'SearchEngine' in the prompt. -}+promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()+promptSearchBrowser' config browser (SearchEngine name site) = do+    hc <- historyCompletionP config (searchName `isPrefixOf`)+    mkXPrompt (Search name) config hc $ search browser site+  where+    searchName = showXPrompt (Search name)  {- | Like 'search', but in this case, the string is not specified but grabbed  from the user's response to a prompt. Example:
XMonad/Actions/ShowText.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.ShowText+-- Description :  Display text on the screen. -- Copyright   :  (c) Mario Pastorelli (2012) -- License     :  BSD-style (see xmonad/LICENSE) --@@ -17,17 +19,15 @@     ( -- * Usage       -- $usage       def-    , defaultSTConfig     , handleTimerEvent     , flashText     , ShowTextConfig(..)     ) where -import Control.Monad (when) import Data.Map (Map,empty,insert,lookup)-import Data.Monoid (mempty, All) import Prelude hiding (lookup) import XMonad+import XMonad.Prelude (All, fi, listToMaybe) import XMonad.StackSet (current,screen) import XMonad.Util.Font (Align(AlignCenter)                        , initXMF@@ -37,19 +37,18 @@ import XMonad.Util.Timer (startTimer) import XMonad.Util.XUtils (createNewWindow                          , deleteWindow-                         , fi                          , showWindow                          , paintAndWrite) import qualified XMonad.Util.ExtensibleState as ES  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.ShowText -- -- Then add the event hook handler: ----- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }+-- > xmonad { handleEventHook = myHandleEventHooks <> handleTimerEvent } -- -- You can then use flashText in your keybindings: --@@ -58,7 +57,7 @@  -- | ShowText contains the map with timers as keys and created windows as values newtype ShowText = ShowText (Map Atom Window)-    deriving (Read,Show,Typeable)+    deriving (Read,Show)  instance ExtensionClass ShowText where     initialValue = ShowText empty@@ -75,22 +74,23 @@  instance Default ShowTextConfig where   def =+#ifdef XFT+    STC { st_font = "xft:monospace-20"+#else     STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+#endif         , st_bg   = "black"         , st_fg   = "white"     } -{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}-defaultSTConfig :: ShowTextConfig-defaultSTConfig = def- -- | Handles timer events that notify when a window should be removed handleTimerEvent :: Event -> X All handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do     (ShowText m) <- ES.get :: X ShowText     a <- io $ internAtom dis "XMONAD_TIMER" False-    when (mtyp == a && length d >= 1)-         (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)+    if | mtyp == a, Just dh <- listToMaybe d ->+           whenJust (lookup (fromIntegral dh) m) deleteWindow+       | otherwise -> pure ()     mempty handleTimerEvent _ = mempty
+ XMonad/Actions/Sift.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Sift+-- Description :  Functions for sifting windows up and down.+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>+-- Stability   :  stable+-- Portability :  unportable+--+-- Functions for sifting windows up and down. Sifts behave identically to+-- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in+-- the wrapping case: rather than rotating the entire stack by one position+-- like a swap would, a sift causes the windows at either end of the stack+-- to trade positions.+--+-----------------------------------------------------------------------------++module XMonad.Actions.Sift (+    -- * Usage+    -- $usage+    siftUp,+    siftDown,+  ) where++import XMonad.StackSet (Stack (Stack), StackSet, modify')+import XMonad.Util.Stack (reverseS)++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Actions.Sift+--+-- and add keybindings such as the following:+--+-- >   , ((modMask .|. shiftMask, xK_j ), windows siftDown)+-- >   , ((modMask .|. shiftMask, xK_k ), windows siftUp  )+--++-- |+-- siftUp, siftDown. Exchange the focused window with its neighbour in+-- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and+-- 'swapDown', wrapping is handled by trading positions with the window+-- at the other end of the stack.+--+siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd+siftUp   = modify' siftUp'+siftDown = modify' (reverseS . siftUp' . reverseS)++siftUp' :: Stack a -> Stack a+siftUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)+siftUp' (Stack t []     rs) =+  case reverse rs of+    (x:xs) -> Stack t (xs ++ [x]) []+    []     -> Stack t []          []
XMonad/Actions/SimpleDate.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.SimpleDate+-- Description :  An example external contrib module for XMonad. -- Copyright   :  (c) Don Stewart 2007 -- License     :  BSD3-style (see LICENSE) --@@ -23,7 +24,7 @@ import XMonad.Util.Run  -- $usage--- To use, import this module into @~\/.xmonad\/xmonad.hs@:+-- To use, import this module into @xmonad.hs@: -- -- >     import XMonad.Actions.SimpleDate --@@ -34,7 +35,7 @@ -- In this example, a popup date menu will now be bound to @mod-d@. -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  date :: X () date = unsafeSpawn "(date; sleep 10) | dzen2"
XMonad/Actions/SinkAll.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.SinkAll+-- Description  : (DEPRECATED) Push floating windows back into tiling. -- License      : BSD3-style (see LICENSE) -- Stability    : unstable -- Portability  : unportable@@ -12,7 +13,7 @@ -- 'sinkAll' function for backwards compatibility. ----------------------------------------------------------------------------- -module XMonad.Actions.SinkAll (+module XMonad.Actions.SinkAll {-# DEPRECATED "Use XMonad.Actions.WithAll instead" #-} (     -- * Usage     -- $usage @@ -22,7 +23,7 @@  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.SinkAll --@@ -31,4 +32,4 @@ -- >   , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
XMonad/Actions/SpawnOn.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-}+ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.SpawnOn+-- Description  : Modify a window spawned by a command. -- Copyright    : (c) Spencer Janssen -- License      : BSD --@@ -28,32 +30,27 @@     shellPromptOn ) where -import Control.Exception (tryJust)-import Control.Monad (guard)-import Data.List (isInfixOf)-import Data.Maybe (isJust)-import System.IO.Error (isDoesNotExistError)-import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID)-import Text.Printf (printf)  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W  import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Process (getPPIDChain)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.SpawnOn -- -- >    main = do -- >      xmonad def { -- >         ...--- >         manageHook = manageSpawn <+> manageHook def+-- >         manageHook = manageSpawn <> manageHook def -- >         ... -- >      } --@@ -66,37 +63,21 @@ -- the spawned application(e.g. float or resize it). -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable+newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]}  instance ExtensionClass Spawner where     initialValue = Spawner []  -getPPIDOf :: ProcessID -> Maybe ProcessID-getPPIDOf pid =-    case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger pid of-      Left _         -> Nothing-      Right contents -> case lines contents of-                          []        -> Nothing-                          first : _ -> case words first of-                                         _ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int)-                                         _                    -> Nothing--getPPIDChain :: ProcessID -> [ProcessID]-getPPIDChain pid' = ppid_chain pid' []-    where ppid_chain pid acc =-              if pid == 0-              then acc-              else case getPPIDOf pid of-                     Nothing   -> acc-                     Just ppid -> ppid_chain ppid (ppid : acc)- -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner f = XS.modify (Spawner . f . pidsRef) +modifySpawnerM :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> X ()+modifySpawnerM f = XS.modifyM (fmap Spawner . f . pidsRef)+ -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. manageSpawn :: ManageHook@@ -105,28 +86,20 @@ manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])         -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@        -> ManageHook-manageSpawnWithGC garbageCollect = do-    Spawner pids <- liftX XS.get-    mp <- pid-    let ppid_chain = case mp of-                       Just winpid -> winpid : getPPIDChain winpid-                       Nothing     -> []-        known_window_handlers = [ mh-                                | ppid <- ppid_chain-                                , let mpid = lookup ppid pids-                                , isJust mpid-                                , let (Just mh) = mpid ]-    case known_window_handlers of-        [] -> idHook-        (mh:_)  -> do-            whenJust mp $ \p -> liftX $ do-                ps <- XS.gets pidsRef-                XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)-            mh+manageSpawnWithGC garbageCollect = pid >>= \case+    Nothing -> mempty+    Just p -> do+        Spawner pids <- liftX XS.get+        ppid_chain <- io $ getPPIDChain p+        case mapMaybe (`lookup` pids) ppid_chain of+            [] -> mempty+            mh : _ -> liftX (gc p) >> mh+  where+    gc p = modifySpawnerM $ garbageCollect . filter ((/= p) . fst)  mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt cb c = do-    cmds <- io $ getCommands+    cmds <- io getCommands     mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb  -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches@@ -147,13 +120,13 @@ -- | Replacement for 'spawn' which launches -- application on given workspace. spawnOn :: WorkspaceId -> String -> X ()-spawnOn ws cmd = spawnAndDo (doShift ws) cmd+spawnOn ws = spawnAndDo (doShift ws)  -- | Spawn an application and apply the manage hook when it opens. spawnAndDo :: ManageHook -> String -> X () spawnAndDo mh cmd = do     p <- spawnPID $ mangle cmd-    modifySpawner $ ((p,mh) :)+    modifySpawner ((p,mh) :)  where     -- TODO this is silly, search for a better solution     mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
XMonad/Actions/Submap.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.Submap+-- Description :  Create a sub-mapping of key bindings. -- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -16,21 +17,23 @@                              -- * Usage                              -- $usage                              submap,+                             visualSubmap,+                             visualSubmapSorted,                              submapDefault,-                             submapDefaultWithKey+                             submapDefaultWithKey,++                             -- * Utilities+                             subName,                             ) where import Data.Bits-import Data.Maybe (fromMaybe)-import XMonad hiding (keys) import qualified Data.Map as M-import Control.Monad.Fix (fix)+import XMonad hiding (keys)+import XMonad.Prelude (fix, fromMaybe, keyToString, cleanKeyMask)+import XMonad.Util.XUtils  {- $usage ----First, import this module into your @~\/.xmonad\/xmonad.hs@:+First, import this module into your @xmonad.hs@:  > import XMonad.Actions.Submap @@ -51,7 +54,7 @@ modifier.  For detailed instructions on editing your key bindings, see-"XMonad.Doc.Extending#Editing_key_bindings".+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -} @@ -62,6 +65,61 @@ submap :: M.Map (KeyMask, KeySym) (X ()) -> X () submap = submapDefault (return ()) +-- | Like 'submap', but visualise the relevant options.+--+-- ==== __Example__+--+-- > import qualified Data.Map as Map+-- > import XMonad.Actions.Submap+-- >+-- > gotoLayout :: [(String, X ())]   -- for use with EZConfig+-- > gotoLayout =  -- assumes you have a layout named "Tall" and one named "Full".+-- >   [("M-l", visualSubmap def $ Map.fromList $ map (\(k, s, a) -> ((0, k), (s, a)))+-- >              [ (xK_t, "Tall", switchToLayout "Tall")     -- "M-l t" switches to "Tall"+-- >              , (xK_r, "Full", switchToLayout "Full")     -- "M-l r" switches to "full"+-- >              ])]+--+-- One could alternatively also write @gotoLayout@ as+--+-- > gotoLayout = [("M-l", visualSubmap def $ Map.fromList $+-- >                         [ ((0, xK_t), subName "Tall" $ switchToLayout "Tall")+-- >                         , ((0, xK_r), subName "Full" $ switchToLayout "Full")+-- >                         ])]+visualSubmap :: WindowConfig -- ^ The config for the spawned window.+             -> M.Map (KeyMask, KeySym) (String, X ())+                             -- ^ A map @keybinding -> (description, action)@.+             -> X ()+visualSubmap = visualSubmapSorted id++-- | Like 'visualSubmap', but is able to sort the descriptions.+-- For example,+--+-- > import Data.Ord (comparing, Down)+-- >+-- > visualSubmapSorted (sortBy (comparing Down)) def+--+-- would sort the @(key, description)@ pairs by their keys in descending+-- order.+visualSubmapSorted :: ([((KeyMask, KeySym), String)] -> [((KeyMask, KeySym), String)])+                             -- ^ A function to resort the descriptions+             -> WindowConfig -- ^ The config for the spawned window.+             -> M.Map (KeyMask, KeySym) (String, X ())+                             -- ^ A map @keybinding -> (description, action)@.+             -> X ()+visualSubmapSorted sorted wc keys =+    withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) ->+        maybe (pure ()) snd (M.lookup (m', s) keys)+  where+    descriptions :: [String]+    descriptions =+        map (\(key, desc) -> keyToString key <> ": " <> desc)+            . sorted+            $ zip (M.keys keys) (map fst (M.elems keys))++-- | Give a name to an action.+subName :: String -> X () -> (String, X ())+subName = (,)+ -- | Like 'submap', but executes a default action if the key did not match. submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X () submapDefault = submapDefaultWithKey . const@@ -71,27 +129,32 @@ submapDefaultWithKey :: ((KeyMask, KeySym) -> X ())                      -> M.Map (KeyMask, KeySym) (X ())                      -> X ()-submapDefaultWithKey defAction keys = do-    XConf { theRoot = root, display = d } <- ask+submapDefaultWithKey defAction keys = waitForKeyPress >>=+    \(m', s) -> fromMaybe (defAction (m', s)) (M.lookup (m', s) keys) -    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime-    io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync-                     none none currentTime+-----------------------------------------------------------------------+-- Internal stuff +waitForKeyPress :: X (KeyMask, KeySym)+waitForKeyPress = do+    XConf{ theRoot = root, display = dpy } <- ask++    io $ do grabKeyboard dpy root False grabModeAsync grabModeAsync currentTime+            grabPointer dpy root False buttonPressMask grabModeAsync grabModeAsync+                        none none currentTime+     (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do-        maskEvent d (keyPressMask .|. buttonPressMask) p+        maskEvent dpy (keyPressMask .|. buttonPressMask) p         ev <- getEvent p         case ev of           KeyEvent { ev_keycode = code, ev_state = m } -> do-            keysym <- keycodeToKeysym d code 0+            keysym <- keycodeToKeysym dpy code 0             if isModifierKey keysym                 then nextkey                 else return (m, keysym)           _ -> return (0, 0)-    -- Remove num lock mask and Xkb group state bits-    m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)--    io $ ungrabPointer d currentTime-    io $ ungrabKeyboard d currentTime--    fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)+    m' <- cleanKeyMask <*> pure m+    io $ do ungrabPointer dpy currentTime+            ungrabKeyboard dpy currentTime+            sync dpy False+    pure (m', s)
XMonad/Actions/SwapPromote.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.SwapPromote+-- Description :  Track the master window history per workspace. -- Copyright   :  (c) 2018 Yclept Nemo -- License     :  BSD-style (see LICENSE) --@@ -57,16 +56,14 @@   import           XMonad+import           XMonad.Prelude import qualified XMonad.StackSet                as W import qualified XMonad.Util.ExtensibleState    as XS  import qualified Data.Map                       as M import qualified Data.Set                       as S-import           Data.List-import           Data.Maybe import           Control.Arrow-import           Control.Applicative ((<$>),(<*>))-import           Control.Monad+import qualified Data.List.NonEmpty             as NE   -- $usage@@ -103,7 +100,7 @@ -- So far floating windows have been treated no differently than tiled windows -- even though their positions are independent of the stack. Often, yanking -- floating windows in and out of the workspace will obliterate the stack--- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is+-- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is -- toggled so frequenty and always replaces the master window. That's why the -- swap functions accept a boolean argument; when @True@ non-focused floating -- windows will be ignored.@@ -118,7 +115,7 @@ -- Without history, the list is empty. newtype MasterHistory = MasterHistory     { getMasterHistory :: M.Map WorkspaceId [Window]-    } deriving (Read,Show,Typeable)+    } deriving (Read,Show)  instance ExtensionClass MasterHistory where     initialValue = MasterHistory M.empty@@ -244,8 +241,8 @@                 (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)                 (b,s3) = swapFunction pm s2                 s4 = stackMerge s3 r-                mh = let w = head . W.integrate $ s3-                     in  const $ w : delete w ch+                mh = let w = NE.head . notEmpty . W.integrate $ s3+                     in const $ w : delete w ch             in (b,Just s4,mh)         (x,y,z) = maybe (False,Nothing,id) swapApply' st     -- Any floating master windows will be added to the history when 'windows'@@ -341,7 +338,7 @@             then (c+1,e:ys,ns)             else (c+1,ys,e:ns)         (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l-    in  (c',ys',snd . unzip $ ns')+    in  (c',ys',map snd ns')  -- | Wrap 'merge'' with an initial virtual index of @0@. Return only the -- unindexed list with elements from the leftover indexed list appended.
XMonad/Actions/SwapWorkspaces.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.SwapWorkspaces+-- Description :  Swap workspace tags without having to move individual windows. -- Copyright   :  (c) Devin Mullins <me@twifkak.com> -- License     :  BSD3-style (see LICENSE) --@@ -29,7 +30,7 @@   -- $usage--- Add this import to your @~\/.xmonad\/xmonad.hs@:+-- Add this import to your @xmonad.hs@: -- -- > import XMonad.Actions.SwapWorkspaces --@@ -43,7 +44,7 @@ -- will swap workspaces 1 and 5. -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Swaps the currently focused workspace with the given workspace tag, via --   @swapWorkspaces@.@@ -53,12 +54,13 @@ -- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace. -- This is an @X ()@ so can be hooked up to your keybindings directly. swapTo :: Direction1D -> X ()-swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent+swapTo dir = findWorkspace getSortByIndex dir anyWS 1 >>= windows . swapWithCurrent  -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new --   one with the two corresponding workspaces' tags swapped. swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd swapWorkspaces t1 t2 = mapWorkspace swap-    where swap w = if      tag w == t1 then w { tag = t2 }-                   else if tag w == t2 then w { tag = t1 }-                   else w+    where swap w+            | tag w == t1 = w { tag = t2 }+            | tag w == t2 = w { tag = t1 }+            | otherwise = w
XMonad/Actions/TagWindows.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.TagWindows+-- Description  : Functions for tagging windows and selecting them by tags. -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de> -- License      : BSD --@@ -26,21 +27,19 @@                  TagPrompt,                  ) where -import Data.List (nub,sortBy)-import Control.Monad import Control.Exception as E -import XMonad.StackSet hiding (filter)--import XMonad.Prompt import XMonad hiding (workspaces)+import XMonad.Prelude+import XMonad.Prompt+import XMonad.StackSet hiding (filter)  econst :: Monad m => a -> IOException -> m a econst = const . return  -- $usage ----- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:+-- To use window tags, import this module into your @xmonad.hs@: -- -- > import XMonad.Actions.TagWindows -- > import XMonad.Prompt    -- to use tagPrompt@@ -65,7 +64,7 @@ --       the tags \"a\" and \"b\" but not \"a b\". -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | set multiple tags for a window at once (overriding any previous tags) setTags :: [String] -> Window -> X ()@@ -84,18 +83,17 @@     io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=                 getTextProperty d w >>=                 wcTextPropertyToTextList d)-               (econst [[]])-    >>= return . words . unwords+               (econst [[]]) <&> (words . unwords)  -- | check a window for the given tag hasTag :: String -> Window -> X Bool-hasTag s w = (s `elem`) `fmap` getTags w+hasTag s w = (s `elem`) <$> getTags w  -- | add a tag to the existing ones addTag :: String -> Window -> X () addTag s w = do     tags <- getTags w-    if (s `notElem` tags) then setTags (s:tags) w else return ()+    when (s `notElem` tags) $ setTags (s:tags) w  -- | remove a tag from a window, if it exists delTag :: String -> Window -> X ()@@ -136,11 +134,6 @@ focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=     maybe (return ()) (windows . focusWindow) -findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)-findM _ []      = return Nothing-findM p (x:xs)  = do b <- p x-                     if b then return (Just x) else findM p xs- -- | apply a pure function to windows with a tag withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X () withTaggedP       t f = withTagged'       t (winMap f)@@ -158,7 +151,7 @@  withTaggedGlobal' :: String -> ([Window] -> X ()) -> X () withTaggedGlobal' t m = gets windowset >>=-    filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m+    filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m  withFocusedP :: (Window -> WindowSet -> WindowSet) -> X () withFocusedP f = withFocused $ windows . f@@ -167,7 +160,7 @@ shiftHere w s = shiftWin (currentTag s) w s  shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd-shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of+shiftToScreen sid w s = case filter (\m -> sid /= screen m) (current s:visible s) of                                 []      -> s                                 (t:_)   -> shiftWin (tag . workspace $ t) w s @@ -180,20 +173,19 @@ tagPrompt :: XPConfig -> (String -> X ()) -> X () tagPrompt c f = do   sc <- tagComplList-  mkXPrompt TagPrompt c (mkComplFunFromList' sc) f+  mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f  tagComplList :: X [String]-tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=-    mapM getTags >>=-    return . nub . concat+tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset)+           >>= mapM getTags+           <&> nub . concat   tagDelPrompt :: XPConfig -> X () tagDelPrompt c = do   sc <- tagDelComplList-  if (sc /= [])-    then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))-    else return ()+  when (sc /= []) $+    mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag)  tagDelComplList :: X [String] tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
+ XMonad/Actions/TiledWindowDragging.hs view
@@ -0,0 +1,92 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.TiledWindowDragging+-- Description :  Change the position of windows by dragging them.+-- Copyright   :  (c) 2020 Leon Kowarschick+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides an action that allows you to change the position of windows by dragging them around.+--+-----------------------------------------------------------------------------++module XMonad.Actions.TiledWindowDragging+  (+  -- * Usage+  -- $usage+    dragWindow+  )+where++import           XMonad+import           XMonad.Prelude+import qualified XMonad.StackSet               as W+import           XMonad.Layout.DraggingVisualizer++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Actions.TiledWindowDragging+-- > import XMonad.Layout.DraggingVisualizer+--+-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:+--+-- > myLayout = draggingVisualizer $ layoutHook def+--+-- Then add a mouse binding for 'dragWindow':+--+-- > , ((modMask .|. shiftMask, button1), dragWindow)+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++++-- | Create a mouse binding for this to be able to drag your windows around.+-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.+dragWindow :: Window -> X ()+dragWindow window = whenX (isClient window) $ withDisplay $ \dpy ->+  withWindowAttributes dpy window $ \wa -> do+    focus window+    (offsetX, offsetY)                    <- getPointerOffset window+    let (winX, winY, winWidth, winHeight)  = getWindowPlacement wa++    mouseDrag+        (\posX posY ->+          let rect = Rectangle (fi (fi winX + (posX - fi offsetX)))+                               (fi (fi winY + (posY - fi offsetY)))+                               (fi winWidth)+                               (fi winHeight)+          in  sendMessage $ DraggingWindow window rect+        )+        (sendMessage DraggingStopped >> performWindowSwitching window)+++-- | get the pointer offset relative to the given windows root coordinates+getPointerOffset :: Window -> X (Int, Int)+getPointerOffset win = do+    (_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)+    return (fi oX, fi oY)++-- | return a tuple of windowX, windowY, windowWidth, windowHeight+getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)+getWindowPlacement wa = (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)++performWindowSwitching :: Window -> X ()+performWindowSwitching win = do+    root                          <- asks theRoot+    (_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)+    ws                            <- gets windowset+    let allWindows = W.index ws+    when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do+        let allWindowsSwitched = map (switchEntries win selWin) allWindows+        (ls, t : rs)          <- pure $ break (== win) allWindowsSwitched+        let newStack           = W.Stack t (reverse ls) rs+        windows $ W.modify' $ const newStack+   where+    switchEntries a b x | x == a    = b+                        | x == b    = a+                        | otherwise = x
+ XMonad/Actions/ToggleFullFloat.hs view
@@ -0,0 +1,122 @@+-- |+-- Module      :  XMonad.Actions.ToggleFullFloat+-- Description :  Fullscreen (float) a window while remembering its original state.+-- Copyright   :  (c) 2022 Tomáš Janoušek <tomi@nomi.cz>+-- License     :  BSD3+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>+--+module XMonad.Actions.ToggleFullFloat (+    -- * Usage+    -- $usage+    toggleFullFloatEwmhFullscreen,+    toggleFullFloat,+    fullFloat,+    unFullFloat,+    gcToggleFullFloat,+    ) where++import qualified Data.Map.Strict as M++import XMonad+import XMonad.Prelude+import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks)+import XMonad.Hooks.ManageHelpers+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS++-- ---------------------------------------------------------------------+-- $usage+--+-- The main use-case is to make 'ewmhFullscreen' (re)store the size and+-- position of floating windows instead of just unconditionally sinking them+-- into the floating layer. To enable this, you'll need this in your+-- @xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Actions.ToggleFullFloat+-- > import XMonad.Hooks.EwmhDesktops+-- >+-- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…}+--+-- Additionally, this "smart" fullscreening can be bound to a key and invoked+-- manually whenever one needs a larger window temporarily:+--+-- >   , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat)++newtype ToggleFullFloat = ToggleFullFloat{ fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) }+    deriving (Show, Read)++instance ExtensionClass ToggleFullFloat where+    extensionType = PersistentExtension+    initialValue = ToggleFullFloat mempty++-- | Full-float a window, remembering its state (tiled/floating and+-- position/size).+fullFloat :: Window -> X ()+fullFloat = windows . appEndo <=< runQuery doFullFloatSave++-- | Restore window to its remembered state.+unFullFloat :: Window -> X ()+unFullFloat = windows . appEndo <=< runQuery doFullFloatRestore++-- | Full-float a window, if it's not already full-floating. Otherwise,+-- restore its original state.+toggleFullFloat :: Window -> X ()+toggleFullFloat w = ifM (isFullFloat w) (unFullFloat w) (fullFloat w)++isFullFloat :: Window -> X Bool+isFullFloat w = gets $ (Just fullRect ==) . M.lookup w . W.floating . windowset+  where+    fullRect = W.RationalRect 0 0 1 1++doFullFloatSave :: ManageHook+doFullFloatSave = do+    w <- ask+    liftX $ do+        f <- gets $ M.lookup w . W.floating . windowset+        -- @M.insertWith const@ = don't overwrite stored original state+        XS.modify' $ ToggleFullFloat . M.insertWith const w f . fromToggleFullFloat+    doFullFloat++doFullFloatRestore :: ManageHook+doFullFloatRestore = do+    w <- ask+    mf <- liftX $ do+        mf <- XS.gets $ M.lookup w . fromToggleFullFloat+        XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat+        pure mf+    doF $ case mf of+        Just (Just f) -> W.float w f  -- was floating before+        Just Nothing -> W.sink w      -- was tiled before+        Nothing -> W.sink w           -- fallback when not found in ToggleFullFloat++-- | Install ToggleFullFloat garbage collection hooks.+--+-- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if+-- using the 'toggleFullFloat' separately from the EWMH hook.+gcToggleFullFloat :: XConfig a -> XConfig a+gcToggleFullFloat c = c { startupHook     = startupHook c <> gcToggleFullFloatStartupHook+                        , handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook }++-- | ToggleFullFloat garbage collection: drop windows when they're destroyed.+gcToggleFullFloatEventHook :: Event -> X All+gcToggleFullFloatEventHook DestroyWindowEvent{ev_window = w} = do+    XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat+    mempty+gcToggleFullFloatEventHook _ = mempty++-- | ToggleFullFloat garbage collection: restrict to existing windows at+-- startup.+gcToggleFullFloatStartupHook :: X ()+gcToggleFullFloatStartupHook = withWindowSet $ \ws ->+    XS.modify' $ ToggleFullFloat . M.filterWithKey (\w _ -> w `W.member` ws) . fromToggleFullFloat++-- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This+-- makes windows restore their original state (size and position if floating)+-- instead of unconditionally sinking into the tiling layer.+--+-- ('gcToggleFullFloat' is included here.)+toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a+toggleFullFloatEwmhFullscreen =+    setEwmhFullscreenHooks doFullFloatSave doFullFloatRestore .+    gcToggleFullFloat
XMonad/Actions/TopicSpace.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NamedFieldPuns #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.TopicSpace+-- Description :  Turns your workspaces into a more topic oriented system. -- Copyright   :  (c) Nicolas Pouillard -- License     :  BSD-style (see LICENSE) --@@ -19,21 +20,49 @@    -- * Usage   -- $usage-   Topic++  -- * Types for Building Topics+    Topic   , Dir   , TopicConfig(..)-  , def-  , defaultTopicConfig+  , TopicItem(..)++    -- * Managing 'TopicItem's+  , topicNames+  , tiActions+  , tiDirs+  , noAction+  , inHome++    -- * Switching and Shifting Topics+  , switchTopic+  , switchNthLastFocused+  , switchNthLastFocusedByScreen+  , switchNthLastFocusedExclude+  , shiftNthLastFocused++    -- * Topic Actions+  , topicActionWithPrompt+  , topicAction+  , currentTopicAction++    -- * Getting the Topic History   , getLastFocusedTopics+  , workspaceHistory+  , workspaceHistoryByScreen++    -- * Modifying the Topic History   , setLastFocusedTopic   , reverseLastFocusedTopics++    -- * History hooks+  , workspaceHistoryHook+  , workspaceHistoryHookExclude++    -- * Pretty Printing   , pprWindowSet-  , topicActionWithPrompt-  , topicAction-  , currentTopicAction-  , switchTopic-  , switchNthLastFocused-  , shiftNthLastFocused++    -- * Utility   , currentTopicDir   , checkTopicConfig   , (>*>)@@ -41,25 +70,26 @@ where  import XMonad--import Data.List-import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)-import Data.Ord-import qualified Data.Map as M-import Control.Monad (liftM2,when,unless,replicateM_)-import System.IO+import XMonad.Prelude -import qualified XMonad.StackSet as W+import qualified Data.Map.Strict           as M+import qualified XMonad.Hooks.StatusBar.PP as SBPP+import qualified XMonad.StackSet           as W -import XMonad.Prompt-import XMonad.Prompt.Workspace+import Data.Map (Map) -import XMonad.Hooks.UrgencyHook-import XMonad.Hooks.DynamicLog (PP(..))-import qualified XMonad.Hooks.DynamicLog as DL+import XMonad.Prompt (XPConfig)+import XMonad.Prompt.Workspace (workspacePrompt) -import XMonad.Util.Run (spawnPipe)-import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Hooks.StatusBar.PP (PP(ppHidden, ppVisible))+import XMonad.Hooks.UrgencyHook (readUrgents)+import XMonad.Hooks.WorkspaceHistory+    ( workspaceHistory+    , workspaceHistoryByScreen+    , workspaceHistoryHook+    , workspaceHistoryHookExclude+    , workspaceHistoryModify+    )  -- $overview -- This module allows to organize your workspaces on a precise topic basis.  So@@ -73,112 +103,133 @@ -- display your topics in an historical way using a custom `pprWindowSet' -- function. You can also easily switch to recent topics using this history -- of last focused topics.+--+-- A blog post highlighting some features of this module can be found+-- <https://tony-zorman.com/posts/topic-space/2022-09-11-topic-spaces.html here>.  -- $usage--- Here is an example of configuration using TopicSpace:+-- You can use this module with the following in your @xmonad.hs@: ----- > -- The list of all topics/workspaces of your xmonad configuration.--- > -- The order is important, new topics must be inserted--- > -- at the end of the list if you want hot-restarting--- > -- to work.--- > myTopics :: [Topic]--- > myTopics =--- >   [ "dashboard" -- the first one--- >   , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"--- >   , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"--- >   , "yi", "documents", "twitter", "pdf"--- >   ]+-- > import qualified Data.Map.Strict as M+-- > import qualified XMonad.StackSet as W -- >+-- > import XMonad.Actions.TopicSpace+-- > import XMonad.Util.EZConfig    -- for the keybindings+-- > import XMonad.Prompt.Workspace -- if you want to use the prompt+--+-- You will then have to+--+--   * Define a new 'TopicConfig' via 'TopicItem's+--+--   * Add the appropriate keybindings+--+--   * Replace the @workspaces@ field in your 'XConfig' with a list of+--     your topics names+--+--   * Optionally, if you want to use the history features, add+--     'workspaceHistoryHook' from "XMonad.Hooks.WorkspaceHistory"+--     (re-exported by this module) or an equivalent function to your+--     @logHook@.  See the documentation of+--     "XMonad.Hooks.WorkspaceHistory" for further details+--+-- Let us go through a full example together.+--+-- A 'TopicItem' consists of three things: the name of the topic, its+-- root directory, and the action associated to it—to be executed if the+-- topic is empty or the action is forced via a keybinding.+--+-- We start by specifying our chosen topics as a list of such+-- 'TopicItem's:+--+-- > topicItems :: [TopicItem]+-- > topicItems =+-- >   [ inHome   "1:WEB"              (spawn "firefox")+-- >   , noAction "2"      "."+-- >   , noAction "3:VID"  "videos"+-- >   , TI       "4:VPN"  "openvpn"   (spawn "urxvt -e randomVPN.sh")+-- >   , inHome   "5:IM"               (spawn "signal" *> spawn "telegram")+-- >   , inHome   "6:IRC"              (spawn "urxvt -e weechat")+-- >   , TI       "dts"    ".dotfiles" spawnShell+-- >   , TI       "xm-con" "hs/xm-con" (spawnShell *> spawnShellIn "hs/xm")+-- >   ]+--+-- Then we just need to put together our topic config:+-- -- > myTopicConfig :: TopicConfig -- > myTopicConfig = def--- >   { topicDirs = M.fromList $--- >       [ ("conf", "w/conf")--- >       , ("dashboard", "Desktop")--- >       , ("yi", "w/dev-haskell/yi")--- >       , ("darcs", "w/dev-haskell/darcs")--- >       , ("haskell", "w/dev-haskell")--- >       , ("xmonad", "w/dev-haskell/xmonad")--- >       , ("tools", "w/tools")--- >       , ("movie", "Movies")--- >       , ("talk", "w/talks")--- >       , ("music", "Music")--- >       , ("documents", "w/documents")--- >       , ("pdf", "w/documents")--- >       ]--- >   , defaultTopicAction = const $ spawnShell >*> 3--- >   , defaultTopic = "dashboard"--- >   , topicActions = M.fromList $--- >       [ ("conf",       spawnShell >> spawnShellIn "wd/ertai/private")--- >       , ("darcs",      spawnShell >*> 3)--- >       , ("yi",         spawnShell >*> 3)--- >       , ("haskell",    spawnShell >*> 2 >>--- >                        spawnShellIn "wd/dev-haskell/ghc")--- >       , ("xmonad",     spawnShellIn "wd/x11-wm/xmonad" >>--- >                        spawnShellIn "wd/x11-wm/xmonad/contrib" >>--- >                        spawnShellIn "wd/x11-wm/xmonad/utils" >>--- >                        spawnShellIn ".xmonad" >>--- >                        spawnShellIn ".xmonad")--- >       , ("mail",       mailAction)--- >       , ("irc",        ssh somewhere)--- >       , ("admin",      ssh somewhere >>--- >                        ssh nowhere)--- >       , ("dashboard",  spawnShell)--- >       , ("twitter",    spawnShell)--- >       , ("web",        spawn browserCmd)--- >       , ("movie",      spawnShell)--- >       , ("documents",  spawnShell >*> 2 >>--- >                        spawnShellIn "Documents" >*> 2)--- >       , ("pdf",        spawn pdfViewerCmd)--- >       ]+-- >   { topicDirs          = tiDirs    topicItems+-- >   , topicActions       = tiActions topicItems+-- >   , defaultTopicAction = const (pure ()) -- by default, do nothing+-- >   , defaultTopic       = "1:WEB"         -- fallback -- >   }--- >--- > -- extend your keybindings--- > myKeys conf@XConfig{modMask=modm} =--- >   [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal--- >   , ((modm              , xK_a     ), currentTopicAction myTopicConfig)--- >   , ((modm              , xK_g     ), promptedGoto)--- >   , ((modm .|. shiftMask, xK_g     ), promptedShift)--- >   {- more  keys ... -}--- >   ]--- >   ++--- >   [ ((modm, k), switchNthLastFocused myTopicConfig i)--- >   | (i, k) <- zip [1..] workspaceKeys]--- >+--+-- Above, we have used the `spawnShell` and `spawnShellIn` helper+-- functions; here they are:+-- -- > spawnShell :: X () -- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn -- > -- > spawnShellIn :: Dir -> X ()--- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"--- >+-- > spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir+--+-- Next, we define some other other useful helper functions.  It is+-- rather common to have a lot of topics—much more than available keys!+-- In a situation like that, it's very convenient to switch topics with+-- a prompt; the following use of 'workspacePrompt' does exactly that.+-- -- > goto :: Topic -> X () -- > goto = switchTopic myTopicConfig -- > -- > promptedGoto :: X ()--- > promptedGoto = workspacePrompt myXPConfig goto+-- > promptedGoto = workspacePrompt def goto -- > -- > promptedShift :: X ()--- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift--- >--- > myConfig = do--- >     checkTopicConfig myTopics myTopicConfig--- >     myLogHook <- makeMyLogHook--- >     return $ def--- >          { borderWidth = 1 -- Width of the window border in pixels.--- >          , workspaces = myTopics--- >          , layoutHook = myModifiers myLayout--- >          , manageHook = myManageHook--- >          , logHook = myLogHook--- >          , handleEventHook = myHandleEventHook--- >          , terminal = myTerminal -- The preferred terminal program.--- >          , normalBorderColor = "#3f3c6d"--- >          , focusedBorderColor = "#4f66ff"--- >          , XMonad.modMask = mod1Mask--- >          , keys = myKeys--- >          , mouseBindings = myMouseBindings--- >          }+-- > promptedShift = workspacePrompt def $ windows . W.shift -- >+-- > -- Toggle between the two most recently used topics, but keep+-- > -- screens separate.  This needs @workspaceHistoryHook@.+-- > toggleTopic :: X ()+-- > toggleTopic = switchNthLastFocusedByScreen myTopicConfig 1+--+-- Hopefully you've gotten a general feeling of how to define these kind of+-- small helper functions using what's provided in this module.+--+-- Adding the appropriate keybindings works as it normally would.  Here,+-- we'll use "XMonad.Util.EZConfig" syntax:+--+-- > myKeys :: [(String, X ())]+-- > myKeys =+-- >   [ ("M-n"        , spawnShell)+-- >   , ("M-a"        , currentTopicAction myTopicConfig)+-- >   , ("M-g"        , promptedGoto)+-- >   , ("M-S-g"      , promptedShift)+-- >   , ("M-S-<Space>", toggleTopic)+-- >   ]+-- >   +++-- >   -- The following does two things:+-- >   --   1. Switch topics (no modifier)+-- >   --   2. Move focused window to topic N (shift modifier)+-- >   [ ("M-" ++ m ++ k, f i)+-- >   | (i, k) <- zip (topicNames topicItems) (map show [1 .. 9 :: Int])+-- >   , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]+-- >   ]+--+-- This makes @M-1@ to @M-9@ switch to the first nine topics that we+-- have specified in @topicItems@.+--+-- You can also switch to the nine last-used topics instead:+--+-- >   [ ("M-" ++ show i, switchNthLastFocused myTopicConfig i)+-- >   | i <- [1 .. 9]+-- >   ]+--+-- We can now put the whole configuration together with the following:+-- -- > main :: IO ()--- > main = xmonad =<< myConfig+-- > main = xmonad $ def+-- >   { workspaces = topicNames topicItems+-- >   }+-- >  `additionalKeysP` myKeys  -- | An alias for @flip replicateM_@ (>*>) :: Monad m => m a -> Int -> m ()@@ -188,85 +239,79 @@ -- | 'Topic' is just an alias for 'WorkspaceId' type Topic = WorkspaceId --- | 'Dir' is just an alias for 'FilePath' but should points to a directory.+-- | 'Dir' is just an alias for 'FilePath', but should point to a directory. type Dir = FilePath  -- | Here is the topic space configuration area.-data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir-                                 -- ^ This mapping associate a directory to each topic.-                               , topicActions       :: M.Map Topic (X ())-                                 -- ^ This mapping associate an action to trigger when+data TopicConfig = TopicConfig { topicDirs          :: Map Topic Dir+                                 -- ^ This mapping associates a directory to each topic.+                               , topicActions       :: Map Topic (X ())+                                 -- ^ This mapping associates an action to trigger when                                  -- switching to a given topic which workspace is empty.                                , defaultTopicAction :: Topic -> X ()                                  -- ^ This is the default topic action.                                , defaultTopic       :: Topic-                                 -- ^ This is the default topic.+                                 -- ^ This is the default (= fallback) topic.                                , maxTopicHistory    :: Int-                                 -- ^ This setups the maximum depth of topic history, usually-                                 -- 10 is a good default since we can bind all of them using-                                 -- numeric keypad.+                                 -- ^ This specifies the maximum depth of the topic history;+                                 -- usually 10 is a good default since we can bind all of+                                 -- them using numeric keypad.                                }+{-# DEPRECATED maxTopicHistory "This field will be removed in the future; history is now handled by XMonad.Hooks.WorkspaceHistory" #-}  instance Default TopicConfig where-    def            = TopicConfig { topicDirs = M.empty-                                 , topicActions = M.empty-                                 , defaultTopicAction = const (ask >>= spawn . terminal . config)-                                 , defaultTopic = "1"-                                 , maxTopicHistory = 10-                                 }--{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}-defaultTopicConfig :: TopicConfig-defaultTopicConfig = def--newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)-instance ExtensionClass PrevTopics where-    initialValue = PrevTopics []-    extensionType = PersistentExtension+  def            = TopicConfig { topicDirs = M.empty+                               , topicActions = M.empty+                               , defaultTopicAction = const (ask >>= spawn . terminal . config)+                               , defaultTopic = "1"+                               , maxTopicHistory = 10+                               } --- | Returns the list of last focused workspaces the empty list otherwise.-getLastFocusedTopics :: X [String]-getLastFocusedTopics = XS.gets getPrevTopics+-- | Return the (possibly empty) list of last focused topics.+getLastFocusedTopics :: X [Topic]+getLastFocusedTopics = workspaceHistory+{-# DEPRECATED getLastFocusedTopics "Use XMonad.Hooks.WorkspaceHistory.workspaceHistory (re-exported by this module) instead" #-} --- | Given a 'TopicConfig', the last focused topic, and a predicate that will--- select topics that one want to keep, this function will set the property--- of last focused topics.-setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()-setLastFocusedTopic w predicate =-  XS.modify $ PrevTopics-    . seqList . nub . (w:) . filter predicate-    . getPrevTopics-  where seqList xs = length xs `seq` xs+-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one+-- wants to keep, this function will cons the topic in front of the list of+-- last focused topics and filter it according to the predicate.  Note that we+-- prune the list in case that its length exceeds 'maxTopicHistory'.+setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()+setLastFocusedTopic tc w predicate = do+  sid <- gets $ W.screen . W.current . windowset+  workspaceHistoryModify $+    take (maxTopicHistory tc) . nub . filter (predicate . snd) . ((sid, w) :)+{-# DEPRECATED setLastFocusedTopic "Use XMonad.Hooks.WorkspaceHistory instead" #-}  -- | Reverse the list of "last focused topics" reverseLastFocusedTopics :: X ()-reverseLastFocusedTopics =-  XS.modify $ PrevTopics . reverse . getPrevTopics+reverseLastFocusedTopics = workspaceHistoryModify reverse --- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration--- and a pretty-printing record 'PP'. It will show the list of topics sorted historically--- and highlighting topics with urgent windows.+-- | This function is a variant of 'SBPP.pprWindowSet' which takes a topic+-- configuration and a pretty-printing record 'PP'. It will show the list of+-- topics sorted historically and highlight topics with urgent windows. pprWindowSet :: TopicConfig -> PP -> X String pprWindowSet tg pp = do-    winset <- gets windowset-    urgents <- readUrgents-    let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset-        maxDepth = maxTopicHistory tg-    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)-                        (`notElem` empty_workspaces)-    lastWs <- getLastFocusedTopics-    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])-        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic-        pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }-        sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)-    return $ DL.pprWindowSet sortWindows urgents pp' winset+  winset <- gets windowset+  urgents <- readUrgents+  let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset+      maxDepth = maxTopicHistory tg+  setLastFocusedTopic tg+                      (W.tag . W.workspace . W.current $ winset)+                      (`notElem` empty_workspaces)+  lastWs <- workspaceHistory+  let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])+      add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic+      pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }+      sortWindows = take maxDepth . sortOn (depth . W.tag)+  return $ SBPP.pprWindowSet sortWindows urgents pp' winset --- | Given a prompt configuration and a topic configuration, triggers the action associated with+-- | Given a prompt configuration and a topic configuration, trigger the action associated with -- the topic given in prompt. topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()-topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))+topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg)) --- | Given a configuration and a topic, triggers the action associated with the given topic.+-- | Given a configuration and a topic, trigger the action associated with the given topic. topicAction :: TopicConfig -> Topic -> X () topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg @@ -276,46 +321,94 @@  -- | Switch to the given topic. switchTopic :: TopicConfig -> Topic -> X ()-switchTopic tg topic = do+switchTopic tc topic = do+  -- Switch to topic and add it to the last seen topics   windows $ W.greedyView topic++  -- If applicable, execute the topic action   wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)-  when (null wins) $ topicAction tg topic+  when (null wins) $ topicAction tc topic --- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.+-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'. switchNthLastFocused :: TopicConfig -> Int -> X ()-switchNthLastFocused tg depth = do-  lastWs <- getLastFocusedTopics-  switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth+switchNthLastFocused = switchNthLastFocusedExclude [] --- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.+-- | Like 'switchNthLastFocused', but also filter out certain topics.+switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()+switchNthLastFocusedExclude excludes tc depth = do+  lastWs <- filter (`notElem` excludes) <$> workspaceHistory+  switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth++-- | Like 'switchNthLastFocused', but only consider topics that used to+-- be on the current screen.+--+-- For example, the following function allows one to toggle between the+-- currently focused and the last used topic, while treating different+-- screens completely independently from one another.+--+-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1+switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()+switchNthLastFocusedByScreen tc depth = do+  sid <- gets $ W.screen . W.current . windowset+  sws <- fromMaybe []+       . listToMaybe+       . map snd+       . filter ((== sid) . fst)+     <$> workspaceHistoryByScreen+  switchTopic tc $ (sws ++ repeat (defaultTopic tc)) !! depth++-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing. shiftNthLastFocused :: Int -> X () shiftNthLastFocused n = do-  ws <- fmap (listToMaybe . drop n) getLastFocusedTopics+  ws <- fmap (listToMaybe . drop n) workspaceHistory   whenJust ws $ windows . W.shift --- | Returns the directory associated with current topic returns the empty string otherwise.-currentTopicDir :: TopicConfig -> X String+-- | Return the directory associated with the current topic, or return the empty+-- string if the topic could not be found.+currentTopicDir :: TopicConfig -> X FilePath currentTopicDir tg = do   topic <- gets (W.tag . W.workspace . W.current . windowset)   return . fromMaybe "" . M.lookup topic $ topicDirs tg --- | Check the given topic configuration for duplicates topics or undefined topics.+-- | Check the given topic configuration for duplicate or undefined topics. checkTopicConfig :: [Topic] -> TopicConfig -> IO () checkTopicConfig tags tg = do-    -- tags <- gets $ map W.tag . workspaces . windowset+  -- tags <- gets $ map W.tag . workspaces . windowset -    let-      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)-      dups       = tags \\ nub tags-      diffTopic  = seenTopics \\ sort tags-      check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst+  let+    seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)+    dups       = tags \\ nub tags+    diffTopic  = seenTopics \\ sort tags+    check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst -    check diffTopic "Seen but missing topics/workspaces"-    check dups      "Duplicate topics/workspaces"+  check diffTopic "Seen but missing topics/workspaces"+  check dups      "Duplicate topics/workspaces" --- | Display the given message using the @xmessage@ program.-xmessage :: String -> IO ()-xmessage s = do-  h <- spawnPipe "xmessage -file -"-  hPutStr h s-  hClose h+-- | Convenience type for specifying topics.+data TopicItem = TI+  { tiName   :: !Topic  -- ^ 'Topic' ≡ 'String'+  , tiDir    :: !Dir    -- ^ Directory associated with topic; 'Dir' ≡ 'String'+  , tiAction :: !(X ()) -- ^ Startup hook when topic is empty+  }++-- | Extract the names from a given list of 'TopicItem's.+topicNames :: [TopicItem] -> [Topic]+topicNames = map tiName++-- | From a list of 'TopicItem's, build a map that can be supplied as+-- the 'topicDirs'.+tiDirs :: [TopicItem] -> Map Topic Dir+tiDirs = M.fromList . map (\TI{ tiName, tiDir } -> (tiName, tiDir))++-- | From a list of 'TopicItem's, build a map that can be supplied as+-- the 'topicActions'.+tiActions :: [TopicItem] -> Map Topic (X ())+tiActions = M.fromList . map (\TI{ tiName, tiAction } -> (tiName, tiAction))++-- | Associate a directory with the topic, but don't spawn anything.+noAction :: Topic -> Dir -> TopicItem+noAction n d = TI n d (pure ())++-- | Topic with @tiDir = ~/@.+inHome :: Topic -> X () -> TopicItem+inHome n = TI n "."
XMonad/Actions/TreeSelect.hs view
@@ -1,9 +1,12 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.TreeSelect+-- Description :  Display workspaces or actions in a tree-like format. -- Copyright   :  (c) Tom Smeets <tom.tsmeets@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -39,6 +42,7 @@      , TSConfig(..)     , tsDefaultConfig+    , def        -- * Navigation       -- $navigation@@ -60,16 +64,13 @@     , treeselectAt     ) where -import Control.Applicative import Control.Monad.Reader import Control.Monad.State-import Data.List (find)-import Data.Maybe import Data.Tree-import Foreign+import Foreign (shiftL, shiftR, (.&.)) import System.IO-import System.Posix.Process (forkProcess, executeFile) import XMonad hiding (liftX)+import XMonad.Prelude import XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.NamedWindows@@ -78,8 +79,9 @@ import qualified Data.Map as M  #ifdef XFT-import Graphics.X11.Xft+import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender+import Graphics.X11.Xft #endif  -- $usage@@ -113,10 +115,10 @@ -- -- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces ----- > xmonad $ defaultConfig { ...--- >                        , workspaces = toWorkspaces myWorkspaces--- >                        , logHook = workspaceHistoryHook--- >                        }+-- > xmonad $ def { ...+-- >              , workspaces = toWorkspaces myWorkspaces+-- >              , logHook = workspaceHistoryHook+-- >              } -- -- After that you still need to bind buttons to 'treeselectWorkspace' to start selecting a workspaces and moving windows --@@ -131,22 +133,22 @@ -- $config -- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes. ----- The default config defined as 'tsDefaultConfig'+-- The default config defined as 'def' ----- > tsDefaultConfig = TSConfig { ts_hidechildren = True--- >                            , ts_background   = 0xc0c0c0c0--- >                            , ts_font         = "xft:Sans-16"--- >                            , ts_node         = (0xff000000, 0xff50d0db)--- >                            , ts_nodealt      = (0xff000000, 0xff10b8d6)--- >                            , ts_highlight    = (0xffffffff, 0xffff0000)--- >                            , ts_extra        = 0xff000000--- >                            , ts_node_width   = 200--- >                            , ts_node_height  = 30--- >                            , ts_originX      = 0--- >                            , ts_originY      = 0--- >                            , ts_indent       = 80--- >                            , ts_navigate     = defaultNavigation--- >                            }+-- > def = TSConfig { ts_hidechildren = True+-- >                , ts_background   = 0xc0c0c0c0+-- >                , ts_font         = "xft:Sans-16"+-- >                , ts_node         = (0xff000000, 0xff50d0db)+-- >                , ts_nodealt      = (0xff000000, 0xff10b8d6)+-- >                , ts_highlight    = (0xffffffff, 0xffff0000)+-- >                , ts_extra        = 0xff000000+-- >                , ts_node_width   = 200+-- >                , ts_node_height  = 30+-- >                , ts_originX      = 0+-- >                , ts_originY      = 0+-- >                , ts_indent       = 80+-- >                , ts_navigate     = defaultNavigation+-- >                }  -- $pixel --@@ -160,8 +162,8 @@ -- white       = 0xffffffff -- black       = 0xff000000 -- red         = 0xffff0000--- blue        = 0xff00ff00--- green       = 0xff0000ff+-- green       = 0xff00ff00+-- blue        = 0xff0000ff -- transparent = 0x00000000 -- @ @@ -258,6 +260,7 @@ -- Using nice alternating blue nodes tsDefaultConfig :: TSConfig a tsDefaultConfig = def+{-# DEPRECATED tsDefaultConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TreeSelect) instead." #-}  -- | Tree Node With a name and extra text data TSNode a = TSNode { tsn_name  :: String@@ -316,7 +319,9 @@         set_colormap attributes colormap         set_background_pixel attributes ts_background         set_border_pixel attributes 0-        createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes+        w <- createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes+        setClassHint display w (ClassHint "xmonad-tree_select" "xmonad")+        pure w      liftIO $ do         -- TODO: move below?@@ -405,7 +410,7 @@                             , "XConfig.workspaces: "                             ] ++ map tag ws         hPutStrLn stderr msg-        _ <- forkProcess $ executeFile "xmessage" True [msg] Nothing+        xmessage msg         return ()   where     mkNode n w = do@@ -448,8 +453,8 @@ -- >        ] -- >    ] treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()-treeselectAction c xs = treeselect c xs >>= \x -> case x of-    Just a  -> a >> return ()+treeselectAction c xs = treeselect c xs >>= \case+    Just a  -> void a     Nothing -> return ()  forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]@@ -461,7 +466,7 @@  -- | Quit returning the currently selected node select :: TreeSelect a (Maybe a)-select = Just <$> gets (tsn_value . cursor . tss_tree)+select = gets (Just . (tsn_value . cursor . tss_tree))  -- | Quit without returning anything cancel :: TreeSelect a (Maybe a)@@ -523,18 +528,21 @@ -- | wait for keys and run navigation navigate :: TreeSelect a (Maybe a) navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do-    maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e+    maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask .|. buttonPressMask) e      ev <- getEvent e -    if ev_event_type ev == keyPress-      then do-        (ks, _) <- lookupString $ asKeyEvent e-        return $ do-            mask <- liftX $ cleanMask (ev_state ev)-            f <- asks ts_navigate-            fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f-      else return navigate+    if | ev_event_type ev == keyPress -> do+           ks <- keycodeToKeysym d (ev_keycode ev) 0+           return $ do+               mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)+               f <- asks ts_navigate+               fromMaybe navigate $ M.lookup (mask, ks) f+       | ev_event_type ev == buttonPress -> do+           -- See XMonad.Prompt Note [Allow ButtonEvents]+           allowEvents d replayPointer currentTime+           return navigate+       | otherwise -> return navigate  -- | Request a full redraw redraw :: TreeSelect a ()@@ -599,7 +607,7 @@     colormap <- gets tss_colormap     visual   <- gets tss_visual     liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra-        (ix * ts_indent) (iy * ts_node_height)+        (ix * ts_indent + ts_originX) (iy * ts_node_height + ts_originY)         ts_node_width ts_node_height      -- TODO: draw extra text (transparent background? or ts_background)@@ -641,17 +649,29 @@         setForeground display gc col         wcDrawImageString display window fnt gc x y text #ifdef XFT-    Xft fnt -> do+    Xft fnts -> do         withXftDraw display window visual colormap $             \ft_draw -> withXftColorValue display visual colormap (fromARGB col) $-            \ft_color -> xftDrawString ft_draw ft_color fnt x y text+#if MIN_VERSION_X11_xft(0, 3, 4)+            \ft_color -> xftDrawStringFallback ft_draw ft_color (NE.toList fnts) (fi x) (fi y) text+#else+            \ft_color -> xftDrawString ft_draw ft_color (NE.head fnts) x y text+#endif  -- | Convert 'Pixel' to 'XRenderColor' -- -- Note that it uses short to represent its components fromARGB :: Pixel -> XRenderColor-fromARGB x = XRenderColor (fromIntegral $ 0xff00 .&. shiftR x 8)  -- red-                          (fromIntegral $ 0xff00 .&. x)           -- green-                          (fromIntegral $ 0xff00 .&. shiftL x 8)  -- blue-                          (fromIntegral $ 0xff00 .&. shiftR x 16) -- alpha+fromARGB x =+#if MIN_VERSION_X11_xft(0, 3, 3)+    XRenderColor r g b a+#else+    -- swapped green/blue as a workaround for the faulty Storable instance in X11-xft < 0.3.3+    XRenderColor r b g a+#endif+  where+    r = fromIntegral $ 0xff00 .&. shiftR x 8+    g = fromIntegral $ 0xff00 .&. x+    b = fromIntegral $ 0xff00 .&. shiftL x 8+    a = fromIntegral $ 0xff00 .&. shiftR x 16 #endif
+ XMonad/Actions/UpKeys.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}+{- |+   Module      : XMonad.Actions.UpKeys+   Description : Bind an action to the release of a key+   Copyright   : (c) Tony Zorman, 2024+   License     : BSD-3+   Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>++A combinator for binding an action to the release of a key. This can be+useful for hold-type buttons, where the press of a key engages some+functionality, and its release… releases it again.+-}+module XMonad.Actions.UpKeys+  ( -- * Usage+    -- $usage+    useUpKeys,+    UpKeysConfig (..),+    ezUpKeys,+  )+where++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import XMonad+import XMonad.Prelude+import XMonad.Util.EZConfig (mkKeymap)+import qualified XMonad.Util.ExtensibleConf as XC++{- $usage+You can use this module with the following in your @xmonad.hs@:++> import XMonad.Actions.UpKeys++Next, define the keys and actions you want to have happen on the release+of a key:++> myUpKeys = ezUpKeys $+>   [ ("M-z", myAction)+>   , ("M-a", myAction2)+>   ]++All that's left is to plug this definition into the 'useUpKeys'+combinator that this module provides:++> main :: IO ()+> main = xmonad+>      . useUpKeys (def{ grabKeys = True, upKeys = myUpKeys })+>      $ myConfig++Note the presence of @'grabKeys' = True@; this is for situations where+you don't have any of these keys bound to do something upon pressing+them; i.e., you use them solely for their release actions. If you want+something to happen in both cases, remove that part (@'grabKeys' =+False@ is the default) and bind the keys to actions as you normally+would.++==== __Examples__++As an extended example, consider the case where you want all of your+docks (e.g., status bar) to "pop up" when you press the super key, and+then vanish again once that keys is released.++Since docks are not generally part of XMonad's window-set—otherwise, we+would have to manage them—we first need a way to access and manipulate+all docks.++> onAllDocks :: (Display -> Window -> IO ()) -> X ()+> onAllDocks act = withDisplay \dpy -> do+>   rootw <- asks theRoot+>   (_, _, wins) <- io $ queryTree dpy rootw+>   traverse_ (io . act dpy) =<< filterM (runQuery checkDock) wins++This is also the place where one could filter for just status bar,+trayer, and so on.++Now we have to decide what kinds of keys we want to watch out for. Since+you most likely use left super as your modifier key, this is a little+bit more complicated than for other keys, as you will most likely see+the key both as a @KeyMask@, as well as a @KeySym@. One could think a+bit and probably come up with an elegant solution for this—or one could+grab all possible key combinations by brute-force!++> dockKeys :: X () -> [((KeyMask, KeySym), X ())]+> dockKeys act = map (actKey . foldr1 (.|.)) . combinations $ keyMasks+>  where+>   actKey :: KeyMask -> ((KeyMask, KeySym), X ())+>   actKey mask = ((mask, xK_Super_L), act)+>+>   keyMasks :: [KeyMask]+>   keyMasks = [ noModMask, shiftMask, lockMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask ]+>+>   -- Return all combinations of a sequence of values.+>   combinations :: [a] -> [[a]]+>   combinations xs = concat [combs i xs | i <- [1 .. length xs]]+>    where+>     combs 0 _      = [[]]+>     combs _ []     = []+>     combs n (x:xs) = map (x:) (combs (n-1) xs) <> combs n xs++Given some action, like lowering or raising the window, we generate all+possible combinations of modifiers that may be pressed with the super+key. This is a good time to say that this is just for demonstrative+purposes, btw—please don't actually do this.++All that's left is to plug everything into the machinery of this module,+and we're done!++> import qualified Data.Map.Strict as Map+>+> main :: IO ()+> main = xmonad+>      . … -- other combinators+>      . useUpKeys (def { upKeys = Map.fromList $ dockKeys (onAllDocks lowerWindow) })+>      $ myConfig `additionalKeys` dockKeys (onAllDocks raiseWindow)+>+> myConfig = …+-}++data UpKeysConfig = UpKeysConfig+  { -- | Whether to grab all keys that are not already grabbed.+    grabKeys :: !Bool+    -- | The keys themselves.+  , upKeys :: !(Map (KeyMask, KeySym) (X ()))+  }++-- | The default 'UpKeysConfig'; keys are not grabbed, and no upkeys are+-- specified.+instance Default UpKeysConfig where+  def :: UpKeysConfig+  def = UpKeysConfig { grabKeys = False, upKeys = mempty }++instance Semigroup UpKeysConfig where+  (<>) :: UpKeysConfig -> UpKeysConfig -> UpKeysConfig+  UpKeysConfig g u <> UpKeysConfig g' u' = UpKeysConfig (g && g') (u <> u')++-- | Bind actions to keys upon their release.+useUpKeys :: UpKeysConfig -> (XConfig l -> XConfig l)+useUpKeys upKeysConf = flip XC.once upKeysConf \conf -> conf+  { handleEventHook = handleEventHook conf <> (\e -> handleKeyUp e $> All True)+  , startupHook     = startupHook     conf <> when (grabKeys upKeysConf) grabUpKeys+  }+ where+  grabUpKeys :: X ()+  grabUpKeys = do+    XConf{ display = dpy, theRoot = rootw } <- ask+    realKeys <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig+    let grab :: (KeyMask, KeyCode) -> X ()+        grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync+    traverse_ grab =<< mkGrabs (Map.keys realKeys)++-- | Parse the given EZConfig-style keys into the internal keymap+-- representation.+--+-- This is just 'mkKeymap' with a better name.+ezUpKeys :: XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())+ezUpKeys = mkKeymap++-- | A handler for key-up events.+handleKeyUp :: Event -> X ()+handleKeyUp KeyEvent{ ev_event_type, ev_state, ev_keycode }+  | ev_event_type == keyRelease = withDisplay \dpy -> do+      s   <- io $ keycodeToKeysym dpy ev_keycode 0+      cln <- cleanMask ev_state+      ks  <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig+      userCodeDef () $ whenJust (ks Map.!? (cln, s)) id+handleKeyUp _ = pure ()
XMonad/Actions/UpdateFocus.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.UpdateFocus+-- Description :  Updates the focus on mouse move in unfocused windows. -- Copyright   :  (c) Daniel Schoepe -- License     :  BSD3-style (see LICENSE) --@@ -16,17 +17,17 @@     -- * Usage     -- $usage     focusOnMouseMove,-    adjustEventInput+    adjustEventInput,+    focusUnderPointer, ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W-import Control.Monad (when)-import Data.Monoid  -- $usage -- To make the focus update on mouse movement within an unfocused window, add the--- following to your @~\/.xmonad\/xmonad.hs@:+-- following to your @xmonad.hs@: -- -- > import XMonad.Actions.UpdateFocus -- > xmonad $ def {@@ -40,7 +41,7 @@  -- | Changes the focus if the mouse is moved within an unfocused window. focusOnMouseMove :: Event -> X All-focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do+focusOnMouseMove MotionEvent{ ev_x = x, ev_y = y, ev_window = root } = do     -- check only every 15 px to avoid excessive calls to translateCoordinates     when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do       dpy <- asks display@@ -58,3 +59,25 @@   io $ selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask                                 .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask                                 .|. buttonPressMask .|. pointerMotionMask++-- | Focus the window under the mouse pointer, unless we're currently changing+-- focus with the mouse or dragging. This is the inverse to+-- "XMonad.Actions.UpdatePointer": instead of moving the mouse pointer to+-- match the focus, we change the focus to match the mouse pointer.+--+-- This is meant to be used together with+-- 'XMonad.Actions.UpdatePointer.updatePointer' in individual key bindings.+-- Bindings that change focus should invoke+-- 'XMonad.Actions.UpdatePointer.updatePointer' at the end, bindings that+-- switch workspaces or change layouts should call 'focusUnderPointer' at the+-- end. Neither should go to 'logHook', as that would override the other.+--+-- This is more finicky to set up than 'focusOnMouseMove', but ensures that+-- focus is updated immediately, without having to touch the mouse.+focusUnderPointer :: X ()+focusUnderPointer = whenX (not <$> (asks mouseFocused <||> gets (isJust . dragging))) $ do+  dpy <- asks display+  root <- asks theRoot+  (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root+  w <- gets (W.peek . windowset)+  when (w' /= none && Just w' /= w) (focus w')
XMonad/Actions/UpdatePointer.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonadContrib.UpdatePointer+-- Description :  Causes the pointer to follow whichever window focus changes to. -- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky -- License     :  BSD3-style (see LICENSE) --@@ -24,15 +25,13 @@     where  import XMonad-import XMonad.Util.XUtils (fi)-import Control.Arrow-import Control.Monad+import XMonad.Prelude import XMonad.StackSet (member, peek, screenDetail, current)-import Data.Maybe-import Control.Exception +import Control.Arrow ((&&&), (***))+ -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.UpdatePointer@@ -61,6 +60,11 @@ -- | Update the pointer's location to the currently focused -- window or empty screen unless it's already there, or unless the user was changing -- focus with the mouse+--+-- See also 'XMonad.Actions.UpdateFocus.focusUnderPointer' for an inverse+-- operation that updates the focus instead. The two can be combined in a+-- single config if neither goes into 'logHook' but are invoked explicitly in+-- individual key bindings. updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X () updatePointer refPos ratio = do   ws <- gets windowset@@ -68,10 +72,9 @@   let defaultRect = screenRect $ screenDetail $ current ws   rect <- case peek ws of         Nothing -> return defaultRect-        Just w  -> do tryAttributes <- io $ try $ getWindowAttributes dpy w-                      return $ case tryAttributes of-                        Left (_ :: SomeException) -> defaultRect-                        Right attributes          -> windowAttributesToRectangle attributes+        Just w  -> maybe defaultRect windowAttributesToRectangle+               <$> safeGetWindowAttributes w+   root <- asks theRoot   mouseIsMoving <- asks mouseFocused   (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root@@ -105,6 +108,7 @@ lerp r a b = (1 - r) * realToFrac a + r * realToFrac b  clip :: Ord a => (a, a) -> a -> a-clip (lower, upper) x = if x < lower then lower-    else if x > upper then upper else x-+clip (lower, upper) x+  | x < lower = lower+  | x > upper = upper+  | otherwise = x
XMonad/Actions/Warp.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.Warp+-- Description :  Warp the pointer to a given window or screen. -- Copyright   :  (c) daniel@wagner-home.com -- License     :  BSD3-style (see LICENSE) --@@ -22,12 +23,12 @@                            warpToWindow                           ) where -import Data.List+import XMonad.Prelude import XMonad import XMonad.StackSet as W  {- $usage-You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+You can use this module with the following in your @xmonad.hs@:  > import XMonad.Actions.Warp @@ -44,7 +45,7 @@ -}  -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.   data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight@@ -90,18 +91,16 @@ -- | Warp the pointer to a given position relative to the currently --   focused window.  Top left = (0,0), bottom right = (1,1). warpToWindow :: Rational -> Rational -> X ()-warpToWindow h v =-    withDisplay $ \d ->-        withFocused $ \w -> do-            wa <- io $ getWindowAttributes d w-            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))+warpToWindow h v = withDisplay $ \d -> withFocused $ \w ->+  withWindowAttributes d w $ \wa ->+    warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))  -- | Warp the pointer to the given position (top left = (0,0), bottom --   right = (1,1)) on the given screen. warpToScreen :: ScreenId -> Rational -> Rational -> X () warpToScreen n h v = do     root <- asks theRoot-    (StackSet {current = x, visible = xs}) <- gets windowset+    StackSet{current = x, visible = xs} <- gets windowset     whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)         $ \r ->             warp root (rect_x r + fraction h (rect_width  r))
XMonad/Actions/WindowBringer.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.WindowBringer+-- Description :  Dmenu operations to bring windows to you, and bring you to windows. -- Copyright   :  Devin Mullins <me@twifkak.com> -- License     :  BSD-style (see LICENSE) --@@ -21,21 +22,24 @@                     WindowBringerConfig(..),                     gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',                     bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',-                    windowMap, windowMap', bringWindow, actionMenu+                    copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs',+                    windowMap, windowAppMap, windowMap', bringWindow, actionMenu,+                    defaultDMenuArgs                    ) where -import Control.Applicative((<$>))+import Control.Monad import qualified Data.Map as M  import qualified XMonad.StackSet as W import XMonad import qualified XMonad as X import XMonad.Util.Dmenu (menuMapArgs)-import XMonad.Util.NamedWindows (getName)+import XMonad.Util.NamedWindows (getName, getNameWMClass)+import XMonad.Actions.CopyWindow (copyWindow)  -- $usage ----- Import the module into your @~\/.xmonad\/xmonad.hs@:+-- Import the module into your @xmonad.hs@: -- -- > import XMonad.Actions.WindowBringer --@@ -43,20 +47,28 @@ -- -- > , ((modm .|. shiftMask, xK_g     ), gotoMenu) -- > , ((modm .|. shiftMask, xK_b     ), bringMenu)+-- > , ((modm .|. shiftMask, xK_y     ), copyMenu) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. +-- | The default arguments passed to dmenu. You may want to use this with+--   the *MenuArgs functions.+defaultDMenuArgs :: [String]+defaultDMenuArgs = ["-i"]+ data WindowBringerConfig = WindowBringerConfig     { menuCommand :: String -- ^ The shell command that will handle window selection     , menuArgs :: [String] -- ^ Arguments to be passed to menuCommand     , windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window+    , windowFilter :: Window -> X Bool -- ^ Filter function to decide which windows to consider     }  instance Default WindowBringerConfig where     def = WindowBringerConfig{ menuCommand = "dmenu"-                             , menuArgs = ["-i"]+                             , menuArgs = defaultDMenuArgs                              , windowTitler = decorateName+                             , windowFilter = \_ -> return True                              }  -- | Pops open a dmenu with window titles. Choose one, and you will be@@ -87,10 +99,41 @@ gotoMenuArgs' :: String -> [String] -> X () gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args } +-- | Pops open a dmenu with window titles. Choose one, and it will be copied into your current workspace.+copyMenu :: X ()+copyMenu = copyMenuArgs defaultDMenuArgs+ -- | Pops open a dmenu with window titles. Choose one, and it will be+--   copied into your current workspace. This version+--   accepts a configuration object.+copyMenuConfig :: WindowBringerConfig -> X ()+copyMenuConfig wbConfig = actionMenu wbConfig copyBringWindow++-- | Pops open a dmenu with window titles. Choose one, and it will be+--   copied into your current workspace. This version+--   takes a list of arguments to pass to dmenu.+copyMenuArgs :: [String] -> X ()+copyMenuArgs args = copyMenuConfig def { menuArgs = args }++-- | Pops open an application with window titles given over stdin. Choose one,+--   and it will be copied into your current workspace.+copyMenu' :: String -> X ()+copyMenu' cmd = copyMenuConfig def { menuArgs = [], menuCommand = cmd }++-- | Pops open an application with window titles given over stdin. Choose one,+--   and it will be copied into your current+--   workspace. This version allows arguments to the chooser to be specified.+copyMenuArgs' :: String -> [String] -> X ()+copyMenuArgs' cmd args = copyMenuConfig def { menuArgs = args, menuCommand = cmd }++-- | Brings a copy of the specified window into the current workspace.+copyBringWindow :: Window -> X.WindowSet -> X.WindowSet+copyBringWindow w ws = copyWindow w (W.currentTag ws) ws++-- | Pops open a dmenu with window titles. Choose one, and it will be --   dragged, kicking and screaming, into your current workspace. bringMenu :: X ()-bringMenu = bringMenuArgs def+bringMenu = bringMenuArgs defaultDMenuArgs  -- | Pops open a dmenu with window titles. Choose one, and it will be --   dragged, kicking and screaming, into your current workspace. This version@@ -123,11 +166,8 @@ -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action --   if found. actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()-actionMenu WindowBringerConfig{ menuCommand = cmd-                              , menuArgs = args-                              , windowTitler = titler-                              } action-    = windowMap' titler >>= menuMapFunction >>= flip X.whenJust (windows . action)+actionMenu c@WindowBringerConfig{ menuCommand = cmd, menuArgs = args } action =+  windowMap' c >>= menuMapFunction >>= flip X.whenJust (windows . action)     where       menuMapFunction :: M.Map String a -> X (Maybe a)       menuMapFunction = menuMapArgs cmd args@@ -135,15 +175,20 @@  -- | A map from window names to Windows. windowMap :: X (M.Map String Window)-windowMap = windowMap' decorateName+windowMap = windowMap' def +-- | A map from application executable names to Windows.+windowAppMap :: X (M.Map String Window)+windowAppMap = windowMap' def { windowTitler = decorateAppName }+ -- | A map from window names to Windows, given a windowTitler function.-windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)-windowMap' titler = do-  ws <- gets X.windowset-  M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)- where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)-       keyValuePair ws w = flip (,) w <$> titler ws w+windowMap' :: WindowBringerConfig -> X (M.Map String Window)+windowMap' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do+  windowSet <- gets X.windowset+  M.fromList . concat <$> mapM keyValuePairs (W.workspaces windowSet)+ where keyValuePairs ws = let wins = W.integrate' (W.stack ws)+                           in mapM (keyValuePair ws) =<< filterM include wins+       keyValuePair ws w = (, w) <$> titler ws w  -- | Returns the window name as will be listed in dmenu. --   Tagged with the workspace ID, to guarantee uniqueness, and to let the user@@ -151,4 +196,12 @@ decorateName :: X.WindowSpace -> Window -> X String decorateName ws w = do   name <- show <$> getName w+  return $ name ++ " [" ++ W.tag ws ++ "]"++-- | Returns the window name as will be listed in dmenu.  This will+-- return the executable name of the window along with its workspace+-- ID.+decorateAppName :: X.WindowSpace -> Window -> X String+decorateAppName ws w = do+  name <- show <$> getNameWMClass w   return $ name ++ " [" ++ W.tag ws ++ "]"
XMonad/Actions/WindowGo.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE ViewPatterns #-}+ {- | Module      :  XMonad.Actions.WindowGo+Description :  Operations for raising (traveling to) windows. License     :  Public domain  Maintainer  :  <gwern0@gmail.com>@@ -36,10 +39,8 @@                  module XMonad.ManageHook                 ) where -import Control.Monad-import Data.Char (toLower) import qualified Data.List as L (nub,sortBy)-import Data.Monoid+import XMonad.Prelude import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask) import Graphics.X11 (Window) import XMonad.ManageHook@@ -47,9 +48,11 @@ import XMonad.Prompt.Shell (getBrowser, getEditor) import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack) import XMonad.Util.Run (safeSpawnProg)+import qualified Data.List.NonEmpty as NE+ {- $usage -Import the module into your @~\/.xmonad\/xmonad.hs@:+Import the module into your @xmonad.hs@:  > import XMonad.Actions.WindowGo @@ -65,7 +68,8 @@ > (className =? "Firefox" <||> className =? "Firefox-bin")  For detailed instructions on editing your key bindings, see-"XMonad.Doc.Extending#Editing_key_bindings". -}+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.+-}  -- | Get the list of workspaces sorted by their tag workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a]@@ -88,7 +92,10 @@ -- | The same as ifWindows, but applies a ManageHook to the first match -- instead and discards the other matches ifWindow :: Query Bool -> ManageHook -> X () -> X ()-ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)+ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty)+-- ifWindows guarantees that the list given to the function is+-- non-empty. This should really use Data.List.NonEmpty, but, alas,+-- that would be a breaking change.  {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.    Presumably this executable is the same one that you were looking for.@@ -159,9 +166,12 @@ raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do   foc <- withWindowSet $ return . W.peek   case foc of-    Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match-                            in windows $ focusFn y-    _ -> windows . focusFn . head $ ws+    Just w | w `elem` ws ->+        let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws+            -- cannot fail to match+        in windows $ focusFn y+    _ -> windows . focusFn . NE.head . notEmpty $ ws+         -- ws is non-empty by ifWindows's definition.  -- | Given a function which gets us a String, we try to raise a window with that classname, --   or we then interpret that String as a executable name.
XMonad/Actions/WindowMenu.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.WindowMenu+-- Description :  Display window management actions in the center of the focused window. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -29,11 +30,11 @@ import XMonad.Actions.GridSelect import XMonad.Layout.Maximize import XMonad.Actions.Minimize-import XMonad.Util.XUtils (fi)+import XMonad.Prelude (fi)  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- >    import XMonad.Actions.WindowMenu --@@ -50,9 +51,9 @@                 else (nBC, fBC)  windowMenu :: X ()-windowMenu = withFocused $ \w -> do+windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do     tags <- asks (workspaces . config)-    Rectangle x y wh ht <- getSize w+    let Rectangle x y wh ht = getSize wa     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh         originFractY = (fi y - fi sy + fi ht / 2) / fi sht@@ -68,12 +69,10 @@                     | tag <- tags ]     runSelectedAction gsConfig actions -getSize :: Window -> X (Rectangle)-getSize w = do-  d  <- asks display-  wa <- io $ getWindowAttributes d w+getSize :: WindowAttributes -> Rectangle+getSize wa =   let x = fi $ wa_x wa       y = fi $ wa_y wa       wh = fi $ wa_width wa       ht = fi $ wa_height wa-  return (Rectangle x y wh ht)+   in Rectangle x y wh ht
XMonad/Actions/WindowNavigation.hs view
@@ -1,9 +1,12 @@+{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.WindowNavigation+-- Description :  Experimental rewrite of "XMonad.Layout.WindowNavigation". -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>, --                          Devin Mullins <me@twifkak.com>--- Maintainer  :  Devin Mullins <me@twifkak.com>+-- Maintainer  :  Devin Mullins <me@twifkak.com>,+--                Platon Pronko <platon7pronko@gmail.com> -- License     :  BSD3-style (see LICENSE) -- Stability   :  unstable -- Portability :  unportable@@ -36,21 +39,20 @@                                        withWindowNavigationKeys,                                        WNAction(..),                                        go, swap,+                                       goPure, swapPure,                                        Direction2D(..), WNState,                                        ) where -import XMonad+import XMonad hiding (state)+import XMonad.Prelude (catMaybes, fromMaybe, sortOn) import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W -import Control.Applicative ((<$>)) import Control.Arrow (second) import Data.IORef-import Data.List (sortBy) import Data.Map (Map())+import Data.List (partition, find) import qualified Data.Map as M-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)-import Data.Ord (comparing) import qualified Data.Set as S  -- $usage@@ -65,6 +67,11 @@ -- >             $ def { ... } -- >     xmonad config --+-- Or, for the brave souls:+--+-- > main = xmonad =<< withWindowNavigation (xK_w, xK_a, xK_s, xK_d)+-- >             $ def { ... }+-- -- Here, we pass in the keys for navigation in counter-clockwise order from up. -- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@ -- to swap windows.@@ -98,118 +105,316 @@  withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) withWindowNavigationKeys wnKeys conf = do-    posRef <- newIORef M.empty-    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)+    stateRef <- newIORef M.empty+    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys)                                  `M.union` keys conf cnf,-                  logHook = logHook conf >> trackMovement posRef }-  where fromWNAction posRef (WNGo dir)   = go   posRef dir-        fromWNAction posRef (WNSwap dir) = swap posRef dir+                  logHook = logHook conf >> trackMovement stateRef }+  where fromWNAction stateRef (WNGo dir)   = go   stateRef dir+        fromWNAction stateRef (WNSwap dir) = swap stateRef dir  data WNAction = WNGo Direction2D | WNSwap Direction2D  type WNState = Map WorkspaceId Point --- go:--- 1. get current position, verifying it matches the current window--- 2. get target windowrect--- 3. focus window--- 4. set new position+-- | Focus window in the given direction. go :: IORef WNState -> Direction2D -> X ()-go = withTargetWindow W.focusWindow+go stateRef dir = runPureAction stateRef (goPure dir) +-- | Swap current window with the window in the given direction.+-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows). swap :: IORef WNState -> Direction2D -> X ()-swap = withTargetWindow swapWithFocused+swap stateRef dir = runPureAction stateRef (swapPure dir)++type WindowRectFn x = (Window -> x (Maybe Rectangle))+-- | (state, oldWindowSet, mappedWindows, windowRect)+type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)+type WNOutput = (WNState, WindowSet)++-- | Run the pure action inside X monad.+runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()+runPureAction stateRef action = do+  oldState <- io (readIORef stateRef)+  oldWindowSet <- gets windowset+  mappedWindows <- gets mapped+  (newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX)+  windows (const newWindowSet)+  io $ writeIORef stateRef newState++-- | Version of `go` not dependent on X monad (needed for testing).+goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput+goPure dir input@(oldState, oldWindowSet, mappedWindows, _) =+  if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1+  then+    -- Handle the special case of Full layout, when there's only one mapped window on a screen.+    return ( oldState+           , case dir of+               U -> W.focusUp oldWindowSet+               L -> W.focusDown oldWindowSet+               D -> W.focusDown oldWindowSet+               R -> W.focusUp oldWindowSet+           )+  else+    withTargetWindow W.focusWindow dir input++-- | Version of `swap` not dependent on X monad (needed for testing).+swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput+swapPure = withTargetWindow swapWithFocused   where swapWithFocused targetWin winSet =             case W.peek winSet of                 Just currentWin -> W.focusWindow currentWin $                                    mapWindows (swapWin currentWin targetWin) winSet                 Nothing -> winSet-        mapWindows f ss = W.mapWorkspace (mapWindows' f) ss-        mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }+        mapWindows f = W.mapWorkspace (mapWindows' f)+        mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s }         mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)-        swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win+        swapWin win1 win2 win+          | win == win1 = win2+          | win == win2 = win1+          | otherwise = win -withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()-withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do-    targets <- filter ((/= win) . fst) <$> navigableTargets pos dir-    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do-      windows (adj targetWin)-      setPosition posRef pos targetRect+-- | Select a target window in the given direction and modify the WindowSet.+-- 1. Get current position, verifying it matches the current window (exit if no focused window).+-- 2. Get the target window.+-- 3. Execute an action on the target window and windowset.+-- 4. Set the new position.+withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput+withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do+  whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do+    targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos+    whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) ->+      let newWindowSet = adj targetWin oldWindowSet+      in return (modifyState newWindowSet newPos oldState, newWindowSet) +-- | Update position on outside changes in windows. trackMovement :: IORef WNState -> X ()-trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do-                           windowRect win >>= flip whenJust (setPosition posRef pos . snd)+trackMovement stateRef = do+  oldState <- io (readIORef stateRef)+  oldWindowSet <- gets windowset+  mappedWindows <- gets mapped+  whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do+      io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState -fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()-fromCurrentPoint posRef f = withFocused $ \win -> do-                                currentPosition posRef >>= f win+-- | Get focused window and current position.+getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))+getCurrentWindow input@(_, oldWindowSet, _, _) =+  whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do+    (pos, rect) <- currentPosition input+    return $ Just (window, rect, pos) --- Gets the current position from the IORef passed in, or if nothing (say, from--- a restart), derives the current position from the current window. Also,--- verifies that the position is congruent with the current window (say, if you--- used mod-j/k or mouse or something).-currentPosition :: IORef WNState -> X Point-currentPosition posRef = do-    root <- asks theRoot-    currentWindow <- gets (W.peek . windowset)-    currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)+-- | Gets the current position from the state passed in, or if nothing+-- (say, from a restart), derives the current position from the current window.+-- Also, verifies that the position is congruent with the current window+-- (say, if you moved focus using mouse or something).+-- Returns the window rectangle for convenience, since we'll need it later anyway.+currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)+currentPosition (state, oldWindowSet, _, windowRect) = do+  currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)+  let posMaybe = M.lookup (W.currentTag oldWindowSet) state+      middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)+  return $ case posMaybe of+    Nothing -> (middleOf currentRect, currentRect)+    Just pos -> (centerPosition currentRect pos, currentRect) -    wsid <- gets (W.currentTag . windowset)-    mp <- M.lookup wsid <$> io (readIORef posRef)+-- | Inserts new position into the state.+modifyState :: WindowSet -> Point -> WNState -> WNState+modifyState oldWindowSet =+  M.insert (W.currentTag oldWindowSet) -    return $ maybe (middleOf currentRect) (`inside` currentRect) mp+-- | "Jumps" the current position into the middle of target rectangle.+-- (keeps the position as-is if it is already inside the target rectangle)+centerPosition :: Rectangle -> Point -> Point+centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do+  if pointWithin x y r+  then pos+  else Point (midPoint rx rw) (midPoint ry rh) -  where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)+midPoint :: Position -> Dimension -> Position+midPoint pos dim = pos + fromIntegral dim `div` 2 -setPosition :: IORef WNState -> Point -> Rectangle -> X ()-setPosition posRef oldPos newRect = do-    wsid <- gets (W.currentTag . windowset)-    io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)+-- | Make a list of target windows we can navigate to,+-- sorted by desirability of navigation.+navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]+navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do+  allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input+  let+    screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet+    (thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles -inside :: Point -> Rectangle -> Point-Point x y `inside` Rectangle rx ry rw rh =-    Point (x `within` (rx, rw)) (y `within` (ry, rh))-  where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim-                                    then pos-                                    else midPoint lower dim+    pos = pointTransform dir currentPos+    wr = rectTransform dir currentRect -midPoint :: Position -> Dimension -> Position-midPoint pos dim = pos + fromIntegral dim `div` 2+    rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) &&+                   ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||+                    (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis+    sortByP2 = sortOn (rect_p2 . snd)+    posBeforeEdge r = point_p pos < rect_p2 r -navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]-navigableTargets point dir = navigable dir point <$> windowRects+    rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&+                         rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr+    rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr+    rectOverlapsBothEdges r = rectOverlapsEdge r &&+                              rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r+    distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r))+    distanceToRectCenter r =+      let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos+      in if distance <= 0+         then distance + 1+         else distance+    sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd) --- Filters and sorts the windows in terms of what is closest from the Point in--- the Direction2D.-navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]-navigable d pt = sortby d . filter (inr d pt . snd)+    rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr &&+                    rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr+    sortByLength = sortOn (rect_psize . snd) --- Produces a list of normal-state windows, on any screen. Rectangles are--- adjusted based on screen position relative to the current screen, because I'm--- bad like that.-windowRects :: X [(Window, Rectangle)]-windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped+    rectAfterEdge r = rect_p1 r > rect_p2 wr -windowRect :: Window -> X (Maybe (Window, Rectangle))-windowRect win = withDisplay $ \dpy -> do+    -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation:+    inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r++    clamp v v1 v2 | v < v1 = v1+                  | v >= v2 = v2 - 1+                  | otherwise = v+    dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))++  return $ mapSnd (inversePointTransform dir) $ concat+    [+      -- First, navigate to windows that are fully inside current window+      -- and have higher coordinate bigger than current position.+      -- ┌──────────────────┐+      -- │   current        │  (all examples assume direction=R)+      -- │    ┌──────────┐  │+      -- │  ──┼─► inside │  │+      -- │    └──────────┘  │+      -- └──────────────────┘+      -- Also include windows fully overlapping current on the orthogonal axis:+      --             ┌──────────────┐+      --             │ overlapping  │+      -- ┌───────────┤              ├────┐+      -- │ current ──┼─►            │    │+      -- └───────────┤              ├────┘+      --             └──────────────┘+      mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles++      -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction.+      -- ┌──────────────┬─────────────┐   ┌───────────┐                   ┌─────────────┐+      -- │ current      │ adjacent    │   │ current   │                   │ current     │+      -- │            ──┼─►           │   │       ┌───┴───────────────┐   │         ┌───┴─────────────┐+      -- │              │             │   │     ──┼─► │   overlapping │   │       ──┼─►               │+      -- │              ├─────────────┘   │       └───┬───────────────┘   └─────────┤     overlapping │+      -- │              │                 │           │                             │                 │+      -- └──────────────┘                 └───────────┘                             └─────────────────┘+    , mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles++      -- Windows fully overlapping current window "in the middle" on the parallel axis are also included,+      -- if position is inside them:+      --     ┌───────────┐+      --     │  current  │+      -- ┌───┤-----------├────────────────┐+      -- │   │     *   ──┼─►  overlapping │+      -- └───┤-----------├────────────────┘+      --     └───────────┘+    , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles++      -- Then navigate to windows that fully encompass the current window.+      -- ┌─────────────────────┐+      -- │    outer            │+      -- │  ┌─────────────┐    │+      -- │  │  current  ──┼─►  │+      -- │  └─────────────┘    │+      -- └─────────────────────┘+    , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles++      -- Then navigate to windows that are fully after current window in the chosen direction.+      -- ┌──────────────┐+      -- │ current      │  ┌────────────────┐+      -- │              │  │                │+      -- │            ──┼──┼─► not adjacent │+      -- │              │  │                │+      -- │              │  └────────────────┘+      -- └──────────────┘+    , mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles++      -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray.+    , mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles++      -- If everything else fails, then navigate to the window that is fully inside current window,+      -- but is before the current position.+      -- This can happen when we are at the last window on a screen, and attempt to navigate even further.+      -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway,+      -- and user is probably not so fully aware of the precise position anyway.+    , mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $+      sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles+    ]++-- Structs for direction-independent space - equivalent to rotating points and rectangles such that+-- navigation direction points to the right.+-- Allows us to abstract over direction in the navigation functions.+data DirPoint = DirPoint+  { point_p :: Position -- coordinate parallel to the direction+  , point_o :: Position -- coordinate orthogonal to the direction+  }+data DirRectangle = DirRectangle+  { rect_p1 :: Position -- lower rectangle coordinate parallel to the direction+  , rect_p2 :: Position -- higher rectangle coordinate parallel to the direction+  , rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction+  , rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction+  }+{- HLINT ignore "Use camelCase" -}+rect_psize :: DirRectangle -> Dimension+rect_psize r = fromIntegral (rect_p2 r - rect_p1 r)++-- | Transform a point from screen space into direction-independent space.+pointTransform :: Direction2D -> Point -> DirPoint+pointTransform dir (Point x y) = case dir of+  U -> DirPoint (negate y - 1) x+  L -> DirPoint (negate x - 1) (negate y - 1)+  D -> DirPoint y (negate x - 1)+  R -> DirPoint x y++-- | Transform a point from direction-independent space back into screen space.+inversePointTransform :: Direction2D -> DirPoint -> Point+inversePointTransform dir p = case dir of+  U -> Point (point_o p) (negate $ point_p p + 1)+  L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1)+  D -> Point (negate $ point_o p + 1) (point_p p)+  R -> Point (point_p p) (point_o p)++-- | Transform a rectangle from screen space into direction-independent space.+rectTransform :: Direction2D -> Rectangle -> DirRectangle+rectTransform dir (Rectangle x y w h) = case dir of+  U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w)+  L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y)+  D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x)+  R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h)++-- | Produces a list of normal-state windows on all screens, excluding currently focused window.+windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]+windowRects (_, oldWindowSet, mappedWindows, windowRect) =+  let+    allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows+    windowRect2 w = fmap (w,) <$> windowRect w+  in catMaybes <$> mapM windowRect2 allWindows++windowRectX :: Window -> X (Maybe Rectangle)+windowRectX win = withDisplay $ \dpy -> do     (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win-    return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))+    return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)     `catchX` return Nothing --- Modified from droundy's implementation of WindowNavigation:+-- Maybe below functions can be replaced with some standard helper functions? -inr :: Direction2D -> Point -> Rectangle -> Bool-inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&-                                                        py < ry + fromIntegral h-inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&-                                            py >  ry-inr R (Point px py) (Rectangle rx ry _ h) = px <  rx &&-                                            py >= ry && py < ry + fromIntegral h-inr L (Point px py) (Rectangle rx ry w h) =             px > rx + fromIntegral w &&-                                            py >= ry && py < ry + fromIntegral h+-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.+whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b+whenJust' monadMaybeValue deflt f = do+  maybeValue <- monadMaybeValue+  case maybeValue of+    Nothing -> return deflt+    Just value -> f value -sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]-sortby D = sortBy $ comparing (rect_y . snd)-sortby R = sortBy $ comparing (rect_x . snd)-sortby U = reverse . sortby D-sortby L = reverse . sortby R+-- | Filter a list of tuples on the second tuple member.+filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]+filterSnd f = filter (f . snd)++-- | Map a second tuple member in a list of tuples.+mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]+mapSnd f = map (second f)
XMonad/Actions/WithAll.hs view
@@ -1,28 +1,30 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.WithAll+-- Description  : Perform a given action on all or certain groups of windows. -- License      : BSD3-style (see LICENSE) -- Stability    : unstable -- Portability  : unportable ----- Provides functions for performing a given action on all windows of--- the current workspace.+-- Provides functions for performing a given action on all or certain+-- groups of windows on the current workspace. -----------------------------------------------------------------------------  module XMonad.Actions.WithAll (     -- * Usage     -- $usage     sinkAll, withAll,-    withAll', killAll) where+    withAll', killAll,+    killOthers) where -import Data.Foldable hiding (foldr)+import XMonad.Prelude hiding (foldr)  import XMonad import XMonad.StackSet  -- $usage ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.WithAll --@@ -31,7 +33,7 @@ --     , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Un-float all floating windows on the current workspace. sinkAll :: X ()@@ -50,3 +52,7 @@ -- | Kill all the windows on the current workspace. killAll :: X() killAll = withAll killWindow++-- | Kill all the unfocused windows on the current workspace.+killOthers :: X ()+killOthers = withUnfocused killWindow
XMonad/Actions/Workscreen.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module     :  XMonad.Actions.Workscreen+-- Description:  Display a set of workspaces on several screens. -- Copyright  :  (c) 2012 kedals0 -- License    :  BSD3-style (see LICENSE) --@@ -20,7 +23,6 @@ -- This also permits to see all workspaces of a workscreen even if just -- one screen is present, and to move windows from workspace to workscreen. ------------------------------------------------------------------------------{-# LANGUAGE DeriveDataTypeable #-}  module XMonad.Actions.Workscreen (   -- * Usage@@ -35,12 +37,13 @@   ) where  import XMonad hiding (workspaces)+import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.OnScreen  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Workscreen -- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]@@ -55,26 +58,26 @@ -- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]] -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)+data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show) type WorkscreenId=Int -data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)+data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show) instance ExtensionClass WorkscreenStorage where   initialValue = WorkscreenStorage 0 []  -- | Helper to group workspaces. Multiply workspace by screens number. expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]-expandWorkspace nscr ws = concat $ map expandId ws+expandWorkspace nscr = concatMap expandId   where expandId wsId = let t = wsId ++ "_"                         in map ((++) t . show ) [1..nscr]  -- | Create workscreen list from workspace list. Group workspaces to -- packets of screens number size. fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]-fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)+fromWorkspace n ws = zipWith Workscreen [0..] (fromWorkspace' n ws) fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]] fromWorkspace' _ [] = [] fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)@@ -90,7 +93,7 @@                            let wscr = if wscrId == c                                           then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)                                           else a !! wscrId-                               (x,_:ys) = splitAt wscrId a+                               (x, notEmpty -> _ :| ys) = splitAt wscrId a                                newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)                            windows (viewWorkscreen' wscr)                            XS.put newWorkscreenStorage@@ -106,5 +109,6 @@ -- @WorkscreenId@. shiftToWorkscreen :: WorkscreenId -> X () shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get-                              let ws = head . workspaces $ a !! wscrId-                              windows $ W.shift ws+                              case workspaces (a !! wscrId) of+                                []      -> pure ()+                                (w : _) -> windows $ W.shift w
XMonad/Actions/WorkspaceCursors.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.WorkspaceCursors+-- Description  : Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. -- Copyright    : (c) 2009 Adam Vogt <vogt.adam@gmail.com> -- License      : BSD --@@ -46,14 +47,10 @@ import XMonad.Actions.FocusNth(focusNth') import XMonad.Layout.LayoutModifier(ModifiedLayout(..),                                     LayoutModifier(handleMess, redoLayout))-import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),+import XMonad(Message, WorkspaceId, X, XState(windowset),               fromMessage, sendMessage, windows, gets)-import Control.Monad((<=<), guard, liftM, liftM2, when)-import Control.Applicative((<$>))-import Data.Foldable(Foldable(foldMap), toList)-import Data.Maybe(fromJust, listToMaybe)-import Data.Monoid(Monoid(mappend, mconcat))-import Data.Traversable(sequenceA)+import XMonad.Util.Stack (reverseS)+import XMonad.Prelude  -- $usage --@@ -61,13 +58,10 @@ -- -- > import XMonad -- > import XMonad.Actions.WorkspaceCursors--- > import XMonad.Hooks.DynamicLog -- > import XMonad.Util.EZConfig -- > import qualified XMonad.StackSet as W -- >--- > main = do--- >     x <- xmobar conf--- >     xmonad x+-- > main = xmonad conf -- > -- > conf = additionalKeysP def -- >        { layoutHook = workspaceCursors myCursors $ layoutHook def@@ -92,7 +86,8 @@ --   workspaces. Or change it such that workspaces are created when you try to --   view it. ----- * Function for pretty printing for DynamicLog that groups workspaces by+-- * Function for pretty printing for "XMonad.Hooks.StatusBar.PP" that groups+--   workspaces by -- common prefixes -- -- * Examples of adding workspaces to the cursors, having them appear multiple@@ -100,10 +95,10 @@  -- | makeCursors requires a nonempty string, and each sublist must be nonempty makeCursors ::  [[String]] -> Cursors String-makeCursors [] = error "Workspace Cursors cannot be empty"-makeCursors a = concat . reverse <$> foldl addDim x xs-    where x = end $ map return $ head a-          xs = map (map return) $ tail a+makeCursors []       = error "Workspace Cursors cannot be empty"+makeCursors (a : as) = concat . reverse <$> foldl addDim x xs+    where x = end $ map return a+          xs = map (map return) as           -- this could probably be simplified, but this true:           -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))           -- the strange order is used because it makes the regular M-1..9@@ -118,7 +113,7 @@  data Cursors a     = Cons (W.Stack (Cursors a))-    | End a deriving (Eq,Show,Read,Typeable)+    | End a deriving (Eq,Show,Read)  instance Foldable Cursors where     foldMap f (End x) = f x@@ -144,7 +139,7 @@  -- This could be made more efficient, if the fact that the suffixes are grouped focusTo ::  (Eq t) => t -> Cursors t -> Maybe (Cursors t)-focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True)+focusTo x = find ((x==) . getFocus) . changeFocus (const True)  -- | non-wrapping version of 'W.focusUp'' noWrapUp ::  W.Stack t -> W.Stack t@@ -153,20 +148,19 @@  -- | non-wrapping version of 'W.focusDown'' noWrapDown ::  W.Stack t -> W.Stack t-noWrapDown = reverseStack . noWrapUp . reverseStack-    where reverseStack (W.Stack t ls rs) = W.Stack t rs ls+noWrapDown = reverseS . noWrapUp . reverseS  focusDepth ::  Cursors t -> Int focusDepth (Cons x) = 1 + focusDepth (W.focus x) focusDepth (End  _) = 0  descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)-descend f 1 (Cons x) = Cons `liftM` f x-descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x+descend f 1 (Cons x) = Cons <$> f x+descend f n (Cons x) | n > 1 = fmap Cons $ descend f (pred n) `onFocus` x descend _ _ x = return x  onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)-onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st)+onFocus f st = (\x -> st { W.focus = x}) <$> f (W.focus st)  -- | @modifyLayer@ is used to change the focus at a given depth modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()@@ -192,10 +186,10 @@ modifyLayer' f depth = modifyCursors (descend f depth)  modifyCursors ::  (Cursors String -> X (Cursors String)) -> X ()-modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<)+modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<) -data WorkspaceCursors a = WorkspaceCursors (Cursors String)-    deriving (Typeable,Read,Show)+newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)+    deriving (Read,Show)  -- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as -- your outermost modifier, unless you want different cursors at different@@ -203,8 +197,7 @@ workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a workspaceCursors = ModifiedLayout . WorkspaceCursors -data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }-    deriving (Typeable)+newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }  instance Message ChangeCursors @@ -219,4 +212,4 @@         return (arrs,WorkspaceCursors <$> focusTo cws cs)      handleMess (WorkspaceCursors cs) m =-        sequenceA $ fmap WorkspaceCursors . ($ cs) . unWrap <$> fromMessage m+        traverse (fmap WorkspaceCursors . ($ cs) . unWrap) (fromMessage m)
XMonad/Actions/WorkspaceNames.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.WorkspaceNames+-- Description :  Persistently rename workspace and swap them along with their names. -- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz> -- License     :  BSD3-style (see LICENSE) --@@ -8,22 +9,19 @@ -- Stability   :  experimental -- Portability :  unportable ----- Provides bindings to rename workspaces, show these names in DynamicLog and+-- Provides bindings to rename workspaces, show these names in a status bar and -- swap workspaces along with their names. These names survive restart. -- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully -- dynamic topic space workflow. -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable #-}- module XMonad.Actions.WorkspaceNames (     -- * Usage     -- $usage      -- * Workspace naming     renameWorkspace,-    workspaceNamesPP,     getWorkspaceNames',     getWorkspaceNames,     getWorkspaceName,@@ -37,26 +35,30 @@     swapWithCurrent,      -- * Workspace prompt-    workspaceNamePrompt+    workspaceNamePrompt,++    -- * StatusBar, EwmhDesktops integration+    workspaceNamesPP,+    workspaceNamesEwmh,     ) where  import XMonad+import XMonad.Prelude (fromMaybe, isInfixOf, (<&>), (>=>)) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS) import qualified XMonad.Actions.SwapWorkspaces as Swap-import XMonad.Hooks.DynamicLog (PP(..))-import XMonad.Prompt (mkXPrompt, XPConfig)+import XMonad.Hooks.StatusBar.PP (PP(..))+import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename)+import XMonad.Prompt (mkXPrompt, XPConfig, historyCompletionP) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex)  import qualified Data.Map as M-import Data.Maybe (fromMaybe)-import Data.List (isInfixOf)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.WorkspaceNames --@@ -64,11 +66,18 @@ -- -- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace def) ----- and apply workspaceNamesPP to your DynamicLog pretty-printer:+-- and apply workspaceNamesPP to your pretty-printer: ----- > myLogHook =--- >     workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog+-- > myPP = workspaceNamesPP xmobarPP --+-- Check "XMonad.Hooks.StatusBar" for more information on how to incorprate+-- this into your status bar.+--+-- To expose workspace names to pagers and other EWMH clients, integrate this+-- with "XMonad.Hooks.EwmhDesktops":+--+-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…}+-- -- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s -- functionality, which may be used this way: --@@ -79,13 +88,13 @@ -- >     | (i, k) <- zip workspaces [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.    -- | Workspace names container. newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)-    deriving (Typeable, Read, Show)+    deriving (Read, Show)  instance ExtensionClass WorkspaceNames where     initialValue = WorkspaceNames M.empty@@ -97,21 +106,20 @@     WorkspaceNames m <- XS.get     return (`M.lookup` m) --- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for--- workspaces with a name, and to @\"t\"@ otherwise.-getWorkspaceNames :: X (WorkspaceId -> String)-getWorkspaceNames = do-    lookup <- getWorkspaceNames'-    return $ \wks -> wks ++ maybe "" (':' :) (lookup wks)+-- | Returns a function for 'ppRename' that appends @sep@ and the workspace+-- name, if set.+getWorkspaceNames :: String -> X (String -> WindowSpace -> String)+getWorkspaceNames sep = ren <$> getWorkspaceNames'+  where+    ren name s w = s ++ maybe "" (sep ++) (name (W.tag w))  -- | Gets the name of a workspace, if set, otherwise returns nothing. getWorkspaceName :: WorkspaceId -> X (Maybe String)-getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'+getWorkspaceName w = ($ w) <$> getWorkspaceNames'  -- | Gets the name of the current workspace. See 'getWorkspaceName' getCurrentWorkspaceName :: X (Maybe String)-getCurrentWorkspaceName = do-    getWorkspaceName =<< gets (W.currentTag . windowset)+getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset)  -- | Sets the name of a workspace. Empty string makes the workspace unnamed -- again.@@ -130,26 +138,14 @@ -- | Prompt for a new name for the current workspace and set it. renameWorkspace :: XPConfig -> X () renameWorkspace conf = do-    mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName-    where pr = Wor "Workspace name: "---- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show--- workspace names as well.-workspaceNamesPP :: PP -> X PP-workspaceNamesPP pp = do-    names <- getWorkspaceNames-    return $-        pp {-            ppCurrent         = ppCurrent         pp . names,-            ppVisible         = ppVisible         pp . names,-            ppHidden          = ppHidden          pp . names,-            ppHiddenNoWindows = ppHiddenNoWindows pp . names,-            ppUrgent          = ppUrgent          pp . names-        }+    completion <- historyCompletionP conf (prompt ==)+    mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName+  where+    prompt = "Workspace name: "  -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. swapTo :: Direction1D -> X ()-swapTo dir = swapTo' dir AnyWS+swapTo dir = swapTo' dir anyWS  -- | Swap with the previous or next workspace of the given type. swapTo' :: Direction1D -> WSType -> X ()@@ -169,19 +165,27 @@     WorkspaceNames m <- XS.get     let getname w = fromMaybe "" $ M.lookup w m         set w name m' = if null name then M.delete w m' else M.insert w name m'-    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m+    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) m  -- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.-workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X ()+workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X () workspaceNamePrompt conf job = do-    myWorkspaces <- gets $ map W.tag . W.workspaces . windowset-    myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces-    let pairs = zip myWorkspacesName myWorkspaces+    myWorkspaces <- gets $ W.workspaces . windowset+    myWorkspacesName <- getWorkspaceNames ":" <&> \n -> [n (W.tag w) w | w <- myWorkspaces]+    let pairs = zip myWorkspacesName (map W.tag myWorkspaces)     mkXPrompt (Wor "Select workspace: ") conf               (contains myWorkspacesName)               (job . toWsId pairs)-  where toWsId pairs name = case lookup name pairs of-                                Nothing -> ""-                                Just i -> i+  where toWsId pairs name = fromMaybe "" (lookup name pairs)         contains completions input =-          return $ filter (Data.List.isInfixOf input) completions+          return $ filter (isInfixOf input) completions++-- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show+-- workspace names as well.+workspaceNamesPP :: PP -> X PP+workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren }++-- | Tell "XMonad.Hooks.EwmhDesktops" to append workspace names to desktop+-- names.+workspaceNamesEwmh :: XConfig l -> XConfig l+workspaceNamesEwmh = addEwmhWorkspaceRename $ getWorkspaceNames ":"
XMonad/Config/Arossato.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Config.Arossato+-- Description :  Andrea Rossato's xmonad configuration. -- Copyright   :  (c) Andrea Rossato 2007 -- License     :  BSD3-style (see LICENSE) --@@ -15,6 +16,7 @@ ------------------------------------------------------------------------  module XMonad.Config.Arossato+    {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-}     ( -- * Usage       -- $usage       arossatoConfig@@ -22,7 +24,7 @@  import qualified Data.Map as M -import XMonad hiding ( (|||) )+import XMonad import qualified XMonad.StackSet as W  import XMonad.Actions.CycleWS@@ -30,7 +32,6 @@ import XMonad.Hooks.ManageDocks import XMonad.Hooks.ServerMode import XMonad.Layout.Accordion-import XMonad.Layout.LayoutCombinators import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders import XMonad.Layout.SimpleFloat@@ -46,7 +47,7 @@  -- $usage -- The simplest way to use this configuration module is to use an--- @~\/.xmonad\/xmonad.hs@ like this:+-- @xmonad.hs@ like this: -- -- > module Main (main) where -- >@@ -63,7 +64,7 @@ -- -- You can use this module also as a starting point for writing your -- own configuration module from scratch. Save it as your--- @~\/.xmonad\/xmonad.hs@ and:+-- @xmonad.hs@ and: -- -- 1. Change the module name from --@@ -147,8 +148,8 @@           , ((modMask x              , xK_F3    ), shellPrompt       def                 )           , ((modMask x              , xK_F4    ), sshPrompt         def                 )           , ((modMask x              , xK_F5    ), themePrompt       def                 )-          , ((modMask x              , xK_F6    ), windowPromptGoto  def                 )-          , ((modMask x              , xK_F7    ), windowPromptBring def                 )+          , ((modMask x              , xK_F6    ), windowPrompt def Goto  allWindows     )+          , ((modMask x              , xK_F7    ), windowPrompt def Bring allWindows     )           , ((modMask x              , xK_comma ), prevWS                                )           , ((modMask x              , xK_period), nextWS                                )           , ((modMask x              , xK_Right ), windows W.focusDown                   )
XMonad/Config/Azerty.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Azerty+-- Description  : Fix some keybindings for users of French keyboard layouts. -- Copyright    : (c) Devin Mullins <me@twifkak.com> -- License      : BSD --@@ -26,7 +27,7 @@ import qualified Data.Map as M  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Azerty@@ -36,17 +37,17 @@ -- If you prefer, an azertyKeys function is provided which you can use as so: -- -- > import qualified Data.Map as M--- > main = xmonad someConfig { keys = \c -> azertyKeys c <+> keys someConfig c }+-- > main = xmonad someConfig { keys = \c -> azertyKeys c <> keys someConfig c } -azertyConfig = def { keys = azertyKeys <+> keys def }+azertyConfig = def { keys = azertyKeys <> keys def } -belgianConfig = def { keys = belgianKeys <+> keys def }+belgianConfig = def { keys = belgianKeys <> keys def }  azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]  belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0] -azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $+azertyKeysTop topRow conf@XConfig{modMask = modm} = M.fromList $     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]     ++     [((m .|. modm, k), windows $ f i)
XMonad/Config/Bepo.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Bepo+-- Description  : Fix keybindings for the BEPO keyboard layout. -- Copyright    : (c) Yorick Laupa <yo.eight@gmail.com> -- License      : BSD --@@ -25,7 +26,7 @@ import qualified Data.Map as M  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bepo@@ -37,11 +38,10 @@ -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c } -bepoConfig = def { keys = bepoKeys <+> keys def }+bepoConfig = def { keys = bepoKeys <> keys def } -bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $-    [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]-    ++-    [((m .|. modm, k), windows $ f i)-        | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],-          (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+bepoKeys conf@XConfig { modMask = modm } = M.fromList $+    ((modm, xK_semicolon), sendMessage (IncMasterN (-1)))+    : [((m .|. modm, k), windows $ f i)+          | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],+            (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
XMonad/Config/Bluetile.hs view
@@ -3,6 +3,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Config.Bluetile+-- Description :  Default configuration of [Bluetile](http://projects.haskell.org/bluetile/). -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -25,19 +26,18 @@     bluetileConfig     ) where -import XMonad hiding ( (|||) )+import XMonad  import XMonad.Layout.BorderResize-import XMonad.Layout.BoringWindows+import XMonad.Layout.BoringWindows hiding (Replace) import XMonad.Layout.ButtonDecoration import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Layout.DraggingVisualizer-import XMonad.Layout.LayoutCombinators import XMonad.Layout.Maximize import XMonad.Layout.Minimize import XMonad.Layout.MouseResizableTile-import XMonad.Layout.Named+import XMonad.Layout.Renamed import XMonad.Layout.NoBorders import XMonad.Layout.PositionStoreFloat import XMonad.Layout.WindowSwitcherDecoration@@ -62,11 +62,10 @@ import qualified Data.Map as M  import System.Exit-import Data.Monoid-import Control.Monad(when)+import XMonad.Prelude(when)  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bluetile@@ -82,7 +81,7 @@ bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]  bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())-bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $+bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $     -- launching and killing programs     [ ((modMask'              , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal     , ((modMask',               xK_p     ), gnomeRun)    --  %! Launch Gnome "Run application" dialog@@ -113,14 +112,14 @@      -- floating layer support     , ((modMask',               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling-    , ((modMask' .|. shiftMask, xK_t     ), withFocused $ float ) -- %! Float window+    , ((modMask' .|. shiftMask, xK_t     ), withFocused float ) -- %! Float window      -- increase or decrease number of windows in the master area     , ((modMask'              , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area     , ((modMask'              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area      -- quit, or restart-    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit+    , ((modMask' .|. shiftMask, xK_q     ), io exitSuccess) -- %! Quit     , ((modMask'              , xK_q     ), restart "xmonad" True) -- %! Restart      -- Metacity-like workspace switching@@ -160,19 +159,19 @@         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]  bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())-bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $+bluetileMouseBindings XConfig{XMonad.modMask = modMask'} = M.fromList     -- mod-button1 %! Move a floated window by dragging-    [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $-                                focus w >> mouseMoveWindow w >> windows W.shiftMaster))+    [ ((modMask', button1), \w -> isFloating w >>= \isF -> when isF $+                                focus w >> mouseMoveWindow w >> windows W.shiftMaster)     -- mod-button2 %! Switch to next and first layout-    , ((modMask', button2), (\_ -> sendMessage NextLayout))-    , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))+    , ((modMask', button2), \_ -> sendMessage NextLayout)+    , ((modMask' .|. shiftMask, button2), \_ -> sendMessage $ JumpToLayout "Floating")     -- mod-button3 %! Resize a floated window by dragging-    , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $-                                focus w >> mouseResizeWindow w >> windows W.shiftMaster))+    , ((modMask', button3), \w -> isFloating w >>= \isF -> when isF $+                                focus w >> mouseResizeWindow w >> windows W.shiftMaster)     ] -isFloating :: Window -> X (Bool)+isFloating :: Window -> X Bool isFloating w = do     ws <- gets windowset     return $ M.member w (W.floating ws)@@ -183,31 +182,28 @@                 , className =? "MPlayer" --> doFloat                 , isFullscreen --> doFullFloat] -bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (-                        named "Floating" floating |||-                        named "Tiled1" tiled1 |||-                        named "Tiled2" tiled2 |||-                        named "Fullscreen" fullscreen-                        )+bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $+                        renamed [Replace "Floating"] floating |||+                        renamed [Replace "Tiled1"] tiled1 |||+                        renamed [Replace "Tiled2"] tiled2 |||+                        renamed [Replace "Fullscreen"] fullscreen         where-            floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat-            tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored-            tiled2 = tilingDeco $ maximize $ mouseResizableTile+            floating = floatingDeco $ maximize $ borderResize positionStoreFloat+            tiled1 = tilingDeco $ maximize mouseResizableTileMirrored+            tiled2 = tilingDeco $ maximize mouseResizableTile             fullscreen = tilingDeco $ maximize $ smartBorders Full              tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)-            floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l+            floatingDeco = buttonDeco shrinkText defaultThemeWithButtons  bluetileConfig =-    docks $+    docks . ewmhFullscreen . ewmh $     def         { modMask = mod4Mask,   -- logo key           manageHook = bluetileManageHook,           layoutHook = bluetileLayoutHook,-          logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,-          handleEventHook = ewmhDesktopsEventHook-                                `mappend` fullscreenEventHook-                                `mappend` minimizeEventHook+          logHook = currentWorkspaceOnTop,+          handleEventHook = minimizeEventHook                                 `mappend` serverModeEventHook' bluetileCommands                                 `mappend` positionStoreEventHook,           workspaces = bluetileWorkspaces,
XMonad/Config/Desktop.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Desktop+-- Description  : Core settings for interfacing with desktop environments. -- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com> -- License      : BSD --@@ -23,7 +24,7 @@     -- specification. Extra xmonad settings unique to specific DE's are     -- added by overriding or modifying @desktopConfig@ fields in the     -- same way that the default configuration is customized in-    -- @~\/.xmonad/xmonad.hs@.+    -- @xmonad.hs@.     --     -- For more information about EWMH see:     --@@ -57,6 +58,7 @@ import XMonad import XMonad.Hooks.ManageDocks import XMonad.Hooks.EwmhDesktops+import XMonad.Layout.LayoutModifier (ModifiedLayout) import XMonad.Util.Cursor  import qualified Data.Map as M@@ -70,7 +72,7 @@ -- <http://haskell.org/haskellwiki/Xmonad> -- -- To configure xmonad for use with a DE or with DE tools like panels--- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@,+-- and pagers, in place of @def@ in your @xmonad.hs@, -- use @desktopConfig@ or one of the other desktop configs from the -- @XMonad.Config@ namespace. The following setup and customization examples -- work the same way for the other desktop configs as for @desktopConfig@.@@ -89,7 +91,7 @@  -- $customizing -- To customize a desktop config, modify its fields as is illustrated with--- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad".+-- the default configuration @def@ in <https://xmonad.org/TUTORIAL.html the tutorial>.  -- $layouts -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.@@ -104,7 +106,7 @@ -- > main = -- >   xmonad $ desktopConfig { -- >     -- add manage hooks while still ignoring panels and using default manageHooks--- >       manageHook = myManageHook <+> manageHook desktopConfig+-- >       manageHook = myManageHook <> manageHook desktopConfig -- > -- >     -- add a fullscreen tabbed layout that does not avoid covering -- >     -- up desktop panels before the desktop layouts@@ -127,7 +129,7 @@ -- To add to the logHook while still sending workspace and window information -- to DE apps use something like: ----- >  , logHook = myLogHook <+> logHook desktopConfig+-- >  , logHook = myLogHook <> logHook desktopConfig -- -- Or for more elaborate logHooks you can use @do@: --@@ -141,7 +143,7 @@ -- To customize xmonad's event handling while still having it respond -- to EWMH events from pagers, task bars: ----- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig+-- >  , handleEventHook = myEventHooks <> handleEventHook desktopConfig -- -- or 'mconcat' if you write a list event of event hooks --@@ -155,7 +157,7 @@  -- $startupHook -- To run the desktop startupHook, plus add further actions to be run each--- time xmonad starts or restarts, use '<+>' to combine actions as in the+-- time xmonad starts or restarts, use '<>' to combine actions as in the -- logHook example, or something like: -- -- >  , startupHook = do@@ -164,13 +166,16 @@ -- >        adjustEventInput -- +desktopConfig :: XConfig (ModifiedLayout AvoidStruts+                             (Choose Tall (Choose (Mirror Tall) Full))) desktopConfig = docks $ ewmh def-    { startupHook     = setDefaultCursor xC_left_ptr <+> startupHook def+    { startupHook     = setDefaultCursor xC_left_ptr <> startupHook def     , layoutHook      = desktopLayoutModifiers $ layoutHook def-    , keys            = desktopKeys <+> keys def }+    , keys            = desktopKeys <> keys def } -desktopKeys (XConfig {modMask = modm}) = M.fromList $+desktopKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X ())+desktopKeys XConfig{modMask = modm} = M.fromList     [ ((modm, xK_b), sendMessage ToggleStruts) ] -desktopLayoutModifiers layout = avoidStruts layout-+desktopLayoutModifiers :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a+desktopLayoutModifiers = avoidStruts
XMonad/Config/Dmwit.hs view
@@ -1,14 +1,16 @@ -- boilerplate {{{-{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}+{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}-module XMonad.Config.Dmwit where+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Dmwit+-- Description :  Daniel Wagner's xmonad configuration.+--+------------------------------------------------------------------------+module XMonad.Config.Dmwit {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} where  -- system imports-import Control.Applicative-import Control.Monad import Control.Monad.Trans-import Data.Char-import Data.List import Data.Map (Map, fromList) import Data.Ratio import Data.Word@@ -29,9 +31,10 @@ import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Layout.Grid-import XMonad.Layout.IndependentScreens+import XMonad.Layout.IndependentScreens hiding (withScreen) import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders+import XMonad.Prelude hiding (fromList) import XMonad.Util.Dzen hiding (x, y) import XMonad.Util.SpawnOnce -- }}}@@ -75,7 +78,7 @@     where     sign | n > 0 = "+" | otherwise = "-"     ctlKind      = map (\c -> if c == ' ' then '-' else c) kind-    parseKind    = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind+    parseKind    = unwords . map (\(notEmpty -> c :| cs) -> toUpper c : cs) . words $ kind     setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%"     listCommand  = "pactl list " ++ ctlKind ++ "s" -- }}}@@ -112,7 +115,6 @@         Just (16 :% 9)  -> viewFullOn 1 "5" win         _               -> doFloat     where-    fi               = fromIntegral :: Dimension -> Double     approx (n, d)    = approxRational (fi n / fi d) (1/100)  operationOn f s n w = do@@ -215,13 +217,13 @@     keys                    = keyBindings,     layoutHook              = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full,     manageHook              =     (title =? "CGoban: Main Window" --> doF sinkFocus)-                              <+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")-                              <+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")-                              <+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one-                              <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)-                              <+> fullscreenMPlayer-                              <+> floatAll ["Gimp", "Wine"]-                              <+> manageSpawn,+                              <> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")+                              <> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")+                              <> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <> compared to) this one+                              <> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)+                              <> fullscreenMPlayer+                              <> floatAll ["Gimp", "Wine"]+                              <> manageSpawn,     logHook                 = allPPs nScreens,     startupHook             = refresh                            >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]@@ -236,7 +238,7 @@     ((m .|. shiftMask  , xK_p          ), spawnHere termLauncher),     ((m .|. shiftMask  , xK_c          ), kill),     ((m                , xK_q          ), restart "xmonad" True),-    ((m .|. shiftMask  , xK_q          ), io (exitWith ExitSuccess)),+    ((m .|. shiftMask  , xK_q          ), io exitSuccess),     ((m                , xK_grave      ), sendMessage NextLayout),     ((m .|. shiftMask  , xK_grave      ), setLayout $ layoutHook conf),     ((m                , xK_o          ), sendMessage Toggle),@@ -306,7 +308,7 @@ color c = xmobarColor c ""  ppFocus s@(S s_) = whenCurrentOn s def {-    ppOrder  = \(_:_:windowTitle:_) -> [windowTitle],+    ppOrder  = \case{ _:_:windowTitle:_ -> [windowTitle]; _ -> [] },     ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")     } @@ -316,7 +318,7 @@     ppHiddenNoWindows   = color dark,     ppUrgent            = color "red",     ppSep               = "",-    ppOrder             = \(wss:_layout:_title:_) -> [wss],+    ppOrder             = \case{ wss:_layout:_title:_ -> [wss]; _ -> [] },     ppOutput            = appendFile (pipeName "workspaces" s_) . (++"\n")     } -- }}}
XMonad/Config/Droundy.hs view
@@ -1,25 +1,27 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- |+-- Module      :  XMonad.Config.Droundy+-- Description :  David Roundy's xmonad config. -- Copyright   :  (c) Spencer Janssen 2007 -- License     :  BSD3-style (see LICENSE) -- --------------------------------------------------------------------------module XMonad.Config.Droundy ( config, mytab ) where+module XMonad.Config.Droundy {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( config, mytab ) where -import XMonad hiding (keys, config, (|||))+import XMonad hiding (keys, config) import qualified XMonad (keys)  import qualified XMonad.StackSet as W import qualified Data.Map as M-import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import System.Exit ( exitSuccess )  import XMonad.Layout.Tabbed ( tabbed,                               shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) import XMonad.Layout.Combo ( combineTwo )-import XMonad.Layout.Named ( named )+import XMonad.Layout.Renamed ( Rename(Replace), renamed ) import XMonad.Layout.LayoutCombinators import XMonad.Layout.Square ( Square(Square) ) import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),@@ -39,8 +41,8 @@ import XMonad.Actions.CopyWindow ( kill1, copy ) import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,                                           selectWorkspace, renameWorkspace, removeWorkspace )-import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),-                                Direction1D( Prev, Next) )+import XMonad.Actions.CycleWS ( moveTo, hiddenWS, emptyWS,+                                Direction1D( Prev, Next), WSType ((:&:), Not) )  import XMonad.Hooks.ManageDocks ( avoidStruts, docks ) import XMonad.Hooks.EwmhDesktops ( ewmh )@@ -77,11 +79,11 @@     , ((modMask x,               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling      -- quit, or restart-    , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad+    , ((modMask x .|. shiftMask, xK_Escape), io exitSuccess) -- %! Quit xmonad     , ((modMask x              , xK_Escape), restart "xmonad" True) -- %! Restart xmonad -    , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)-    , ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS)+    , ((modMask x .|. shiftMask, xK_Right), moveTo Next $ hiddenWS :&: Not emptyWS)+    , ((modMask x .|. shiftMask, xK_Left), moveTo Prev $ hiddenWS :&: Not emptyWS)     , ((modMask x, xK_Right), sendMessage $ Go R)     , ((modMask x, xK_Left), sendMessage $ Go L)     , ((modMask x, xK_Up), sendMessage $ Go U)@@ -113,9 +115,9 @@     ]      ++-    zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])+    zip (map (modMask x,) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])     ++-    zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])+    zip (map (modMask x .|. shiftMask,) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])  config = docks $ ewmh def          { borderWidth = 1 -- Width of the window border in pixels.@@ -123,10 +125,10 @@          , layoutHook = showWName $ workspaceDir "~" $                         boringWindows $ smartBorders $ windowNavigation $                         maximizeVertical $ toggleLayouts Full $ avoidStruts $-                        named "tabbed" mytab |||-                        named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||-                        named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||-                        named "widescreen" ((mytab *||* mytab)+                        renamed [Replace "tabbed"] mytab |||+                        renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) |||+                        renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) |||+                        renamed [Replace "widescreen"] ((mytab *||* mytab)                                                 ****//* combineTwo Square mytab mytab) --   |||                         --mosaic 0.25 0.5          , terminal = "xterm" -- The preferred terminal program.
XMonad/Config/Example.hs view
@@ -28,9 +28,10 @@   -- simple overrides:   xmonad $ desktopConfig     { modMask    = mod4Mask -- Use the "Win" key for the mod key-    , manageHook = myManageHook <+> manageHook desktopConfig-    , layoutHook = desktopLayoutModifiers $ myLayouts-    , logHook    = dynamicLogString def >>= xmonadPropLog+    , manageHook = myManageHook <> manageHook desktopConfig+    , layoutHook = desktopLayoutModifiers myLayouts+    , logHook    = (dynamicLogString def >>= xmonadPropLog)+                    <> logHook desktopConfig     }      `additionalKeysP` -- Add some extra key bindings:@@ -68,11 +69,11 @@ -- Use the `xprop' tool to get the info you need for these matches. -- For className, use the second value that xprop gives you. myManageHook = composeOne-  [ className =? "Pidgin" -?> doFloat-  , className =? "XCalc"  -?> doFloat-  , className =? "mpv"    -?> doFloat+  -- Handle floating windows:+  [ transience            -- move transient windows to their parent   , isDialog              -?> doCenterFloat--    -- Move transient windows to their parent:-  , transience+  ] <> composeAll+  [ className =? "Pidgin" --> doFloat+  , className =? "XCalc"  --> doFloat+  , className =? "mpv"    --> doFloat   ]
XMonad/Config/Gnome.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Gnome+-- Description  : Config for integrating xmonad with GNOME. -- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com> -- License      : BSD --@@ -31,7 +32,7 @@ import System.Environment (getEnvironment)  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Gnome@@ -42,10 +43,10 @@  gnomeConfig = desktopConfig     { terminal = "gnome-terminal"-    , keys     = gnomeKeys <+> keys desktopConfig+    , keys     = gnomeKeys <> keys desktopConfig     , startupHook = gnomeRegister >> startupHook desktopConfig } -gnomeKeys (XConfig {modMask = modm}) = M.fromList $+gnomeKeys XConfig{modMask = modm} = M.fromList     [ ((modm, xK_p), gnomeRun)     , ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ] @@ -72,7 +73,7 @@ -- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string gnomeRegister :: MonadIO m => m () gnomeRegister = io $ do-    x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment+    x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment     whenJust x $ \sessionId -> safeSpawn "dbus-send"             ["--session"             ,"--print-reply=literal"
XMonad/Config/Kde.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Kde+-- Description  : Config for integrating xmonad with KDE. -- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com> -- License      : BSD --@@ -27,7 +28,7 @@ import qualified Data.Map as M  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Kde@@ -41,18 +42,18 @@  kdeConfig = desktopConfig     { terminal = "konsole"-    , keys     = kdeKeys <+> keys desktopConfig }+    , keys     = kdeKeys <> keys desktopConfig }  kde4Config = desktopConfig     { terminal = "konsole"-    , keys     = kde4Keys <+> keys desktopConfig }+    , keys     = kde4Keys <> keys desktopConfig } -kdeKeys (XConfig {modMask = modm}) = M.fromList $+kdeKeys XConfig{modMask = modm} = M.fromList     [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")     , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")     ] -kde4Keys (XConfig {modMask = modm}) = M.fromList $+kde4Keys XConfig{modMask = modm} = M.fromList     [ ((modm,               xK_p), spawn "krunner")     , ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")     ]
XMonad/Config/Mate.hs view
@@ -1,8 +1,11 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-+-- TODO: Remove when we depend on a version of xmonad that has unGrab.+{-# OPTIONS_GHC -Wno-deprecations  #-}+{-# OPTIONS_GHC -Wno-dodgy-imports #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Mate+-- Description  : Config for integrating xmonad with MATE. -- Copyright    : (c) Brandon S Allbery KF8NH, 2014 -- License      : BSD --@@ -20,20 +23,24 @@     -- $usage     mateConfig,     mateRun,+    matePanel,     mateRegister,+    mateLogout,+    mateShutdown,     desktopLayoutModifiers     ) where -import XMonad-import XMonad.Config.Desktop-import XMonad.Util.Run (safeSpawn)-+import System.Environment (getEnvironment) import qualified Data.Map as M -import System.Environment (getEnvironment)+import XMonad hiding (unGrab)+import XMonad.Config.Desktop+import XMonad.Prelude (toUpper)+import XMonad.Util.Run (safeSpawn)+import XMonad.Util.Ungrab (unGrab)  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Mate@@ -44,24 +51,32 @@  mateConfig = desktopConfig     { terminal = "mate-terminal"-    , keys     = mateKeys <+> keys desktopConfig+    , keys     = mateKeys <> keys desktopConfig     , startupHook = mateRegister >> startupHook desktopConfig } -mateKeys (XConfig {modMask = modm}) = M.fromList $+mateKeys XConfig{modMask = modm} = M.fromList     [ ((modm, xK_p), mateRun)-    , ((modm .|. shiftMask, xK_q), spawn "mate-session-save --logout-dialog") ]+    , ((modm, xK_d), unGrab >> matePanel "MAIN_MENU")+    , ((modm .|. shiftMask, xK_q), mateLogout) ]  -- | Launch the "Run Application" dialog.  mate-panel must be running for this--- to work.+-- to work.  partial application for existing keybinding compatibility. mateRun :: X ()-mateRun = withDisplay $ \dpy -> do+mateRun = matePanel "RUN_DIALOG"++-- | Launch a panel action. Either the "Run Application" dialog ("run_dialog" parameter,+-- see above) or the main menu ("main_menu" parameter).  mate-panel must be running+-- for this to work.+matePanel :: String -> X ()+matePanel action = withDisplay $ \dpy -> do+    let panel = "_MATE_PANEL_ACTION"     rw <- asks theRoot-    mate_panel <- getAtom "_MATE_PANEL_ACTION"-    panel_run  <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG"+    mate_panel <- getAtom panel+    panel_action <- getAtom (panel ++ "_" ++ map toUpper action)      io $ allocaXEvent $ \e -> do         setEventType e clientMessage-        setClientMessageEvent e rw mate_panel 32 panel_run 0+        setClientMessageEvent e rw mate_panel 32 panel_action 0         sendEvent dpy rw False structureNotifyMask e         sync dpy False @@ -77,7 +92,7 @@ -- (the extra quotes are required by dconf) mateRegister :: MonadIO m => m () mateRegister = io $ do-    x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment+    x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment     whenJust x $ \sessionId -> safeSpawn "dbus-send"             ["--session"             ,"--print-reply=literal"@@ -86,3 +101,12 @@             ,"org.mate.SessionManager.RegisterClient"             ,"string:xmonad"             ,"string:"++sessionId]++-- | Display MATE logout dialog. This is the default mod-q action.+mateLogout :: MonadIO m => m ()+mateLogout = spawn "mate-session-save --logout-dialog"++-- | Display MATE shutdown dialog. You can override mod-q to invoke this, or bind it+-- to another key if you prefer.+mateShutdown :: MonadIO m => m ()+mateShutdown = spawn "mate-session-save --shutdown-dialog"
XMonad/Config/Prime.hs view
@@ -1,8 +1,10 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Config.Prime+-- Description :  Draft of a brand new config syntax for xmonad. -- Copyright   :  Devin Mullins <devin.mullins@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -22,7 +24,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Config.Prime (+module XMonad.Config.Prime {-# DEPRECATED "This module is a perpetual draft and will therefore be removed from xmonad-contrib in the near future." #-} ( -- Note: The identifiers here are listed in the order that makes the most sense -- for a user, while the definitions below are listed in the order that makes -- the most sense for a developer.@@ -115,7 +117,7 @@ import Prelude hiding ((>>), mod) import qualified Prelude as P ((>>=), (>>)) -import Data.Monoid (All)+import XMonad.Prelude (All)  import XMonad hiding (xmonad, XConfig(..)) import XMonad (XConfig(XConfig))@@ -125,7 +127,7 @@ import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings)  -- $start_here--- To start with, create a @~\/.xmonad\/xmonad.hs@ that looks like this:+-- To start with, create a @xmonad.hs@ that looks like this: -- -- > {-# LANGUAGE RebindableSyntax #-} -- > import XMonad.Config.Prime@@ -279,7 +281,7 @@ -- -- Note that operator precedence mandates the parentheses here. manageHook :: Summable ManageHook ManageHook (XConfig l)-manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<+>)+manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<>)  -- | Custom X event handler. Return @All True@ if the default handler should -- also be run afterwards. Default does nothing. To add an event handler:@@ -288,7 +290,7 @@ -- > ... -- >   handleEventHook =+ serverModeEventHook handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)-handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<+>)+handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<>)  -- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding -- appends to the end:@@ -387,7 +389,7 @@   MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings  -- | Mouse button bindings to an 'X' actions on a window. Default: see @`man--- xmonad`@. To make mod-<scrollwheel> switch workspaces:+-- xmonad`@. To make @mod-\<scrollwheel\>@ switch workspaces: -- -- > import XMonad.Actions.CycleWS (nextWS, prevWS) -- > ...@@ -478,7 +480,7 @@ -- >     wsSetName 1 "mail" -- >     wsSetName 2 "web" wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig-wsSetName index newName = wsNames =. (map maybeSet . zip [0..])+wsSetName index newName = wsNames =. zipWith (curry maybeSet) [0..]   where maybeSet (i, oldName) | i == (index - 1) = newName                               | otherwise = oldName @@ -497,8 +499,8 @@ withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf   where sprime :: ScreenConfig -> Prime l l         sprime sconf =-          (keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),-                                               (mod, action) <- sActions_ sconf])+          keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),+                                              (mod, action) <- sActions_ sconf]  data ScreenConfig = ScreenConfig {   sKeys_ :: [String],
XMonad/Config/Sjanssen.hs view
@@ -1,5 +1,11 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module XMonad.Config.Sjanssen (sjanssenConfig) where+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Sjanssen+-- Description :  Spencer Janssen's xmonad config.+--+------------------------------------------------------------------------+module XMonad.Config.Sjanssen {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} (sjanssenConfig) where  import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W@@ -24,10 +30,10 @@     docks $ ewmh $ def         { terminal = "exec urxvt"         , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]-        , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $-                [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))-                , ((modm, button2), (\w -> focus w >> windows W.swapMaster))-                , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]+        , mouseBindings = \XConfig {modMask = modm} -> M.fromList+                [ ((modm, button1), \w -> focus w >> mouseMoveWindow w)+                , ((modm, button2), \w -> focus w >> windows W.swapMaster)+                , ((modm.|. shiftMask, button1), \w -> focus w >> mouseResizeWindow w) ]         , keys = \c -> mykeys c `M.union` keys def c         , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog         , layoutHook  = modifiers layouts@@ -35,8 +41,8 @@                                     | (x, w) <- [ ("Firefox", "web")                                                 , ("Ktorrent", "7")                                                 , ("Amarokapp", "7")]]-                        <+> manageHook def <+> manageSpawn-                        <+> (isFullscreen --> doFullFloat)+                        <> manageHook def <> manageSpawn+                        <> (isFullscreen --> doFullFloat)         , startupHook = mapM_ spawnOnce spawns         }  where@@ -50,12 +56,12 @@              , "trayer --transparent true --expand true --align right "                ++ "--edge bottom --widthtype request" ] -    mykeys (XConfig {modMask = modm}) = M.fromList $+    mykeys XConfig{modMask = modm} = M.fromList         [((modm,               xK_p     ), shellPromptHere myPromptConfig)         ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))         ,((modm .|. shiftMask, xK_c     ), kill1)         ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)-        ,((modm .|. shiftMask, xK_0     ), windows $ copyToAll)+        ,((modm .|. shiftMask, xK_0     ), windows copyToAll)         ,((modm,               xK_z     ), layoutScreens 2 $ TwoPane 0.5 0.5)         ,((modm .|. shiftMask, xK_z     ), rescreen)         , ((modm             , xK_b     ), sendMessage ToggleStruts)
XMonad/Config/Xfce.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Xfce+-- Description  : Config for integrating xmonad with Xfce. -- Copyright    : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com> -- License      : BSD --@@ -26,7 +27,7 @@ import qualified Data.Map as M  -- $usage--- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Xfce@@ -36,10 +37,10 @@ -- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop".  xfceConfig = desktopConfig-    { terminal = "Terminal"-    , keys     = xfceKeys <+> keys desktopConfig }+    { terminal = "xfce4-terminal"+    , keys     = xfceKeys <> keys desktopConfig } -xfceKeys (XConfig {modMask = modm}) = M.fromList $+xfceKeys XConfig{modMask = modm} = M.fromList     [ ((modm,               xK_p), spawn "xfrun4")     , ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")     , ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")
XMonad/Doc/Configuring.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Doc.Configuring+-- Description :  Brief xmonad tutorial. -- Copyright   :  (C) 2007 Don Stewart and Andrea Rossato -- License     :  BSD3 --@@ -8,11 +9,14 @@ -- Stability   :  unstable -- Portability :  portable ----- This is a brief tutorial that will teach you how to create a--- basic xmonad configuration.+-- This is a brief tutorial that will teach you how to create a basic+-- xmonad configuration.  For a more comprehensive tutorial, see the+-- <https://xmonad.org/TUTORIAL.html xmonad website>. -- -- For more detailed instructions on extending xmonad with the--- xmonad-contrib library, see "XMonad.Doc.Extending".+-- xmonad-contrib library, see+-- <https://xmonad.org/TUTORIAL.html the tutorial>+-- and "XMonad.Doc.Extending". -- ----------------------------------------------------------------------------- @@ -148,4 +152,3 @@ is started.  -}-
XMonad/Doc/Developing.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Doc.Developing+-- Description :  Brief overview of the xmonad internals. -- Copyright   :  (C) 2007 Andrea Rossato -- License     :  BSD3 --@@ -67,6 +68,11 @@ --------------------------------------------------------------------------------  {- $writing++Here are some libraries that may be useful when writing your own module:++  - XMonad.Prelude: Re-export commonly used functions from prelude, as+    well as some xmonad-specific helpers. -}  {- $xmonad-libs@@ -80,7 +86,7 @@  Basically, xmonad and the xmonad-contrib libraries let users write their own window manager in just a few lines of code. While-@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration+@xmonad.hs@ at first seems to be simply a configuration file, it is actually a complete Haskell program which uses the xmonad and xmonad-contrib libraries to create a custom window manager. @@ -100,13 +106,13 @@ xmonad installs a binary, @xmonad@, which must be executed by the Xsession starting script. This binary, whose code can be read in @Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile'-to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@.+to run @ghc@ in order to build a binary from @xmonad.hs@. If this compilation process fails, for any reason, a default @main@ entry point will be used, which calls the 'XMonad.Main.xmonad' function with a default configuration.  Thus, the real @main@ entry point, the one that even the users' custom-window manager application in @~\/.xmonad\/xmonad.hs@ must call, is+window manager application in @xmonad.hs@ must call, is the 'XMonad.Main.xmonad' function. This function takes a configuration as its only argument, whose type ('XMonad.Core.XConfig') is defined in "XMonad.Core".@@ -243,32 +249,13 @@  {- $style -These are the coding guidelines for contributing to xmonad and the-xmonad contributed extensions.--* Comment every top level function (particularly exported funtions), and-  provide a type signature.--* Use Haddock syntax in the comments (see below).--* Follow the coding style of the other modules.--* Code should be compilable with "ghc-options: -Wall -Werror" set in the-xmonad-contrib.cabal file. There should be no warnings.--* Code should be free of any warnings or errors from the Hlint tool; use your-  best judgement on some warnings like eta-reduction or bracket removal, though.--* Partial functions should be avoided: the window manager should not-  crash, so never call 'error' or 'undefined'.--* Tabs are /illegal/. Use 4 spaces for indenting.--* Any pure function added to the core must have QuickCheck properties-  precisely defining its behaviour. Tests for everything else are encouraged.+For coding style guidelines while contributing, please see the+<https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md#style-guidelines style guidelines>+of xmonad's CONTRIBUTING.md. -For examples of Haddock documentation syntax, have a look at other-extensions.  Important points are:+For examples of Haddock documentation syntax, have a look at+<https://haskell-haddock.readthedocs.io/en/latest/markup.html its documentation>+or other extensions.  Important points are:  * Every exported function (or even better, every function) should have   a Haddock comment explaining what it does, and providing examples.@@ -285,10 +272,17 @@  To generate and view the Haddock documentation for your extension, run -> runhaskell Setup haddock+> stack haddock --no-haddock-deps -and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@.+If the builds succeeds, at the end stack should tell you where the+generated @index.html@ is located. +Alternatively, you can also run++> cabal haddock++to similar effect.+ For more information, see the Haddock documentation: <http://www.haskell.org/haddock/doc/html/index.html>. @@ -301,6 +295,6 @@ {- $license  New modules should identify the author, and be submitted under the-same license as xmonad (BSD3 license or freer).+same license as xmonad (BSD3).  -}
XMonad/Doc/Extending.hs view
@@ -1,1725 +1,696 @@--------------------------------------------------------------------------------- |--- Module      :  XMonad.Doc.Extending--- Copyright   :  (C) 2007 Andrea Rossato--- License     :  BSD3------ Maintainer  :  andrea.rossato@unibz.it--- Stability   :  unstable--- Portability :  portable------ This module documents the xmonad-contrib library and--- how to use it to extend the capabilities of xmonad.------ Reading this document should not require a deep knowledge of--- Haskell; the examples are intended to be useful and understandable--- for those users who do not know Haskell and don't want to have to--- learn it just to configure xmonad.  You should be able to get by--- just fine by ignoring anything you don't understand and using the--- provided examples as templates.  However, relevant Haskell features--- are discussed when appropriate, so this document will hopefully be--- useful for more advanced Haskell users as well.------ Those wishing to be totally hardcore and develop their own xmonad--- extensions (it's easier than it sounds, we promise!) should read--- the documentation in "XMonad.Doc.Developing".------ More configuration examples may be found on the Haskell wiki:------ <http://haskell.org/haskellwiki/Xmonad/Config_archive>-----------------------------------------------------------------------------------module XMonad.Doc.Extending-    (-    -- * The xmonad-contrib library-    -- $library--    -- ** Actions-    -- $actions--    -- ** Configurations-    -- $configs--    -- ** Hooks-    -- $hooks--    -- ** Layouts-    -- $layouts--    -- ** Prompts-    -- $prompts--    -- ** Utilities-    -- $utils--    -- * Extending xmonad-    -- $extending--    -- ** Editing key bindings-    -- $keys--    -- *** Adding key bindings-    -- $keyAdding--    -- *** Removing key bindings-    -- $keyDel--    -- *** Adding and removing key bindings-    -- $keyAddDel--    -- ** Editing mouse bindings-    -- $mouse--    -- ** Editing the layout hook-    -- $layoutHook--    -- ** Editing the manage hook-    -- $manageHook--    -- ** The log hook and external status bars-    -- $logHook-    ) where----------------------------------------------------------------------------------------  The XmonadContrib Library--------------------------------------------------------------------------------------{- $library--The xmonad-contrib (xmc) library is a set of extension modules-contributed by xmonad hackers and users, which provide additional-xmonad features.  Examples include various layout modes (tabbed,-spiral, three-column...), prompts, program launchers, the ability to-manipulate windows and workspaces in various ways, alternate-navigation modes, and much more.  There are also \"meta-modules\"-which make it easier to write new modules and extensions.--This is a concise yet complete overview of the xmonad-contrib modules.-For more information about any particular module, just click on its-name to view its Haddock documentation; each module should come with-extensive documentation.  If you find a module that could be better-documented, or has incorrect documentation, please report it as a bug-(<https://github.com/xmonad/xmonad/issues>)!---}--{- $actions--In the @XMonad.Actions@ namespace you can find modules exporting-various functions that are usually intended to be bound to key-combinations or mouse actions, in order to provide functionality-beyond the standard keybindings provided by xmonad.--See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to-edit your key bindings.--* "XMonad.Actions.AfterDrag":-    Allows you to add actions dependent on the current mouse drag.--* "XMonad.Actions.BluetileCommands":-    External commands for interfacing the [Bluetile](https://hackage.haskell.org/package/bluetile)-    tiling window manager with Xmonad.--* "XMonad.Actions.Commands":-    Allows you to run internal xmonad commands (X () actions) using-    a dmenu menu in addition to key bindings.  Requires dmenu and-    the Dmenu XMonad.Actions module.--* "XMonad.Actions.ConstrainedResize":-    Lets you constrain the aspect ratio of a floating-    window (by, say, holding shift while you resize).-    Useful for making a nice circular XClock window.--* "XMonad.Actions.CopyWindow":-    Provides bindings to duplicate a window on multiple workspaces,-    providing dwm-like tagging functionality.--* "XMonad.Actions.CycleRecentWS":-    Provides bindings to cycle through most recently used workspaces-    with repeated presses of a single key (as long as modifier key is-    held down). This is similar to how many window managers handle-    window switching.--* "XMonad.Actions.CycleSelectedLayouts":-    This module allows to cycle through the given subset of layouts.--* "XMonad.Actions.CycleWS":-    Provides bindings to cycle forward or backward through the list of-    workspaces, to move windows between workspaces, and to cycle-    between screens. Replaces the former XMonad.Actions.RotView.--* "XMonad.Actions.CycleWindows":-    Provides bindings to cycle windows up or down on the current workspace-    stack while maintaining focus in place.--* "XMonad.Actions.DeManage":-    This module provides a method to cease management of a window-    without unmapping it. "XMonad.Hooks.ManageDocks" is a-    more automated solution if your panel supports it.--* "XMonad.Actions.DwmPromote":-    Dwm-like swap function for xmonad.-    Swaps focused window with the master window. If focus is in the-    master, swap it with the next window in the stack. Focus stays in the-    master.--* "XMonad.Actions.DynamicProjects":-    Imbues workspaces with additional features so they can be treated as-    individual project areas.--* "XMonad.Actions.DynamicWorkspaceGroups":-    Dynamically manage "workspace groups", sets of workspaces being used-    together for some common task or purpose, to allow switching between-    workspace groups in a single action. Note that this only makes sense for-    multi-head setups.--* "XMonad.Actions.DynamicWorkspaceOrder":-    Remember a dynamically updateable ordering on workspaces, together with-    tools for using this ordering with "XMonad.Actions.CycleWS" and "XMonad.Hooks.DynamicLog".--* "XMonad.Actions.DynamicWorkspaces":-    Provides bindings to add and delete workspaces.  Note that you may only-    delete a workspace that is already empty.--* "XMonad.Actions.FindEmptyWorkspace":-    Find an empty workspace.--* "XMonad.Actions.FlexibleManipulate":-    Move and resize floating windows without warping the mouse.--* "XMonad.Actions.FlexibleResize":-    Resize floating windows from any corner.--* "XMonad.Actions.FloatKeys":-    Move and resize floating windows.--* "XMonad.Actions.FloatSnap":-    Move and resize floating windows using other windows and the edge of the-    screen as guidelines.--* "XMonad.Actions.FocusNth":-    Focus the nth window of the current workspace.--* "XMonad.Actions.GridSelect":-    GridSelect displays items(e.g. the opened windows) in a 2D grid and lets-    the user select from it with the cursor/hjkl keys or the mouse.--* "XMonad.Actions.GroupNavigation":-    Provides methods for cycling through groups of windows across workspaces,-    ignoring windows that do not belong to this group. A group consists of all-    windows matching a user-provided boolean query. Also provides a method for-    jumping back to the most recently used window in any given group.--* "XMonad.Actions.KeyRemap":-    Remap Keybinding on the fly, e.g having Dvorak char,-    but everything with Control/Shift is left US Layout.--* "XMonad.Actions.Launcher":-    A set of prompts for XMonad.--* "XMonad.Actions.LinkWorkspaces":-    Provides bindings to add and delete links between workspaces. It is aimed at-    providing useful links between workspaces in a multihead setup.-    Linked workspaces are view at the same time.--* "XMonad.Actions.MessageFeedback":-    Alternative to 'XMonad.Operations.sendMessage' that provides knowledge-    of whether the message was handled, and utility functions based on-    this facility.--* "XMonad.Actions.MouseGestures":-    Support for simple mouse gestures.--* "XMonad.Actions.MouseResize":-    A layout modifier to resize windows with the mouse by grabbing the-    window's lower right corner.--* "XMonad.Actions.Navigation2D":-    Navigation2D is an xmonad extension that allows easy directional navigation-    of windows and screens (in a multi-monitor setup).--* "XMonad.Actions.NoBorders":-    This module provides helper functions for dealing with window borders.--* "XMonad.Actions.OnScreen":-    Control workspaces on different screens (in xinerama mode).--* "XMonad.Actions.PerWorkspaceKeys":-    Define key-bindings on per-workspace basis.--* "XMonad.Actions.PhysicalScreens":-    Manipulate screens ordered by physical location instead of ID--* "XMonad.Actions.Plane":-    This module has functions to navigate through workspaces in a bidimensional-    manner.--* "XMonad.Actions.Promote":-    Alternate promote function for xmonad.--* "XMonad.Actions.RandomBackground":-    An action to start terminals with a random background color--* "XMonad.Actions.RotSlaves":-    Rotate all windows except the master window and keep the focus in-    place.--* "XMonad.Actions.Search":-    A module for easily running Internet searches on web sites through xmonad.-    Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.--* "XMonad.Actions.ShowText":-    ShowText displays text for sometime on the screen similar to-    "XMonad.Util.Dzen" which offers more features (currently).--* "XMonad.Actions.SimpleDate":-    An example external contrib module for XMonad.-    Provides a simple binding to dzen2 to print the date as a popup menu.--* "XMonad.Actions.SinkAll":-    (Deprecated) Provides a simple binding that pushes all floating windows on the-    current workspace back into tiling. Instead, use the more general-    "XMonad.Actions.WithAll"--* "XMonad.Actions.SpawnOn":-    Provides a way to modify a window spawned by a command(e.g shift it to the workspace-    it was launched on) by using the _NET_WM_PID property that most windows set on creation.--* "XMonad.Actions.Submap":-    A module that allows the user to create a sub-mapping of key bindings.--* "XMonad.Actions.SwapWorkspaces":-    Lets you swap workspace tags, so you can keep related ones next to-    each other, without having to move individual windows.--* "XMonad.Actions.TagWindows":-    Functions for tagging windows and selecting them by tags.--* "XMonad.Actions.TopicSpace":-    Turns your workspaces into a more topic oriented system.--* "XMonad.Actions.TreeSelect":-    TreeSelect displays your workspaces or actions in a Tree-like format.-    You can select the desired workspace/action with the cursor or hjkl keys.-    This module is fully configurable and very useful if you like to have a-    lot of workspaces.--* "XMonad.Actions.UpdateFocus":-    Updates the focus on mouse move in unfocused windows.--* "XMonad.Actions.UpdatePointer":-    Causes the pointer to follow whichever window focus changes to.--* "XMonad.Actions.Warp":-    Warp the pointer to a given window or screen.--* "XMonad.Actions.WindowBringer":-    dmenu operations to bring windows to you, and bring you to windows.-    That is to say, it pops up a dmenu with window names, in case you forgot-    where you left your XChat.--* "XMonad.Actions.WindowGo":-    Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query-    monad, such as 'runOrRaise'.--* "XMonad.Actions.WindowMenu":-    Uses "XMonad.Actions.GridSelect" to display a number of actions related to-    window management in the center of the focused window.--* "XMonad.Actions.WindowNavigation":-    Experimental rewrite of "XMonad.Layout.WindowNavigation".--* "XMonad.Actions.WithAll":-    Provides functions for performing a given action on all windows of-    the current workspace.--* "XMonad.Actions.Workscreen":-    A workscreen permits to display a set of workspaces on several screens. In-    xinerama mode, when a workscreen is viewed, workspaces associated to all-    screens are visible. The first workspace of a workscreen is displayed on-    first screen, second on second screen, etc. Workspace position can be easily-    changed. If the current workscreen is called again, workspaces are shifted.-    This also permits to see all workspaces of a workscreen even if just one screen-    is present, and to move windows from workspace to workscreen.--* "XMonad.Actions.WorkspaceCursors":-    Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.--* "XMonad.Actions.WorkspaceNames":-    Provides bindings to rename workspaces, show these names in DynamicLog and-    swap workspaces along with their names. These names survive restart. Together-    with "XMonad.Layout.WorkspaceDir" this provides for a fully dynamic topic-    space workflow.--}--{- $configs--In the @XMonad.Config@ namespace you can find modules exporting the-configurations used by some of the xmonad and xmonad-contrib-developers.  You can look at them for examples while creating your own-configuration; you can also simply import them and use them as your-own configuration, possibly with some modifications.---* "XMonad.Config.Arossato":-    This module specifies my xmonad defaults.--* "XMonad.Config.Azerty":-    Fixes some keybindings for users of French keyboard layouts.--* "XMonad.Config.Bepo":-    This module fixes some of the keybindings for the francophone among you who-    use a BEPO keyboard layout. Based on "XMonad.Config.Azerty".--* "XMonad.Config.Bluetile":-    This is the default configuration of [Bluetile](http://projects.haskell.org/bluetile/).-    If you are migrating from Bluetile to xmonad or want to create a similar setup,-    then this will give you pretty much the same thing, except for Bluetile's-    helper applications such as the dock.--* "XMonad.Config.Desktop":-    This module provides core desktop environment settings used-    in the Gnome, Kde, and Xfce config configs. It is also useful-    for people using other environments such as lxde, or using-    tray or panel applications without full desktop environments.--* "XMonad.Config.Dmwit":-    [dmwit](https://github.com/dmwit)'s xmonad configs and helpers.--* "XMonad.Config.Droundy":-    Droundy's xmonad config.--* "XMonad.Config.Gnome":-    This module provides a config suitable for use with the GNOME desktop environment.--* "XMonad.Config.Kde":-    This module provides a config suitable for use with the KDE desktop environment.--* "XMonad.Config.Mate":-    This module provides a config suitable for use with the MATE desktop environment.--* "XMonad.Config.Prime":-    This is a draft of a brand new config syntax for xmonad. It aims to be-    1) easier to copy/paste snippets from the docs 2) easier to get the gist-    for what's going on, for you imperative programmers. It's brand new, so it's-    pretty much guaranteed to break or change syntax. But what's the worst that-    could happen? Xmonad crashes and logs you out? It probably won't do that.-    Give it a try.--* "XMonad.Config.Sjanssen":-    [spencerjanssen](https://github.com/spencerjanssen)'s xmonad configs.--* "XMonad.Config.Xfce":-    This module provides a config suitable for use with the Xfce desktop environment.---}--{- $hooks--In the @XMonad.Hooks@ namespace you can find modules exporting-hooks. Hooks are actions that xmonad performs when certain events-occur. The two most important hooks are:--* 'XMonad.Core.manageHook': this hook is called when a new window-  xmonad must take care of is created. This is a very powerful hook,-  since it lets us examine the new window's properties and act-  accordingly. For instance, we can configure xmonad to put windows-  belonging to a given application in the float layer, not to manage-  dock applications, or open them in a given workspace. See-  "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on-  customizing 'XMonad.Core.manageHook'.--* 'XMonad.Core.logHook': this hook is called when the stack of windows-  managed by xmonad has been changed, by calling the-  'XMonad.Operations.windows' function. For instance-  "XMonad.Hooks.DynamicLog" will produce a string (whose format can be-  configured) to be printed to the standard output. This can be used-  to display some information about the xmonad state in a status bar.-  See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more-  information.--* 'XMonad.Core.handleEventHook': this hook is called on all events handled-  by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras"-  and xmonad source and development documentation for more details.--Here is a list of the modules found in @XMonad.Hooks@:--* "XMonad.Hooks.CurrentWorkspaceOnTop":-    Ensures that the windows of the current workspace are always in front of-    windows that are located on other visible screens. This becomes important if-    you use decoration and drag windows from one screen to another.-    Using this module, the dragged window will always be in front of other windows.--* "XMonad.Hooks.DebugEvents":-    Module to dump diagnostic information about X11 events received by xmonad.-    This is incomplete due to "Event" being incomplete and not providing-    information about a number of events, and enforcing artificial constraints-    on others (for example ClientMessage); the X11 package will require a number-    of changes to fix these problems.--* "XMonad.Hooks.DebugKeyEvents":-    A debugging module to track key events, useful when you can't tell whether-    xmonad is processing some or all key events.--* "XMonad.Hooks.DebugStack":-    Dump the state of the StackSet. A logHook and handleEventHook are also provided.--* "Xmonad.Hooks.DynamicBars":-    Manage per-screen status bars.--* "XMonad.Hooks.DynamicHooks":-    One-shot and permanent ManageHooks that can be updated at runtime.--* "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send-  information about xmonad's state to standard output, suitable for-  putting in a status bar of some sort. See-  "XMonad.Doc.Extending#The_log_hook_and_external_status_bars".--* "XMonad.Hooks.EwmhDesktops":-    Makes xmonad use the EWMH hints to tell panel applications about its-    workspaces and the windows therein. It also allows the user to interact-    with xmonad by clicking on panels and window lists.--* "XMonad.Hooks.FadeInactive":-    Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,-    which causes those windows to become slightly translucent if something-    like xcompmgr is running--* "XMonad.Hooks.FadeWindows":-    A more flexible and general compositing interface than FadeInactive. Windows-    can be selected and opacity specified by means of FadeHooks, which are very-    similar to ManageHooks and use the same machinery.--* "XMonad.Hooks.FloatNext":-    Hook and keybindings for automatically sending the next-    spawned window(s) to the floating layer.--* "XMonad.Hooks.ICCCMFocus":-    Deprecated.--* "XMonad.Hooks.InsertPosition":-    Configure where new windows should be added and which window should be-    focused.--* "XMonad.Hooks.ManageDebug":-    A manageHook and associated logHook for debugging "ManageHooks". Simplest-    usage: wrap your xmonad config in the debugManageHook combinator. Or use-    debugManageHookOn for a triggerable version, specifying the triggering key-    sequence in "EZConfig" syntax. Or use the individual hooks in whatever way you see fit.--* "XMonad.Hooks.ManageDocks":-    This module provides tools to automatically manage 'dock' type programs,-    such as gnome-panel, kicker, dzen, and xmobar.--* "XMonad.Hooks.ManageHelpers": provide helper functions to be used-  in @manageHook@.--* "XMonad.Hooks.Minimize":-    Handles window manager hints to minimize and restore windows. Use-    this with XMonad.Layout.Minimize.--* "XMonad.Hooks.Place":-    Automatic placement of floating windows.--* "XMonad.Hooks.PositionStoreHooks":-    This module contains two hooks for the PositionStore (see XMonad.Util.PositionStore) --    a ManageHook and an EventHook. The ManageHook can be used to fill the-    PositionStore with position and size information about new windows. The advantage-    of using this hook is, that the information is recorded independent of the-    currently active layout. So the floating shape of the window can later be restored-    even if it was opened in a tiled layout initially. The EventHook makes sure-    that windows are deleted from the PositionStore when they are closed.--* "XMonad.Hooks.RestoreMinimized":-    (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized-    windows (see "XMonad.Layout.Minimize") by selecting them on a-    taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).--* "XMonad.Hooks.ScreenCorners":-    Run X () actions by touching the edge of your screen with your mouse.--* "XMonad.Hooks.Script":-    Provides a simple interface for running a ~\/.xmonad\/hooks script with the-    name of a hook.--* "XMonad.Hooks.ServerMode":-    Allows sending commands to a running xmonad process.--* "XMonad.Hooks.SetWMName":-    Sets the WM name to a given string, so that it could be detected using-    _NET_SUPPORTING_WM_CHECK protocol.  May be useful for making Java GUI-    programs work.--* "XMonad.Hooks.ToggleHook":-    Hook and keybindings for toggling hook behavior.--* "XMonad.Hooks.UrgencyHook":-    UrgencyHook lets you configure an action to occur when a window demands-    your attention. (In traditional WMs, this takes the form of \"flashing\"-    on your \"taskbar.\" Blech.)--* "XMonad.Hooks.WallpaperSetter":-    Log hook which changes the wallpapers depending on visible workspaces.--* "XMonad.Hooks.WorkspaceByPos":-    Useful in a dual-head setup: Looks at the requested geometry of-    new windows and moves them to the workspace of the non-focused-    screen if necessary.--* "XMonad.Hooks.WorkspaceHistory":-    Keeps track of workspace viewing order.--* "XMonad.Hooks.XPropManage":-    A ManageHook matching on XProperties.---}--{- $layouts--In the @XMonad.Layout@ namespace you can find modules exporting-contributed tiling algorithms, such as a tabbed layout, a circle, a spiral,-three columns, and so on.--You will also find modules which provide facilities for combining-different layouts, such as "XMonad.Layout.Combo", "XMonad.Layout.ComboP",-"XMonad.Layout.LayoutBuilder", "XMonad.Layout.SubLayouts", or-"XMonad.Layout.LayoutCombinators".--Layouts can be also modified with layout modifiers. A general-interface for writing layout modifiers is implemented in-"XMonad.Layout.LayoutModifier".--For more information on using those modules for customizing your-'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook".--* "XMonad.Layout.Accordion":-    LayoutClass that puts non-focused windows in ribbons at the top and bottom-    of the screen.--* "XMonad.Layout.AutoMaster":-    Provides layout modifier AutoMaster. It separates screen in two parts --    master and slave. Size of slave area automatically changes depending on-    number of slave windows.--* "XMonad.Layout.AvoidFloats":-    Find a maximum empty rectangle around floating windows and use that area to-    display non-floating windows.--* "XMonad.Layout.BinarySpacePartition":-    Layout where new windows will split the focused window in half, based off of BSPWM.--* "XMonad.Layout.BorderResize":-    This layout modifier will allow to resize windows by dragging their-    borders with the mouse. However, it only works in layouts or modified-    layouts that react to the SetGeometry message.-    "XMonad.Layout.WindowArranger" can be used to create such a setup.-    BorderResize is probably most useful in floating layouts.--* "XMonad.Layout.BoringWindows":-    BoringWindows is an extension to allow windows to be marked boring--* "XMonad.Layout.ButtonDecoration":-    A decoration that includes small buttons on both ends which invoke various-    actions when clicked on: Show a window menu (see "XMonad.Actions.WindowMenu"),-    minimize, maximize or close the window.--* "XMonad.Layout.CenteredMaster":-    Two layout modifiers. centerMaster places master window at center,-    on top of all other windows, which are managed by base layout.-    topRightMaster is similar, but places master window in top right corner-    instead of center.--* "XMonad.Layout.Circle":-    Circle is an elliptical, overlapping layout.--* "XMonad.Layout.Column":-    Provides Column layout that places all windows in one column. Windows-    heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is-    given. With Shrink/Expand messages you can change the q value.--* "XMonad.Layout.Combo":-    A layout that combines multiple layouts.--* "XMonad.Layout.ComboP":-    A layout that combines multiple layouts and allows to specify where to put-    new windows.--* "XMonad.Layout.Cross":-    A Cross Layout with the main window in the center.--* "XMonad.Layout.Decoration":-    A layout modifier and a class for easily creating decorated-    layouts.--* "XMonad.Layout.DecorationAddons":-    Various stuff that can be added to the decoration. Most of it is intended to-    be used by other modules. See "XMonad.Layout.ButtonDecoration" for a module-    that makes use of this.--* "XMonad.Layout.DecorationMadness":-    A collection of decorated layouts: some of them may be nice, some-    usable, others just funny.--* "XMonad.Layout.Dishes":-    Dishes is a layout that stacks extra windows underneath the master-    windows.--* "XMonad.Layout.DragPane":-    Layouts that splits the screen either horizontally or vertically and-    shows two windows.  The first window is always the master window, and-    the other is either the currently focused window or the second window in-    layout order. See also "XMonad.Layout.MouseResizableTall"--* "XMonad.Layout.DraggingVisualizer":-    A helper module to visualize the process of dragging a window by making it-    follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration" for a-    module that makes use of this.--* "XMonad.Layout.Drawer":-    A layout modifier that puts some windows in a "drawer" which retracts and-    expands depending on whether any window in it has focus. Useful for music-    players, tool palettes, etc.--* "XMonad.Layout.Dwindle":-    Three layouts: The first, Spiral, is a reimplementation of spiral with, at-    least to me, more intuitive semantics. The second, Dwindle, is inspired by-    a similar layout in awesome and produces the same sequence of decreasing-    window sizes as Spiral but pushes the smallest windows into a screen corner-    rather than the centre. The third, Squeeze arranges all windows in one row-    or in one column, with geometrically decreasing sizes.--* "XMonad.Layout.DwmStyle":-    A layout modifier for decorating windows in a dwm like style.--* "XMonad.Layout.FixedColumn":-    A layout much like Tall, but using a multiple of a window's minimum-    resize amount instead of a percentage of screen to decide where to-    split. This is useful when you usually leave a text editor or-    terminal in the master pane and like it to be 80 columns wide.--* "XMonad.Layout.Fullscreen":-    Hooks for sending messages about fullscreen windows to layouts, and a few-    example layout modifier that implement fullscreen windows.--* "XMonad.Layout.Gaps":-    Create manually-sized gaps along edges of the screen which will not-    be used for tiling, along with support for toggling gaps on and-    off. You probably want "XMonad.Hooks.ManageDocks".--* "XMonad.Layout.Grid":-    A simple layout that attempts to put all windows in a square grid.--* "XMonad.Layout.GridVariants":-    Two layouts: one is a variant of the Grid layout that allows the-    desired aspect ratio of windows to be specified.  The other is like-    Tall but places a grid with fixed number of rows and columns in the-    master area and uses an aspect-ratio-specified layout for the-    slaves.--* "XMonad.Layout.Groups":-    Two-level layout with windows split in individual layout groups, themselves-    managed by a user-provided layout.--*   * "XMonad.Layout.Groups.Examples":-        Example layouts for "XMonad.Layout.Groups".--*   * "XMonad.Layout.Groups.Helpers":-        Utility functions for "XMonad.Layout.Groups".--*   * "XMonad.Layout.Groups.Wmii":-        A wmii-like layout algorithm.--* "XMonad.Layout.Hidden":-    Similar to XMonad.Layout.Minimize but completely removes windows from the-    window set so XMonad.Layout.BoringWindows isn't necessary. Perfect companion-    to XMonad.Layout.BinarySpacePartition since it can be used to move windows-    to another part of the BSP tree.--* "XMonad.Layout.HintedGrid":-    A not so simple layout that attempts to put all windows in a square grid-    while obeying their size hints.--* "XMonad.Layout.HintedTile":-    A gapless tiled layout that attempts to obey window size hints,-    rather than simply ignoring them.--* "XMonad.Layout.IM":-    Layout modfier suitable for workspace with multi-windowed instant messenger-    (like Psi or Tkabber).--* "XMonad.Layout.IfMax":-    Provides IfMax layout, which will run one layout if there are maximum N-    windows on workspace, and another layout, when number of windows is greater-    than N.--* "XMonad.Layout.ImageButtonDecoration":-    A decoration that includes small image buttons on both ends which invoke-    various actions when clicked on: Show a window menu (see "XMonad.Actions.WindowMenu"),-    minimize, maximize or close the window.--* "XMonad.Layout.IndependentScreens":-    Utility functions for simulating independent sets of workspaces on-    each screen (like dwm's workspace model), using internal tags to-    distinguish workspaces associated with each screen.--* "XMonad.Layout.LayoutBuilder":-    A layout combinator that sends a specified number of windows to one rectangle-    and the rest to another.--* "XMonad.Layout.LayoutCombinators":-    The "XMonad.Layout.LayoutCombinators" module provides combinators-    for easily combining multiple layouts into one composite layout, as-    well as a way to jump directly to any particular layout (say, with-    a keybinding) without having to cycle through other layouts to get-    to it.--* "XMonad.Layout.LayoutHints":-    Make layouts respect size hints.--* "XMonad.Layout.LayoutModifier":-    A module for writing easy layout modifiers, which do not define a-    layout in and of themselves, but modify the behavior of or add new-    functionality to other layouts.  If you ever find yourself writing-    a layout which takes another layout as a parameter, chances are you-    should be writing a LayoutModifier instead!--    In case it is not clear, this module is not intended to help you-    configure xmonad, it is to help you write other extension modules.-    So get hacking!--* "XMonad.Layout.LayoutScreens":-    Divide a single screen into multiple screens.--* "XMonad.Layout.LimitWindows":-    A layout modifier that limits the number of windows that can be shown.--* "XMonad.Layout.MagicFocus":-    Automagically put the focused window in the master area.--* "XMonad.Layout.Magnifier":-    Screenshot  :  <http://caladan.rave.org/magnifier.png>-    This is a layout modifier that will make a layout increase the size-    of the window that has focus.--* "XMonad.Layout.Master":-    Layout modfier that adds a master window to another layout.--* "XMonad.Layout.Maximize":-    Temporarily yanks the focused window out of the layout to mostly fill-    the screen.--* "XMonad.Layout.MessageControl":-    Provides message escaping and filtering facilities which-    help control complex nested layouts.--* "XMonad.Layout.Minimize":-    Makes it possible to minimize windows, temporarily removing them-    from the layout until they are restored.--* "XMonad.Layout.Monitor":-    Layout modfier for displaying some window (monitor) above other windows--* "XMonad.Layout.Mosaic":-    Based on MosaicAlt, but aspect ratio messages always change the aspect-    ratios, and rearranging the window stack changes the window sizes.--* "XMonad.Layout.MosaicAlt":-    A layout which gives each window a specified amount of screen space-    relative to the others. Compared to the 'Mosaic' layout, this one-    divides the space in a more balanced way.--* "XMonad.Layout.MouseResizableTile":-    A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option-    to use the mouse to adjust the layout.--* "XMonad.Layout.MultiColumns":-    This layout tiles windows in a growing number of columns. The number of-    windows in each column can be controlled by messages.--* "XMonad.Layout.MultiToggle":-    Dynamically apply and unapply transformers to your window layout. This can-    be used to rotate your window layout by 90 degrees, or to make the-    currently focused window occupy the whole screen (\"zoom in\") then undo-    the transformation (\"zoom out\").--*   * "XMonad.Layout.MultiToggle.Instances":-        Some convenient common instances of the Transformer class, for use with "XMonad.Layout.MultiToggle".--* "XMonad.Layout.Named":-    A module for assigning a name to a given layout.--* "XMonad.Layout.NoBorders":-    Make a given layout display without borders.  This is useful for-    full-screen or tabbed layouts, where you don't really want to waste a-    couple of pixels of real estate just to inform yourself that the visible-    window has focus.--* "XMonad.Layout.NoFrillsDecoration":-    Most basic version of decoration for windows without any additional-    modifications. In contrast to "XMonad.Layout.SimpleDecoration" this will-    result in title bars that span the entire window instead of being only the-    length of the window title.--* "XMonad.Layout.OnHost":-    Configure layouts on a per-host basis: use layouts and apply layout modifiers-    selectively, depending on the host. Heavily based on "XMonad.Layout.PerWorkspace"-    by Brent Yorgey.--* "XMonad.Layout.OneBig":-    Places one (master) window at top left corner of screen, and other (slave)-    windows at the top.--* "XMonad.Layout.PerScreen":-    Configure layouts based on the width of your screen; use your favorite-    multi-column layout for wide screens and a full-screen layout for small ones.--* "XMonad.Layout.PerWorkspace":-    Configure layouts on a per-workspace basis: use layouts and apply-    layout modifiers selectively, depending on the workspace.--* "XMonad.Layout.PositionStoreFloat":-    A floating layout which has been designed with a dual-head setup in mind.-    It makes use of "XMonad.Util.PositionStore" as well as "XMonad.Hooks.PositionStoreHooks".-    Since there is currently no way to move or resize windows with the keyboard-    alone in this layout, it is adviced to use it in combination with a decoration-    such as "XMonad.Layout.NoFrillsDecoration" (to move windows) and the layout-    modifier "XMonad.Layout.BorderResize" (to resize windows).--* "XMonad.Layout.Reflect":-    Reflect a layout horizontally or vertically.--* "XMonad.Layout.Renamed":-    Layout modifier that can modify the description of its underlying layout on-    a (hopefully) flexible way.--* "XMonad.Layout.ResizableTile":-    More useful tiled layout that allows you to change a width\/height of window.-    See also "XMonad.Layout.MouseResizableTile".--* "XMonad.Layout.ResizeScreen":-    A layout transformer to have a layout respect a given screen-    geometry. Mostly used with "Decoration" (the Horizontal and the-    Vertical version will react to SetTheme and change their dimension-    accordingly.--* "XMonad.Layout.Roledex":-    This is a completely pointless layout which acts like Microsoft's Flip 3D--* "XMonad.Layout.ShowWName":-    This is a layout modifier that will show the workspace name--* "XMonad.Layout.SimpleDecoration":-    A layout modifier for adding simple decorations to the windows of a-    given layout. The decorations are in the form of ion-like tabs-    for window titles.--* "XMonad.Layout.SimpleFloat":-    A basic floating layout.--* "XMonad.Layout.Simplest":-    A very simple layout. The simplest, afaik. Used as a base for-    decorated layouts.--* "XMonad.Layout.SimplestFloat":-    A basic floating layout like SimpleFloat but without the decoration.--* "XMonad.Layout.SortedLayout":-    A new LayoutModifier that sorts a given layout by a list of-    properties. The order of properties in the list determines-    the order of windows in the final layout. Any unmatched windows-    go to the end of the order.--* "XMonad.Layout.Spacing":-    Add a configurable amount of space around windows.--* "XMonad.Layout.Spiral":-    A spiral tiling layout.--* "XMonad.Layout.Square":-    A layout that splits the screen into a square area and the rest of the-    screen.-    This is probably only ever useful in combination with-    "XMonad.Layout.Combo".-    It sticks one window in a square region, and makes the rest-    of the windows live with what's left (in a full-screen sense).--* "XMonad.Layout.StackTile":-    A stacking layout, like dishes but with the ability to resize master pane.-    Mostly useful on small screens.--* "XMonad.Layout.Stoppable":-    This module implements a special kind of layout modifier, which when applied-    to a layout, causes xmonad to stop all non-visible processes. In a way,-    this is a sledge-hammer for applications that drain power. For example, given-    a web browser on a stoppable workspace, once the workspace is hidden the web-    browser will be stopped.--* "XMonad.Layout.SubLayouts":-    A layout combinator that allows layouts to be nested.--* "XMonad.Layout.TabBarDecoration":-    A layout modifier to add a bar of tabs to your layouts.--* "XMonad.Layout.Tabbed":-    A tabbed layout for the Xmonad Window Manager--* "XMonad.Layout.ThreeColumns":-    A layout similar to tall but with three columns. With 2560x1600 pixels this-    layout can be used for a huge main window and up to six reasonable sized-    slave windows.--* "XMonad.Layout.ToggleLayouts":-    A module to toggle between two layouts.--* "XMonad.Layout.TwoPane":-    A layout that splits the screen horizontally and shows two windows.  The-    left window is always the master window, and the right is either the-    currently focused window or the second window in layout order.--* "XMonad.Layout.WindowArranger":-    This is a pure layout modifier that will let you move and resize-    windows with the keyboard in any layout.--* "XMonad.Layout.WindowNavigation":-    WindowNavigation is an extension to allow easy navigation of a workspace.-    See also "XMonad.Actions.WindowNavigation".--* "XMonad.Layout.WindowSwitcherDecoration":-    A decoration that allows to switch the position of windows by dragging them-    onto each other.--* "XMonad.Layout.WorkspaceDir":-    WorkspaceDir is an extension to set the current directory in a workspace.-    Actually, it sets the current directory in a layout, since there's no way I-    know of to attach a behavior to a workspace.  This means that any terminals-    (or other programs) pulled up in that workspace (with that layout) will-    execute in that working directory.  Sort of handy, I think.-    Note this extension requires the 'directory' package to be installed.---}--{- $prompts--In the @XMonad.Prompt@ name space you can find modules providing-graphical prompts for getting user input and using it to perform-various actions.--The "XMonad.Prompt" provides a library for easily writing new prompt-modules.--These are the available prompts:--* "XMonad.Prompt.AppLauncher":-    A module for launch applicationes that receive parameters in the command-    line. The launcher call a prompt to get the parameters.--* "XMonad.Prompt.AppendFile":-    A prompt for appending a single line of text to a file.  Useful for-    keeping a file of notes, things to remember for later, and so on----    using a keybinding, you can write things down just about as quickly-    as you think of them, so it doesn't have to interrupt whatever else-    you're doing.-    Who knows, it might be useful for other purposes as well!--* "XMonad.Prompt.ConfirmPrompt":-    A module for setting up simple confirmation prompts for keybindings.--* "XMonad.Prompt.DirExec":-    A directory file executables prompt for XMonad. This might be useful if you-    don't want to have scripts in your PATH environment variable (same-    executable names, different behavior) - otherwise you might want to use-    "XMonad.Prompt.Shell" instead - but you want to have easy access to these-    executables through the xmonad's prompt.--* "XMonad.Prompt.Directory":-    A directory prompt for XMonad--* "XMonad.Prompt.Email":-    A prompt for sending quick, one-line emails, via the standard GNU-    \'mail\' utility (which must be in your $PATH).  This module is-    intended mostly as an example of using "XMonad.Prompt.Input" to-    build an action requiring user input.--* "XMonad.Prompt.Input":-    A generic framework for prompting the user for input and passing it-    along to some other action.--* "XMonad.Prompt.Layout":-    A layout-selection prompt for XMonad--* "XMonad.Prompt.Man":-    A manual page prompt for XMonad window manager.-    TODO-    * narrow completions by section number, if the one is specified-    (like @\/etc\/bash_completion@ does)--* "XMonad.Prompt.Pass":-    This module provides 3 combinators for ease passwords manipulation (generate, read, remove):-    1) one to lookup passwords in the password-storage.-    2) one to generate a password for a given password label that the user inputs.-    3) one to delete a stored password for a given password label that the user inputs.---* "XMonad.Prompt.RunOrRaise":-    A prompt for XMonad which will run a program, open a file,-    or raise an already running program, depending on context.--* "XMonad.Prompt.Shell":-    A shell prompt for XMonad--* "XMonad.Prompt.Ssh":-    A ssh prompt for XMonad--* "XMonad.Prompt.Theme":-    A prompt for changing the theme of the current workspace--* "XMonad.Prompt.Window":-    xprompt operations to bring windows to you, and bring you to windows.--* "XMonad.Prompt.Workspace":-    A workspace prompt for XMonad--* "XMonad.Prompt.XMonad":-    A prompt for running XMonad commands--Usually a prompt is called by some key binding. See-"XMonad.Doc.Extending#Editing_key_bindings", which includes examples-of adding some prompts.---}--{- $utils--In the @XMonad.Util@ namespace you can find modules exporting various-utility functions that are used by the other modules of the-xmonad-contrib library.--There are also utilities for helping in configuring xmonad or using-external utilities.--A non complete list with a brief description:--* "XMonad.Util.Cursor": configure the default cursor/pointer glyph.--* "XMonad.Util.CustomKeys": configure key bindings (see-  "XMonad.Doc.Extending#Editing_key_bindings").--* "XMonad.Util.DebugWindow":-    Module to dump window information for diagnostic/debugging purposes. See-    "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.--* "XMonad.Util.Dmenu":-    A convenient binding to dmenu.-    Requires the process-1.0 package--* "XMonad.Util.Dzen":-    Handy wrapper for dzen. Requires dzen >= 0.2.4.--* "XMonad.Util.EZConfig":-    Configure key bindings easily, including a-    parser for writing key bindings in "M-C-x" style.--* "XMonad.Util.ExtensibleState":-    Module for storing custom mutable state in xmonad.--* "XMonad.Util.Font":-    A module for abstracting a font facility over-    Core fonts and Xft.--* "XMonad.Util.Image":-    Utilities for manipulating [[Bool]] as images.--* "XMonad.Util.Invisible":-    A data type to store the layout state--* "XMonad.Util.Loggers":-    A collection of simple logger functions and formatting utilities-    which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of-    a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog"-    for more information.--*   * "XMonad.Util.Loggers.NamedScratchpad":-        A collection of Loggers (see "XMonad.Util.Loggers") for NamedScratchpads-        (see "XMonad.Util.NamedScratchpad").--* "XMonad.Util.NamedActions":-    A wrapper for keybinding configuration that can list the available-    keybindings.--* "XMonad.Util.NamedScratchpad":-    Like "XMonad.Util.Scratchpad" toggle windows to and from the current-    workspace. Supports several arbitrary applications at the same time.--* "XMonad.Util.NamedWindows":-    This module allows you to associate the X titles of windows with-    them.--* "XMonad.Util.NoTaskbar":-    Utility function and 'ManageHook` to mark a window to be ignored by-    EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since-    you will usually be taken to the `NSP` workspace by them.--* "XMonad.Util.Paste":-    A module for sending key presses to windows. This modules provides generalized-    and specialized functions for this task.--* "XMonad.Util.PositionStore":-    A utility module to store information about position and size of a window.-    See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this.--* "XMonad.Util.RemoteWindows":-    This module implements a proper way of finding out whether the window is remote or local.--* "XMonad.Util.Replace":-    Implements a @--replace@ flag outside of core.--* "XMonad.Util.Run":-    This modules provides several commands to run an external process.-    It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by-    Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and-    XMonad.Util.RunInXTerm (by Andrea Rossato).--* "XMonad.Util.Scratchpad":-    Very handy hotkey-launched toggleable floating terminal window.--* "XMonad.Util.SpawnNamedPipe":-    A module for spawning a pipe whose Handle lives in the Xmonad state.--* "XMonad.Util.SpawnOnce":-    A module for spawning a command once, and only once. Useful to start status-    bars and make session settings inside startupHook.--* "XMonad.Util.Stack":-    Utility functions for manipulating Maybe Stacks.--* "XMonad.Util.StringProp":-    Internal utility functions for storing Strings with the root window.-    Used for global state like IORefs with string keys, but more latency,-    persistent between xmonad restarts.--* "XMonad.Util.Themes":-    A (hopefully) growing collection of themes for decorated layouts.--* "XMonad.Util.Timer":-    A module for setting up timers--* "XMonad.Util.Types":-    Miscellaneous commonly used types.--* "XMonad.Util.Ungrab":-    Release xmonad's keyboard and pointer grabs immediately, so-    screen grabbers and lock utilities, etc. will work. Replaces-    the short sleep hackaround.--* "XMonad.Util.WindowProperties":-    EDSL for specifying window properties; various utilities related to window-    properties.--* "XMonad.Util.WindowState":-    Functions for saving per-window data.--* "XMonad.Util.WorkspaceCompare":-    Functions for examining, comparing, and sorting workspaces.--* "XMonad.Util.XSelection":-    A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).-    'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils--* "XMonad.Util.XUtils":-    A module for painting on the screen---}----------------------------------------------------------------------------------------  Extending Xmonad--------------------------------------------------------------------------------------{- $extending-#Extending_xmonad#--Since the @xmonad.hs@ file is just another Haskell module, you may-import and use any Haskell code or libraries you wish, such as-extensions from the xmonad-contrib library, or other code you write-yourself.---}--{- $keys-#Editing_key_bindings#--Editing key bindings means changing the 'XMonad.Core.XConfig.keys'-field of the 'XMonad.Core.XConfig' record used by xmonad.  For-example, you could write:-->    import XMonad->->    main = xmonad $ def { keys = myKeys }--and provide an appropriate definition of @myKeys@, such as:--> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList->             [ ((modm, xK_F12), xmonadPrompt def)->             , ((modm, xK_F3 ), shellPrompt  def)->             ]--This particular definition also requires importing "XMonad.Prompt",-"XMonad.Prompt.Shell", "XMonad.Prompt.XMonad", and "Data.Map":--> import qualified Data.Map as M-> import XMonad.Prompt-> import XMonad.Prompt.Shell-> import XMonad.Prompt.XMonad--For a list of the names of particular keys (such as xK_F12, and so-on), see-<http://hackage.haskell.org/packages/archive/X11/latest/doc/html/Graphics-X11-Types.html>--Usually, rather than completely redefining the key bindings, as we did-above, we want to simply add some new bindings and\/or remove existing-ones.---}--{- $keyAdding-#Adding_key_bindings#--Adding key bindings can be done in different ways. See the end of this-section for the easiest ways. The type signature of-'XMonad.Core.XConfig.keys' is:-->    keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())--In order to add new key bindings, you need to first create an-appropriate 'Data.Map.Map' from a list of key bindings using-'Data.Map.fromList'.  This 'Data.Map.Map' of new key bindings then-needs to be joined to a 'Data.Map.Map' of existing bindings using-'Data.Map.union'.--Since we are going to need some of the functions of the "Data.Map"-module, before starting we must first import this modules:-->    import qualified Data.Map as M---For instance, if you have defined some additional key bindings like-these:-->    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList->             [ ((modm, xK_F12), xmonadPrompt def)->             , ((modm, xK_F3 ), shellPrompt  def)->             ]--then you can create a new key bindings map by joining the default one-with yours:-->    newKeys x  = myKeys x `M.union` keys def x--Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field-of the configuration:-->    main = xmonad $ def { keys = newKeys }--Alternatively, the '<+>' operator can be used which in this usage does exactly-the same as the explicit usage of 'M.union' and propagation of the config-argument, thanks to appropriate instances in "Data.Monoid".-->    main = xmonad $ def { keys = myKeys <+> keys def }--All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:--->    module Main (main) where->->    import XMonad->->    import qualified Data.Map as M->    import Graphics.X11.Xlib->    import XMonad.Prompt->    import XMonad.Prompt.Shell->    import XMonad.Prompt.XMonad->->    main :: IO ()->    main = xmonad $ def { keys = myKeys <+> keys def }->->    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList->             [ ((modm, xK_F12), xmonadPrompt def)->             , ((modm, xK_F3 ), shellPrompt  def)->             ]--There are much simpler ways to accomplish this, however, if you are-willing to use an extension module to help you configure your keys.-For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both-provide useful functions for editing your key bindings; "XMonad.Util.EZConfig" even lets you use emacs-style keybinding descriptions like \"M-C-<F12>\".-- -}--{- $keyDel-#Removing_key_bindings#--Removing key bindings requires modifying the 'Data.Map.Map' which-stores the key bindings.  This can be done with 'Data.Map.difference'-or with 'Data.Map.delete'.--For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@-(you just want to leave xmonad running forever). To do this you need-to define @newKeys@ as a 'Data.Map.difference' between the default-map and the map of the key bindings you want to remove.  Like so:-->    newKeys x = keys def x `M.difference` keysToRemove x->->    keysToRemove :: XConfig Layout ->    M.Map (KeyMask, KeySym) (X ())->    keysToRemove x = M.fromList->             [ ((modm              , xK_q ), return ())->             , ((modm .|. shiftMask, xK_q ), return ())->             ]--As you can see, it doesn't matter what actions we associate with the-keys listed in @keysToRemove@, so we just use @return ()@ (the-\"null\" action).--It is also possible to simply define a list of keys we want to unbind-and then use 'Data.Map.delete' to remove them. In that case we would-write something like:-->    newKeys x = foldr M.delete (keys def x) (keysToRemove x)->->    keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]->    keysToRemove x =->             [ (modm              , xK_q )->             , (modm .|. shiftMask, xK_q )->             ]--Another even simpler possibility is the use of some of the utilities-provided by the xmonad-contrib library. Look, for instance, at-'XMonad.Util.EZConfig.removeKeys'.---}--{- $keyAddDel-#Adding_and_removing_key_bindings#--Adding and removing key bindings requires simply combining the steps-for removing and adding.  Here is an example from-"XMonad.Config.Arossato":-->    defKeys    = keys def->    delKeys x  = foldr M.delete           (defKeys x) (toRemove x)->    newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)->    -- remove some of the default key bindings->    toRemove XConfig{modMask = modm} =->        [ (modm              , xK_j     )->        , (modm              , xK_k     )->        , (modm              , xK_p     )->        , (modm .|. shiftMask, xK_p     )->        , (modm .|. shiftMask, xK_q     )->        , (modm              , xK_q     )->        ] ++->        -- I want modm .|. shiftMask 1-9 to be free!->        [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]]->    -- These are my personal key bindings->    toAdd XConfig{modMask = modm} =->        [ ((modm              , xK_F12   ), xmonadPrompt def )->        , ((modm              , xK_F3    ), shellPrompt  def )->        ] ++->        -- Use modm .|. shiftMask .|. controlMask 1-9 instead->        [( (m .|. modm, k), windows $ f i)->         | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]->        ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]->        ]--You can achieve the same result using the "XMonad.Util.CustomKeys"-module; take a look at the 'XMonad.Util.CustomKeys.customKeys'-function in particular.--NOTE: modm is defined as the modMask you defined (or left as the default) in-your config.--}--{- $mouse-#Editing_mouse_bindings#--Most of the previous discussion of key bindings applies to mouse-bindings as well.  For example, you could configure button4 to close-the window you click on like so:-->    import qualified Data.Map as M->->    myMouse x  = [ (0, button4), (\w -> focus w >> kill) ]->->    newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x))->->    main = xmonad $ def { ..., mouseBindings = newMouse, ... }--Overriding or deleting mouse bindings works similarly.  You can also-configure mouse bindings much more easily using the-'XMonad.Util.EZConfig.additionalMouseBindings' and-'XMonad.Util.EZConfig.removeMouseBindings' functions from the-"XMonad.Util.EZConfig" module.---}--{- $layoutHook-#Editing_the_layout_hook#--When you start an application that opens a new window, when you change-the focused window, or move it to another workspace, or change that-workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for-reordering the visible windows on the visible workspace(s).--Since different layouts may be attached to different workspaces, and-you can change them, xmonad needs to know which one to use. In this-sense the layoutHook may be thought as the list of layouts that-xmonad will use for laying out windows on the screen(s).--The problem is that the layout subsystem is implemented with an-advanced feature of the Haskell programming language: type classes.-This allows us to very easily write new layouts, combine or modify-existing layouts, create layouts with internal state, etc. See-"XMonad.Doc.Extending#The_LayoutClass" for more information. This-means that we cannot simply have a list of layouts as we used to have-before the 0.5 release: a list requires every member to belong to the-same type!--Instead the combination of layouts to be used by xmonad is created-with a specific layout combinator: 'XMonad.Layout.|||'.--Suppose we want a list with the 'XMonad.Layout.Full',-'XMonad.Layout.Tabbed.tabbed' and-'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our-@~\/.xmonad\/xmonad.hs@, all the needed modules:-->    import XMonad->->    import XMonad.Layout.Tabbed->    import XMonad.Layout.Accordion--Then we create the combination of layouts we need:-->    mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion---Now, all we need to do is change the 'XMonad.Core.layoutHook'-field of the 'XMonad.Core.XConfig' record, like so:-->    main = xmonad $ def { layoutHook = mylayoutHook }--Thanks to the new combinator, we can apply a layout modifier to a-whole combination of layouts, instead of applying it to each one. For-example, suppose we want to use the-'XMonad.Layout.NoBorders.noBorders' layout modifier, from the-"XMonad.Layout.NoBorders" module (which must be imported):-->    mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion)--If we want only the tabbed layout without borders, then we may write:-->    mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion--Our @~\/.xmonad\/xmonad.hs@ will now look like this:-->    import XMonad->->    import XMonad.Layout.Tabbed->    import XMonad.Layout.Accordion->    import XMonad.Layout.NoBorders->->    mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion->->    main = xmonad $ def { layoutHook = mylayoutHook }--That's it!---}--{- $manageHook-#Editing_the_manage_hook#--The 'XMonad.Core.manageHook' is a very powerful tool for customizing-the behavior of xmonad with regard to new windows.  Whenever a new-window is created, xmonad calls the 'XMonad.Core.manageHook', which-can thus be used to perform certain actions on the new window, such as-placing it in a specific workspace, ignoring it, or placing it in the-float layer.--The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer-and Gimp, and to ignore gnome-panel, desktop_window, kicker, and-kdesktop.--The "XMonad.ManageHook" module provides some simple combinators that-can be used to alter the 'XMonad.Core.manageHook' by replacing or adding-to the default actions.--Let's start by analyzing the default 'XMonad.Config.manageHook', defined-in "XMonad.Config":--->    manageHook :: ManageHook->    manageHook = composeAll->                    [ className =? "MPlayer"        --> doFloat->                    , className =? "Gimp"           --> doFloat->                    , resource  =? "desktop_window" --> doIgnore->                    , resource  =? "kdesktop"       --> doIgnore ]--'XMonad.ManageHook.composeAll' can be used to compose a list of-different 'XMonad.Config.ManageHook's. In this example we have a list-of 'XMonad.Config.ManageHook's formed by the following commands: the-Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className'-are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the-float layer with the 'XMonad.ManageHook.doFloat' function; the windows-whose resource names are respectively \"desktop_window\" and-\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore'-function.--This is another example of 'XMonad.Config.manageHook', taken from-"XMonad.Config.Arossato":-->    myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat->                               , resource =? "win"          --> doF (W.shift "doc") -- xpdf->                               , resource =? "firefox-bin"  --> doF (W.shift "web")->                               ]->    newManageHook = myManageHook <+> manageHook def---Again we use 'XMonad.ManageHook.composeAll' to compose a list of-different 'XMonad.Config.ManageHook's. The first one will put-RealPlayer on the float layer, the second one will put the xpdf-windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF'-and 'XMonad.StackSet.shift' functions, and the third one will put all-firefox windows on the workspace called "web". Then we use the-'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the-default 'XMonad.Config.manageHook' to form @newManageHook@.--Each 'XMonad.Config.ManageHook' has the form:-->    property =? match --> action--Where @property@ can be:--* 'XMonad.ManageHook.title': the window's title--* 'XMonad.ManageHook.resource': the resource name--* 'XMonad.ManageHook.className': the resource class name.--* 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the-  property @somestring@.--(You can retrieve the needed information using the X utility named-@xprop@; for example, to find the resource class name, you can type--> xprop | grep WM_CLASS--at a prompt, then click on the window whose resource class you want to-know.)--@match@ is the string that will match the property value (for instance-the one you retrieved with @xprop@).--An  @action@ can be:--* 'XMonad.ManageHook.doFloat': to place the window in the float layer;--* 'XMonad.ManageHook.doIgnore': to ignore the window;--* 'XMonad.ManageHook.doF': to execute a function with the window as-  argument.--For example, suppose we want to add a 'XMonad.Config.manageHook' to-float RealPlayer, which usually has a 'XMonad.ManageHook.resource'-name of \"realplay.bin\".--First we need to import "XMonad.ManageHook":-->    import XMonad.ManageHook--Then we create our own 'XMonad.Config.manageHook':-->    myManageHook = resource =? "realplay.bin" --> doFloat--We can now use the 'XMonad.ManageHook.<+>' combinator to add our-'XMonad.Config.manageHook' to the default one:-->    newManageHook = myManageHook <+> manageHook def--(Of course, if we wanted to completely replace the default-'XMonad.Config.manageHook', this step would not be necessary.) Now,-all we need to do is change the 'XMonad.Core.manageHook' field of the-'XMonad.Core.XConfig' record, like so:-->    main = xmonad def { ..., manageHook = newManageHook, ... }--And we are done.--Obviously, we may wish to add more then one-'XMonad.Config.manageHook'. In this case we can use a list of hooks,-compose them all with 'XMonad.ManageHook.composeAll', and add the-composed to the default one.--For instance, if we want RealPlayer to float and thunderbird always-opened in the workspace named "mail", we can do so like this:-->    myManageHook = composeAll [ resource =? "realplay.bin"    --> doFloat->                              , resource =? "thunderbird-bin" --> doF (W.shift "mail")->                              ]--Remember to import the module that defines the 'XMonad.StackSet.shift'-function, "XMonad.StackSet", like this:-->    import qualified XMonad.StackSet as W--And then we can add @myManageHook@ to the default one to create-@newManageHook@ as we did in the previous example.--One more thing to note about this system is that if-a window matches multiple rules in a 'XMonad.Config.manageHook', /all/-of the corresponding actions will be run (in the order in which they-are defined).  This is a change from versions before 0.5, when only-the first rule that matched was run.--Finally, for additional rules and actions you can use in your-manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers".---}--{- $logHook-#The_log_hook_and_external_status_bars#--When the stack of the windows managed by xmonad changes for any-reason, xmonad will call 'XMonad.Core.logHook', which can be used to-output some information about the internal state of xmonad, such as the-layout that is presently in use, the workspace we are in, the focused-window's title, and so on.--Extracting information about the internal xmonad state can be somewhat-difficult if you are not familiar with the source code. Therefore,-it's usually easiest to use a module that has been designed-specifically for logging some of the most interesting information-about the internal state of xmonad: "XMonad.Hooks.DynamicLog".  This-module can be used with an external status bar to print the produced-logs in a convenient way; the most commonly used status bars are dzen-and xmobar.--By default the 'XMonad.Core.logHook' doesn't produce anything. To-enable it you need first to import "XMonad.Hooks.DynamicLog":-->    import XMonad.Hooks.DynamicLog--Then you just need to update the 'XMonad.Core.logHook' field of the-'XMonad.Core.XConfig' record with one of the provided functions. For-example:-->    main = xmonad def { logHook = dynamicLog }--More interesting configurations are also possible; see the-"XMonad.Hooks.DynamicLog" module for more possibilities.--You may now enjoy your extended xmonad experience.--Have fun!+{-# LANGUAGE CPP #-}+-- We need to link to the current version of xmonad-docs, but both+-- CURRENT_PACKAGE_VERSION and VERSION_xmonad_contrib contain quotation marks+-- that we can't get rid of using CPP, so as a workaround we define the+-- components separately in cpp-options and check that they're still in sync.+#if !__HLINT__ && \+    !( MIN_VERSION_xmonad_contrib(XMONAD_CONTRIB_VERSION_MAJOR, XMONAD_CONTRIB_VERSION_MINOR, XMONAD_CONTRIB_VERSION_PATCH) \+    && !MIN_VERSION_xmonad_contrib(XMONAD_CONTRIB_VERSION_MAJOR, XMONAD_CONTRIB_VERSION_MINOR, XMONAD_CONTRIB_VERSION_PATCH + 1) \+    )+#error "Please update XMONAD_CONTRIB_VERSION_* in xmonad-contrib.cabal"+#endif++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Extending+-- Description :  A module to document the xmonad-contrib library.+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This module documents the xmonad-contrib library and guides you+-- through some more advanced parts of extending the capabilities of+-- xmonad.  If you're new to xmonad, you should first check out the+-- <https://xmonad.org/TUTORIAL.html tutorial> and treat this document+-- as supplemental reading.+--+-- Knowing Haskell is by no means a prerequisite for configuring xmonad+-- and the tutorial emphasizes this.  This document, however, does+-- assume a basic familiarity with the language.  This is so that we can+-- dive a bit deeper into what the different hooks do, or how to write+-- our own little functions to configure xmonad.+--+-- Those wishing to be totally hardcore and develop their own xmonad+-- extensions (it's easier than it sounds, we promise!) should read the+-- documentation in "XMonad.Doc.Developing".+--+-- More configuration examples can be found+-- <https://xmonad.org/TUTORIAL.html#closing-thoughts here>.+--+-----------------------------------------------------------------------------++module XMonad.Doc.Extending+    (+    -- * The xmonad-contrib library+    -- $library++    -- ** Actions+    -- $actions++    -- ** Hooks+    -- $hooks++    -- ** Layouts+    -- $layouts++    -- ** Prompts+    -- $prompts++    -- ** Utilities+    -- $utils++    -- * Extending xmonad+    -- $extending++    -- ** Adding key bindings+    -- $keys++    -- *** Removing key bindings+    -- $keyDel++    -- ** Editing mouse bindings+    -- $mouse++    -- ** Editing the layout hook #LayoutHook#+    -- $layoutHook++    -- ** Editing the manage hook #ManageHook#+    -- $manageHook++    ) where++--------------------------------------------------------------------------------+--+--  The XmonadContrib Library+--+--------------------------------------------------------------------------------++{- $library++The xmonad-contrib library is a set of extension modules contributed+by xmonad hackers and users that provide additional features to+xmonad.  Examples include various layout modes (tabbed, spiral,+three-column...), prompts, program launchers, the ability to+manipulate windows and workspaces in various ways, alternate+navigation modes, and much more.  There are also \"meta-modules\"+which make it easier to write new modules and extensions.++This is a description of the different namespaces in xmonad-contrib.+For more information about any particular module, go to the root of+the documentation and just click on its name to view its Haddock+documentation; each module should come with extensive documentation.+If you find a module that could be better documented, or has incorrect+documentation, please+<https://github.com/xmonad/xmonad-contrib/issues report it as a bug>!++First and foremost, xmonad defines its own prelude for commonly used+functions, as well as re-exports from @base@.++* "XMonad.Prelude":+    Utility functions and re-exports for a more ergonomic developing+    experience.++There are also other documentation modules, showing you around+individual parts of xmonad:++* "XMonad.Doc.Configuring":+    Brief tutorial that will teach you how to create a basic+    xmonad configuration.++* "XMonad.Doc.Developing":+    A brief overview of xmonad's internals.++A list of the contrib modules can be found at+<https://xmonad.github.io/xmonad-docs/xmonad-contrib-XMONAD_CONTRIB_VERSION_MAJOR.XMONAD_CONTRIB_VERSION_MINOR.XMONAD_CONTRIB_VERSION_PATCH/>+-}++{- $actions++In the @XMonad.Actions@ namespace you can find modules exporting+various functions that are usually intended to be bound to key+combinations or mouse actions, in order to provide functionality+beyond the standard keybindings offered by xmonad.++-}++{- $hooks++In the @XMonad.Hooks@ namespace you can find modules exporting+hooks—actions that xmonad performs when certain events occur.+The three most important hooks are:++* 'XMonad.Core.manageHook': this hook is called when a new window that+  xmonad must take care of is created. This is a very powerful hook,+  since it lets us examine the new window's properties and act+  accordingly. For instance, we can configure xmonad to put windows+  belonging to a given application in the float layer, not to manage+  dock applications, or open them in a given workspace. See [Editing the+  manage hook](#g:Editing_the_manage_hook) for more information on+  customizing 'XMonad.Core.manageHook'.++* 'XMonad.Core.logHook': this hook is called when the stack of windows+  managed by xmonad changes; for example, this is invoked at the end of+  the 'XMonad.Operations.windows' function. A big application for this+  is to display some information about xmonad in a status bar. The aptly+  named "XMonad.Hooks.StatusBar" will produce a string (whose format can+  be configured) to be written, for example, to an X11 property.++* 'XMonad.Core.handleEventHook': this hook is called on all events handled+  by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras"+  and xmonad source and development documentation for more details.++-}++{- $layouts++In the @XMonad.Layout@ namespace you can find modules exporting+contributed layout algorithms, such as a tabbed layout, a circle, a spiral,+three columns, and so on.++You will also find modules which provide facilities for combining+different layouts, such as "XMonad.Layout.Combo", "XMonad.Layout.ComboP",+"XMonad.Layout.LayoutBuilder", "XMonad.Layout.SubLayouts", or+"XMonad.Layout.LayoutCombinators".++Layouts can be also modified with layout modifiers. A general+interface for writing layout modifiers is implemented in+"XMonad.Layout.LayoutModifier".++For more information on using those modules for customizing your+'XMonad.Core.layoutHook' see [Editing the layout hook](#g:LayoutHook).++-}++{- $prompts++In the @XMonad.Prompt@ namespace you can find modules providing+graphical prompts for getting user input and using it to perform+various actions.++The "XMonad.Prompt" module provides a library for easily writing new+prompts.++-}++{- $utils++In the @XMonad.Util@ namespace you can find modules exporting various+utility functions that are used by the other modules of the+@xmonad-contrib@ library.++There are also utilities for helping in configuring xmonad or using+external utilities.++-}++--------------------------------------------------------------------------------+--+--  Extending Xmonad+--+--------------------------------------------------------------------------------++{- $extending+#Extending_xmonad#++Since the @xmonad.hs@ file is just another Haskell program, you may+import and use any Haskell code or libraries you wish, such as+extensions from the xmonad-contrib library, or other code you write+yourself.++-}++{- $keys++In the+<https://github.com/xmonad/xmonad/blob/master/TUTORIAL.md#customizing-xmonad customization section>+of the tutorial we have seen how to add new keys to xmonad with the help+of the 'XMonad.Util.EZConfig.additionalKeysP' function.  But how does+that work?  Assuming that library didn't exist yet, could we write it+ourselves?++Let's concentrate on the easier case of trying to write our own+'XMonad.Util.EZConfig.additionalKeys'.  This works exactly like its+almost-namesake, but requires you to specify the keys in the "default"+style—that is:++> main :: IO ()+> main = xmonad $ def+>   `additionalKeys`+>     [ ((mod1Mask, xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+>     , ((mod1Mask, xK_BackSpace), spawn "xterm")+>     ]++The extra work that 'XMonad.Util.EZConfig.additionalKeysP' does is only+in parsing the input string (turning @"M1-m"@ into @(mod1Mask, xK_m)@).+As we have seen in the tutorial, is also allows one to write @M@ and+have xmonad pick up on the correct modifier key to use—something which+'XMonad.Util.EZConfig.additionalKeys' can't do.++Editing key bindings means changing the 'XMonad.Core.keys' field of the+'XMonad.Core.XConfig' record used by xmonad.  For example, to override+/all/ of the default bindings with our own, we would write++> import XMonad+> import Data.Map (Map)+> import qualified Data.Map as Map+>+> main :: IO ()+> main = xmonad $ def { keys = myKeys }+>  where+>   myKeys :: XConfig l -> Map (ButtonMask, KeySym) (X ())+>   myKeys conf = Map.fromList+>     [ ((mod1Mask    , xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+>     , ((modMask conf, xK_BackSpace), spawn "xterm")+>     ]++Now, obviously we don't want to do that; we only want to add to existing+bindings (or, perhaps, override some of them with our own).  Let's break+@myKeys@ down a little.  You can think of the type signature of @myKeys@+(and hence also of @keys@) like this:++>    myKeys :: UserConfig -> Map KeyPress Action++It takes some user config and, from that, produces a map that associates+certain keypresses with actions to execute.  The reason why it might+take the user config may seem a bit mysterious at first, but it is for+the simple reason that some keybindings (like the workspace switching+ones) need access to the user config.  We have already seen this above+when we queried @modMask conf@.  If it helps, think of this as a+@Reader@ monad with the config being the read-only state.++This means that, as a first guess, the type signature of our version of+'XMonad.Util.EZConfig.additionalKeys' might look like++> myAdditionalKeys :: XConfig l+>                     -- ^ Base config with xmonad's default keybindings+>                  -> (XConfig l -> Map (ButtonMask, KeySym) (X ()))+>                     -- ^ User supplied keybindings+>                  -> XConfig l+>                     -- ^ Resulting config with everything merged together++However, even assuming a correct implementation, using this is not very+ergonomic:++> main = xmonad $ def+>  `myAdditionalKeys`+>    (\conf -> Map.fromList+>      [ ((mod1Mask    , xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+>      , ((modMask conf, xK_BackSpace), spawn "xterm")+>      ])++Having to specify a lambda with parentheses and call+'Data.Map.Strict.fromList' does not make for a good user experience.+Since one /always/ has to call that function anyways, we may well just+accept a list from the user and transform it to a map ourselves.  As an+additional simplification, how about we don't care about the config+argument at all and simply ask the user for a list?  The resulting+signature++> myAdditionalKeys :: XConfig l+>                  -> [(ButtonMask, KeySym), (X ())]+>                  -> XConfig l++looks exactly like what we want!  Note that this is also the time we+lose the ability to automagically fill in the correct modifier key,+since the input to @myAdditionalKeys@ is already structured data (as+opposed to just some strings that need to be parsed).++Now that we know what kind of data structure—that is, maps—we are+dealing with, the implementation of this function simply merges the two+together, preferring the user config to xmonad's defaults in case of any+conflicts.  Thankfully, someone else has already done the hard work and+written the merging function for us; it's called+'Data.Map.Strict.union'.++What's left is essentially playing "type tetris":++> myAdditionalKeys baseConf keyList =+>   let mergeKeylist conf = Map.fromList keyList `Map.union` (keys baseConf) conf+>    in baseConf { keys = mergeKeylist }++The function @mergeKeyList@ take some user config, transforms the custom+keybindings into a map (@Map.fromList keyList@), gets the keys from the+base config (remember @keys baseConf@ is again a function, morally of+type @UserConfig -> Map KeyPress Action@, and so we have to apply @conf@+to it in order to get a map!), and then merges these two maps together.+Since @mergeKeylist@ now has exactly the right type signature, we can+just set that as the keys.++If you like operators, 'Data.Monoid.<>' (or xmonad's alias for it,+'XMonad.ManageHook.<+>') does exactly the same as the explicit usage of+'Data.Map.Strict.union' because that's the specified binary operation in+the 'Data.Monoid.Monoid' instance for 'Data.Map.Strict.Map'.  Note that+the function works as expected (preferring user defined keys) because+'Data.Map.union' is /left biased/, which means that if the same key is+present in both maps it will prefer the associated value of the left+map.++Our function now works as expected:++> main :: IO ()+> main = xmonad $ def+>   `myAdditionalKeys`+>     [ ((mod1Mask, xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+>     , ((mod1Mask, xK_BackSpace), spawn "xterm")+>     ]++Lastly, if you want you can also emulate the automatic modifier+detection by 'XMonad.Util.EZConfig.additionalKeysP' by defining the bulk+of your config as a separate function++> myConfig = def { modMask = mod4Mask }++and then using that information++> main :: IO ()+> main = xmonad $ myConfig+>   `myAdditionalKeys`+>     [ ((mod, xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+>     , ((mod, xK_BackSpace), spawn "xterm")+>     ]+>  where mod = modMask myConfig++Hopefully you now feel well equipped to write some small functions that+extend xmonad an scratch a particular itch!++ -}++{- $keyDel+#Removing_key_bindings#++As we've learned, XMonad stores keybindings inside of a+'Data.Map.Strict.Map', which means that removing keybindings requires+modifying it.  This can be done with 'Data.Map.difference' or with+'Data.Map.Strict.delete'.++For example, suppose you want to entirely rid yourself of @"M-q"@ and+@"M-s-q"@ (you just want to leave xmonad running forever).  To do this+with bare @xmonad@, you need to define @newKeys@ as a+'Data.Map.Strict.difference' between the default map and the map of the+key bindings you want to remove.  Like so:++> newKeys :: XConfig l -> Map (KeyMask, KeySym) (X ())+> newKeys x = keys def x `M.difference` keysToRemove x+>+> keysToRemove :: XConfig l -> Map (KeyMask, KeySym) (X ())+> keysToRemove x = M.fromList+>          [ ((modm              , xK_q ), return ())+>          , ((modm .|. shiftMask, xK_q ), return ())+>          ]++As you can see, it doesn't matter what actions we associate with the+keys listed in @keysToRemove@, so we just use @return ()@ (the \"null\"+action).  Since @newKeys@ contains all of the default keys, you can+simply pass it to 'XMonad.Core.XConfig' as your map of keybindings:++> main :: IO ()+> main = xmonad $ def { keys = newKeys }++However, having to manually type @return ()@ every time seems like a+drag, doesn't it?  And this approach isn't at all compatible with adding+custom keybindings via 'XMonad.Util.EZConfig.additionalKeysP'!  Well,+good thing "XMonad.Util.EZConfig" also sports+'XMonad.Util.EZConfig.removeKeysP'.  You can use it as you would expect.++> main :: IO ()+> main = xmonad $ def+>   { … }+>  `removeKeysP` ["M-q", "M-S-q"]++Can you guess how 'XMonad.Util.EZConfig.removeKeysP' works?  It's almost+the same code we wrote above, just accepting a list of keybindings.  Try+to see if you can come up with an implementation of++> removeKeysP :: XConfig l -> [String] -> XConfig l++If you're done, just click on @# Source@ when viewing the+'XMonad.Util.EZConfig.removeKeysP' documentation (did you know that+Haddock lets you do that for every function?) and compare.++By the way, one can conveniently combine+'XMonad.Util.EZConfig.additionalKeysP' and+'XMonad.Util.EZConfig.removeKeysP' by just intuitively chaining them:++> main :: IO ()+> main = xmonad $ def+>   { … }+>  `additionalKeysP myKeys+>  `removeKeysP`    ["M-q", "M-S-q"]++If you don't use the @P@ alternatives of EZConfig, there is also an+aptly named 'XMonad.Util.EZConfig.removeKeys'.  Again, can you try to+come up with an implementation yourself that has the correct signature?++> removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a++In addition to 'Data.Map.Strict.delete', you will probably need to use+'foldr'.++-}++{- $mouse+#Editing_mouse_bindings#++Most of the previous discussion of key bindings applies to mouse+bindings as well.  For example, you could configure button4 to close+the window you click on like so:++>    import qualified Data.Map as M+>+>    myMouse x  = [ (0, button4), (\w -> focus w >> kill) ]+>+>    newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x))+>+>    main = xmonad $ def { ..., mouseBindings = newMouse, ... }++Overriding or deleting mouse bindings works similarly.  You can also+configure mouse bindings much more easily using the+'XMonad.Util.EZConfig.additionalMouseBindings' and+'XMonad.Util.EZConfig.removeMouseBindings' functions from the+"XMonad.Util.EZConfig" module.++-}++{- $layoutHook+#Editing_the_layout_hook#++When you start an application that opens a new window, when you change+the focused window, or move it to another workspace, or change that+workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for+reordering the visible windows on the visible workspace(s).++Since different layouts may be attached to different workspaces, and+you can change them, xmonad needs to know which one to use. In this+sense the layoutHook may be thought as the list of layouts that+xmonad will use for laying out windows on the screen(s).++The problem is that the layout subsystem is implemented with an+advanced feature of the Haskell programming language: type classes.+This allows us to very easily write new layouts, combine or modify+existing layouts, create layouts with internal state, etc. This+means that we cannot simply have a list of layouts: a list requires+every member to belong to the same type!++Instead the combination of layouts to be used by xmonad is created+with a specific layout combinator: 'XMonad.Layout.|||'.++Suppose we want a list with the 'XMonad.Layout.Full',+'XMonad.Layout.Tabbed.tabbed' and+'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our+@xmonad.hs@, all the needed modules:++>    import XMonad+>+>    import XMonad.Layout.Tabbed+>    import XMonad.Layout.Accordion++Then we create the combination of layouts we need:++>    mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion+++Now, all we need to do is change the 'XMonad.Core.layoutHook'+field of the 'XMonad.Core.XConfig' record, like so:++>    main = xmonad $ def { layoutHook = mylayoutHook }++Thanks to the new combinator, we can apply a layout modifier to a+whole combination of layouts, instead of applying it to each one. For+example, suppose we want to use the+'XMonad.Layout.NoBorders.noBorders' layout modifier, from the+"XMonad.Layout.NoBorders" module (which must be imported):++>    mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion)++If we want only the tabbed layout without borders, then we may write:++>    mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion++Our @xmonad.hs@ will now look like this:++>    import XMonad+>+>    import XMonad.Layout.Tabbed+>    import XMonad.Layout.Accordion+>    import XMonad.Layout.NoBorders+>+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion+>+>    main = xmonad $ def { layoutHook = mylayoutHook }++That's it!++-}++{- $manageHook+#Editing_the_manage_hook#++The 'XMonad.Core.manageHook' is a very powerful tool for customizing+the behavior of xmonad with regard to new windows.  Whenever a new+window is created, xmonad calls the 'XMonad.Core.manageHook', which+can thus be used to perform certain actions on the new window, such as+placing it in a specific workspace, ignoring it, or placing it in the+float layer.++The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer+and Gimp, and to ignore gnome-panel, desktop_window, kicker, and+kdesktop.++The "XMonad.ManageHook" module provides some simple combinators that+can be used to alter the 'XMonad.Core.manageHook' by replacing or adding+to the default actions.++Let's start by analyzing the default 'XMonad.Config.manageHook', defined+in "XMonad.Config":+++>    manageHook :: ManageHook+>    manageHook = composeAll+>                    [ className =? "MPlayer"        --> doFloat+>                    , className =? "Gimp"           --> doFloat+>                    , resource  =? "desktop_window" --> doIgnore+>                    , resource  =? "kdesktop"       --> doIgnore ]++'XMonad.ManageHook.composeAll' can be used to compose a list of+different 'XMonad.Config.ManageHook's. In this example we have a list+of 'XMonad.Config.ManageHook's formed by the following commands: the+Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className'+are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the+float layer with the 'XMonad.ManageHook.doFloat' function; the windows+whose resource names are respectively \"desktop_window\" and+\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore'+function.++This is another example of 'XMonad.Config.manageHook', taken from+"XMonad.Config.Arossato":++>    myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat+>                               , resource =? "win"          --> doF (W.shift "doc") -- xpdf+>                               , resource =? "firefox-bin"  --> doF (W.shift "web")+>                               ]+>    newManageHook = myManageHook <> manageHook def+++Again we use 'XMonad.ManageHook.composeAll' to compose a list of+different 'XMonad.Config.ManageHook's. The first one will put+RealPlayer on the float layer, the second one will put the xpdf+windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF'+and 'XMonad.StackSet.shift' functions, and the third one will put all+firefox windows on the workspace called "web". Then we use the+'<>' combinator to compose @myManageHook@ with the+default 'XMonad.Config.manageHook' to form @newManageHook@.++Each 'XMonad.Config.ManageHook' has the form:++>    property =? match --> action++Where @property@ can be:++* 'XMonad.ManageHook.title': the window's title++* 'XMonad.ManageHook.resource': the resource name++* 'XMonad.ManageHook.className': the resource class name.++* 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the+  property @somestring@.++(You can retrieve the needed information using the X utility named+@xprop@; for example, to find the resource class name, you can type++> xprop | grep WM_CLASS++at a prompt, then click on the window whose resource class you want to+know.)++@match@ is the string that will match the property value (for instance+the one you retrieved with @xprop@).++An  @action@ can be:++* 'XMonad.ManageHook.doFloat': to place the window in the float layer;++* 'XMonad.ManageHook.doIgnore': to ignore the window;++* 'XMonad.ManageHook.doF': to execute a function with the window as+  argument.++For example, suppose we want to add a 'XMonad.Config.manageHook' to+float RealPlayer, which usually has a 'XMonad.ManageHook.resource'+name of \"realplay.bin\".++First we need to import "XMonad.ManageHook":++>    import XMonad.ManageHook++Then we create our own 'XMonad.Config.manageHook':++>    myManageHook = resource =? "realplay.bin" --> doFloat++We can now use the '<>' combinator to add our+'XMonad.Config.manageHook' to the default one:++>    newManageHook = myManageHook <> manageHook def++(Of course, if we wanted to completely replace the default+'XMonad.Config.manageHook', this step would not be necessary.) Now,+all we need to do is change the 'XMonad.Core.manageHook' field of the+'XMonad.Core.XConfig' record, like so:++>    main = xmonad def { ..., manageHook = newManageHook, ... }++And we are done.++Obviously, we may wish to add more then one+'XMonad.Config.manageHook'. In this case we can use a list of hooks,+compose them all with 'XMonad.ManageHook.composeAll', and add the+composed to the default one.++For instance, if we want RealPlayer to float and thunderbird always+opened in the workspace named "mail", we can do so like this:++>    myManageHook = composeAll [ resource =? "realplay.bin"    --> doFloat+>                              , resource =? "thunderbird-bin" --> doF (W.shift "mail")+>                              ]++Remember to import the module that defines the 'XMonad.StackSet.shift'+function, "XMonad.StackSet", like this:++>    import qualified XMonad.StackSet as W++And then we can add @myManageHook@ to the default one to create+@newManageHook@ as we did in the previous example.++One more thing to note about this system is that if+a window matches multiple rules in a 'XMonad.Config.manageHook', /all/+of the corresponding actions will be run (in the order in which they+are defined).  An alternative version where only the first rule that+matches is run is available as 'XMonad.Hooks.ManageHelpers.composeOne'.++For additional rules and actions you can use in your manageHook, check+out the contrib module "XMonad.Hooks.ManageHelpers".  -}
+ XMonad/Hooks/BorderPerWindow.hs view
@@ -0,0 +1,77 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.BorderPerWindow+-- Description :  Set border width for a window in a ManageHook.+-- Copyright   :  (c) 2021 Xiaokui Shu+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  subbyte@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Want to customize border width, for each window on all layouts? Want+-- specific window have no border on all layouts? Try this.+-----------------------------------------------------------------------------++module XMonad.Hooks.BorderPerWindow ( -- * Usage+                                      -- $usage+                                      defineBorderWidth+                                    , actionQueue++                                      -- * Design Considerations+                                      -- $design+                                    ) where+++import XMonad+import XMonad.Util.ActionQueue (enqueue, actionQueue)++-- $usage+--+-- To use this module, first import it+--+-- > import XMonad.Hooks.BorderPerWindow (defineBorderWidth, actionQueue)+--+-- Then specify which window to customize the border of in your+-- @manageHook@:+--+-- > myManageHook :: ManageHook+-- > myManageHook = composeAll+-- >     [ className =? "firefox"  --> defineBorderWidth 0+-- >     , className =? "Chromium" --> defineBorderWidth 0+-- >     , isDialog                --> defineBorderWidth 8+-- >     ]+--+-- Finally, add the 'actionQueue' combinator and @myManageHook@ to your+-- config:+--+-- > main = xmonad $ actionQueue $ def+-- >     { ...+-- >     , manageHook = myManageHook+-- >     , ...+-- >     }+--+-- Note that this module is incompatible with other ways of changing+-- borders, like "XMonad.Layout.NoBorders".  This is because we are+-- changing the border exactly /once/ (when the window first appears)+-- and not every time some condition is satisfied.++-- $design+--+-- 1. Keep it simple. Since the extension does not aim to change border setting+--    when layout changes, only execute the border setting function once to+--    avoid potential window flashing/jumping/scaling.+--+-- 2. The 'ManageHook' eDSL is a nice language for specifying windows. Let's+--    build on top of it and use it to specify window to define border.++defineBorderWidth :: Dimension -> ManageHook+defineBorderWidth bw = do+    w <- ask+    liftX . enqueue $ updateBorderWidth w bw+    idHook++updateBorderWidth :: Window -> Dimension -> X ()+updateBorderWidth w bw = do+    withDisplay $ \d -> io $ setWindowBorderWidth d w bw+    refresh
XMonad/Hooks/CurrentWorkspaceOnTop.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.CurrentWorkspaceOnTop+-- Description :  Ensure that windows on the current workspace are on top. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -22,14 +22,15 @@     currentWorkspaceOnTop     ) where +import qualified Data.List.NonEmpty as NE (nonEmpty)+import qualified Data.Map as M import XMonad+import XMonad.Prelude (NonEmpty ((:|)), when) import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS-import Control.Monad(when)-import qualified Data.Map as M  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.CurrentWorkspaceOnTop -- >@@ -40,7 +41,7 @@ -- >  } -- -data CWOTState = CWOTS String deriving Typeable+newtype CWOTState = CWOTS String  instance ExtensionClass CWOTState where   initialValue = CWOTS ""@@ -55,15 +56,17 @@         let s = S.current ws             wsp = S.workspace s             viewrect = screenRect $ S.screenDetail s-            tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)+            tmpStack = S.stack wsp >>= S.filter (`M.notMember` S.floating ws)         (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect         updateLayout curTag ml'         let this = S.view curTag ws-            fltWins = filter (flip M.member (S.floating ws)) $ S.index this-            wins = fltWins ++ (map fst rs)  -- order: first all floating windows, then the order the layout returned+            fltWins = filter (`M.member` S.floating ws) $ S.index this+            wins = fltWins ++ map fst rs  -- order: first all floating windows, then the order the layout returned         -- end of reimplementation -        when (not . null $ wins) $ do-            io $ raiseWindow d (head wins)  -- raise first window of current workspace to the very top,-            io $ restackWindows d wins      -- then use restackWindows to let all other windows from the workspace follow+        case NE.nonEmpty wins of+            Nothing         -> pure ()+            Just (w :| ws') -> do+                io $ raiseWindow d w            -- raise first window of current workspace to the very top,+                io $ restackWindows d (w : ws') -- then use restackWindows to let all other windows from the workspace follow         XS.put(CWOTS curTag)
XMonad/Hooks/DebugEvents.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DebugEvents+-- Description :  Dump diagnostic information about X11 events received by xmonad. -- Copyright   :  (c) Brandon S Allbery KF8NH, 2012 -- License     :  BSD3-style (see LICENSE) --@@ -24,31 +25,24 @@ import           XMonad                               hiding (windowEvent                                                              ,(-->)                                                              )+import           XMonad.Prelude                       hiding (fi, bool)  import           XMonad.Hooks.DebugKeyEvents                 (debugKeyEvents) import           XMonad.Util.DebugWindow                     (debugWindow)  -- import           Graphics.X11.Xlib.Extras.GetAtomName        (getAtomName) -import           Control.Exception.Extensible         as E+import           Control.Exception                    as E import           Control.Monad.State import           Control.Monad.Reader-import           Data.Char                                   (isDigit)-import           Data.Maybe                                  (fromJust)-import           Data.List                                   (genericIndex-                                                             ,genericLength-                                                             ,unfoldr-                                                             ) import           Codec.Binary.UTF8.String-import           Data.Maybe                                  (fromMaybe)-import           Data.Monoid-import           Foreign+import           Foreign                                     hiding (void) import           Foreign.C.Types import           Numeric                                     (showHex) import           System.Exit import           System.IO import           System.Process-import           Control.Applicative+import           GHC.Stack                                   (HasCallStack, prettyCallStack, callStack)  -- | Event hook to dump all received events.  You should probably not use this --   unconditionally; it will produce massive amounts of output.@@ -58,17 +52,17 @@ -- | Dump an X11 event.  Can't be used directly as a 'handleEventHook'. debugEventsHook' :: Event -> X () -debugEventsHook' (ConfigureRequestEvent {ev_window       = w-                                        ,ev_parent       = p-                                        ,ev_x            = x-                                        ,ev_y            = y-                                        ,ev_width        = wid-                                        ,ev_height       = ht-                                        ,ev_border_width = bw-                                        ,ev_above        = above-                                        ,ev_detail       = place-                                        ,ev_value_mask   = msk-                                        }) = do+debugEventsHook' ConfigureRequestEvent{ev_window       = w+                                      ,ev_parent       = p+                                      ,ev_x            = x+                                      ,ev_y            = y+                                      ,ev_width        = wid+                                      ,ev_height       = ht+                                      ,ev_border_width = bw+                                      ,ev_above        = above+                                      ,ev_detail       = place+                                      ,ev_value_mask   = msk+                                      } = do   windowEvent "ConfigureRequest" w   windowEvent "  parent"         p --  mask <- quickFormat msk $ dumpBits wmCRMask@@ -91,95 +85,93 @@                            ]   say "  requested" s -debugEventsHook' (ConfigureEvent        {ev_window = w-                                        ,ev_above  = above-                                        }) = do+debugEventsHook' ConfigureEvent        {ev_window = w+                                       ,ev_above  = above+                                       } = do   windowEvent "Configure" w   -- most of the content is covered by debugWindow   when (above /= none) $ debugWindow above >>= say "  above" -debugEventsHook' (MapRequestEvent       {ev_window     = w-                                        ,ev_parent     = p-                                        }) =+debugEventsHook' MapRequestEvent       {ev_window     = w+                                       ,ev_parent     = p+                                       } =   windowEvent "MapRequest" w >>   windowEvent "  parent"   p -debugEventsHook' e@(KeyEvent {ev_event_type = t})+debugEventsHook' e@KeyEvent {ev_event_type = t}     | t == keyPress =   io (hPutStr stderr "KeyPress ") >>   debugKeyEvents e >>   return () -debugEventsHook' (ButtonEvent           {ev_window = w-                                        ,ev_state  = s-                                        ,ev_button = b-                                        }) = do+debugEventsHook' ButtonEvent           {ev_window = w+                                       ,ev_state  = s+                                       ,ev_button = b+                                       } = do   windowEvent "Button" w   nl <- gets numberlockMask   let msk | s == 0    = ""-          | otherwise = "modifiers " ++ vmask nl s+          | otherwise = "modifiers " ++ keymaskToString nl s   say "  button" $ show b ++ msk -debugEventsHook' (DestroyWindowEvent    {ev_window = w-                                        }) =+debugEventsHook' DestroyWindowEvent    {ev_window = w+                                        } =   windowEvent "DestroyWindow" w -debugEventsHook' (UnmapEvent            {ev_window = w-                                        }) =+debugEventsHook' UnmapEvent            {ev_window = w+                                       } =   windowEvent "Unmap" w -debugEventsHook' (MapNotifyEvent        {ev_window = w-                                        }) =+debugEventsHook' MapNotifyEvent        {ev_window = w+                                       } =   windowEvent "MapNotify" w  {- way too much output; suppressed. -debugEventsHook' (CrossingEvent         {ev_window    = w-                                        ,ev_subwindow = s-                                        }) =+debugEventsHook' (CrossingEvent        {ev_window    = w+                                       ,ev_subwindow = s+                                       }) =   windowEvent "Crossing"    w >>   windowEvent "  subwindow" s -}-debugEventsHook' (CrossingEvent         {}) =+debugEventsHook' CrossingEvent         {} =   return () -debugEventsHook' (SelectionRequest      {ev_requestor = rw-                                        ,ev_owner     = ow-                                        ,ev_selection = a-                                        }) =+debugEventsHook' SelectionRequest      {ev_requestor = rw+                                       ,ev_owner     = ow+                                       ,ev_selection = a+                                       } =   windowEvent "SelectionRequest" rw >>   windowEvent "  owner"          ow >>   atomEvent   "  atom"           a -debugEventsHook' (PropertyEvent         {ev_window    = w-                                        ,ev_atom      = a-                                        ,ev_propstate = s-                                        }) = do+debugEventsHook' PropertyEvent         {ev_window    = w+                                       ,ev_atom      = a+                                       ,ev_propstate = s+                                       } = do   a' <- atomName a   -- too many of these, and they're not real useful-  if a' `elem` ["_NET_WM_USER_TIME"---               ,"_NET_WM_WINDOW_OPACITY"-               ] then return () else do-  windowEvent "Property on" w-  s' <- case s of-          1 -> return "deleted"-          0 -> dumpProperty a a' w (7 + length a')-          _ -> error "Illegal propState; Xlib corrupted?"-  say "  atom" $ a' ++ s'+  if a' == "_NET_WM_USER_TIME" then return () else do+    windowEvent "Property on" w+    s' <- case s of+            1 -> return "deleted"+            0 -> dumpProperty a a' w (7 + length a')+            _ -> error "Illegal propState; Xlib corrupted?"+    say "  atom" $ a' ++ s' -debugEventsHook' (ExposeEvent           {ev_window = w-                                        }) =+debugEventsHook' ExposeEvent           {ev_window = w+                                       } =   windowEvent "Expose" w -debugEventsHook' (ClientMessageEvent    {ev_window       = w-                                        ,ev_message_type = a-                                        -- @@@ they did it again!  no ev_format,-                                        --     and ev_data is [CInt]-                                        -- @@@ and get a load of the trainwreck-                                        --     that is setClientMessageEvent!---                                        ,ev_format       = b-                                        ,ev_data         = vs'-                                        }) = do+debugEventsHook' ClientMessageEvent    {ev_window       = w+                                       ,ev_message_type = a+                                       -- @@@ they did it again!  no ev_format,+                                       --     and ev_data is [CInt]+                                       -- @@@ and get a load of the trainwreck+                                       --     that is setClientMessageEvent!+--                                     ,ev_format       = b+                                       ,ev_data         = vs'+                                       } = do   windowEvent "ClientMessage on" w   n <- atomName a   -- this is a sort of custom property@@ -190,7 +182,7 @@                   ta <- getAtom ta'                   return (ta,b,l)   let wl = bytes b-  vs <- io $ take (l * wl) `fmap` splitCInt vs'+  vs <- io $ take (l * wl) <$> splitCInt vs'   s <- dumpProperty' w a n ta b vs 0 (10 + length n)   say "  message" $ n ++ s @@ -199,7 +191,7 @@ -- | Emit information about an atom. atomName   :: Atom -> X String atomName a =  withDisplay $ \d ->-  io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a+  io $ fromMaybe ("(unknown atom " ++ show a ++ ")") <$> getAtomName d a  -- | Emit an atom with respect to the current event. atomEvent     :: String -> Atom -> X ()@@ -211,7 +203,7 @@  -- | Helper to emit tagged event information. say     :: String -> String -> X ()-say l s =  trace $ l ++ ' ':s+say l s =  XMonad.trace $ l ++ ' ':s  -- | Deconstuct a list of 'CInt's into raw bytes splitCInt    :: [CInt] -> IO Raw@@ -226,34 +218,6 @@                   ,("WM_SAVE_YOURSELF"  ,("STRING"            , 8,0))                   ] -#if __GLASGOW_HASKELL__ < 707-finiteBitSize :: Bits a => a -> Int-finiteBitSize x = bitSize x-#endif----- | Convert a modifier mask into a useful string-vmask                 :: KeyMask -> KeyMask -> String-vmask numLockMask msk =  unwords $-                         reverse $-                         fst     $-                         foldr vmask' ([],msk) masks-    where-      masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++-              [(numLockMask,"num"  )-              ,(   lockMask,"lock" )-              ,(controlMask,"ctrl" )-              ,(  shiftMask,"shift")-              ,(   mod5Mask,"mod5" )-              ,(   mod4Mask,"mod4" )-              ,(   mod3Mask,"mod3" )-              ,(   mod2Mask,"mod2" )-              ,(   mod1Mask,"mod1" )-              ]-      vmask'   _   a@( _,0)                = a-      vmask' (m,s)   (ss,v) | v .&. m == m = (s : ss,v .&. complement m)-      vmask'   _        r                  = r- -- formatting properties.  ick. --  -- @@@ Document the parser.  Someday.@@ -276,20 +240,21 @@                         }  newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)-#ifndef __HADDOCK__+     deriving (Functor              ,Applicative              ,Monad              ,MonadIO+             ,MonadFail              ,MonadState  DecodeState              ,MonadReader Decode              )-#endif + -- | Retrive, parse, and dump a window property.  As all the high-level property---   interfaces lose information necessary to decode properties correctly, we +--   interfaces lose information necessary to decode properties correctly, we --   work at the lowest level available.-dumpProperty          :: Atom -> String -> Window -> Int -> X String+dumpProperty          :: HasCallStack => Atom -> String -> Window -> Int -> X String dumpProperty a n w i  =  do   prop <- withDisplay $ \d ->     io     $@@ -313,9 +278,9 @@               vsp     case rc of       0 -> do-        fmt <- fromIntegral `fmap` peek fmtp-        vs' <-                     peek vsp-        sz  <- fromIntegral `fmap` peek szp+        fmt <- fromIntegral <$> peek fmtp+        vs' <-                  peek vsp+        sz  <- fromIntegral <$> peek szp         case () of           () | fmt == none     -> xFree vs' >> return (Left   "(property deleted)"   )              | sz < 0          -> xFree vs' >> return (Left $ "(illegal bit size " ++@@ -325,9 +290,9 @@                                                               show sz              ++                                                               ")"                    )              | otherwise       -> do-                 len <- fromIntegral `fmap` peek lenp+                 len <- fromIntegral <$> peek lenp                  -- that's as in "ack! it's fugged!"-                 ack <- fromIntegral `fmap` peek ackp+                 ack <- fromIntegral <$> peek ackp                  vs <- peekArray (len * bytes sz) vs'                  _ <- xFree vs'                  return $ Right (fmt,sz,ack,vs)@@ -338,7 +303,8 @@  -- @@@ am I better off passing in the Decode and DecodeState? -- | Parse and dump a property (or a 'ClientMessage').-dumpProperty'                             :: Window -- source window+dumpProperty'                             :: HasCallStack+                                          => Window -- source window                                           -> Atom   -- property id                                           -> String -- property name                                           -> Atom   -- property type@@ -369,11 +335,11 @@   (_,ds') <- runDecode dec ds $ dumpProp a n   let fin = length (value ds')       len = length vs-      lost = if ack == 0 then "" else "and " ++ show ack ++ " lost bytes"+      lost = if ack == 0 then "" else " and " ++ show ack ++ " lost bytes"       unk = case () of               () | fin == len -> "undecodeable "                  | fin == 0   -> "."-                 | otherwise  -> "and remainder (" ++ show (len - fin) ++ '/':show len ++ ")"+                 | otherwise  -> " and remainder (" ++ show (len - fin) ++ '/':show len ++ ")"   (_,ds'') <- if fin == 0               then return (True,ds')               else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8@@ -384,7 +350,7 @@  -- | A simplified version of 'dumpProperty\'', to format random values from --   events.-quickFormat     :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String+quickFormat     :: (HasCallStack, Storable i, Integral i) => [i] -> Decoder Bool -> X String quickFormat v f =  do   let vl = length v   vs <- io $@@ -414,10 +380,10 @@ bytes   :: Int -> Int bytes w =  w `div` 8 --- | The top level property decoder, for a wide variety of standard ICCCM and ---   EWMH window properties.  We pass part of the 'ReaderT' as arguments for +-- | The top level property decoder, for a wide variety of standard ICCCM and+--   EWMH window properties.  We pass part of the 'ReaderT' as arguments for --   pattern matching.-dumpProp                                              :: Atom -> String -> Decoder Bool+dumpProp                                              :: HasCallStack => Atom -> String -> Decoder Bool  dumpProp _ "CLIPBOARD"                                =  dumpSelection dumpProp _ "_NET_SUPPORTED"                           =  dumpArray dumpAtom@@ -461,10 +427,13 @@ dumpProp _ "_NET_WM_VISIBLE_NAME"                     =  dumpUTF dumpProp _ "_NET_WM_ICON_NAME"                        =  dumpUTF dumpProp _ "_NET_WM_VISIBLE_ICON_NAME"                =  dumpUTF-dumpProp _ "_NET_WM_DESKTOP"                          =  dumpExcept [(0xFFFFFFFF,"all")]-                                                                    dump32+-- @@@ the property is CARDINAL; the message is _NET_WM_DESKTOP of 5 dump32s+--     [desktop/all, source indication, 3 zeroes]+-- dumpProp _ "_NET_WM_DESKTOP"                          =  dumpExcept [(0xFFFFFFFF,"all")]+--                                                                     dump32+dumpProp _ "_NET_WM_DESKTOP"                          =  dumpSetDesktop dumpProp _ "_NET_WM_WINDOW_TYPE"                      =  dumpArray dumpAtom-dumpProp _ "_NET_WM_STATE"                            =  dumpArray dumpAtom+dumpProp _ "_NET_WM_STATE"                            =  dumpNWState dumpProp _ "_NET_WM_ALLOWED_ACTIONS"                  =  dumpArray dumpAtom dumpProp _ "_NET_WM_STRUT"                            =  dumpList [("left gap"  ,dump32)                                                                   ,("right gap" ,dump32)@@ -502,6 +471,12 @@                                                                   ] dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER"             =  dumpExcept [(0,"illegal value 0")]                                                                     dump64+dumpProp _ "_NET_WM_OPAQUE_REGION"                    =  dumpArray $ dumpList [("x",dump32)+                                                                              ,("y",dump32)+                                                                              ,("w",dump32)+                                                                              ,("h",dump32)+                                                                              ]+dumpProp _ "_NET_WM_BYPASS_COMPOSITOR"                =  dumpEnum cpState dumpProp _ "_NET_STARTUP_ID"                          =  dumpUTF dumpProp _ "WM_PROTOCOLS"                             =  dumpArray dumpAtom dumpProp _ "WM_COLORMAP_WINDOWS"                      =  dumpArray dumpWindow@@ -527,12 +502,12 @@              | a == sECONDARY                         =  dumpSelection                -- this is gross              | a == wM_TRANSIENT_FOR                  =  do-                 root <- fromIntegral `fmap` inX (asks theRoot)+                 root <- fromIntegral <$> inX (asks theRoot)                  w <- asks window-                 WMHints {wmh_window_group = group} <-+                 WMHints {wmh_window_group = wgroup} <-                    inX $ asks display >>= io . flip getWMHints w-                 dumpExcept [(0   ,"window group " ++ show group)-                            ,(root,"window group " ++ show group)+                 dumpExcept [(0   ,"window group " ++ show wgroup)+                            ,(root,"window group " ++ show wgroup)                             ]                             dumpWindow              | a == rESOURCE_MANAGER                  =  dumpString@@ -556,8 +531,8 @@                                                                              ]                                                                    )                                                                   ]-             | a == wM_NORMAL_HINTS                   =  (...)-             | a == wM_ZOOM_HINTS                     =  (...) -- same as previous+             | a == wM_NORMAL_HINTS                   =  dumpSizeHints+             | a == wM_ZOOM_HINTS                     =  dumpSizeHints              | a == rGB_DEFAULT_MAP                   =  (...) -- XStandardColormap              | a == rGB_BEST_MAP                      =  (...) -- "              | a == rGB_RED_MAP                       =  (...) -- "@@ -602,27 +577,27 @@ withIndent w =  local (\r -> r {indent = indent r + w})  -- dump an array of items.  this dumps the entire property-dumpArray      :: Decoder Bool -> Decoder Bool+dumpArray      :: HasCallStack => Decoder Bool -> Decoder Bool dumpArray item =  do   withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "")  -- step through values as an array, ending on parse error or end of list-dumpArray'          :: Decoder Bool -> String -> Decoder Bool+dumpArray'          :: HasCallStack => Decoder Bool -> String -> Decoder Bool dumpArray' item pfx =  do   vs <- gets value-  if vs == []+  if null vs     then append "]"     else append pfx >> whenD item (dumpArray' item ",")  -- keep parsing until a parse step fails -- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when', --     which suggests that 'whenX' is *also* the same function... yep.  ISAGN-whenD     :: Monad m => m Bool -> m Bool -> m Bool+whenD     :: (HasCallStack, Monad m) => m Bool -> m Bool -> m Bool whenD p f =  p >>= \b -> if b then f else return False  -- verify a decoder parameter, else call error reporter -- once again, it's more general than I originally wrote-guardR                  :: (MonadReader r m, Eq v)+guardR                  :: (HasCallStack, MonadReader r m, Eq v)                         => (r -> v)                -- value selector                         -> v                       -- expected value                         -> (v -> v -> m a)         -- error reporter@@ -633,43 +608,47 @@   if v == val then good else err v val  -- this is kinda dumb-fi       :: Bool -> a -> a -> a+fi       :: HasCallStack => Bool -> a -> a -> a fi p n y =  if p then y else n -- flip (if' p), if that existed  -- verify we have the expected word size-guardSize      :: Int -> Decoder Bool -> Decoder Bool+guardSize      :: HasCallStack => Int -> Decoder Bool -> Decoder Bool -- see XSync documentation for this insanity-guardSize 64 =  guardR width 32 propSizeErr . guardSize' 8         propShortErr-guardSize  w =  guardR width  w propSizeErr . guardSize' (bytes w) propShortErr+guardSize 64 =  guardR width 32 propSizeErr . guardSize' 8         (propShortErr' 1)+guardSize  w =  guardR width  w propSizeErr . guardSize' (bytes w) (propShortErr' 2) -guardSize'       :: Int -> Decoder a -> Decoder a -> Decoder a-guardSize' l n y =  gets value >>= \vs -> fi (length vs >= l) n y+guardSize'       :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a+guardSize' l n y =  gets value >>= \vs -> fi (length vs >= bytes l) n y +-- @guardSize@ doesn't work with empty arrays+guardSize''       :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a+guardSize'' l n y =  gets value >>= \vs -> fi (null vs || length vs >= bytes l) n y+ -- verify we have the expected property type-guardType    :: Atom -> Decoder Bool -> Decoder Bool+guardType    :: HasCallStack => Atom -> Decoder Bool -> Decoder Bool guardType  t =  guardR pType t propTypeErr  -- dump a structure as a named tuple-dumpList       :: [(String,Decoder Bool)] -> Decoder Bool+dumpList       :: HasCallStack => [(String,Decoder Bool)] -> Decoder Bool dumpList proto =  do   a <- asks pType   dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "("  -- same but elements have their own distinct types-dumpList'       :: [(String,Decoder Bool,Atom)] -> Decoder Bool+dumpList'       :: HasCallStack => [(String,Decoder Bool,Atom)] -> Decoder Bool dumpList' proto =  dumpList'' (maxBound :: CULong) proto "("  -- same but only dump elements identified by provided mask-dumpListByMask     :: CULong -> [(String,Decoder Bool)] -> Decoder Bool+dumpListByMask     :: HasCallStack => CULong -> [(String,Decoder Bool)] -> Decoder Bool dumpListByMask m p =  do   a <- asks pType   dumpList'' m (map (\(s,d) -> (s,d,a)) p) "("  -- and the previous two combined-dumpListByMask'     :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool+dumpListByMask'     :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool dumpListByMask' m p =  dumpList'' m p "(" -dumpList''                    :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool+dumpList''                    :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool dumpList'' _ []           _   =  append ")" >> return True dumpList'' 0 _            _   =  append ")" >> return True dumpList'' m ((l,p,t):ps) sep = do@@ -694,37 +673,34 @@  -- do the getTextProperty dance, the hard way. -- @@@ @COMPOUND_TEXT@ not supported yet.-dumpString :: Decoder Bool+dumpString :: HasCallStack => Decoder Bool dumpString =  do   fmt <- asks pType-  x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]-  case x of-    [cOMPOUND_TEXT,uTF8_STRING] -> case () of-      () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)-         | fmt == sTRING        -> guardSize  8 $ do-                                     vs <- gets value-                                     modify (\r -> r {value = []})-                                     let ss = flip unfoldr (map twiddle vs) $-                                              \s -> if null s-                                                    then Nothing-                                                    else let (w,s'') = break (== '\NUL') s-                                                             s'      = if null s''-                                                                       then s''-                                                                       else tail s''-                                                          in Just (w,s')-                                     case ss of-                                       [s] -> append $ show s-                                       ss' -> let go (s:ss'') c = append c        >>-                                                                  append (show s) >>-                                                                  go ss'' ","-                                                  go []       _ = append "]"-                                               in append "[" >> go ss' ""-         | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)-         | otherwise            -> (inX $ atomName fmt) >>=-                                   failure . ("unrecognized string type " ++)+  [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]+  case () of+    () | fmt == cOMPOUND_TEXT -> guardSize'' 16 (propShortErr' 3) ( ... )+       | fmt == sTRING        -> guardSize''  8 (propShortErr' 4) $ do+                                   vs <- gets value+                                   modify (\r -> r {value = []})+                                   let ss = flip unfoldr (map twiddle vs) $+                                            \s -> if null s+                                                  then Nothing+                                                  else let (w,s'') = break (== '\NUL') s+                                                           s'      = drop 1 s''+                                                        in Just (w,s')+                                   case ss of+                                     [s] -> append $ show s+                                     ss' -> let go (s:ss'') c = append c        >>+                                                                append (show s) >>+                                                                go ss'' ","+                                                go []       _ = append "]"+                                             in append "[" >> go ss' ""+       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)+       | otherwise            -> inX (atomName fmt) >>=+                                 failure . ("unrecognized string type " ++)  -- show who owns a selection-dumpSelection :: Decoder Bool+dumpSelection :: HasCallStack => Decoder Bool dumpSelection =  do   -- system selections contain a window ID; others are random   -- note that the window ID will be the same as the owner, so@@ -738,29 +714,40 @@       append $ "owned by " ++ w  -- for now, not querying Xkb-dumpXKlInds :: Decoder Bool+dumpXKlInds :: HasCallStack => Decoder Bool dumpXKlInds =  guardType iNTEGER $ do-                 n <- fmap fromIntegral `fmap` getInt' 32+                 n <- fmap fromIntegral <$> getInt' 32                  case n of-                   Nothing -> propShortErr+                   Nothing -> propShortErr' 5                    Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])   where-    dumpInds                               :: Word32 -> Word32 -> Int -> [String] -> [String]+    dumpInds                               :: HasCallStack => Word32 -> Word32 -> Int -> [String] -> [String]     dumpInds n bt c bs | n == 0 && c == 1 =  ["none"]                        | n == 0           =  bs                        | n .&. bt /= 0    =  dumpInds (n .&. complement bt)                                                       (bt `shiftL` 1)                                                       (c + 1)-                                                      ((show c):bs)+                                                      (show c:bs)                        | otherwise        =  dumpInds n                                                       (bt `shiftL` 1)                                                       (c + 1)                                                       bs  -- decode an Atom-dumpAtom :: Decoder Bool-dumpAtom =-  guardType aTOM $ do++dumpAtom :: HasCallStack => Decoder Bool+dumpAtom = dumpAtom'' aTOM++{-+dumpAtom' :: HasCallStack => String -> Decoder Bool+dumpAtom' t' = do+  t <- inX $ getAtom t'+  dumpAtom'' t+-}++dumpAtom'' :: HasCallStack => Atom -> Decoder Bool+dumpAtom'' t =+  guardType t $ do   a <- getInt' 32   case a of     Nothing -> return False@@ -768,15 +755,16 @@            an <- inX $ atomName $ fromIntegral a'            append an -dumpWindow :: Decoder Bool+dumpWindow :: HasCallStack => Decoder Bool dumpWindow =  guardSize 32 $ guardType wINDOW $ do                 w <- getInt' 32                 case w of                   Nothing -> return False+                  Just 0  -> append "none"                   Just w' -> inX (debugWindow (fromIntegral w')) >>= append  -- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list-dumpActiveWindow :: Decoder Bool+dumpActiveWindow :: HasCallStack => Decoder Bool dumpActiveWindow =  guardSize 32 $ do                       t <- asks pType                       nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW"@@ -790,49 +778,87 @@                                      t' <- inX $ atomName t                                      failure $ concat ["(bad type "                                                       ,t'-                                                      ,"; expected WINDOW or _NET_ACTIVE_WINDOW"+                                                      ,"; expected WINDOW or _NET_ACTIVE_WINDOW)"                                                       ]++-- likewise but for _NET_WM_DESKTOP+dumpSetDesktop :: HasCallStack => Decoder Bool+dumpSetDesktop =  guardSize 32 $ do+                    t <- asks pType+                    nWD <- inX $ getAtom "_NET_WM_DESKTOP"+                    case () of+                      () | t == cARDINAL -> dumpExcept [(0xFFFFFFFF,"all")]+                                                       dump32+                         | t == nWD      -> dumpList' [("desktop",dumpExcept [(0xFFFFFFFF,"all")]+                                                                             dump32              ,cARDINAL)+                                                      ,("source" ,dumpEnum awSource              ,cARDINAL)+                                                      ]+                      _                -> do+                                     t' <- inX $ atomName t+                                     failure $ concat ["(bad type "+                                                      ,t'+                                                      ,"; expected CARDINAL or _NET_WM_DESKTOP)"+                                                      ]++-- and again for _NET_WM_STATE+dumpNWState :: HasCallStack => Decoder Bool+dumpNWState =  guardSize'' 32 propShortErr $ do+                    t <- asks pType+                    nWS <- inX $ getAtom "_NET_WM_STATE"+                    case () of+                      () | t == aTOM -> dumpArray dumpAtom+                         | t == nWS  -> dumpList' [("action",dumpEnum nwAction,cARDINAL)+                                                  ,("atom1" ,dumpAtom         ,aTOM)+                                                  ,("atom2" ,dumpAtom         ,aTOM)+                                                  ]+                      _                -> do+                                     t' <- inX $ atomName t+                                     failure $ concat ["(bad type "+                                                      ,t'+                                                      ,"; expected ATOM or _NET_WM_STATE)"+                                                      ]+ -- dump a generic CARDINAL value-dumpInt   :: Int -> Decoder Bool+dumpInt   :: HasCallStack => Int -> Decoder Bool dumpInt w =  guardSize w $ guardType cARDINAL $ getInt w show  -- INTEGER is the signed version of CARDINAL-dumpInteger   :: Int -> Decoder Bool+dumpInteger   :: HasCallStack => Int -> Decoder Bool dumpInteger w =  guardSize w $ guardType iNTEGER $ getInt w (show . signed w)  -- reinterpret an unsigned as a signed-signed     :: Int -> Integer -> Integer+signed     :: HasCallStack => Int -> Integer -> Integer signed w i =  bit (w + 1) - i  -- and wrappers to keep the parse list in bounds-dump64 :: Decoder Bool+dump64 :: HasCallStack => Decoder Bool dump64 =  dumpInt 64 -dump32 :: Decoder Bool+dump32 :: HasCallStack => Decoder Bool dump32 =  dumpInt 32  {- not used in standard properties-dump16 :: Decoder Bool+dump16 :: HasCallStack => Decoder Bool dump16 =  dumpInt 16 -} -dump8 :: Decoder Bool+dump8 :: HasCallStack => Decoder Bool dump8 =  dumpInt 8  -- I am assuming for the moment that this is a single string. -- This might be false; consider the way the STRING properties -- handle lists.-dumpUTF :: Decoder Bool+dumpUTF :: HasCallStack => Decoder Bool dumpUTF =  do   uTF8_STRING <- inX $ getAtom "UTF8_STRING"-  guardType uTF8_STRING $ guardSize 8 $ do-  s <- gets value-  modify (\r -> r {value = []})-  append . show . decode . map fromIntegral $ s-  return True+  guardType uTF8_STRING $ guardSize'' 8 propShortErr $ do+    s <- gets value+    modify (\r -> r {value = []})+    append . show . decode . map fromIntegral $ s+    return True  -- dump an enumerated value using a translation table-dumpEnum'        :: [String] -> Atom -> Decoder Bool+dumpEnum'        :: HasCallStack => [String] -> Atom -> Decoder Bool dumpEnum' ss fmt =  guardType fmt $                     getInt 32     $                     \r -> case () of@@ -841,15 +867,16 @@                                | otherwise             -> genericIndex ss r  -- we do not, unlike @xev@, try to ascii-art pixmaps.-dumpPixmap :: Decoder Bool+dumpPixmap :: HasCallStack => Decoder Bool dumpPixmap =  guardType pIXMAP $ do                 p' <- getInt' 32                 case p' of                   Nothing -> return False+                  Just 0  -> append "none"                   Just p  -> do                     append $ "pixmap " ++ showHex p ""                     g' <- inX $ withDisplay $ \d -> io $-                            Just `fmap` getGeometry d (fromIntegral p)+                            (Just <$> getGeometry d (fromIntegral p))                             `E.catch`                             \e -> case fromException e of                                     Just x -> throw e `const` (x `asTypeOf` ExitSuccess)@@ -869,46 +896,80 @@                                      ,")"                                      ] -dumpOLAttrs :: Decoder Bool+dumpOLAttrs :: HasCallStack => Decoder Bool dumpOLAttrs = do   pt <- inX $ getAtom "_OL_WIN_ATTR"   guardType pt $ do     msk <- getInt' 32     case msk of-      Nothing   -> propShortErr+      Nothing   -> propShortErr' 7       Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom     )                                                       ,("menu"        ,dump32       ) -- @@@ unk                                                       ,("pushpin"     ,dumpEnum bool)                                                       ,("limited menu",dump32       ) -- @@@ unk                                                       ] -dumpMwmHints :: Decoder Bool+dumpMwmHints :: HasCallStack => Decoder Bool dumpMwmHints =  do   ta <- asks property   guardType ta $ do     msk <- getInt' 32     case msk of-      Nothing   -> propShortErr-      Just msk' -> dumpListByMask (fromIntegral msk') [("functions"  ,dumpBits mwmFuncs    )-                                                      ,("decorations",dumpBits mwmDecos    )-                                                      ,("input mode" ,dumpEnum mwmInputMode)-                                                      ,("status"     ,dumpBits mwmState    )-                                                      ]+      Nothing   -> propShortErr' 8+      Just msk' -> dumpListByMask' (fromIntegral msk') [("functions"  ,dumpBits mwmFuncs    ,cARDINAL)+                                                       ,("decorations",dumpBits mwmDecos    ,cARDINAL)+                                                       ,("input mode" ,dumpEnum mwmInputMode,cARDINAL) -- @@@ s/b iNTEGER?+                                                       ,("status"     ,dumpBits mwmState    ,cARDINAL)+                                                       ] -dumpMwmInfo :: Decoder Bool+dumpMwmInfo :: HasCallStack => Decoder Bool dumpMwmInfo =  do   ta <- asks property   guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL)                            ,("window",dumpWindow       ,wINDOW  )                            ]-             ++dumpSizeHints :: HasCallStack => Decoder Bool+dumpSizeHints =  do+  guardType wM_SIZE_HINTS $ do+    -- flags, 4 unused CARD32s, fields as specified by flags+    msk <- fmap fromIntegral <$> getInt' 32+    eat (4 * 4) >> pure False+    case msk of+      Nothing   -> propShortErr' 9+      Just msk' -> dumpListByMask' msk' [("min size"    ,dumpSize  ,cARDINAL)+                                        ,("max size"    ,dumpSize  ,cARDINAL)+                                        ,("increment"   ,dumpSize  ,cARDINAL)+                                        ,("aspect ratio",dumpAspect,cARDINAL)+                                        ,("base size"   ,dumpSize  ,cARDINAL)+                                        ,("gravity"     ,dumpGrav  ,cARDINAL)+                                        ]++dumpSize :: HasCallStack => Decoder Bool+dumpSize =  append "(" >> dump32 >> append "," >> dump32 >> append ")"++dumpAspect :: HasCallStack => Decoder Bool+dumpAspect =  do+  -- have to do this manually since it doesn't really fit+  append "min = "+  dump32+  append "/"+  dump32+  append ", max = "+  dump32+  append "/"+  dump32++dumpGrav :: HasCallStack => Decoder Bool+dumpGrav =  dumpEnum wmGravity+ -- the most common case-dumpEnum    :: [String] -> Decoder Bool+dumpEnum    :: HasCallStack => [String] -> Decoder Bool dumpEnum ss =  dumpEnum' ss cARDINAL  -- implement exceptional cases atop a normal dumper -- @@@ there's gotta be a better way-dumpExcept           :: [(Integer,String)] -> Decoder Bool -> Decoder Bool+dumpExcept           :: HasCallStack => [(Integer,String)] -> Decoder Bool -> Decoder Bool dumpExcept xs item = do   -- this horror brought to you by reparsing to get the right value for our use   sp <- get@@ -923,7 +984,8 @@     -- and after all that, we can process the exception list     dumpExcept' xs that v -dumpExcept'                                      :: [(Integer,String)]+dumpExcept'                                      :: HasCallStack+                                                 => [(Integer,String)]                                                  -> DecodeState                                                  -> Integer                                                  -> Decoder Bool@@ -933,7 +995,7 @@  -- use @ps@ to get process information. -- @@@@ assumes a POSIX @ps@, not a BSDish one.-dumpPid :: Decoder Bool+dumpPid :: HasCallStack => Decoder Bool dumpPid =  guardType cARDINAL $ do              n <- getInt' 32              case n of@@ -945,23 +1007,23 @@                       case o of                         Nothing -> append $ "pid " ++ pid                         Just p' -> do-                                  prc <- io $ lines `fmap` hGetContents p'+                                  prc <- io $ lines <$> hGetContents p'                                   -- deliberately forcing it                                   append $ if length prc < 2                                            then "pid " ++ pid                                            else prc !! 1 -dumpTime :: Decoder Bool+dumpTime :: HasCallStack => Decoder Bool dumpTime =  append "server event # " >> dump32 -dumpState :: Decoder Bool+dumpState :: HasCallStack => Decoder Bool dumpState =  do   wM_STATE <- inX $ getAtom "WM_STATE"   guardType wM_STATE $ dumpList' [("state"      ,dumpEnum wmState,cARDINAL)                                  ,("icon window",dumpWindow      ,wINDOW  )                                  ] -dumpMotifDragReceiver :: Decoder Bool+dumpMotifDragReceiver :: HasCallStack => Decoder Bool dumpMotifDragReceiver =  do   ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO"   guardType ta $ dumpList' [("endian"    ,dumpMotifEndian,cARDINAL)@@ -969,11 +1031,11 @@                            ,("style"     ,dumpMDropStyle ,cARDINAL) -- @@@ dummy                            ] -dumpMDropStyle :: Decoder Bool+dumpMDropStyle :: HasCallStack => Decoder Bool dumpMDropStyle =  do   d <- getInt' 8   pad 1 $ case d of-            Nothing             -> propShortErr+            Nothing             -> propShortErr' 9             Just ps | ps == 0   -> pad 12 $ append "none"                     | ps == 1   -> pad 12 $ append "drop only"                     | ps == 2   ->          append "prefer preregister " >> dumpMDPrereg@@ -983,7 +1045,7 @@                     | ps == 6   -> pad 12 $ append "prefer receiver"                     | otherwise -> failure $ "unknown drop style " ++ show ps -dumpMDPrereg :: Decoder Bool+dumpMDPrereg :: HasCallStack => Decoder Bool dumpMDPrereg =  do   -- this is a bit ugly; we pretend to be extending the above dumpList'   append ","@@ -993,7 +1055,7 @@   append "drop sites = "   dsc' <- getInt' 16   case dsc' of-    Nothing  -> propShortErr+    Nothing  -> propShortErr' 10     Just dsc -> do       withIndent 13 $ append (show dsc)       pad 2 $ do@@ -1001,36 +1063,36 @@         append "total size = "         withIndent 13 dump32         dumpMDBlocks $ fromIntegral dsc-    + dumpMDBlocks   :: Int -> Decoder Bool dumpMDBlocks _ =  propSimple "(drop site info)" -- @@@ maybe later if needed -dumpMotifEndian :: Decoder Bool+dumpMotifEndian :: HasCallStack => Decoder Bool dumpMotifEndian =  guardType cARDINAL $ guardSize 8 $ do-  c <- map twiddle `fmap` eat 1+  c <- map twiddle <$> eat 1   case c of     ['l'] -> append "little"     ['B'] -> append "big"     _     -> failure "bad endian flag" -pad     :: Int -> Decoder Bool -> Decoder Bool+pad     :: HasCallStack => Int -> Decoder Bool -> Decoder Bool pad n p =  do   vs <- gets value   if length vs < n-    then propShortErr+    then propShortErr' 11     else modify (\r -> r {value = drop n vs}) >> p -dumpPercent :: Decoder Bool+dumpPercent :: HasCallStack => Decoder Bool dumpPercent =  guardType cARDINAL $ do                  n <- getInt' 32                  case n of                    Nothing -> return False-                   Just n' -> +                   Just n' ->                        let pct = 100 * fromIntegral n' / fromIntegral (maxBound :: Word32)                            pct :: Double                         in append $ show (round pct :: Integer) ++ "%" -dumpWmHints :: Decoder Bool+dumpWmHints :: HasCallStack => Decoder Bool dumpWmHints =   guardType wM_HINTS $ do   msk <- getInt' 32@@ -1047,7 +1109,7 @@                                  ,("window_group" ,dumpWindow      ,wINDOW  )                                  ] -dumpBits    :: [String] -> Decoder Bool+dumpBits    :: HasCallStack => [String] -> Decoder Bool dumpBits bs =  guardType cARDINAL $ do                  n <- getInt' 32                  case n of@@ -1105,6 +1167,9 @@             ,"pager/task list"             ] +cpState :: [String]+cpState =  ["no preference","disable compositing","force compositing"]+ {- eventually... wmHintsFlags :: [String] wmHintsFlags =  ["Input"@@ -1148,6 +1213,12 @@ wmState :: [String] wmState =  ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"] +nwAction :: [String]+nwAction =  ["Clear", "Set", "Toggle"]++wmGravity :: [String]+wmGravity =  ["forget/unmap","NW","N","NE","W","C","E","SW","S","SE","static"]+ nwmEnum                  :: Maybe String                          -> [String]                          -> [String]@@ -1157,7 +1228,7 @@ -- and the lowest level coercions --  -- parse and return an integral value-getInt'    :: Int -> Decoder (Maybe Integer)+getInt'    :: HasCallStack => Int -> Decoder (Maybe Integer) -- see XSync documentation for this insanity getInt' 64 =  guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $               guardSize' 8 (propShortErr >> return Nothing) $ do@@ -1165,8 +1236,8 @@                 hi <- inhale 32                 return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1) getInt' w  =  guardR width w  (\a e -> propSizeErr a e >> return Nothing) $-              guardSize' (bytes w) (propShortErr >> return Nothing)       $-              Just `fmap` inhale w+              guardSize' (bytes w) (propShortErr' 13 >> return Nothing)       $+              Just <$> inhale w  -- parse an integral value and feed it to a show-er of some kind getInt     :: Int -> (Integer -> String) -> Decoder Bool@@ -1178,28 +1249,25 @@ -- @@@@@@@@@ evil beyond evil.  there *has* to be a better way inhale    :: Int -> Decoder Integer inhale  8 =  do-               x <- eat 1-               case x of-                 [b] -> return $ fromIntegral b+               [b] <- eat 1+               return $ fromIntegral b inhale 16 =  do-               x <- eat 2-               case x of-                 [b0,b1] -> io $ allocaArray 2 $ \p -> do-                              pokeArray p [b0,b1]-                              [v] <- peekArray 1 (castPtr p :: Ptr Word16)-                              return $ fromIntegral v+               [b0,b1] <- eat 2+               io $ allocaArray 2 $ \p -> do+                 pokeArray p [b0,b1]+                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)+                 return $ fromIntegral v inhale 32 =  do-               x <- eat 4-               case x of-                 [b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do-                                    pokeArray p [b0,b1,b2,b3]-                                    [v] <- peekArray 1 (castPtr p :: Ptr Word32)-                                    return $ fromIntegral v+               [b0,b1,b2,b3] <- eat 4+               io $ allocaArray 4 $ \p -> do+                 pokeArray p [b0,b1,b2,b3]+                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)+                 return $ fromIntegral v inhale  b =  error $ "inhale " ++ show b  eat   :: Int -> Decoder Raw eat n =  do-  (bs,rest) <- splitAt n `fmap` gets value+  (bs,rest) <- gets (splitAt n . value)   modify (\r -> r {value = rest})   return bs @@ -1210,8 +1278,8 @@ append =  append' True  -- and the same but for errors-failure :: String -> Decoder Bool-failure =  append' False+failure :: HasCallStack => String -> Decoder Bool+failure =  append' False . (++ prettyCallStack callStack)  -- common appender append'     :: Bool -> String -> Decoder Bool@@ -1225,8 +1293,12 @@ propSimple s =  modify (\r -> r {value = []}) >> append s  -- report various errors-propShortErr :: Decoder Bool+propShortErr :: HasCallStack => Decoder Bool propShortErr =  failure "(property ended prematurely)"++-- debug version+propShortErr'   :: HasCallStack => Int -> Decoder Bool+propShortErr' n =  failure $ "(short prop " ++ show n ++ ")"  propSizeErr     :: Int -> Int -> Decoder Bool propSizeErr e a =  failure $ "(bad bit width " ++
XMonad/Hooks/DebugKeyEvents.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.DebugKeyEvents+-- Description  : Track key events. -- Copyright    : (c) 2011 Brandon S Allbery <allbery.b@gmail.com> -- License      : BSD --@@ -19,6 +20,7 @@                                    ) where  import           XMonad.Core+import           XMonad.Prelude import           XMonad.Operations               (cleanMask)  import           Graphics.X11.Xlib@@ -26,8 +28,6 @@  import           Control.Monad.State             (gets) import           Data.Bits-import           Data.List                       (intercalate)-import           Data.Monoid import           Numeric                         (showHex) import           System.IO                       (hPutStrLn                                                  ,stderr)@@ -41,7 +41,7 @@ -- -- If you already have a handleEventHook then you should append it: ----- >      , handleEventHook = ... <+> debugKeyEvents+-- >      , handleEventHook = ... <> debugKeyEvents -- -- Logged key events look like: --@@ -51,33 +51,32 @@ -- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after -- sanitizing it (removing @numberLockMask@, etc.) ----- For more detailed instructions on editing the logHook see:------ "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"+-- For more detailed instructions on editing the logHook see+-- <https://xmonad.org/TUTORIAL.html#make-xmonad-and-xmobar-talk-to-each-other the tutorial>.  -- | Print key events to stderr for debugging debugKeyEvents :: Event -> X All-debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})+debugKeyEvents KeyEvent{ev_event_type = t, ev_state = m, ev_keycode = code}   | t == keyPress =       withDisplay $ \dpy -> do         sym <- io $ keycodeToKeysym dpy code 0         msk <- cleanMask m         nl <- gets numberlockMask-        io $ hPutStrLn stderr $ intercalate " " ["keycode"-                                                ,show code-                                                ,"sym"-                                                ,show sym-                                                ," ("-                                                ,hex sym-                                                ," \""-                                                ,keysymToString sym-                                                ,"\") mask"-                                                ,hex m-                                                ,"(" ++ vmask nl m ++ ")"-                                                ,"clean"-                                                ,hex msk-                                                ,"(" ++ vmask nl msk ++ ")"-                                                ]+        io $ hPutStrLn stderr $ unwords ["keycode"+                                        ,show code+                                        ,"sym"+                                        ,show sym+                                        ," ("+                                        ,hex sym+                                        ," \""+                                        ,keysymToString sym+                                        ,"\") mask"+                                        ,hex m+                                        ,"(" ++ vmask nl m ++ ")"+                                        ,"clean"+                                        ,hex msk+                                        ,"(" ++ vmask nl msk ++ ")"+                                        ]         return (All True) debugKeyEvents _ = return (All True) @@ -87,15 +86,11 @@  -- | Convert a modifier mask into a useful string vmask                 :: KeyMask -> KeyMask -> String-vmask numLockMask msk =  intercalate " " $+vmask numLockMask msk =  unwords $                          reverse $                          fst $                          foldr vmask' ([],msk) masks     where--#if __GLASGOW_HASKELL__ < 707-      finiteBitSize x = bitSize x-#endif       masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++               [(numLockMask,"num"  )               ,(   lockMask,"lock" )
XMonad/Hooks/DebugStack.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DebugStack+-- Description :  Dump the state of the StackSet. -- Copyright   :  (c) Brandon S Allbery KF8NH, 2014 -- License     :  BSD3-style (see LICENSE) --@@ -24,6 +25,7 @@                                ) where  import           XMonad.Core+import           XMonad.Prelude import qualified XMonad.StackSet                                       as W  import           XMonad.Util.DebugWindow@@ -31,10 +33,7 @@ import           Graphics.X11.Types                  (Window) import           Graphics.X11.Xlib.Extras            (Event) -import           Control.Monad                       (foldM) import           Data.Map                            (member)-import           Data.Monoid                         (All(..))-import           Data.List                           (intercalate)  -- | Print the state of the current window stack for the current workspace to --   @stderr@, which for most installations goes to @~/.xsession-errors@.
XMonad/Hooks/DynamicBars.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DynamicBars+-- Description :  Manage per-screen status bars. -- Copyright   :  (c) Ben Boeckel 2012 -- License     :  BSD-style (as xmonad) --@@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Hooks.DynamicBars (+module XMonad.Hooks.DynamicBars {-# DEPRECATED "Use XMonad.Hooks.StatusBar instead" #-} (   -- * Usage   -- $usage     DynamicStatusBar@@ -29,15 +29,9 @@  import Prelude -import Control.Monad import Control.Monad.Trans (lift) import Control.Monad.Writer (WriterT, execWriterT, tell) -import Data.List-import Data.Maybe-import Data.Monoid-import Data.Foldable (traverse_)- import Graphics.X11.Xinerama import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras@@ -46,6 +40,7 @@ import System.IO  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.DynamicLog import qualified XMonad.Util.ExtensibleState as XS@@ -84,9 +79,9 @@ -- is called when the number of screens changes and on startup. -- -data DynStatusBarInfo = DynStatusBarInfo+newtype DynStatusBarInfo = DynStatusBarInfo   { dsbInfo :: [(ScreenId, Handle)]-  } deriving (Typeable)+  }  instance ExtensionClass DynStatusBarInfo where   initialValue = DynStatusBarInfo []@@ -118,12 +113,12 @@ dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup)  dynStatusBarRun :: X () -> Event -> X All-dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True)-dynStatusBarRun _      _                              = return (All True)+dynStatusBarRun action RRScreenChangeNotifyEvent{} = action >> return (All True)+dynStatusBarRun _      _                           = return (All True)  updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X () updateStatusBars sb cleanup = do-  (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo+  (dsbInfoScreens, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo   screens <- getScreens   when (screens /= dsbInfoScreens) $ do       newHandles <- liftIO $ do@@ -134,14 +129,14 @@  updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X () updateStatusBars' sb cleanup = do-  (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo+  (dsbInfoScreens, dsbInfoHandles) <- XS.get <&> (unzip . dsbInfo)   screens <- getScreens   when (screens /= dsbInfoScreens) $ do       let oldInfo = zip dsbInfoScreens dsbInfoHandles       let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo       newInfo <- liftIO $ do-          mapM_ hClose $ map snd infoToClose-          mapM_ cleanup $ map fst infoToClose+          mapM_ (hClose . snd) infoToClose+          mapM_ (cleanup . fst) infoToClose           let newScreens = screens \\ dsbInfoScreens           newHandles <- mapM sb newScreens           return $ zip newScreens newHandles@@ -158,7 +153,7 @@  multiPPFormat :: (PP -> X String) -> PP -> PP -> X () multiPPFormat dynlStr focusPP unfocusPP = do-  (_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo+  (_, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo   multiPP' dynlStr focusPP unfocusPP dsbInfoHandles  multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
XMonad/Hooks/DynamicHooks.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DynamicHooks+-- Description :  One-shot and permanent ManageHooks that can be updated at runtime. -- Copyright   :  (c) Braden Shepherdson 2008 -- License     :  BSD-style (as xmonad) --@@ -23,12 +23,9 @@   ) where  import XMonad+import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS -import Data.List-import Data.Maybe (listToMaybe)-import Data.Monoid- -- $usage -- Provides two new kinds of 'ManageHooks' that can be defined at runtime. --@@ -41,7 +38,7 @@ -- -- To use this module, add 'dynamicMasterHook' to your 'manageHook': ----- > xmonad { manageHook = myManageHook <+> dynamicMasterHook }+-- > xmonad { manageHook = myManageHook <> dynamicMasterHook } -- -- You can then use the supplied functions in your keybindings: --@@ -51,7 +48,6 @@ data DynamicHooks = DynamicHooks     { transients :: [(Query Bool, ManageHook)]     , permanent  :: ManageHook }-                    deriving Typeable  instance ExtensionClass DynamicHooks where     initialValue = DynamicHooks [] idHook@@ -62,19 +58,19 @@ -- doFloat and doIgnore are idempotent. -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'. dynamicMasterHook :: ManageHook-dynamicMasterHook = (ask >>= \w -> liftX (do+dynamicMasterHook = ask >>= \w -> liftX $ do   dh <- XS.get   (Endo f)  <- runQuery (permanent dh) w   ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)   let (ts',nts) = partition fst ts   gs <- mapM (flip runQuery w . snd . snd) ts'-  let (Endo g) = maybe (Endo id) id $ listToMaybe gs+  let (Endo g) = fromMaybe (Endo id) $ listToMaybe gs   XS.put $ dh { transients = map snd nts }   return $ Endo $ f . g-                                       ))+ -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'. addDynamicHook :: ManageHook -> X ()-addDynamicHook m = updateDynamicHook (<+> m)+addDynamicHook m = updateDynamicHook (<> m)  -- | Modifies the permanent 'ManageHook' with an arbitrary function. updateDynamicHook :: (ManageHook -> ManageHook) -> X ()@@ -90,4 +86,4 @@ -- > oneShotHook dynHooksRef (className =? "example) doFloat -- oneShotHook :: Query Bool -> ManageHook -> X ()-oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }+oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):transients dh }
+ XMonad/Hooks/DynamicIcons.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DynamicIcons+-- Description :  Dynamically update workspace names based on its contents\/windows on it.+-- Copyright   :  (c) Ivy Pierlot <ivyp@outlook.com.au>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ivy Pierlot <ivyp@outlook.com.au>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Dynamically augment workspace names logged to a status bar+-- based on the contents (windows) of the workspace.+-----------------------------------------------------------------------------++module XMonad.Hooks.DynamicIcons (+    -- * Usage+    -- $usage++    -- * Creating Dynamic Icons+    iconsPP, dynamicLogIconsWithPP, appIcon,++    -- * Customization+    dynamicIconsPP, getWorkspaceIcons,+    IconConfig(..),+    iconsFmtAppend, iconsFmtReplace, wrapUnwords,+    iconsGetAll, iconsGetFocus,++    ) where+import XMonad++import qualified XMonad.StackSet as S+import qualified Data.Map as M++import XMonad.Hooks.StatusBar.PP+import XMonad.Prelude (for, maybeToList, (<&>), (<=<), (>=>))++-- $usage+-- Dynamically augment Workspace's 'WorkspaceId' as shown on a status bar+-- based on the 'Window's inside the Workspace.+--+-- Icons are specified by a @Query [String]@, which is something like a+-- 'ManageHook' (and uses the same syntax) that returns a list of 'String's+-- (icons). This 'Query' is evaluated for each window and the results are+-- joined together. 'appIcon' is a useful shortcut here.+--+-- For example:+--+-- > myIcons :: Query [String]+-- > myIcons = composeAll+-- >   [ className =? "discord" --> appIcon "\xfb6e"+-- >   , className =? "Discord" --> appIcon "\xf268"+-- >   , className =? "Firefox" --> appIcon "\63288"+-- >   , className =? "Spotify" <||> className =? "spotify" --> appIcon "阮"+-- >   ]+--+-- then you can add it to your "XMonad.Hooks.StatusBar" config:+--+-- > myBar = statusBarProp "xmobar" (iconsPP myIcons myPP)+-- > main = xmonad . withSB myBar $ … $ def+--+-- Here is an example of this+--+-- <<https://user-images.githubusercontent.com/300342/111010930-36a54300-8398-11eb-8aec-b3059b04fa31.png>>+--+-- Note: You can use any string you want here.+-- The example shown here uses NerdFont Icons to represent open applications.+--+-- If you want to customize formatting and/or combine this with other+-- 'PP' extensions like "XMonad.Util.ClickableWorkspaces", here's a more+-- advanced example how to do that:+--+-- > myIconConfig = def{ iconConfigIcons = myIcons, iconConfigFmt = iconsFmtAppend concat }+-- > myBar = statusBarProp "xmobar" (clickablePP =<< dynamicIconsPP myIconConfig myPP)+-- > main = xmonad . withSB myBar . … $ def+--+-- This can be also used with "XMonad.Hooks.DynamicLog":+--+-- > main = xmonad $ … $ def+-- >   { logHook = dynamicLogIconsWithPP myIcons xmobarPP+-- >   , … }+--+-- or with more customziation:+--+-- > myIconConfig = def{ iconConfigIcons = myIcons, iconConfigFmt = iconsFmtAppend concat }+-- > main = xmonad $ … $ def+-- >   { logHook = xmonadPropLog =<< dynamicLogString =<< clickablePP =<<+-- >               dynamicIconsPP myIconConfig xmobarPP+-- >   , … }+++-- | Shortcut for configuring single icons.+appIcon :: String -> Query [String]+appIcon = pure . pure++-- | Adjusts the 'PP' and then runs 'dynamicLogWithPP'+dynamicLogIconsWithPP :: Query [String] -- ^ The 'IconSet' to use+                      -> PP -- ^ The 'PP' to alter+                      -> X () -- ^ The resulting 'X' action+dynamicLogIconsWithPP q = dynamicLogWithPP <=< iconsPP q++-- | Adjusts the 'PP' with the given 'IconSet'+iconsPP :: Query [String] -- ^ The 'IconSet' to use+        -> PP -- ^ The 'PP' to alter+        -> X PP -- ^ The resulting 'X PP'+iconsPP q = dynamicIconsPP def{ iconConfigIcons = q }++-- | Modify a pretty-printer, 'PP', to augment+-- workspace names with icons based on the contents (windows) of the workspace.+dynamicIconsPP :: IconConfig -> PP -> X PP+dynamicIconsPP ic pp = getWorkspaceIcons ic <&> \ren -> pp{ ppRename = ppRename pp >=> ren }++-- | Returns a function for 'ppRename' that augments workspaces with icons+-- according to the provided 'IconConfig'.+getWorkspaceIcons :: IconConfig -> X (String -> WindowSpace -> String)+getWorkspaceIcons conf@IconConfig{..} = fmt <$> getWorkspaceIcons' conf+  where+    fmt icons s w = iconConfigFmt s (M.findWithDefault [] (S.tag w) icons)++getWorkspaceIcons' :: IconConfig  -> X (M.Map WorkspaceId [String])+getWorkspaceIcons' IconConfig{..} = do+    ws <- gets (S.workspaces . windowset)+    is <- for ws $ foldMap (runQuery iconConfigIcons) <=< iconConfigFilter . S.stack+    pure $ M.fromList (zip (map S.tag ws) is)++-- | Datatype for expanded 'Icon' configurations+data IconConfig = IconConfig+    { iconConfigIcons :: Query [String]+      -- ^ What icons to use for each window.+    , iconConfigFmt :: WorkspaceId -> [String] -> String+      -- ^ How to format the result, see 'iconsFmtReplace', 'iconsFmtAppend'.+    , iconConfigFilter :: Maybe (S.Stack Window) -> X [Window]+      -- ^ Which windows (icons) to show.+    }++instance Default IconConfig where+    def = IconConfig+        { iconConfigIcons = mempty+        , iconConfigFmt = iconsFmtReplace (wrapUnwords "{" "}")+        , iconConfigFilter = iconsGetAll+        }++-- | 'iconConfigFmt' that replaces the workspace name with icons, if any.+--+-- First parameter specifies how to concatenate multiple icons. Useful values+-- include: 'concat', 'unwords', 'wrapUnwords'.+--+-- ==== __Examples__+--+-- >>> iconsFmtReplace concat "1" []+-- "1"+--+-- >>> iconsFmtReplace concat "1" ["A", "B"]+-- "AB"+--+-- >>> iconsFmtReplace (wrapUnwords "{" "}") "1" ["A", "B"]+-- "{A B}"+iconsFmtReplace :: ([String] -> String) -> WorkspaceId -> [String] -> String+iconsFmtReplace cat ws is | null is   = ws+                          | otherwise = cat is++-- | 'iconConfigFmt' that appends icons to the workspace name.+--+-- First parameter specifies how to concatenate multiple icons. Useful values+-- include: 'concat', 'unwords', 'wrapUnwords'.+--+-- ==== __Examples__+--+-- >>> iconsFmtAppend concat "1" []+-- "1"+--+-- >>> iconsFmtAppend concat "1" ["A", "B"]+-- "1:AB"+iconsFmtAppend :: ([String] -> String) -> WorkspaceId -> [String] -> String+iconsFmtAppend cat ws is | null is   = ws+                         | otherwise = ws ++ ':' : cat is++-- | Join words with spaces, and wrap the result in delimiters unless there+-- was exactly one element.+--+-- ==== __Examples__+--+-- >>> wrapUnwords "{" "}" ["A", "B"]+-- "{A B}"+--+-- >>> wrapUnwords "{" "}" ["A"]+-- "A"+--+-- >>> wrapUnwords "{" "}" []+-- ""+wrapUnwords :: String -> String -> [String] -> String+wrapUnwords _ _ [x] = x+wrapUnwords l r xs  = wrap l r (unwords xs)++-- | 'iconConfigFilter' that shows all windows of every workspace.+iconsGetAll :: Maybe (S.Stack Window) -> X [Window]+iconsGetAll = pure . S.integrate'++-- | 'iconConfigFilter' that shows only the focused window for each workspace.+iconsGetFocus :: Maybe (S.Stack Window) -> X [Window]+iconsGetFocus = pure . maybeToList . fmap S.focus
XMonad/Hooks/DynamicLog.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleContexts, PatternGuards #-}+{-# LANGUAGE FlexibleContexts #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DynamicLog+-- Description :  Send information about xmonad's state to an X11 property or standard output. -- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au> -- License     :  BSD3-style (see LICENSE) --@@ -10,6 +11,16 @@ -- Stability   :  unstable -- Portability :  unportable --+-- __Note:__ This module is a __compatibility wrapper__ for the following:+--+-- * "XMonad.Hooks.StatusBar"+-- * "XMonad.Hooks.StatusBar.PP"+--+-- DynamicLog API is frozen and users are encouraged to migrate to these+-- modern replacements.+--+-- /Original description and documentation follows:/+-- -- xmonad calls the logHook with every internal state update, which is -- useful for (among other things) outputting status information to an -- external status bar program such as xmobar or dzen.  DynamicLog@@ -23,67 +34,52 @@     -- $usage      -- * Drop-in loggers-    dzen,-    dzenWithFlags,+    xmobarProp,     xmobar,     statusBar,+    dzen,+    dzenWithFlags,     dynamicLog,     dynamicLogXinerama, -    xmonadPropLog',     xmonadPropLog,+    xmonadPropLog',+    xmonadDefProp,      -- * Build your own formatter     dynamicLogWithPP,     dynamicLogString,-    PP(..), defaultPP, def,+    PP(..), def,      -- * Example formatters     dzenPP, xmobarPP, sjanssenPP, byorgeyPP,      -- * Formatting utilities-    wrap, pad, trim, shorten,-    xmobarColor, xmobarAction, xmobarRaw,-    xmobarStrip, xmobarStripTags,-    dzenColor, dzenEscape, dzenStrip,+    wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft',+    xmobarColor, xmobarAction, xmobarBorder,+    xmobarRaw, xmobarStrip, xmobarStripTags,+    dzenColor, dzenEscape, dzenStrip, filterOutWsPP,      -- * Internal formatting functions     pprWindowSet,-    pprWindowSetXinerama--    -- * To Do-    -- $todo+    pprWindowSetXinerama,    ) where  -- Useful imports -import Codec.Binary.UTF8.String (encodeString)-import Control.Monad (liftM2, msum)-import Data.Char ( isSpace, ord )-import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)-import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )-import Data.Ord ( comparing )-import qualified Data.Map as M-import qualified XMonad.StackSet as S--import Foreign.C (CChar)- import XMonad -import XMonad.Util.WorkspaceCompare-import XMonad.Util.NamedWindows-import XMonad.Util.Run- import XMonad.Layout.LayoutModifier-import XMonad.Hooks.UrgencyHook import XMonad.Hooks.ManageDocks+import XMonad.Hooks.StatusBar.PP+import XMonad.Hooks.StatusBar  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: ----- >    import XMonad--- >    import XMonad.Hooks.DynamicLog+-- > import XMonad+-- > import XMonad.Hooks.DynamicLog -- -- If you just want a quick-and-dirty status bar with zero effort, try -- the 'xmobar' or 'dzen' functions:@@ -140,15 +136,9 @@ -- changes, you could make a keybinding to cycle the layout and -- display the current status: ----- >    , ((mod1Mask, xK_a     ), sendMessage NextLayout >> (dynamicLogString myPP >>= \d->spawn $"xmessage "++d))+-- >    , ((mod1Mask, xK_a     ), sendMessage NextLayout >> (dynamicLogString myPP >>= xmessage)) -- --- $todo------   * incorporate dynamicLogXinerama into the PP framework somehow------   * add an xmobarEscape function- ------------------------------------------------------------------------  -- | Run xmonad with a dzen status bar with specified dzen@@ -160,22 +150,18 @@ -- > -- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d" ----- This function can be used to customize the arguments passed to dzen2.--- e.g changing the default width and height of dzen2.------ If you wish to customize the status bar format at all, you'll have to--- use the 'statusBar' function instead.------ The binding uses the XMonad.Hooks.ManageDocks module to automatically--- handle screen placement for dzen, and enables 'mod-b' for toggling--- the menu bar.+-- This function works much in the same way as the 'dzen' function, only that it+-- can also be used to customize the arguments passed to dzen2, e.g changing the+-- default width and height of dzen2. -- -- You should use this function only when the default 'dzen' function does not -- serve your purpose. -- dzenWithFlags :: LayoutClass l Window-    => String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))-dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf+              => String     -- ^ Flags to give to @dzen@+              -> XConfig l  -- ^ The base config+              -> IO (XConfig (ModifiedLayout AvoidStruts l))+dzenWithFlags flags = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey  -- | Run xmonad with a dzen status bar set to some nice defaults. --@@ -183,82 +169,43 @@ -- > -- > myConfig = def { ... } ----- The intent is that the above config file should provide a nice--- status bar with minimal effort.------ The binding uses the XMonad.Hooks.ManageDocks module to automatically--- handle screen placement for dzen, and enables 'mod-b' for toggling--- the menu bar. Please refer to 'dzenWithFlags' function for further--- documentation.+-- This works pretty much the same as the 'xmobar' function. -- dzen :: LayoutClass l Window-     => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))-dzen conf = dzenWithFlags flags conf+     => XConfig l  -- ^ The base config+     -> IO (XConfig (ModifiedLayout AvoidStruts l))+dzen = dzenWithFlags flags  where     fg      = "'#a8a3f7'" -- n.b quoting     bg      = "'#3f3c6d'"-    flags   = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg-+    flags   = "-e 'onstart=lower' -dock -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg --- | Run xmonad with a xmobar status bar set to some nice defaults.------ > main = xmonad =<< xmobar myConfig--- >--- > myConfig = def { ... }------ This works pretty much the same as 'dzen' function above.---+-- | This function works like 'xmobarProp', but uses pipes instead of+-- property-based logging. xmobar :: LayoutClass l Window-       => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))-xmobar conf = statusBar "xmobar" xmobarPP toggleStrutsKey conf+       => XConfig l  -- ^ The base config+       -> IO (XConfig (ModifiedLayout AvoidStruts l))+xmobar = statusBar "xmobar" xmobarPP toggleStrutsKey --- | Modifies the given base configuration to launch the given status bar,--- send status information to that bar, and allocate space on the screen edges--- for the bar.+-- | Like 'statusBarProp', but uses pipes instead of property-based logging.+-- Only use this function if your status bar does not support reading from a+-- property of the root window. statusBar :: LayoutClass l Window-          => String    -- ^ the command line to launch the status bar-          -> PP        -- ^ the pretty printing options+          => String    -- ^ The command line to launch the status bar+          -> PP        -- ^ The pretty printing options           -> (XConfig Layout -> (KeyMask, KeySym))-                       -- ^ the desired key binding to toggle bar visibility-          -> XConfig l -- ^ the base config+                       -- ^ The desired key binding to toggle bar visibility+          -> XConfig l -- ^ The base config           -> IO (XConfig (ModifiedLayout AvoidStruts l))-statusBar cmd pp k conf = do-    h <- spawnPipe cmd-    return $ docks $ conf-        { layoutHook = avoidStruts (layoutHook conf)-        , logHook = do-                        logHook conf-                        dynamicLogWithPP pp { ppOutput = hPutStrLn h }-        , keys       = liftM2 M.union keys' (keys conf)-        }- where-    keys' = (`M.singleton` sendMessage ToggleStruts) . k---- | Write a string to a property on the root window.  This property is of--- type UTF8_STRING. The string must have been processed by encodeString--- (dynamicLogString does this).-xmonadPropLog' :: String -> String -> X ()-xmonadPropLog' prop msg = do-    d <- asks display-    r <- asks theRoot-    xlog <- getAtom prop-    ustring <- getAtom "UTF8_STRING"-    io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)- where-    encodeCChar :: String -> [CChar]-    encodeCChar = map (fromIntegral . ord)---- | Write a string to the _XMONAD_LOG property on the root window.-xmonadPropLog :: String -> X ()-xmonadPropLog = xmonadPropLog' "_XMONAD_LOG"+statusBar cmd pp k conf= do+  sb <- statusBarPipe cmd (pure pp)+  return $ withEasySB sb k conf  -- | -- Helper function which provides ToggleStruts keybinding -- toggleStrutsKey :: XConfig t -> (KeyMask, KeySym)-toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b )--------------------------------------------------------------------------+toggleStrutsKey = defToggleStrutsKey  -- | An example log hook, which prints status information to stdout in -- the default format:@@ -273,58 +220,6 @@ dynamicLog :: X () dynamicLog = dynamicLogWithPP def --- | Format the current status using the supplied pretty-printing format,---   and write it to stdout.-dynamicLogWithPP :: PP -> X ()-dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp---- | The same as 'dynamicLogWithPP', except it simply returns the status---   as a formatted string without actually printing it to stdout, to---   allow for further processing, or use in some application other than---   a status bar.-dynamicLogString :: PP -> X String-dynamicLogString pp = do--    winset <- gets windowset-    urgents <- readUrgents-    sort' <- ppSort pp--    -- layout description-    let ld = description . S.layout . S.workspace . S.current $ winset--    -- workspace list-    let ws = pprWindowSet sort' urgents pp winset--    -- window title-    wt <- maybe (return "") (fmap show . getName) . S.peek $ winset--    -- run extra loggers, ignoring any that generate errors.-    extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp--    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $-                        [ ws-                        , ppLayout pp ld-                        , ppTitle  pp $ ppTitleSanitize pp wt-                        ]-                        ++ catMaybes extras---- | Format the workspace information, given a workspace sorting function,---   a list of urgent windows, a pretty-printer format, and the current---   WindowSet.-pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String-pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $-            map S.workspace (S.current s : S.visible s) ++ S.hidden s-   where this     = S.currentTag s-         visibles = map (S.tag . S.workspace) (S.visible s)--         fmt w = printer pp (S.tag w)-          where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = ppUrgent-                        | S.tag w == this                                               = ppCurrent-                        | S.tag w `elem` visibles && isJust (S.stack w)                 = ppVisible-                        | S.tag w `elem` visibles                                       = liftM2 fromMaybe ppVisible ppVisibleNoWindows-                        | isJust (S.stack w)                                            = ppHidden-                        | otherwise                                                     = ppHiddenNoWindows- -- | -- Workspace logger with a format designed for Xinerama: --@@ -345,260 +240,27 @@ dynamicLogXinerama :: X () dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama -pprWindowSetXinerama :: WindowSet -> String-pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen-  where onscreen  = map (S.tag . S.workspace)-                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws-        offscreen = map S.tag . filter (isJust . S.stack)-                        . sortBy (comparing S.tag) $ S.hidden ws---- | Wrap a string in delimiters, unless it is empty.-wrap :: String  -- ^ left delimiter-     -> String  -- ^ right delimiter-     -> String  -- ^ output string-     -> String-wrap _ _ "" = ""-wrap l r m  = l ++ m ++ r---- | Pad a string with a leading and trailing space.-pad :: String -> String-pad = wrap " " " "---- | Trim leading and trailing whitespace from a string.-trim :: String -> String-trim = f . f-    where f = reverse . dropWhile isSpace---- | Limit a string to a certain length, adding "..." if truncated.-shorten :: Int -> String -> String-shorten n xs | length xs < n = xs-             | otherwise     = take (n - length end) xs ++ end- where-    end = "..."---- | Output a list of strings, ignoring empty ones and separating the---   rest with the given separator.-sepBy :: String   -- ^ separator-      -> [String] -- ^ fields to output-      -> String-sepBy sep = concat . intersperse sep . filter (not . null)---- | Use dzen escape codes to output a string with given foreground---   and background colors.-dzenColor :: String  -- ^ foreground color: a color name, or #rrggbb format-          -> String  -- ^ background color-          -> String  -- ^ output string-          -> String-dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)- where (fg1,fg2) | null fg = ("","")-                 | otherwise = ("^fg(" ++ fg ++ ")","^fg()")-       (bg1,bg2) | null bg = ("","")-                 | otherwise = ("^bg(" ++ bg ++ ")","^bg()")---- | Escape any dzen metacharacters.-dzenEscape :: String -> String-dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])---- | Strip dzen formatting or commands.-dzenStrip :: String -> String-dzenStrip = strip [] where-    strip keep x-      | null x              = keep-      | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x)-      | '^' == head x       = strip keep (drop 1 . dropWhile (/= ')') $ x)-      | otherwise           = let (good,x') = span (/= '^') x-                              in strip (keep ++ good) x'---- | Use xmobar escape codes to output a string with given foreground---   and background colors.-xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format-            -> String  -- ^ background color-            -> String  -- ^ output string-            -> String-xmobarColor fg bg = wrap t "</fc>"- where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]---- | Encapsulate text with an action. The text will be displayed, and the--- action executed when the displayed text is clicked. Illegal input is not--- filtered, allowing xmobar to display any parse errors. Uses xmobar's new--- syntax wherein the command is surrounded by backticks.-xmobarAction :: String-                -- ^ Command. Use of backticks (`) will cause a parse error.-             -> String-                -- ^ Buttons 1-5, such as "145". Other characters will cause a-                -- parse error.-             -> String-                -- ^ Displayed/wrapped text.-             -> String-xmobarAction command button = wrap l r-    where-        l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"-        r = "</action>"---- | Encapsulate arbitrary text for display only, i.e. untrusted content if--- wrapped (perhaps from window titles) will be displayed only, with all tags--- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not--- to shorten the result.-xmobarRaw :: String -> String-xmobarRaw "" = ""-xmobarRaw s  = concat ["<raw=", show $ length s, ":", s, "/>"]---- ??? add an xmobarEscape function?---- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and--- the matching tags like </fc>.-xmobarStrip :: String -> String-xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) where--converge :: (Eq a) => (a -> a) -> a -> a-converge f a = let xs = iterate f a-    in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs--xmobarStripTags :: [String] -- ^ tags-        -> String -> String -- ^ with all <tag>...</tag> removed-xmobarStripTags tags = strip [] where-    strip keep [] = keep-    strip keep x-        | rest: _ <- mapMaybe dropTag tags = strip keep rest---        | '<':xs <- x = strip (keep ++ "<") xs-        | (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags-      where dropTag :: String -> Maybe String-            dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x),-                                                   closeTag tag `stripPrefix` x]--    dropTilClose, openTag, closeTag :: String -> String-    dropTilClose = drop 1 . dropWhile (/= '>')-    openTag str = "<" ++ str ++ "="-    closeTag str = "</" ++ str ++ ">"---- | The 'PP' type allows the user to customize the formatting of---   status information.-data PP = PP { ppCurrent :: WorkspaceId -> String-               -- ^ how to print the tag of the currently focused-               -- workspace-             , ppVisible :: WorkspaceId -> String-               -- ^ how to print tags of visible but not focused-               -- workspaces (xinerama only)-             , ppHidden  :: WorkspaceId -> String-               -- ^ how to print tags of hidden workspaces which-               -- contain windows-             , ppHiddenNoWindows :: WorkspaceId -> String-               -- ^ how to print tags of empty hidden workspaces-             , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)-               -- ^ how to print tags of empty visible workspaces-             , ppUrgent :: WorkspaceId -> String-               -- ^ format to be applied to tags of urgent workspaces.-             , ppSep :: String-               -- ^ separator to use between different log sections-               -- (window name, layout, workspaces)-             , ppWsSep :: String-               -- ^ separator to use between workspace tags-             , ppTitle :: String -> String-               -- ^ window title format-             , ppTitleSanitize :: String -> String-              -- ^  escape / sanitizes input to 'ppTitle'-             , ppLayout :: String -> String-               -- ^ layout name format-             , ppOrder :: [String] -> [String]-               -- ^ how to order the different log sections. By-               --   default, this function receives a list with three-               --   formatted strings, representing the workspaces,-               --   the layout, and the current window title,-               --   respectively. If you have specified any extra-               --   loggers in 'ppExtras', their output will also be-               --   appended to the list.  To get them in the reverse-               --   order, you can just use @ppOrder = reverse@.  If-               --   you don't want to display the current layout, you-               --   could use something like @ppOrder = \\(ws:_:t:_) ->-               --   [ws,t]@, and so on.-             , ppSort :: X ([WindowSpace] -> [WindowSpace])-               -- ^ how to sort the workspaces.  See-               -- "XMonad.Util.WorkspaceCompare" for some useful-               -- sorts.-             , ppExtras :: [X (Maybe String)]-               -- ^ loggers for generating extra information such as-               -- time and date, system load, battery status, and so-               -- on.  See "XMonad.Util.Loggers" for examples, or create-               -- your own!-             , ppOutput :: String -> IO ()-               -- ^ applied to the entire formatted string in order to-               -- output it.  Can be used to specify an alternative-               -- output method (e.g. write to a pipe instead of-               -- stdout), and\/or to perform some last-minute-               -- formatting.-             }---- | The default pretty printing options, as seen in 'dynamicLog'.-{-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-}-defaultPP :: PP-defaultPP = def--instance Default PP where-    def   = PP { ppCurrent         = wrap "[" "]"-               , ppVisible         = wrap "<" ">"-               , ppHidden          = id-               , ppHiddenNoWindows = const ""-               , ppVisibleNoWindows= Nothing-               , ppUrgent          = id-               , ppSep             = " : "-               , ppWsSep           = " "-               , ppTitle           = shorten 80-               , ppTitleSanitize   = xmobarStrip . dzenEscape-               , ppLayout          = id-               , ppOrder           = id-               , ppOutput          = putStrLn-               , ppSort            = getSortByIndex-               , ppExtras          = []-               }---- | Settings to emulate dwm's statusbar, dzen only.-dzenPP :: PP-dzenPP = def { ppCurrent  = dzenColor "white" "#2b4f98" . pad-                   , ppVisible  = dzenColor "black" "#999999" . pad-                   , ppHidden   = dzenColor "black" "#cccccc" . pad-                   , ppHiddenNoWindows = const ""-                   , ppUrgent   = dzenColor "red" "yellow" . pad-                   , ppWsSep    = ""-                   , ppSep      = ""-                   , ppLayout   = dzenColor "black" "#cccccc" .-                                  (\ x -> pad $ case x of-                                            "TilePrime Horizontal" -> "TTT"-                                            "TilePrime Vertical"   -> "[]="-                                            "Hinted Full"          -> "[ ]"-                                            _                      -> x-                                  )-                   , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape-                   }---- | Some nice xmobar defaults.-xmobarPP :: PP-xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"-                     , ppTitle   = xmobarColor "green"  "" . shorten 40-                     , ppVisible = wrap "(" ")"-                     , ppUrgent  = xmobarColor "red" "yellow"-                     }---- | The options that sjanssen likes to use with xmobar, as an--- example.  Note the use of 'xmobarColor' and the record update on--- 'def'.-sjanssenPP :: PP-sjanssenPP = def { ppCurrent = xmobarColor "white" "black"-                 , ppTitle = xmobarColor "#00ee00" "" . shorten 120-                 }---- | The options that byorgey likes to use with dzen, as another example.-byorgeyPP :: PP-byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces-                , ppHidden  = dzenColor "black"  "#a8a3f7" . pad-                , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad-                , ppUrgent  = dzenColor "red"    "yellow"  . pad-                , ppSep     = " | "-                , ppWsSep   = ""-                , ppTitle   = shorten 70-                , ppOrder   = reverse-                }-  where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']-                                       then pad wsId-                                       else ""+-- | Run xmonad with a property-based xmobar status bar set to some nice+-- defaults.+--+-- > main = xmonad $ xmobarProp myConfig+-- >+-- > myConfig = def { ... }+--+-- The intent is that the above config file should provide a nice+-- status bar with minimal effort. Note that you still need to configure+-- xmobar to use the @XMonadLog@ plugin instead of the default @StdinReader@,+-- see above.+--+-- If you wish to customize the status bar format at all, use the modernized+-- interface provided by the "XMonad.Hooks.StatusBar" and+-- "XMonad.Hooks.StatusBar.PP" modules instead.+--+-- The binding uses the "XMonad.Hooks.ManageDocks" module to automatically+-- handle screen placement for xmobar, and enables 'mod-b' for toggling+-- the menu bar.+xmobarProp :: LayoutClass l Window+           => XConfig l  -- ^ The base config+           -> XConfig (ModifiedLayout AvoidStruts l)+xmobarProp =+  withEasySB (statusBarProp "xmobar" (pure xmobarPP)) toggleStrutsKey
XMonad/Hooks/DynamicProperty.hs view
@@ -1,71 +1,24 @@------------------------------------------------------------------------------ -- | -- Module      :  XMonad.Hooks.DynamicProperty+-- Description :  Apply a ManageHook to an already-mapped window. -- Copyright   :  (c) Brandon S Allbery, 2015 -- License     :  BSD3-style (see LICENSE)--- -- Maintainer  :  allbery.b@gmail.com--- Stability   :  unstable--- Portability :  not portable ----- Module to apply a ManageHook to an already-mapped window when a property--- changes. This would commonly be used to match browser windows by title,--- since the final title will only be set after (a) the window is mapped,--- (b) its document has been loaded, (c) all load-time scripts have run.--- (Don't blame browsers for this; it's inherent in HTML and the DOM. And--- changing title dynamically is explicitly permitted by ICCCM and EWMH;--- you don't really want to have your editor window umapped/remapped to--- show the current document and modified state in the titlebar, do you?)------ This is a handleEventHook that triggers on a PropertyChange event. It--- currently ignores properties being removed, in part because you can't--- do anything useful in a ManageHook involving nonexistence of a property.-----------------------------------------------------------------------------------module XMonad.Hooks.DynamicProperty where+module XMonad.Hooks.DynamicProperty {-# DEPRECATED "Use \"XMonad.Hooks.OnPropertyChange\" instead." #-}+                                    ( module XMonad.Hooks.OnPropertyChange+                                    , dynamicPropertyChange+                                    , dynamicTitle+                                    ) where  import XMonad-import Data.Monoid-import Control.Applicative-import Control.Monad (when)+import XMonad.Hooks.OnPropertyChange+import XMonad.Prelude --- |--- Run a 'ManageHook' when a specific property is changed on a window. Note--- that this will run on any window which changes the property, so you should--- be very specific in your 'MansgeHook' matching (lots of windows change--- their titles on the fly!):------ dynamicPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2")--- --- Note that the fixity of (-->) won't allow it to be mixed with ($), so you--- can't use the obvious $ shorthand.------ > dynamicPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work!------ Consider instead phrasing it like any--- other 'ManageHook':------ >      , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <+> handleEventHook baseConfig--- > --- >    {- ... -}--- > --- >    myDynHook = composeAll [...]---+-- | 'dynamicPropertyChange' = 'onXPropertyChange' dynamicPropertyChange :: String -> ManageHook -> Event -> X All-dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do-  pa <- getAtom prop-  when (ps == propertyNewValue && a == pa) $ do-    g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w)-    windows g-  return mempty -- so anything else also processes it-dynamicPropertyChange _ _ _ = return mempty+dynamicPropertyChange = onXPropertyChange --- | A shorthand for the most common case, dynamic titles+-- | 'dynamicTitle' = 'onTitleChange' dynamicTitle :: ManageHook -> Event -> X All--- strictly, this should also check _NET_WM_NAME. practically, both will--- change and each gets its own PropertyEvent, so we'd need to record that--- we saw the event for that window and ignore the second one. Instead, just--- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false,--- since there's always someone who can't bother being compliant.)-dynamicTitle = dynamicPropertyChange "WM_NAME"+dynamicTitle = onTitleChange
XMonad/Hooks/EwmhDesktops.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternGuards #-}+ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.EwmhDesktops+-- Description  : Make xmonad use the extended window manager hints (EWMH). -- Copyright    : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de> -- License      : BSD --@@ -8,101 +13,436 @@ -- Stability    : unstable -- Portability  : unportable ----- Makes xmonad use the EWMH hints to tell panel applications about its--- workspaces and the windows therein. It also allows the user to interact--- with xmonad by clicking on panels and window lists.+-- Makes xmonad use the+-- <https://specifications.freedesktop.org/wm-spec/latest/ EWMH>+-- hints to tell panel applications about its workspaces and the windows+-- therein. It also allows the user to interact with xmonad by clicking on+-- panels and window lists. ----------------------------------------------------------------------------- module XMonad.Hooks.EwmhDesktops (     -- * Usage     -- $usage     ewmh,+    ewmhFullscreen,+    ewmhDesktopsManageHook,+    ewmhDesktopsMaybeManageHook,++    -- * Customization+    -- $customization++    -- ** Sorting/filtering of workspaces+    -- $customSort+    addEwmhWorkspaceSort, setEwmhWorkspaceSort,++    -- ** Renaming of workspaces+    -- $customRename+    addEwmhWorkspaceRename, setEwmhWorkspaceRename,++    -- ** Window activation+    -- $customActivate+    setEwmhActivateHook,++    -- ** Workspace switching+    -- $customWorkspaceSwitch+    setEwmhSwitchDesktopHook,++    -- ** Fullscreen+    -- $customFullscreen+    setEwmhFullscreenHooks,++    -- ** @_NET_DESKTOP_VIEWPORT@+    -- $customManageDesktopViewport+    disableEwmhManageDesktopViewport,++    -- $customHiddenWorkspaceMapper+    setEwmhHiddenWorkspaceToScreenMapping,+    -- ** @_NET_WM_STATE_{ABOVE,BELOW}@+    -- $customManageAboveBelowState+    enableEwmhManageAboveBelowState,++    -- * Standalone hooks (deprecated)     ewmhDesktopsStartup,     ewmhDesktopsLogHook,     ewmhDesktopsLogHookCustom,     ewmhDesktopsEventHook,     ewmhDesktopsEventHookCustom,-    fullscreenEventHook+    fullscreenEventHook,+    fullscreenStartup,     ) where  import Codec.Binary.UTF8.String (encode)-import Control.Applicative((<$>))-import Data.List-import Data.Maybe-import Data.Monoid+import Data.Bits+import qualified Data.Map.Strict as M  import XMonad-import Control.Monad+import XMonad.Prelude import qualified XMonad.StackSet as W +import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName-import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32)+import qualified XMonad.Util.ExtensibleConf as XC+import qualified XMonad.Util.ExtensibleState as XS  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.EwmhDesktops -- >--- > main = xmonad $ ewmh def{ handleEventHook =--- >            handleEventHook def <+> fullscreenEventHook }+-- > main = xmonad $ … . ewmhFullscreen . ewmh . … $ def{…} ----- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".-+-- or, if fullscreen handling is not desired, just+--+-- > main = xmonad $ … . ewmh . … $ def{…}+--+-- You may also be interested in 'XMonad.Hooks.ManageDocks.docks' and+-- 'XMonad.Hooks.UrgencyHook.withUrgencyHook', which provide support for other+-- parts of the+-- <https://specifications.freedesktop.org/wm-spec/latest/ EWMH specification>. --- | Add EWMH functionality to the given config.  See above for an example.+-- | Add EWMH support for workspaces (virtual desktops) to the given+-- 'XConfig'.  See above for an example. ewmh :: XConfig a -> XConfig a-ewmh c = c { startupHook     = startupHook c +++ ewmhDesktopsStartup-           , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook-           , logHook         = logHook c +++ ewmhDesktopsLogHook }- -- @@@ will fix this correctly later with the rewrite- where x +++ y = mappend y x+ewmh c = c { startupHook     = ewmhDesktopsStartup <> startupHook c+           , handleEventHook = ewmhDesktopsEventHook <> handleEventHook c+           , logHook         = ewmhDesktopsLogHook <> logHook c+           , manageHook      = ewmhDesktopsManageHook' <> manageHook c } --- |--- Initializes EwmhDesktops and advertises EWMH support to the X--- server-ewmhDesktopsStartup :: X ()-ewmhDesktopsStartup = setSupported --- |--- Notifies pagers and window lists, such as those in the gnome-panel--- of the current state of workspaces and windows.-ewmhDesktopsLogHook :: X ()-ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id--- |--- Generalized version of ewmhDesktopsLogHook that allows an arbitrary--- user-specified function to transform the workspace list (post-sorting)-ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()-ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do-    sort' <- getSortByIndex-    let ws = f $ sort' $ W.workspaces s+-- $customization+-- It's possible to customize the behaviour of 'ewmh' in several ways: -    -- Number of Workspaces-    setNumberOfDesktops (length ws)+-- | Customizable configuration for EwmhDesktops+data EwmhDesktopsConfig =+    EwmhDesktopsConfig+        { workspaceSort :: X WorkspaceSort+            -- ^ configurable workspace sorting/filtering+        , workspaceRename :: X (String -> WindowSpace -> String)+            -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename')+        , activateHook :: ManageHook+            -- ^ configurable handling of window activation requests+        , fullscreenHooks :: (ManageHook, ManageHook)+            -- ^ configurable handling of fullscreen state requests+        , switchDesktopHook :: WorkspaceId -> WindowSet -> WindowSet+            -- ^ configurable action for handling _NET_CURRENT_DESKTOP+        , manageDesktopViewport :: Bool+            -- ^ manage @_NET_DESKTOP_VIEWPORT@?+        , hiddenWorkspaceToScreen :: WindowSet -> WindowSpace -> WindowScreen+            -- ^ map hidden workspaces to screens for @_NET_DESKTOP_VIEWPORT@+        , handleAboveBelowState :: Bool+            -- ^ handle @_NET_WM_STATE_ABOVE@ and @_NET_WM_STATE_BELOW@?+        } -    -- Names thereof-    setDesktopNames (map W.tag ws)+instance Default EwmhDesktopsConfig where+    def = EwmhDesktopsConfig+        { workspaceSort = getSortByIndex+        , workspaceRename = pure pure+        , activateHook = doFocus+        , fullscreenHooks = (doFullFloat, doSink)+        , switchDesktopHook = W.view+        , manageDesktopViewport = True+        -- Hidden workspaces are mapped to the current screen by default.+        , hiddenWorkspaceToScreen = \winset _ -> W.current winset+        , handleAboveBelowState = False+        } -    -- all windows, with focused windows last-    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws-    setClientList wins -    -- Remap the current workspace to handle any renames that f might be doing.-    let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])-        maybeCurrent  = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')+-- $customSort+-- The list of workspaces exposed to EWMH pagers (like+-- <https://github.com/taffybar/taffybar taffybar> and+-- <https://github.com/polybar/polybar polybar>) and clients (such as+-- <http://tomas.styblo.name/wmctrl/ wmctrl> and+-- <https://github.com/jordansissel/xdotool/ xdotool>) may be sorted and/or+-- filtered via a user-defined function.+--+-- To show visible workspaces first, one may switch to a Xinerama-aware+-- sorting function:+--+-- > import XMonad.Util.WorkspaceCompare+-- >+-- > mySort = getSortByXineramaRule+-- > main = xmonad $ … . setEwmhWorkspaceSort mySort . ewmh . … $ def{…}+--+-- Another useful example is not exposing the hidden scratchpad workspace:+--+-- > import XMonad.Util.NamedScratchpad+-- > import XMonad.Util.WorkspaceCompare+-- >+-- > myFilter = filterOutWs [scratchpadWorkspaceTag]+-- > main = xmonad $ … . addEwmhWorkspaceSort (pure myFilter) . ewmh . … $ def{…} -    fromMaybe (return ()) $ setCurrentDesktop <$> maybeCurrent+-- | Add (compose after) an arbitrary user-specified function to sort/filter+-- the workspace list. The default/initial function is 'getSortByIndex'. This+-- can be used to e.g. filter out scratchpad workspaces. Workspaces /must not/+-- be renamed here.+addEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l+addEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = liftA2 (.) f (workspaceSort c) } -    sequence_ $ zipWith setWorkspaceWindowDesktops [0..] ws+-- | Like 'addEwmhWorkspaceSort', but replace it instead of adding/composing.+setEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l+setEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = f } -    setActiveWindow -    return ()+-- $customRename+-- The workspace names exposed to EWMH pagers and other clients (e.g.+-- <https://arbtt.nomeata.de/ arbtt>) may be altered using a similar+-- interface to 'XMonad.Hooks.StatusBar.PP.ppRename'. To configure workspace+-- renaming, use 'addEwmhWorkspaceRename'.+--+-- As an example, to expose workspaces uppercased:+--+-- > import Data.Char+-- >+-- > myRename :: String -> WindowSpace -> String+-- > myRename s _w = map toUpper s+-- >+-- > main = xmonad $ … . addEwmhWorkspaceRename (pure myRename) . ewmh . … $ def{…}+--+-- Some modules like "XMonad.Actions.WorkspaceNames" provide ready-made+-- integrations:+--+-- > import XMonad.Actions.WorkspaceNames+-- >+-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…}+--+-- The above ensures workspace names are exposed through EWMH. +-- | Add (compose after) an arbitrary user-specified function to rename each+-- workspace. This works just like 'XMonad.Hooks.StatusBar.PP.ppRename': the+-- @WindowSpace -> …@ acts as a Reader monad. Useful with+-- "XMonad.Actions.WorkspaceNames", "XMonad.Layout.IndependentScreens",+-- "XMonad.Hooks.DynamicIcons".+addEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l+addEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = liftA2 (<=<) f (workspaceRename c) } --- |--- Intercepts messages from pagers and similar applications and reacts on them.+-- | Like 'addEwmhWorkspaceRename', but replace it instead of adding/composing.+setEwmhWorkspaceRename :: X (String -> WindowSpace -> String) -> XConfig l -> XConfig l+setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f }+++-- $customActivate+-- When a client sends a @_NET_ACTIVE_WINDOW@ request to activate a window, by+-- default that window is activated by invoking the 'doFocus' 'ManageHook'.+-- <https://specifications.freedesktop.org/wm-spec/1.5/ar01s03.html#idm45623294083744 The EWMH specification suggests>+-- that a window manager may instead just mark the window as urgent, and this+-- can be achieved using the following:+--+-- > import XMonad.Hooks.UrgencyHook+-- >+-- > main = xmonad $ … . setEwmhActivateHook doAskUrgent . ewmh . … $ def{…}+--+-- One may also wish to ignore activation requests from certain applications+-- entirely:+--+-- > import XMonad.Hooks.ManageHelpers+-- >+-- > myActivateHook :: ManageHook+-- > myActivateHook =+-- >   className /=? "Google-chrome" <&&> className /=? "google-chrome" --> doFocus+-- >+-- > main = xmonad $ … . setEwmhActivateHook myActivateHook . ewmh . … $ def{…}+--+-- Arbitrarily complex hooks can be used. This last example marks Chrome+-- windows as urgent and focuses everything else:+--+-- > myActivateHook :: ManageHook+-- > myActivateHook = composeOne+-- >   [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent+-- >   , pure True -?> doFocus ]+--+-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers", "XMonad.Hooks.Focus" and+-- "XMonad.Layout.IndependentScreens" for functions that can be useful here.++-- | Set (replace) the hook which is invoked when a client sends a+-- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus'+-- which focuses the window immediately, switching workspace if necessary.+-- 'XMonad.Hooks.UrgencyHook.doAskUrgent' is a less intrusive alternative.+--+-- More complex hooks can be constructed using combinators from+-- "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus".+setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l+setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h }+++-- $customWorkspaceSwitch+-- When a client sends a @_NET_CURRENT_DESKTOP@ request to switch to a workspace,+-- the default action used to do that is the 'W.view' function.+-- This may not be the desired behaviour in all configurations.+--+-- For example if using the "XMonad.Layout.IndependentScreens" the default action+-- might move a workspace to a screen that it isn't supposed to be on.+-- This behaviour can be fixed using the following:+--+-- > import XMonad.Actions.OnScreen+-- > import XMonad.Layout.IndependentScreens+-- >+-- > main = xmonad $ ... . setEwmhSwitchDesktopHook focusWorkspace . ewmh . ... $+-- >  def{+-- >    ...+-- >      workspaces = withScreens 2 (workspaces def)+-- >    ...+-- >  }++-- | Set (replace) the action which is invoked when a client sends a+-- @_NET_CURRENT_DESKTOP@ request to switch workspace.+setEwmhSwitchDesktopHook :: (WorkspaceId -> WindowSet -> WindowSet) -> XConfig l -> XConfig l+setEwmhSwitchDesktopHook action = XC.modifyDef $ \c -> c{ switchDesktopHook = action }+++-- $customFullscreen+-- When a client sends a @_NET_WM_STATE@ request to add\/remove\/toggle the+-- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to+-- make the window fullscreen and revert its state. The default hooks are+-- stateless: windows are fullscreened by turning them into fullscreen floats,+-- and reverted by sinking them into the tiling layer. This behaviour can be+-- configured by supplying a pair of 'ManageHook's to 'setEwmhFullscreenHooks'.+--+-- See "XMonad.Actions.ToggleFullFloat" for a pair of hooks that store the+-- original state of floating windows.++-- | Set (replace) the hooks invoked when clients ask to add/remove the+-- $_NET_WM_STATE_FULLSCREEN@ state. The defaults are 'doFullFloat' and+-- 'doSink'.+setEwmhFullscreenHooks :: ManageHook -> ManageHook -> XConfig l -> XConfig l+setEwmhFullscreenHooks f uf = XC.modifyDef $ \c -> c{ fullscreenHooks = (f, uf) }+++-- $customManageDesktopViewport+-- Setting @_NET_DESKTOP_VIEWPORT@ is typically desired but can lead to a+-- confusing workspace list in polybar, where this information is used to+-- re-group the workspaces by monitor. See+-- <https://github.com/polybar/polybar/issues/2603 polybar#2603>.+--+-- To avoid this, you can use:+--+-- > main = xmonad $ … . disableEwmhManageDesktopViewport . ewmh . … $ def{…}+--+-- Note that if you apply this configuration in an already running environment,+-- the property may remain at its previous value. It can be removed by running:+--+-- > xprop -root -remove _NET_DESKTOP_VIEWPORT+--+-- Which should immediately fix your bar.+--+disableEwmhManageDesktopViewport :: XConfig l -> XConfig l+disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False }++-- $customManageAboveBelowState+-- Some applications use the @_NET_WM_STATE_ABOVE@ and @_NET_WM_STATE_BELOW@+-- states to request being kept above or below other windows. By default, xmonad+-- does not handle these states. To enable handling of these states, you can use+-- the following hook:+--+-- > main = xmonad $ … . enableEwmhManageAboveBelowState . ewmh . … $ def{…}+--+-- This will make xmonad respond to requests to set these states by calling+-- lowerWindow and raiseWindow respectively.+enableEwmhManageAboveBelowState :: XConfig l -> XConfig l+enableEwmhManageAboveBelowState = XC.modifyDef (\c -> c{handleAboveBelowState = True})++aboveBelowManageHook :: ManageHook+aboveBelowManageHook =+    ((isEnabled <&&> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_BELOW") --> doLower)+        <> ((isEnabled <&&> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_ABOVE") --> doRaise)+  where+    isEnabled = liftX (XC.withDef (pure . handleAboveBelowState))++aboveBelowEventHook :: Event -> X ()+aboveBelowEventHook+    ClientMessageEvent{ev_event_display = dpy, ev_window = w, ev_message_type = typ, ev_data = action : dats} =+        do+            wmstate <- getAtom "_NET_WM_STATE"+            above <- getAtom "_NET_WM_STATE_ABOVE"+            below <- getAtom "_NET_WM_STATE_BELOW"++            wstate <- fromMaybe [] <$> getProp32 wmstate w++            let isAbove = fi above `elem` wstate+                isBelow = fi below `elem` wstate+                chWstate f = io $ changeProperty32 dpy w wmstate aTOM propModeReplace (f wstate)+                raise = chWstate (filter (/= fi below) . (fi above :)) >> io (raiseWindow dpy w)+                lower = chWstate (filter (/= fi above) . (fi below :)) >> io (lowerWindow dpy w)+                clear st = chWstate (filter (/= fi st))+            when (typ == wmstate) $+                if+                        -- remove+                        | action == 0 -> do+                            when (fi above `elem` dats && isAbove) $ clear above+                            when (fi below `elem` dats && isBelow) $ clear below+                        -- add+                        | action == 1 -> do+                            when (fi above `elem` dats && not isAbove) raise+                            when (fi below `elem` dats && not isBelow) lower+                        -- toggle+                        | action == 2 -> do+                            when (fi above `elem` dats) $+                                if isAbove+                                    then clear above+                                    else raise+                            when (fi below `elem` dats) $+                                if isBelow+                                    then clear below+                                    else lower+                        | otherwise -> trace ("Bad _NET_WM_STATE with data =" <> show action)+            mempty+aboveBelowEventHook _ = mempty++-- $customHiddenWorkspaceMapper+--+-- Mapping the hidden workspaces to the current screen is a good default behavior,+-- but it makes the assumption that workspaces don't belong to a sepcific screen.+-- If the default behaviour is undesired, for example when using "XMonad.Layout.IndependentScreens",+-- it can be customized.+--+-- The following example demonstrates a way to configure the mapping when using "XMonad.Layout.IndependentScreens":+--+-- > import XMonad.Layout.IndependentScreens+-- >+-- > customMapper :: WindowSet -> (WindowSpace -> WindowScreen)+-- > customMapper winset (Workspace wsid _ _) = fromMaybe (W.current winset) maybeMappedScreen+-- >  where+-- >    screenId = unmarshallS wsid+-- >    maybeMappedScreen = screenOnMonitor screenId winset+-- >+-- >+-- > main = xmonad $ ... . setEwmhHiddenWorkspaceToScreenMapping customMapper . ewmh . ... $ def{...}++-- | Set (replace) the function responsible for mapping the hidden workspaces to screens.+setEwmhHiddenWorkspaceToScreenMapping :: (WindowSet -> (WindowSpace -> WindowScreen))+                                        -- ^ Function that given the current WindowSet+                                        -- produces a function to maps a (hidden) workspace to a screen.+                                        -> XConfig l -> XConfig l+setEwmhHiddenWorkspaceToScreenMapping mapper = XC.modifyDef $ \c -> c{ hiddenWorkspaceToScreen = mapper }+++-- | Initializes EwmhDesktops and advertises EWMH support to the X server.+{-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-}+ewmhDesktopsStartup :: X ()+ewmhDesktopsStartup = setSupported >> XC.withDef ewmhDesktopsStartupHook'++-- | Notifies pagers and window lists, such as those in the gnome-panel of the+-- current state of workspaces and windows.+{-# DEPRECATED ewmhDesktopsLogHook "Use ewmh instead." #-}+ewmhDesktopsLogHook :: X ()+ewmhDesktopsLogHook = XC.withDef ewmhDesktopsLogHook'++-- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary+-- user-specified function to sort/filter the workspace list (post-sorting).+{-# DEPRECATED ewmhDesktopsLogHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-}+ewmhDesktopsLogHookCustom :: WorkspaceSort -> X ()+ewmhDesktopsLogHookCustom f =+    ewmhDesktopsLogHook' def{ workspaceSort = (f .) <$> workspaceSort def }++-- | Manage hook that EWMH extensions can hook into. Should be named+-- ewmhDesktopsManageHook for consistency with ewmhDesktopsLogHook for example,+-- but that name is taken.+ewmhDesktopsManageHook' :: ManageHook+ewmhDesktopsManageHook' = aboveBelowManageHook++-- | Intercepts messages from pagers and similar applications and reacts on them.+-- -- Currently supports: -- --  * _NET_CURRENT_DESKTOP (switching desktops)@@ -110,62 +450,243 @@ --  * _NET_WM_DESKTOP (move windows to other desktops) -- --  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)+--+--  * _NET_CLOSE_WINDOW (close window)+{-# DEPRECATED ewmhDesktopsEventHook "Use ewmh instead." #-} ewmhDesktopsEventHook :: Event -> X All-ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id+ewmhDesktopsEventHook = XC.withDef . ewmhDesktopsEventHook' --- |--- Generalized version of ewmhDesktopsEventHook that allows an arbitrary--- user-specified function to transform the workspace list (post-sorting)-ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All-ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)+-- | Generalized version of ewmhDesktopsEventHook that allows an arbitrary+-- user-specified function to sort/filter the workspace list (post-sorting).+{-# DEPRECATED ewmhDesktopsEventHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-}+ewmhDesktopsEventHookCustom :: WorkspaceSort -> Event -> X All+ewmhDesktopsEventHookCustom f e =+    ewmhDesktopsEventHook' e def{ workspaceSort = (f .) <$> workspaceSort def } -handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()-handle f (ClientMessageEvent {-               ev_window = w,-               ev_message_type = mt,-               ev_data = d-       }) = withWindowSet $ \s -> do-       sort' <- getSortByIndex-       let ws = f $ sort' $ W.workspaces s+-- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@+newtype DesktopNames = DesktopNames [String] deriving Eq+instance ExtensionClass DesktopNames where initialValue = DesktopNames [] -       a_cd <- getAtom "_NET_CURRENT_DESKTOP"-       a_d <- getAtom "_NET_WM_DESKTOP"-       a_aw <- getAtom "_NET_ACTIVE_WINDOW"-       a_cw <- getAtom "_NET_CLOSE_WINDOW"-       a_ignore <- mapM getAtom ["XMONAD_TIMER"]-       if  mt == a_cd then do-               let n = head d-               if 0 <= n && fi n < length ws then-                       windows $ W.view (W.tag (ws !! fi n))-                 else  trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n-        else if mt == a_d then do-               let n = head d-               if 0 <= n && fi n < length ws then-                       windows $ W.shiftWin (W.tag (ws !! fi n)) w-                 else  trace $ "Bad _NET_DESKTOP with data[0]="++show n-        else if mt == a_aw then do-               windows $ W.focusWindow w-        else if mt == a_cw then do-               killWindow w-        else if mt `elem` a_ignore then do-           return ()-        else do-          -- The Message is unknown to us, but that is ok, not all are meant-          -- to be handled by the window manager-          return ()-handle _ _ = return ()+-- | Cached @_NET_CLIENT_LIST@+newtype ClientList = ClientList [Window] deriving Eq+instance ExtensionClass ClientList where initialValue = ClientList [none] --- |--- An event hook to handle applications that wish to fullscreen using the--- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()+-- | Cached @_NET_CLIENT_LIST_STACKING@+newtype ClientListStacking = ClientListStacking [Window] deriving Eq+instance ExtensionClass ClientListStacking where initialValue = ClientListStacking [none]++-- | Cached @_NET_CURRENT_DESKTOP@+newtype CurrentDesktop = CurrentDesktop Int deriving Eq+instance ExtensionClass CurrentDesktop where initialValue = CurrentDesktop (complement 0)++-- | Cached @_NET_WM_DESKTOP@+newtype WindowDesktops = WindowDesktops (M.Map Window Int) deriving Eq+instance ExtensionClass WindowDesktops where initialValue = WindowDesktops (M.singleton none (complement 0))++-- | Cached @_NET_ACTIVE_WINDOW@+newtype ActiveWindow = ActiveWindow Window deriving Eq+instance ExtensionClass ActiveWindow where initialValue = ActiveWindow (complement none)++-- | Cached @_NET_DESKTOP_VIEWPORT@+newtype MonitorTags = MonitorTags [WorkspaceId] deriving (Show,Eq)+instance ExtensionClass MonitorTags where initialValue = MonitorTags []++-- | Compare the given value against the value in the extensible state. Run the+-- action if it has changed.+whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()+whenChanged = whenX . XS.modified . const++ewmhDesktopsStartupHook' :: EwmhDesktopsConfig -> X ()+ewmhDesktopsStartupHook' EwmhDesktopsConfig{handleAboveBelowState} =+    when+        handleAboveBelowState+        (addSupported ["_NET_WM_STATE", "_NET_WM_STATE_ABOVE", "_NET_WM_STATE_BELOW"])++ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()+ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport, hiddenWorkspaceToScreen} = withWindowSet $ \s -> do+    sort' <- workspaceSort+    let ws = sort' $ W.workspaces s++    -- Set number of workspaces and names thereof+    rename <- workspaceRename+    let desktopNames = [ rename (W.tag w) w | w <- ws ]+    whenChanged (DesktopNames desktopNames) $ do+        setNumberOfDesktops (length desktopNames)+        setDesktopNames desktopNames++    -- Set client list which should be sorted by window age. We just+    -- guess that StackSet contains windows list in this order which+    -- isn't true but at least gives consistency with windows cycling+    let clientList = nub . concatMap (W.integrate' . W.stack) $ ws+    whenChanged (ClientList clientList) $ setClientList clientList++    -- @ws@ is sorted in the "workspace order", which, by default, is+    -- the lexicographical sorting on @WorkspaceId@.+    -- @_NET_CLIENT_LIST_STACKING@ is expected to be in the "bottom-to-top+    -- stacking order".  It is unclear what that would mean for windows on+    -- invisible workspaces, but it seems reasonable to assume that windows on+    -- the current workspace should be "at the top".  With the focused window to+    -- be the top most, meaning the last.+    --+    -- There has been a number of discussions on the order of windows within a+    -- workspace.  See:+    --+    --   https://github.com/xmonad/xmonad-contrib/issues/567+    --   https://github.com/xmonad/xmonad-contrib/pull/568+    --   https://github.com/xmonad/xmonad-contrib/pull/772+    let clientListStacking =+          let wsInFocusOrder = W.hidden s+                               ++ (map W.workspace . W.visible) s+                               ++ [W.workspace $ W.current s]+              stackWindows (W.Stack cur up down) = reverse up ++ down ++ [cur]+              workspaceWindows = maybe [] stackWindows . W.stack+              -- In case a window is a member of multiple workspaces, we keep+              -- only the last occurrence in the list.  One that is closer to+              -- the top in the focus order.+              uniqueKeepLast = reverse . nub . reverse+           in uniqueKeepLast $ concatMap workspaceWindows wsInFocusOrder+    whenChanged (ClientListStacking clientListStacking) $+      setClientListStacking clientListStacking++    -- Set current desktop number+    let current = W.currentTag s `elemIndex` map W.tag ws+    whenChanged (CurrentDesktop $ fromMaybe 0 current) $+        mapM_ setCurrentDesktop current++    -- Set window-desktop mapping+    let windowDesktops =+          let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]+          in M.unions $ zipWith f [0..] ws+    whenChanged (WindowDesktops windowDesktops) $+        mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)++    -- Set active window+    let activeWindow' = fromMaybe none (W.peek s)+    whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'++    -- Set desktop Viewport+    when manageDesktopViewport $ do+        let visibleScreens = W.current s : W.visible s+            currentTags    = map (W.tag . W.workspace) visibleScreens+        whenChanged (MonitorTags currentTags) $ mkViewPorts s hiddenWorkspaceToScreen (map W.tag ws)++-- | Create the viewports from the current 'WindowSet' and a list of+-- already sorted workspace IDs.+mkViewPorts :: WindowSet -> (WindowSet -> WindowSpace -> WindowScreen) -> [WorkspaceId] -> X ()+mkViewPorts winset hiddenWorkspaceMapper = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)+  where+    foc = W.current winset+    viewPorts :: M.Map WorkspaceId [Position]+    viewPorts = M.fromList $ map mkVisibleViewPort (foc : W.visible winset)+                          ++ map (uncurry mkViewPort) hiddenWorkspacesWithScreens++    hiddenWorkspacesWithScreens :: [(WindowScreen,WindowSpace)]+    hiddenWorkspacesWithScreens = map (\x -> (hiddenWorkspaceMapper winset x, x)) (W.hidden winset)++    mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position])+    mkViewPort scr w = (W.tag w, mkPos scr)++    mkVisibleViewPort :: WindowScreen -> (WorkspaceId, [Position])+    mkVisibleViewPort x = mkViewPort x (W.workspace x)++    mkPos :: WindowScreen -> [Position]+    mkPos scr = [rect_x (rect scr), rect_y (rect scr)]+      where rect = screenRect . W.screenDetail++ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All+ewmhDesktopsEventHook'+        e@ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d}+        EwmhDesktopsConfig{workspaceSort, activateHook, switchDesktopHook, handleAboveBelowState} =+    withWindowSet $ \s -> do+        sort' <- workspaceSort+        let ws = sort' $ W.workspaces s++        a_cd <- getAtom "_NET_CURRENT_DESKTOP"+        a_d <- getAtom "_NET_WM_DESKTOP"+        a_aw <- getAtom "_NET_ACTIVE_WINDOW"+        a_cw <- getAtom "_NET_CLOSE_WINDOW"++        if  | mt == a_cw ->+                killWindow w+            | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->+                if W.currentTag s == W.tag ww then mempty else windows $ switchDesktopHook (W.tag ww)+            | mt == a_cd ->+                trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d+            | not (w `W.member` s) ->+                -- do nothing for unmanaged windows; it'd be just a useless+                -- refresh which breaks menus/popups of misbehaving apps that+                -- send _NET_ACTIVE_WINDOW requests for override-redirect wins+                mempty+            | mt == a_d, n : _ <- d, Just ww <- ws !? fi n ->+                if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w+            | mt == a_d ->+                trace $ "Bad _NET_WM_DESKTOP with data=" ++ show d+            | mt == a_aw, 2 : _ <- d ->+                -- when the request comes from a pager, honor it unconditionally+                -- https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html#sourceindication+                if W.peek s == Just w then mempty else windows $ W.focusWindow w+            | mt == a_aw -> do+                if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w+            | otherwise ->+                -- The Message is unknown to us, but that is ok, not all are meant+                -- to be handled by the window manager+                mempty+        when handleAboveBelowState (aboveBelowEventHook e)+        mempty+ewmhDesktopsEventHook' _ _ = mempty++-- | A 'ManageHook' that shifts windows to the workspace they want to be in.+-- Useful for restoring browser windows to where they were before restart.+--+-- To only use this for browsers (which might be a good idea, as many apps try+-- to restore their window to their original position, but it's rarely+-- desirable outside of security updates of multi-window apps like a browser),+-- use this:+--+-- > stringProperty "WM_WINDOW_ROLE" =? "browser" --> ewmhDesktopsManageHook+ewmhDesktopsManageHook :: ManageHook+ewmhDesktopsManageHook = maybeToDefinite ewmhDesktopsMaybeManageHook++-- | 'ewmhDesktopsManageHook' as a 'MaybeManageHook' for use with+-- 'composeOne'. Returns 'Nothing' if the window didn't indicate any desktop+-- preference, otherwise 'Just' (even if the preferred desktop was out of+-- bounds).+ewmhDesktopsMaybeManageHook :: MaybeManageHook+ewmhDesktopsMaybeManageHook = desktop >>= traverse doShiftI+  where+    doShiftI :: Int -> ManageHook+    doShiftI d = do+        sort' <- liftX . XC.withDef $ \EwmhDesktopsConfig{workspaceSort} -> workspaceSort+        ws <- liftX . gets $ map W.tag . sort' . W.workspaces . windowset+        maybe idHook doShift $ ws !? d++-- | Add EWMH fullscreen functionality to the given config.+ewmhFullscreen :: XConfig a -> XConfig a+ewmhFullscreen c = c { startupHook     = startupHook c <> fullscreenStartup+                     , handleEventHook = handleEventHook c <> fullscreenEventHook }++-- | Advertises EWMH fullscreen support to the X server.+{-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-}+fullscreenStartup :: X ()+fullscreenStartup = setFullscreenSupported++-- | An event hook to handle applications that wish to fullscreen using the+-- @_NET_WM_STATE@ protocol. This includes users of the @gtk_window_fullscreen()@ -- function, such as Totem, Evince and OpenOffice.org. -- -- Note this is not included in 'ewmh'.+{-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-} fullscreenEventHook :: Event -> X All-fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do+fullscreenEventHook = XC.withDef . fullscreenEventHook'++fullscreenEventHook' :: Event -> EwmhDesktopsConfig -> X All+fullscreenEventHook'+    ClientMessageEvent{ev_event_display = dpy, ev_window = win, ev_message_type = typ, ev_data = action:dats}+    EwmhDesktopsConfig{fullscreenHooks = (fullscreenHook, unFullscreenHook)} = do+  managed <- isClient win   wmstate <- getAtom "_NET_WM_STATE"   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"-  wstate <- fromMaybe [] `fmap` getProp32 wmstate win+  wstate <- fromMaybe [] <$> getProp32 wmstate win    let isFull = fromIntegral fullsc `elem` wstate @@ -173,34 +694,31 @@       remove = 0       add = 1       toggle = 2-      ptype = 4 -- The atom property type for changeProperty-      chWstate f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)+      chWstate f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate) -  when (typ == wmstate && fi fullsc `elem` dats) $ do-    when (action == add || (action == toggle && not isFull)) $ do+  when (managed && typ == wmstate && fi fullsc `elem` dats) $ do+    when (not isFull && (action == add || action == toggle)) $ do       chWstate (fi fullsc:)-      windows $ W.float win $ W.RationalRect 0 0 1 1-    when (action == remove || (action == toggle && isFull)) $ do+      windows . appEndo =<< runQuery fullscreenHook win+    when (isFull && (action == remove || action == toggle)) $ do       chWstate $ delete (fi fullsc)-      windows $ W.sink win+      windows . appEndo =<< runQuery unFullscreenHook win    return $ All True -fullscreenEventHook _ = return $ All True+fullscreenEventHook' _ _ = return $ All True  setNumberOfDesktops :: (Integral a) => a -> X () setNumberOfDesktops n = withDisplay $ \dpy -> do     a <- getAtom "_NET_NUMBER_OF_DESKTOPS"-    c <- getAtom "CARDINAL"     r <- asks theRoot-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]+    io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral n]  setCurrentDesktop :: (Integral a) => a -> X () setCurrentDesktop i = withDisplay $ \dpy -> do     a <- getAtom "_NET_CURRENT_DESKTOP"-    c <- getAtom "CARDINAL"     r <- asks theRoot-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]+    io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral i]  setDesktopNames :: [String] -> X () setDesktopNames names = withDisplay $ \dpy -> do@@ -213,30 +731,39 @@  setClientList :: [Window] -> X () setClientList wins = withDisplay $ \dpy -> do-    -- (What order do we really need? Something about age and stacking)     r <- asks theRoot-    c <- getAtom "WINDOW"     a <- getAtom "_NET_CLIENT_LIST"-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)-    a' <- getAtom "_NET_CLIENT_LIST_STACKING"-    io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)+    io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fromIntegral wins) -setWorkspaceWindowDesktops :: (Integral a) => a -> WindowSpace -> X()-setWorkspaceWindowDesktops index workspace =-  mapM_ (flip setWindowDesktop index) (W.integrate' $ W.stack workspace)+setClientListStacking :: [Window] -> X ()+setClientListStacking wins = withDisplay $ \dpy -> do+    r <- asks theRoot+    a <- getAtom "_NET_CLIENT_LIST_STACKING"+    io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fromIntegral wins)  setWindowDesktop :: (Integral a) => Window -> a -> X () setWindowDesktop win i = withDisplay $ \dpy -> do     a <- getAtom "_NET_WM_DESKTOP"-    c <- getAtom "CARDINAL"-    io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]+    io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral i] +setActiveWindow :: Window -> X ()+setActiveWindow w = withDisplay $ \dpy -> do+    r <- asks theRoot+    a <- getAtom "_NET_ACTIVE_WINDOW"+    io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w]++setDesktopViewport :: [Position] -> X ()+setDesktopViewport positions = withDisplay $ \dpy -> do+    r <- asks theRoot+    a <- io $ internAtom dpy "_NET_DESKTOP_VIEWPORT" True+    io $ changeProperty32 dpy r a cARDINAL propModeReplace (map fi positions)+ setSupported :: X () setSupported = withDisplay $ \dpy -> do     r <- asks theRoot     a <- getAtom "_NET_SUPPORTED"-    c <- getAtom "ATOM"     supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"+                         ,"_NET_WM_STATE_DEMANDS_ATTENTION"                          ,"_NET_NUMBER_OF_DESKTOPS"                          ,"_NET_CLIENT_LIST"                          ,"_NET_CLIENT_LIST_STACKING"@@ -245,15 +772,22 @@                          ,"_NET_ACTIVE_WINDOW"                          ,"_NET_WM_DESKTOP"                          ,"_NET_WM_STRUT"+                         ,"_NET_WM_STRUT_PARTIAL"+                         ,"_NET_DESKTOP_VIEWPORT"                          ]-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)+    io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp)      setWMName "xmonad" -setActiveWindow :: X ()-setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do-    let w = fromMaybe none (W.peek s)+-- TODO: use in SetWMName, UrgencyHook+addSupported :: [String] -> X ()+addSupported props = withDisplay $ \dpy -> do     r <- asks theRoot-    a <- getAtom "_NET_ACTIVE_WINDOW"-    c <- getAtom "WINDOW"-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]+    a <- getAtom "_NET_SUPPORTED"+    newSupportedList <- mapM (fmap fromIntegral . getAtom) props+    io $ do+        supportedList <- join . maybeToList <$> getWindowProperty32 dpy a r+        changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList)++setFullscreenSupported :: X ()+setFullscreenSupported = addSupported ["_NET_WM_STATE", "_NET_WM_STATE_FULLSCREEN"]
XMonad/Hooks/FadeInactive.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.FadeInactive+-- Description :  Set the _NET_WM_WINDOW_OPACITY atom for inactive windows. -- Copyright    : (c) 2008 Justin Bogner <mail@justinbogner.com> -- License      : BSD --@@ -27,11 +28,11 @@     ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W-import Control.Monad  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.FadeInactive@@ -46,13 +47,12 @@ -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps> -- or something similar for this to do anything ----- For more detailed instructions on editing the logHook see:------ "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"------ For more detailed instructions on editing the layoutHook see:+-- For more detailed instructions on editing the logHook see+-- <https://xmonad.org/TUTORIAL.html#make-xmonad-and-xmobar-talk-to-each-other the tutorial>. ----- "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY rationalToOpacity :: Integral a => Rational -> a@@ -64,8 +64,7 @@ setOpacity :: Window -> Rational -> X () setOpacity w t = withDisplay $ \dpy -> do     a <- getAtom "_NET_WM_WINDOW_OPACITY"-    c <- getAtom "CARDINAL"-    io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]+    io $ changeProperty32 dpy w a cARDINAL propModeReplace [rationalToOpacity t]  -- | Fades a window out by setting the opacity fadeOut :: Rational -> Window -> X ()@@ -92,7 +91,7 @@  -- | Returns True if the window doesn't have the focus. isUnfocused :: Query Bool-isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset+isUnfocused = ask >>= \w -> liftX . gets $ (Just w /=) . W.peek . windowset  -- | Returns True if the window doesn't have the focus, and the window is on the -- current workspace. This is specifically handy in a multi monitor setup@@ -104,7 +103,7 @@   w <- ask   ws <- liftX $ gets windowset   let thisWS = w `elem` W.index ws-      unfocused = maybe True (w /=) $ W.peek ws+      unfocused = Just w /= W.peek ws   return $ thisWS && unfocused  -- | Fades out every window by the amount returned by the query.@@ -112,4 +111,4 @@ fadeOutLogHook qry = withWindowSet $ \s -> do     let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++                       concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)-    forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry)+    forM_ visibleWins $ liftA2 (=<<) setOpacity (runQuery qry)
XMonad/Hooks/FadeWindows.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.FadeWindows+-- Description :  A more flexible and general compositing interface than FadeInactive. -- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com> -- License     :  BSD --@@ -49,6 +50,7 @@                                 ) where  import           XMonad.Core+import           XMonad.Prelude import           XMonad.ManageHook                       (liftX) import qualified XMonad.StackSet             as W @@ -56,13 +58,10 @@                                                          ,isUnfocused                                                          ) -import           Control.Monad                           (forM_) import           Control.Monad.Reader                    (ask                                                          ,asks) import           Control.Monad.State                     (gets) import qualified Data.Map                    as M-import           Data.Monoid                      hiding ((<>))-import           Data.Semigroup  import           Graphics.X11.Xlib.Extras                (Event(..)) @@ -76,19 +75,28 @@ -- >     , handleEventHook = fadeWindowsEventHook -- >     {- ... -} -- >--- > myFadeHook = composeAll [isUnfocused --> transparency 0.2--- >                         ,                opaque+-- > myFadeHook = composeAll [                 opaque+-- >                         , isUnfocused --> transparency 0.2 -- >                         ] -- -- The above is like FadeInactive with a fade value of 0.2. ----- FadeHooks do not accumulate; instead, they compose from right to--- left like 'ManageHook's, so the above example @myFadeHook@ will--- render unfocused windows at 4/5 opacity and the focused window--- as opaque.  The 'opaque' hook above is optional, by the way, as any--- unmatched window will be opaque by default.+-- 'FadeHook's do not accumulate; instead, they compose from right to+-- left like 'ManageHook's, so in the above example @myFadeHook@ will+-- render unfocused windows at 4/5 opacity and the focused window as+-- opaque.  This means that, in particular, the order in the above+-- example is important. ----- This module is best used with "XMonad.Hooks.MoreManageHelpers", which+-- The 'opaque' hook above is optional, by the way, as any unmatched+-- window will be opaque by default.  If you want to make all windows a+-- bit transparent by default, you can replace 'opaque' with something+-- like+--+-- > transparency 0.93+--+-- at the top of @myFadeHook@.+--+-- This module is best used with "XMonad.Hooks.ManageHelpers", which -- exports a number of Queries that can be used in either @ManageHook@ -- or @FadeHook@. --@@ -97,9 +105,8 @@ -- aren't running a compositing manager, the opacity will be recorded -- but won't take effect until a compositing manager is started. ----- For more detailed instructions on editing the 'logHook' see:------ "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"+-- For more detailed instructions on editing the 'logHook' see+-- <https://xmonad.org/TUTORIAL.html#make-xmonad-and-xmobar-talk-to-each-other the tutorial>. -- -- For more detailed instructions on editing the 'handleEventHook', -- see:@@ -130,14 +137,13 @@ -- to make it obay the monoid laws data Opacity = Opacity Rational | OEmpty +instance Semigroup Opacity where+  r <> OEmpty = r+  _ <> r      = r+ instance Monoid Opacity where   mempty                  = OEmpty-  r      `mappend` OEmpty = r-  _      `mappend` r      = r -instance Semigroup Opacity where-  (<>) = mappend- -- | A FadeHook is similar to a ManageHook, but records window opacity. type FadeHook = Query Opacity @@ -164,17 +170,17 @@ opacity =  doS . Opacity . clampRatio  fadeTo, translucence, fadeBy :: Rational -> FadeHook--- ^ An alias for 'transparency'.+-- | An alias for 'transparency'. fadeTo       = transparency--- ^ An alias for 'transparency'.+-- | An alias for 'transparency'. translucence = transparency--- ^ An alias for 'transparency'.+-- | An alias for 'opacity'. fadeBy       = opacity  invisible, solid :: FadeHook--- ^ An alias for 'transparent'.+-- | An alias for 'transparent'. invisible    = transparent--- ^ An alias for 'opaque'.+-- | An alias for 'opaque'. solid        = opaque  -- | Like 'doF', but usable with 'ManageHook'-like hooks that@@ -205,15 +211,15 @@   forM_ visibleWins $ \w -> do     o <- userCodeDef (Opacity 1) (runQuery h w)     setOpacity w $ case o of-                     OEmpty    -> 0.93+                     OEmpty    -> 1                      Opacity r -> r  -- | A 'handleEventHook' to handle fading and unfading of newly mapped --   or unmapped windows; this avoids problems with layouts such as---   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may+--   'XMonad.Layout.Full' or "XMonad.Layout.Tabbed".  This hook may --   also be useful with "XMonad.Hooks.FadeInactive". fadeWindowsEventHook                     :: Event -> X All-fadeWindowsEventHook (MapNotifyEvent {}) =+fadeWindowsEventHook MapNotifyEvent{} =   -- we need to run the fadeWindowsLogHook.  only one way...   asks config >>= logHook >> return (All True) fadeWindowsEventHook _                   =  return (All True)
+ XMonad/Hooks/FloatConfigureReq.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE LambdaCase #-}+-- |+-- Module      :  XMonad.Hooks.FloatConfigureReq+-- Description :  Customize handling of floating windows' move\/resize\/restack requests (ConfigureRequest).+-- Copyright   :  (c) 2024 Tomáš Janoušek <tomi@nomi.cz>+-- License     :  BSD3+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>+--+-- xmonad normally honours those requests by doing exactly what the client+-- application asked, and refreshing. There are some misbehaving clients,+-- however, that:+--+-- * try to move their window to the last known absolute position regardless+--   of the current xrandr/xinerama layout+--+-- * move their window to 0, 0 for no particular reason (e.g. rxvt-unicode)+--+-- * issue lots of no-op requests causing flickering (e.g. Steam)+--+-- This module provides a replacement handler for 'ConfigureRequestEvent' to+-- work around such misbehaviours.+--+module XMonad.Hooks.FloatConfigureReq (+    -- * Usage+    -- $usage+    MaybeMaybeManageHook,+    floatConfReqHook,++    -- * Known workarounds+    fixSteamFlicker,+    fixSteamFlickerMMMH,+    ) where++import qualified Data.Map.Strict as M+import XMonad+import XMonad.Hooks.ManageHelpers+import XMonad.Prelude+import qualified XMonad.StackSet as W++-- $usage+-- To use this, include the following in your @xmonad.hs@:+--+-- > import XMonad.Hooks.FloatConfigureReq+-- > import XMonad.Hooks.ManageHelpers+--+-- > myFloatConfReqHook :: MaybeMaybeManageHook+-- > myFloatConfReqHook = composeAll+-- >     [ … ]+--+-- > myEventHook :: Event -> X All+-- > myEventHook = mconcat+-- >     [ …+-- >     , floatConfReqHook myFloatConfReqHook+-- >     , … ]+--+-- > main = xmonad $ …+-- >               $ def{ handleEventHook = myEventHook+-- >                    , … }+--+-- Then fill the @myFloatConfReqHook@ with whatever custom rules you need.+--+-- As an example, the following will prevent rxvt-unicode from moving its+-- (floating) window to 0, 0 after a font change but still ensure its size+-- increment hints are respected:+--+-- > className =? "URxvt" -?> pure <$> doFloat+--+-- Another example that avoids flickering and xmonad slowdowns caused by the+-- Steam client (completely ignore all its requests, none of which are+-- meaningful in the context of a tiling WM):+--+-- > map toLower `fmap` className =? "steam" -?> mempty+--+-- (this example is also available as 'fixSteamFlickerMMMH' to be added to+-- one's @myFloatConfReqHook@ and also 'fixSteamFlicker' to be added directly+-- to one's 'handleEventHook')++-- | A variant of 'MaybeManageHook' that additionally may or may not make+-- changes to the 'WindowSet'.+type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet)))++-- | Customizable handler for a 'ConfigureRequestEvent'. If the event's+-- 'ev_window' is a managed floating window, the provided+-- 'MaybeMaybeManageHook' is consulted and its result interpreted as follows:+--+--  * @Nothing@ - no match, fall back to the default handler+--+--  * @Just Nothing@ - match but ignore, no refresh, just send ConfigureNotify+--+--  * @Just (Just a)@ - match, modify 'WindowSet', refresh, send ConfigureNotify+floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All+floatConfReqHook mh ConfigureRequestEvent{ev_window = w} =+    runQuery (join <$> (isFloatQ -?> mh)) w >>= \case+        Nothing -> mempty+        Just e -> do+            whenJust e (windows . appEndo)+            sendConfEvent+            pure (All False)+  where+    sendConfEvent = withDisplay $ \dpy ->+        withWindowAttributes dpy w $ \wa -> do+            io . allocaXEvent $ \ev -> do+                -- We may have made no changes to the window size/position+                -- and thus the X server didn't emit any ConfigureNotify,+                -- so we need to send the ConfigureNotify ourselves to make+                -- sure there is a reply to this ConfigureRequestEvent and the+                -- window knows we (possibly) ignored its request.+                setEventType ev configureNotify+                setConfigureEvent ev w w+                    (wa_x wa) (wa_y wa) (wa_width wa)+                    (wa_height wa) (wa_border_width wa) none (wa_override_redirect wa)+                sendEvent dpy w False 0 ev+floatConfReqHook _ _ = mempty++-- | A 'Query' to determine if a window is floating.+isFloatQ :: Query Bool+isFloatQ = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset++-- | A pre-packaged 'floatConfReqHook' that fixes flickering of the Steam client by ignoring 'ConfigureRequestEvent's on any of its floating windows.+--+-- To use this, add 'fixSteamFlicker' to your 'handleEventHook'.+fixSteamFlicker :: Event -> X All+fixSteamFlicker = floatConfReqHook fixSteamFlickerMMMH++fixSteamFlickerMMMH :: MaybeMaybeManageHook+fixSteamFlickerMMMH = map toLower `fmap` className =? "steam" -?> mempty
XMonad/Hooks/FloatNext.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.FloatNext+-- Description :  Automatically send the next spawned window(s) to the floating layer. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -30,7 +30,7 @@                               , willFloatNext                               , willFloatAllNew -                                -- * 'DynamicLog' utilities+                                -- * Status bar utilities                                 -- $pp                               , willFloatNextPP                               , willFloatAllNewPP@@ -47,13 +47,13 @@ -- to automatically send the next spawned window(s) to the floating -- layer. ----- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use it by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.FloatNext -- -- and adding 'floatNextHook' to your 'ManageHook': ----- > myManageHook = floatNextHook <+> manageHook def+-- > myManageHook = floatNextHook <> manageHook def -- -- The 'floatNext' and 'toggleFloatNext' functions can be used in key -- bindings to float the next spawned window:@@ -97,10 +97,10 @@ -- $pp -- The following functions are used to display the current -- state of 'floatNext' and 'floatAllNew' in your--- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.+-- "XMonad.Hooks.StatusBar.PP". -- 'willFloatNextPP' and 'willFloatAllNewPP' should be added--- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your--- 'XMonad.Hooks.DynamicLog.PP'.+-- to the 'XMonad.Hooks.StatusBar.PP.ppExtras' field of your+-- "XMonad.Hooks.StatusBar.PP". -- -- Use 'runLogHook' to refresh the output of your 'logHook', so -- that the effects of a 'floatNext'/... will be visible
+ XMonad/Hooks/Focus.hs view
@@ -0,0 +1,546 @@+{-# LANGUAGE DerivingVia                #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# OPTIONS_HADDOCK show-extensions     #-}++-- |+-- Module:      XMonad.Hooks.Focus+-- Description: Extends ManageHook EDSL to work on focused windows and current workspace.+-- Copyright:   sgf-dma, 2016+-- Maintainer:  sgf.dma@gmail.com+--+-- Extends "XMonad.ManageHook" EDSL to work on focused windows and current+-- workspace.+--++module XMonad.Hooks.Focus+    (+      -- $main++      -- * FocusQuery.+      --+      -- $focusquery+      Focus (..)+    , FocusLock (..)+    , toggleLock+    , focusLockOn+    , focusLockOff+    , FocusQuery+    , runFocusQuery+    , FocusHook++      -- * Lifting into FocusQuery.+      --+      -- $lift+    , liftQuery+    , new+    , focused+    , focused'+    , focusedOn+    , focusedOn'+    , focusedCur+    , focusedCur'+    , newOn+    , newOnCur+    , unlessFocusLock++      -- * Commonly used actions for modifying focus.+      --+      -- $common+    , keepFocus+    , switchFocus+    , keepWorkspace+    , switchWorkspace++      -- * Running FocusQuery.+      --+      -- $running+    , manageFocus++      -- * Example configurations.+      --+      -- $examples+    , activateSwitchWs+    , activateOnCurrentWs+    , activateOnCurrentKeepFocus+    )+  where++import Control.Arrow ((&&&))+import Control.Monad.Reader++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Hooks.ManageHelpers (currentWs)+++-- $main+--+-- This module provides monad on top of Query monad providing additional+-- information about new window:+--+--  - workspace, where new window will appear;+--  - focused window on workspace, where new window will appear;+--  - current workspace;+--+-- And a property in extensible state:+--+--  - is focus lock enabled? Focus lock instructs all library's 'FocusHook'+--  functions to not move focus or switch workspace.+--+-- Lifting operations for standard 'ManageHook' EDSL combinators into+-- 'FocusQuery' monad allowing to run these combinators on focused window and+-- common actions for keeping focus and\/or workspace, switching focus and\/or+-- workspace are also provided.+--+-- == Quick start.+--+-- I may use one of predefined configurations.+--+-- 1. The default window activation behavior (switch to workspace with+--    activated window and switch focus to it) expressed using this module:+--+--      > import XMonad+--      >+--      > import XMonad.Hooks.EwmhDesktops+--      > import XMonad.Hooks.Focus+--      >+--      > main :: IO ()+--      > main = do+--      >         let ah :: ManageHook+--      >             ah = activateSwitchWs+--      >             xcf = setEwmhActivateHook ah+--      >                 . ewmh $ def{ modMask = mod4Mask }+--      >         xmonad xcf+--+-- 2. Or i may move activated window to current workspace and switch focus to+--    it:+--+--      >         let ah :: ManageHook+--      >             ah = activateOnCurrentWs+--+-- 3. Or move activated window to current workspace, but keep focus unchanged:+--+--      >         let ah :: ManageHook+--      >             ah = activateOnCurrentKeepFocus+--+-- 4. I may use regular 'ManageHook' combinators for filtering, which windows+--    may activate. E.g. activate all windows, except firefox:+--+--      >         let ah :: ManageHook+--      >             ah  = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel")+--      >                     --> activateSwitchWs+--+-- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless+--    xterm is focused on /current/ workspace:+--+--      >         let ah :: ManageHook+--      >             ah  = manageFocus (not <$> focusedCur (className =? "XTerm")+--      >                     --> liftQuery activateSwitchWs)+--+--      or activate all windows, unless focused window on the workspace,+--      /where activated window is/, is not a xterm:+--+--      >         let ah :: ManageHook+--      >             ah  = manageFocus (not <$> focused (className =? "XTerm")+--      >                     --> liftQuery activateSwitchWs)+--+-- == Defining FocusHook.+--+-- I may define my own 'FocusHook' like:+--+-- >    activateFocusHook :: FocusHook+-- >    activateFocusHook = composeAll+-- >            -- If 'gmrun' is focused on workspace, on which+-- >            -- /activated window/ is, keep focus unchanged. But i+-- >            -- may still switch workspace (thus, i use 'composeAll').+-- >            -- See 'keepFocus' properties in the docs below.+-- >            [ focused (className =? "Gmrun")+-- >                            --> keepFocus+-- >            -- Default behavior for activated windows: switch+-- >            -- workspace and focus.+-- >            , return True   --> switchWorkspace <> switchFocus+-- >            ]+-- >+-- >    newFocusHook :: FocusHook+-- >    newFocusHook      = composeOne+-- >            -- Always switch focus to 'gmrun'.+-- >            [ new (className =? "Gmrun")        -?> switchFocus+-- >            -- And always keep focus on 'gmrun'. Note, that+-- >            -- another 'gmrun' will steal focus from already+-- >            -- running one.+-- >            , focused (className =? "Gmrun")    -?> keepFocus+-- >            -- If firefox dialog prompt (e.g. master password+-- >            -- prompt) is focused on current workspace and new+-- >            -- window appears here too, keep focus unchanged+-- >            -- (note, used predicates: @newOnCur <&&> focused@ is+-- >            -- the same as @newOnCur <&&> focusedCur@, but is+-- >            -- /not/ the same as just 'focusedCur' )+-- >            , newOnCur <&&> focused+-- >                ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)+-- >                                                -?> keepFocus+-- >            -- Default behavior for new windows: switch focus.+-- >            , return True                       -?> switchFocus+-- >            ]+--+-- And then use it:+--+-- >    import XMonad+-- >    import XMonad.Util.EZConfig+-- >+-- >    import XMonad.Hooks.EwmhDesktops+-- >    import XMonad.Hooks.ManageHelpers+-- >    import XMonad.Hooks.Focus+-- >+-- >+-- >    main :: IO ()+-- >    main = do+-- >            let newFh :: ManageHook+-- >                newFh = manageFocus newFocusHook+-- >                acFh :: ManageHook+-- >                acFh = manageFocus activateFocusHook+-- >                xcf = setEwmhActivateHook acFh+-- >                    . ewmh $ def+-- >                             { manageHook   = newFh <> manageHook def+-- >                             , modMask      = mod4Mask+-- >                             }+-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]+-- >            xmonad xcf+--+-- Note:+--+--  - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor+--  workspace won't be switched).+--  - I need "XMonad.Hooks.EwmhDesktops" module for enabling window+--  activation.+--  - 'FocusHook' in 'manageHook' will be called /only/ for new windows.+--  - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows.+--+--  Alternatively, i may construct a single 'FocusHook' for both new and+--  activated windows and then just add it to both 'manageHook' and 'setEwmhActivateHook':+--+-- >            let fh :: Bool -> ManageHook+-- >                fh activated = manageFocus $ composeOne+-- >                        [ pure activated -?> activateFocusHook+-- >                        , pure True      -?> newFocusHook+-- >                        ]+-- >                xcf = setEwmhActivateHook (fh True)+-- >                    . ewmh $ def+-- >                             { manageHook   = fh False <> manageHook def+-- >                             , modMask      = mod4Mask+-- >                             }+-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]+--+-- And more technical notes:+--+--  - 'FocusHook' will run /many/ times, so it usually should not keep state+--  or save results. Precisely, it may do anything, but it must be idempotent+--  to operate properly.+--  - 'FocusHook' will see new window at workspace, where functions on the+--  /right/ from it in 'ManageHook' monoid place it.  In other words, in+--  @(Endo WindowSet)@ monoid i may see changes only from functions applied+--  /before/ (more to the right in function composition). Thus, it's better to+--  add 'FocusHook' the last.+--  - 'FocusHook' functions won't see window shift to another workspace made+--  by function from 'FocusHook' itself: new window workspace is determined+--  /before/ running 'FocusHook' and even if later one of 'FocusHook'+--  functions moves window to another workspace, predicates ('focused',+--  'newOn', etc) will still think new window is at workspace it was before.+--  This can be worked around by splitting 'FocusHook' into several different+--  values and evaluating each one separately, like:+--+--      > (FH2 -- manageFocus --> MH2) <> (FH1 -- manageFocus --> MH1) <> ..+--+--      E.g.+--+--      > manageFocus FH2 <> manageFocus FH1 <> ..+--+--      now @FH2@ will see window shift made by @FH1@.+--+-- Another interesting example is moving all activated windows to current+-- workspace by default, and applying 'FocusHook' after:+--+-- >    import XMonad+-- >    import XMonad.Util.EZConfig+-- >+-- >    import XMonad.Hooks.EwmhDesktops+-- >    import XMonad.Hooks.ManageHelpers+-- >    import XMonad.Hooks.Focus+-- >+-- >    main :: IO ()+-- >    main = do+-- >            let fh :: Bool -> ManageHook+-- >                fh activated = manageFocus $ composeOne+-- >                        [ pure activated -?> (newOnCur --> keepFocus)+-- >                        , pure True      -?> newFocusHook+-- >                        ]+-- >                xcf = setEwmhActivateHook (fh True <> activateOnCurrentWs)+-- >                    . ewmh $ def+-- >                             { manageHook = fh False <> manageHook def+-- >                             , modMask    = mod4Mask+-- >                             }+-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]+-- >            xmonad xcf+-- >+-- >    newFocusHook :: FocusHook+-- >    newFocusHook      = composeOne+-- >            -- Always switch focus to 'gmrun'.+-- >            [ new (className =? "Gmrun")        -?> switchFocus+-- >            -- And always keep focus on 'gmrun'. Note, that+-- >            -- another 'gmrun' will steal focus from already+-- >            -- running one.+-- >            , focused (className =? "Gmrun")    -?> keepFocus+-- >            -- If firefox dialog prompt (e.g. master password+-- >            -- prompt) is focused on current workspace and new+-- >            -- window appears here too, keep focus unchanged+-- >            -- (note, used predicates: @newOnCur <&&> focused@ is+-- >            -- the same as @newOnCur <&&> focusedCur@, but is+-- >            -- /not/ the same as just 'focusedCur' )+-- >            , newOnCur <&&> focused+-- >                ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)+-- >                                                -?> keepFocus+-- >            -- Default behavior for new windows: switch focus.+-- >            , return True                       -?> switchFocus+-- >            ]+--+-- Note here:+--+--  - i keep focus, when activated window appears on current workspace, in+--  this example.+--  - when @pure activated -?> (newOnCur --> keepFocus)@ runs, activated+--  window will be /already/ on current workspace, thus, if i do not want to+--  move some activated windows, i should filter them out before applying+--  @activateOnCurrentWs@ 'FocusHook'.+++-- FocusQuery.+-- $focusquery++-- | Information about current workspace and focus.+data Focus          = Focus+                        { -- | Workspace, where new window appears.+                          newWorkspace      :: WorkspaceId+                          -- | Focused window on workspace, where new window+                          -- appears.+                        , focusedWindow     :: Maybe Window+                          -- | Current workspace.+                        , currentWorkspace  :: WorkspaceId+                        }+  deriving (Show)+instance Default Focus where+    def             = Focus+                        { focusedWindow     = Nothing+                        , newWorkspace      = ""+                        , currentWorkspace  = ""+                        }++newtype FocusLock   = FocusLock {getFocusLock :: Bool}+  deriving (Show)+instance ExtensionClass FocusLock where+    initialValue    = FocusLock False++-- | Toggle stored focus lock state.+toggleLock :: X ()+toggleLock          = XS.modify (\(FocusLock b) -> FocusLock (not b))++-- | Lock focus.+focusLockOn :: X ()+focusLockOn         = XS.modify (const (FocusLock True))++-- | Unlock focus.+focusLockOff :: X ()+focusLockOff        = XS.modify (const (FocusLock False))++-- | Monad on top of 'Query' providing additional information about new+-- window.+newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)+  deriving newtype (Functor, Applicative, Monad, MonadReader Focus, MonadIO)+  deriving (Semigroup, Monoid) via Ap FocusQuery a++runFocusQuery :: FocusQuery a -> Focus -> Query a+runFocusQuery (FocusQuery m)    = runReaderT m++type FocusHook = FocusQuery (Endo WindowSet)+++-- Lifting into 'FocusQuery'.+-- $lift++-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'.+liftQuery :: Query a -> FocusQuery a+liftQuery           = FocusQuery . lift++-- | Run 'Query' on new window.+new :: Query a -> FocusQuery a+new                 = liftQuery++-- | Run 'Query' on focused window on workspace, where new window appears. If+-- there is no focused window, return 'False'.+focused :: Query Bool -> FocusQuery Bool+focused m           = getAny <$> focused' (Any <$> m)+-- | More general version of 'focused'.+focused' :: Monoid a => Query a -> FocusQuery a+focused' m          = do+    mw <- asks focusedWindow+    liftQuery (maybe mempty (flip local m . const) mw)++-- | Run 'Query' on window focused at particular workspace. If there is no+-- focused window, return 'False'.+focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool+focusedOn i m       = getAny <$> focusedOn' i (Any <$> m)+-- | More general version of 'focusedOn'.+focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a+focusedOn' i m      = liftQuery $ do+    mw <- liftX $ withWindowSet (return . W.peek . W.view i)+    maybe mempty (flip local m . const) mw++-- | Run 'Query' on focused window on current workspace. If there is no+-- focused window, return 'False'.  Note,+--+-- > focused <&&> newOnCur != focusedCur+--+-- The first will affect only new or activated window appearing on current+-- workspace, while the last will affect any window: focus even for windows+-- appearing on other workpsaces will depend on focus on /current/ workspace.+focusedCur :: Query Bool -> FocusQuery Bool+focusedCur m        = getAny <$> focusedCur' (Any <$> m)+-- | More general version of 'focusedCur'.+focusedCur' :: Monoid a => Query a -> FocusQuery a+focusedCur' m       = asks currentWorkspace >>= \i -> focusedOn' i m++-- | Does new window appear at particular workspace?+newOn :: WorkspaceId -> FocusQuery Bool+newOn i             = asks ((i ==) . newWorkspace)+-- | Does new window appear at current workspace?+newOnCur :: FocusQuery Bool+newOnCur            = asks currentWorkspace >>= newOn++-- | Execute 'Query', unless focus is locked.+unlessFocusLock :: Monoid a => Query a -> Query a+unlessFocusLock m   = do+    FocusLock b <- liftX XS.get+    when' (not b) m++-- Commonly used actions for modifying focus.+--+-- $common+-- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and+-- 'switchWorkspace' overwrite each other (the letftmost will determine what+-- happened):+--+-- prop> keepFocus       <> switchFocus     = keepFocus+-- prop> switchFocus     <> keepFocus       = switchFocus+-- prop> keepWorkspace   <> switchWorkspace = keepWorkspace+-- prop> switchWorkspace <> keepWorkspace   = switchWorkspace+--+-- and operations from different pairs are commutative:+--+-- prop> keepFocus   <> switchWorkspace = switchWorkspace <> keepFocus+-- prop> switchFocus <> switchWorkspace = switchWorkspace <> switchFocus+--+-- etc.++-- | Keep focus on workspace (may not be current), where new window appears.+-- Workspace will not be switched. This operation is idempotent and+-- effectively returns focus to window focused on that workspace before+-- applying @(Endo WindowSet)@ function.+keepFocus :: FocusHook+keepFocus           = focused' $ ask >>= \w -> doF $ \ws ->+                        W.view (W.currentTag ws) . W.focusWindow w $ ws++-- | Switch focus to new window on workspace (may not be current), where new+-- window appears. Workspace will not be switched. This operation is+-- idempotent.+switchFocus :: FocusHook+switchFocus         = do+    FocusLock b <- liftQuery . liftX $ XS.get+    if b+      -- When focus lock is enabled, call 'keepFocus' explicitly (still no+      -- 'keepWorkspace') to overwrite default behavior.+      then keepFocus+      else new $ ask >>= \w -> doF $ \ws ->+            W.view (W.currentTag ws) . W.focusWindow w $ ws++-- | Keep current workspace. Focus will not be changed at either current or+-- new window's  workspace. This operation is idempotent and effectively+-- switches to workspace, which was current before applying @(Endo WindowSet)@+-- function.+keepWorkspace :: FocusHook+keepWorkspace       = do+    ws <- asks currentWorkspace+    liftQuery . doF $ W.view ws++-- | Switch workspace to one, where new window appears. Focus will not be+-- changed at either current or new window's workspace. This operation is+-- idempotent.+switchWorkspace :: FocusHook+switchWorkspace     = do+    FocusLock b <- liftQuery . liftX $ XS.get+    if b+      -- When focus lock is enabled, call 'keepWorkspace' explicitly (still no+      -- 'keepFocus') to overwrite default behavior.+      then keepWorkspace+      else do+        ws <- asks newWorkspace+        liftQuery . doF $ W.view ws++-- Running FocusQuery.+-- $running++-- | I don't know at which workspace new window will appear until @(Endo+-- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run,+-- but in @(Endo WindowSet)@ function i can't already execute monadic actions,+-- because it's pure. So, i compute result for every workspace here and just+-- use it later in @(Endo WindowSet)@ function.  Note, though, that this will+-- execute monadic actions many times, and therefore assume, that result of+-- 'FocusHook' does not depend on the number of times it was executed.+manageFocus :: FocusHook -> ManageHook+manageFocus m       = do+    fws <- liftX . withWindowSet $ return+      . map (W.tag &&& fmap W.focus . W.stack) . W.workspaces+    ct  <- currentWs+    let r = def {currentWorkspace = ct}+    hs <- forM fws $ \(i, mw) -> do+      f <- runFocusQuery m (r {focusedWindow = mw, newWorkspace = i})+      return (i, f)+    reader (selectHook hs) >>= doF+  where+    -- | Select and apply @(Endo WindowSet)@ function depending on which+    -- workspace new window appeared now.+    selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet+    selectHook cfs nw ws    = fromMaybe ws $ do+        i <- W.findTag nw ws+        f <- lookup i cfs+        return (appEndo f ws)++when' :: (Monad m, Monoid a) => Bool -> m a -> m a+when' b mx+  | b               = mx+  | otherwise       = return mempty++-- Exmaple configurations.+-- $examples++-- | Default EWMH window activation behavior: switch to workspace with+-- activated window and switch focus to it. Not to be used in a 'manageHook'.+activateSwitchWs :: ManageHook+activateSwitchWs    = manageFocus (switchWorkspace <> switchFocus)++-- | Move activated window to current workspace. Not to be used in a 'manageHook'.+activateOnCurrent' :: ManageHook+activateOnCurrent'  = currentWs >>= unlessFocusLock . doShift++-- | Move activated window to current workspace and switch focus to it. Note,+-- that i need to explicitly call 'switchFocus' here, because otherwise, when+-- activated window is /already/ on current workspace, focus won't be+-- switched. Not to be used in a 'manageHook'.+activateOnCurrentWs :: ManageHook+activateOnCurrentWs = manageFocus (newOnCur --> switchFocus) <> activateOnCurrent'++-- | Move activated window to current workspace, but keep focus unchanged.+-- Not to be used in a 'manageHook'.+activateOnCurrentKeepFocus :: ManageHook+activateOnCurrentKeepFocus  = manageFocus (newOnCur --> keepFocus) <> activateOnCurrent'
− XMonad/Hooks/ICCCMFocus.hs 
@@ -1,42 +0,0 @@--------------------------------------------------------------------------------- |--- Module       : XMonad.Hooks.ICCCMFocus--- License      : BSD------ Maintainer   : Tony Morris <haskell@tmorris.net>------ Implemented in your @logHook@, Java swing applications will not misbehave--- when it comes to taking and losing focus.------ This has been done by taking the patch in <http://code.google.com/p/xmonad/issues/detail?id=177> and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@.------ @---    conf' =---      conf {---        logHook = takeTopFocus---      }--- @-------------------------------------------------------------------------------module XMonad.Hooks.ICCCMFocus-{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-}-(-  atom_WM_TAKE_FOCUS-, takeFocusX-, takeTopFocus-) where--import XMonad-import XMonad.Hooks.SetWMName-import qualified XMonad.StackSet as W--takeFocusX ::-  Window-  -> X ()-takeFocusX _w = return ()---- | The value to add to your log hook configuration.-takeTopFocus ::-  X ()-takeTopFocus =-  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"-
XMonad/Hooks/InsertPosition.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.InsertPosition+-- Description :  Configure where new windows should be added and how focus should shift. -- Copyright   :  (c) 2009 Adam Vogt -- License     :  BSD-style (see xmonad/LICENSE) --@@ -16,24 +17,30 @@ module XMonad.Hooks.InsertPosition (     -- * Usage     -- $usage-    insertPosition+    setupInsertPosition, insertPosition     ,Focus(..), Position(..)     ) where -import XMonad(ManageHook, MonadReader(ask))+import XMonad (ManageHook, MonadReader (ask), XConfig (manageHook))+import XMonad.Prelude (Endo (Endo), find) import qualified XMonad.StackSet as W-import Control.Applicative((<$>))-import Data.Maybe(fromMaybe)-import Data.List(find)-import Data.Monoid(Endo(Endo))  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module by importing it in your @xmonad.hs@: -- -- > import XMonad.Hooks.InsertPosition--- > xmonad def { manageHook = insertPosition Master Newer <+> myManageHook } ----- You should you put the manageHooks that use 'doShift' to take effect+-- You then just have to add 'setupInsertPosition' to your @main@ function:+--+-- > main = xmonad $ … $ setupInsertPosition Master Newer $ def { … }+--+-- Alternatively (i.e., you should /not/ do this if you already have set+-- up the above combinator), you can also directly insert+-- 'insertPosition' into your manageHook:+--+-- > xmonad def { manageHook = insertPosition Master Newer <> myManageHook }+--+-- NOTE: You should you put the manageHooks that use 'doShift' to take effect -- /before/ 'insertPosition', so that the window order will be consistent. -- Because ManageHooks compose from right to left (like function composition -- '.'), this means that 'insertPosition' should be the leftmost ManageHook.@@ -41,13 +48,18 @@ data Position = Master | End | Above | Below data Focus = Newer | Older +-- | A combinator for setting up 'insertPosition'.+setupInsertPosition :: Position -> Focus -> XConfig a -> XConfig a+setupInsertPosition pos foc cfg =+  cfg{ manageHook = insertPosition pos foc <> manageHook cfg }+ -- | insertPosition. A manage hook for placing new windows. XMonad's default is -- the same as using: @insertPosition Above Newer@. insertPosition :: Position -> Focus -> ManageHook insertPosition pos foc = Endo . g <$> ask   where     g w = viewingWs w (updateFocus w . ins w . W.delete' w)-    ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $+    ins w = (\f ws -> maybe id W.focusWindow (W.peek ws) $ f ws) $         case pos of             Master -> W.insertUp w . W.focusMaster             End    -> insertDown w . W.modify' focusLast'@@ -70,5 +82,7 @@ insertDown w = W.swapDown . W.insertUp w  focusLast' ::  W.Stack a -> W.Stack a-focusLast' st = let ws = W.integrate st-    in W.Stack (last ws) (tail $ reverse ws) []+focusLast' st =+  case reverse (W.integrate st) of+    []       -> st+    (l : ws) -> W.Stack l ws []
XMonad/Hooks/ManageDebug.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.ManageDebug+-- Description :  A manageHook and associated logHook for debugging ManageHooks. -- Copyright   :  (c) Brandon S Allbery KF8NH, 2014 -- License     :  BSD3-style (see LICENSE) --@@ -13,7 +12,7 @@ -- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's. -- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator. -- Or use @debugManageHookOn@ for a triggerable version, specifying the--- triggering key sequence in 'XMonad.Util.EZConfig' syntax. Or use the+-- triggering key sequence in "XMonad.Util.EZConfig" syntax. Or use the -- individual hooks in whatever way you see fit. -- -----------------------------------------------------------------------------@@ -33,25 +32,26 @@ import           XMonad.Util.DebugWindow import           XMonad.Util.EZConfig import qualified XMonad.Util.ExtensibleState                                                 as XS-import           Control.Monad                            (when) --- persistent state for manageHook debugging to trigger logHook debugging-data ManageStackDebug = MSD (Bool,Bool) deriving Typeable+-- state for manageHook debugging to trigger logHook debugging+data MSDFinal = DoLogHook | SkipLogHook deriving Show+data MSDTrigger = MSDActivated | MSDInactive deriving Show+data ManageStackDebug = MSD MSDFinal MSDTrigger deriving Show instance ExtensionClass ManageStackDebug where-  initialValue = MSD (False,False)+  initialValue = MSD SkipLogHook MSDInactive  -- | A combinator to add full 'ManageHook' debugging in a single operation. debugManageHook :: XConfig l -> XConfig l-debugManageHook cf = cf {logHook    = manageDebugLogHook <+> logHook    cf-                        ,manageHook = manageDebug        <+> manageHook cf+debugManageHook cf = cf {logHook    = manageDebugLogHook <> logHook    cf+                        ,manageHook = manageDebug        <> manageHook cf                         }  -- | A combinator to add triggerable 'ManageHook' debugging in a single operation.---   Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press+--   Specify a key sequence as a string in "XMonad.Util.EZConfig" syntax; press --   this key before opening the window to get just that logged. debugManageHookOn :: String -> XConfig l -> XConfig l-debugManageHookOn key cf = cf {logHook    = manageDebugLogHook <+> logHook    cf-                              ,manageHook = maybeManageDebug   <+> manageHook cf+debugManageHookOn key cf = cf {logHook    = manageDebugLogHook <> logHook    cf+                              ,manageHook = maybeManageDebug   <> manageHook cf                               }                            `additionalKeysP`                            [(key,debugNextManagedWindow)]@@ -62,7 +62,7 @@ --   final 'StackSet' state. -- --   Note that the initial state shows only the current workspace; the final---   one shows all workspaces, since your 'ManageHook' might use e.g. 'doShift',+--   one shows all workspaces, since your 'manageHook' might use e.g. 'doShift', manageDebug :: ManageHook manageDebug = do   w <- ask@@ -70,31 +70,38 @@     trace "== manageHook; current stack =="     debugStackString >>= trace     ws <- debugWindow w-    trace $ "new:\n  " ++ ws-    XS.modify $ \(MSD (_,key)) -> MSD (True,key)+    trace $ "new window:\n  " ++ ws+    -- technically we don't care about go here, since only maybeManageDebug+    -- uses it+    XS.modify $ \(MSD _ go') -> MSD DoLogHook go'   idHook  -- | @manageDebug@ only if the user requested it with @debugNextManagedWindow@. maybeManageDebug :: ManageHook maybeManageDebug = do   go <- liftX $ do-    MSD (log_,go') <- XS.get-    XS.put $ MSD (log_,False)+    MSD _ go' <- XS.get+    -- leave it active, as we may manage multiple windows before the logHook+    -- so we now deactivate it in the logHook     return go'-  if go then manageDebug else idHook+  case go of+    MSDActivated -> manageDebug+    _            -> idHook  -- | If @manageDebug@ has set the debug-stack flag, show the stack. manageDebugLogHook :: X () manageDebugLogHook = do-                       MSD (go,key) <- XS.get-                       when go $ do-                         trace "== manageHook; final stack =="-                         debugStackFullString >>= trace-                         XS.put $ MSD (False,key)-                       idHook+                       MSD log' _ <- XS.get+                       case log' of+                         DoLogHook -> do+                                  trace "== manageHook; final stack =="+                                  debugStackFullString >>= trace+                                  -- see comment in maybeManageDebug+                                  XS.put $ MSD SkipLogHook MSDInactive+                         _         -> idHook  -- | Request that the next window to be managed be @manageDebug@-ed. This can --   be used anywhere an X action can, such as key bindings, mouse bindings --   (presumably with 'const'), 'startupHook', etc. debugNextManagedWindow :: X ()-debugNextManagedWindow = XS.modify $ \(MSD (log_,_)) -> MSD (log_,True)+debugNextManagedWindow = XS.modify $ \(MSD log' _) -> MSD log' MSDActivated
XMonad/Hooks/ManageDocks.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP, LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.ManageDocks+-- Description :  Automatically manage 'dock' type programs. -- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de> -- License      : BSD --@@ -15,8 +16,7 @@ module XMonad.Hooks.ManageDocks (     -- * Usage     -- $usage-    docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,-    docksEventHook, docksStartupHook,+    docks, manageDocks, checkDock, AvoidStruts(..), avoidStruts, avoidStrutsOn, onAllDocks,     ToggleStruts(..),     SetStruts(..),     module XMonad.Util.Types,@@ -27,8 +27,11 @@     RectC(..), #endif -    -- for XMonad.Actions.FloatSnap-    calcGap+    -- * For developers of other modules ("XMonad.Actions.FloatSnap")+    calcGap,++    -- * Standalone hooks (deprecated)+    docksEventHook, docksStartupHook,     ) where  @@ -38,23 +41,21 @@ import XMonad.Layout.LayoutModifier import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s)-import XMonad.Util.XUtils (fi) import qualified XMonad.Util.ExtensibleState as XS-import Data.Monoid (All(..), mempty)-import Data.Functor((<$>))+import XMonad.Prelude -import qualified Data.Set as S-import qualified Data.Map as M-import Control.Monad (when, forM_, filterM)+import qualified Data.Set        as S+import qualified Data.Map        as M+import qualified XMonad.StackSet as W  -- $usage--- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:+-- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Hooks.ManageDocks -- -- Wrap your xmonad config with a call to 'docks', like so: ----- > main = xmonad $ docks def+-- > main = xmonad $ … . docks . … $ def{…} -- -- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout -- to prevent windows from overlapping these windows.@@ -82,84 +83,113 @@ -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. --  -- | Add docks functionality to the given config.  See above for an example. docks :: XConfig a -> XConfig a-docks c = c { startupHook     = docksStartupHook <+> startupHook c-            , handleEventHook = docksEventHook <+> handleEventHook c-            , manageHook      = manageDocks <+> manageHook c }+docks c = c { startupHook     = docksStartupHook <> startupHook c+            , handleEventHook = docksEventHook <> handleEventHook c+            , manageHook      = manageDocks <> manageHook c } -newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] }-    deriving (Eq, Typeable)+type WindowStruts = M.Map Window [Strut] -data UpdateDocks = UpdateDocks deriving Typeable+data UpdateDocks = UpdateDocks instance Message UpdateDocks  refreshDocks :: X () refreshDocks = sendMessage UpdateDocks +-- Nothing means cache hasn't been initialized yet+newtype StrutCache = StrutCache { fromStrutCache :: Maybe WindowStruts }+    deriving Eq+ instance ExtensionClass StrutCache where-  initialValue = StrutCache M.empty+    initialValue = StrutCache Nothing -updateStrutCache :: Window -> [Strut] -> X Bool-updateStrutCache w strut = do-  XS.modified $ StrutCache . M.insert w strut . fromStrutCache+modifiedStrutCache :: (Maybe WindowStruts -> X WindowStruts) -> X Bool+modifiedStrutCache f = XS.modifiedM $ fmap (StrutCache . Just) . f . fromStrutCache -deleteFromStructCache :: Window -> X Bool-deleteFromStructCache w = do-  XS.modified $ StrutCache . M.delete w . fromStrutCache+getStrutCache :: X WindowStruts+getStrutCache = do+    cache <- maybeInitStrutCache =<< XS.gets fromStrutCache+    cache <$ XS.put (StrutCache (Just cache)) +updateStrutCache :: Window -> X Bool+updateStrutCache w = modifiedStrutCache $ updateStrut w <=< maybeInitStrutCache++deleteFromStrutCache :: Window -> X Bool+deleteFromStrutCache w = modifiedStrutCache $ fmap (M.delete w) . maybeInitStrutCache++maybeInitStrutCache :: Maybe WindowStruts -> X WindowStruts+maybeInitStrutCache = maybe (queryDocks >>= foldlM (flip updateStrut) M.empty) pure+  where+    queryDocks = withDisplay $ \dpy -> do+        (_, _, wins) <- io . queryTree dpy =<< asks theRoot+        filterM (runQuery checkDock) wins++updateStrut :: Window -> WindowStruts -> X WindowStruts+updateStrut w cache = do+    when (w `M.notMember` cache) $ requestDockEvents w+    strut <- getStrut w+    pure $ M.insert w strut cache++-- | Perform the given action on all docks.+onAllDocks :: (Window -> X ()) -> X ()+onAllDocks act = traverse_ (act . fst) . M.toList =<< getStrutCache+ -- | Detects if the given window is of type DOCK and if so, reveals --   it, but does not manage it. manageDocks :: ManageHook-manageDocks = checkDock --> (doIgnore <+> setDocksMask)-    where setDocksMask = do-            ask >>= \win -> liftX $ withDisplay $ \dpy -> do-                io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)-            mempty+manageDocks = checkDock --> (doIgnore <> doRequestDockEvents)+  where+    doRequestDockEvents = ask >>= liftX . requestDockEvents >> mempty --- | Checks if a window is a DOCK or DESKTOP window+-- | Request events for a dock window.+-- (Only if not already a client to avoid overriding 'clientMask')+requestDockEvents :: Window -> X ()+requestDockEvents w = whenX (not <$> isClient w) $ withDisplay $ \dpy ->+    withWindowAttributes dpy w $ \attrs -> io $ selectInput dpy w $+        wa_your_event_mask attrs .|. propertyChangeMask .|. structureNotifyMask++-- | Checks if a window is a DOCK or DESKTOP window.+-- Ignores xmonad's own windows (usually _NET_WM_WINDOW_TYPE_DESKTOP) to avoid+-- unnecessary refreshes. checkDock :: Query Bool-checkDock = ask >>= \w -> liftX $ do-    dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"-    desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"-    mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w-    case mbr of-        Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)-        _       -> return False+checkDock = isDockOrDesktop <&&> (not <$> isXMonad)+  where+    isDockOrDesktop = ask >>= \w -> liftX $ do+        dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"+        desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"+        mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w+        case mbr of+            Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs+            _       -> return False+    isXMonad = className =? "xmonad"  -- | Whenever a new dock appears, refresh the layout immediately to avoid the -- new dock.+{-# DEPRECATED docksEventHook "Use docks instead." #-} docksEventHook :: Event -> X All-docksEventHook (MapNotifyEvent { ev_window = w }) = do-    whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do-        strut <- getStrut w-        whenX (updateStrutCache w strut) refreshDocks+docksEventHook MapNotifyEvent{ ev_window = w } = do+    whenX (runQuery checkDock w <&&> (not <$> isClient w)) $+        whenX (updateStrutCache w) refreshDocks     return (All True)-docksEventHook (PropertyEvent { ev_window = w-                              , ev_atom = a }) = do+docksEventHook PropertyEvent{ ev_window = w+                            , ev_atom = a } = do     nws <- getAtom "_NET_WM_STRUT"     nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"-    when (a == nws || a == nwsp) $ do-        strut <- getStrut w-        whenX (updateStrutCache w strut) refreshDocks+    when (a == nws || a == nwsp) $+        whenX (updateStrutCache w) refreshDocks     return (All True)-docksEventHook (DestroyWindowEvent {ev_window = w}) = do-    whenX (deleteFromStructCache w) refreshDocks+docksEventHook DestroyWindowEvent{ ev_window = w } = do+    whenX (deleteFromStrutCache w) refreshDocks     return (All True) docksEventHook _ = return (All True) +{-# DEPRECATED docksStartupHook "Use docks instead." #-} docksStartupHook :: X ()-docksStartupHook = withDisplay $ \dpy -> do-    rootw <- asks theRoot-    (_,_,wins) <- io $ queryTree dpy rootw-    docks <- filterM (runQuery checkDock) wins-    forM_ docks $ \win -> do-        strut <- getStrut win-        updateStrutCache win strut-    refreshDocks+docksStartupHook = void getStrutCache  -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut]@@ -167,7 +197,7 @@     msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w     case msp of         Just sp -> return $ parseStrutPartial sp-        Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w+        Nothing -> maybe [] parseStrut <$> getProp32s "_NET_WM_STRUT" w  where     parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]     parseStrut _ = []@@ -180,39 +210,46 @@ -- | Goes through the list of windows and find the gap so that all --   STRUT settings are satisfied. calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)-calcGap ss = withDisplay $ \dpy -> do+calcGap ss = do     rootw <- asks theRoot-    struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache)+    struts <- filter careAbout . concat . M.elems <$> getStrutCache -    -- we grab the window attributes of the root window rather than checking-    -- the width of the screen because xlib caches this info and it tends to-    -- be incorrect after RAndR-    wa <- io $ getWindowAttributes dpy rootw-    let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)+    -- If possible, we grab the window attributes of the root window rather+    -- than checking the width of the screen because xlib caches this info+    -- and it tends to be incorrect after RAndR+    screen <- safeGetWindowAttributes rootw >>= \case+        Nothing -> gets $ r2c . screenRect . W.screenDetail . W.current . windowset+        Just wa -> pure . r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)     return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts   where careAbout (s,_,_,_) = s `S.member` ss  -- | Adjust layout automagically: don't cover up any docks, status --   bars, etc.+--+--   Note that this modifier must be applied before any modifier that+--   changes the screen rectangle, or struts will be applied in the wrong+--   place and may affect the other modifier(s) in odd ways. This is+--   most commonly seen with the 'spacing' modifier and friends. avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a avoidStruts = avoidStrutsOn [U,D,L,R]  -- | Adjust layout automagically: don't cover up docks, status bars,---   etc. on the indicated sides of the screen.  Valid sides are U---   (top), D (bottom), R (right), or L (left).+--   etc. on the indicated sides of the screen.  Valid sides are 'U'+--   (top), 'D' (bottom), 'R' (right), or 'L' (left). The warning in+--   'avoidStruts' applies to this modifier as well. avoidStrutsOn :: LayoutClass l a =>                  [Direction2D]               -> l a               -> ModifiedLayout AvoidStruts l a avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) -data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )+newtype AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )  -- | Message type which can be sent to an 'AvoidStruts' layout --   modifier to alter its behavior. data ToggleStruts = ToggleStruts                   | ToggleStrut Direction2D-  deriving (Read,Show,Typeable)+  deriving (Read,Show)  instance Message ToggleStruts @@ -238,7 +275,7 @@ data SetStruts = SetStruts { addedStruts   :: [Direction2D]                            , removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added.                            }-  deriving (Read,Show,Typeable)+  deriving (Read,Show)  instance Message SetStruts @@ -310,9 +347,5 @@ -- Precondition for every input range @(x, y)@: @x '<=' y@. -- -- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@.- overlaps :: Ord a => (a, a) -> (a, a) -> Bool-(a, b) `overlaps` (x, y) =-  inRange (a, b) x || inRange (a, b) y || inRange (x, y) a-  where-  inRange (i, j) k = i <= k && k <= j+(a, b) `overlaps` (x, y) = not (b < x || y < a) -- not disjoint
XMonad/Hooks/ManageHelpers.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.ManageHelpers+-- Description  : Helper functions to be used in manageHook. -- Copyright    : (c) Lukas Mai -- License      : BSD --@@ -23,22 +25,44 @@ -- >         ], -- >         ... -- >     }+--+-- Here's how you can define more helpers like the ones from this module:+--+-- > -- some function you want to transform into an infix operator+-- > f :: a -> b -> Bool+-- >+-- > -- a new helper+-- > q ***? x = fmap (\a -> f a x) q   -- or: (\b -> f x b)+-- > -- or+-- > q ***? x = fmap (`f` x) q         -- or: (x `f`)+--+-- Any existing operator can be "lifted" in the same way:+--+-- > q ++? x = fmap (++ x) q  module XMonad.Hooks.ManageHelpers (     Side(..),     composeOne,-    (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),+    (-?>), (/=?), (^?), (~?), ($?), (<==?), (</=?), (-->>), (-?>>),     currentWs,+    windowTag,     isInProperty,     isKDETrayWindow,     isFullscreen,+    isMinimized,     isDialog,+    isNotification,     pid,+    desktop,     transientTo,     maybeToDefinite,     MaybeManageHook,     transience,     transience',+    clientLeader,+    sameBy,+    shiftToSame,+    shiftToSame',     doRectFloat,     doFullFloat,     doCenterFloat,@@ -46,16 +70,18 @@     doFloatAt,     doFloatDep,     doHideIgnore,+    doSink,+    doLower,+    doRaise,+    doFocus,     Match, ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Util.WindowProperties (getProp32s) -import Data.Maybe-import Data.Monoid- import System.Posix (ProcessID)  -- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northeast@@ -73,29 +99,39 @@ -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as -- a candidate returns a 'Just' value, effectively running only the first match -- (whereas 'composeAll' continues and executes all matching rules).-composeOne :: [MaybeManageHook] -> ManageHook-composeOne = foldr try idHook+composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a+composeOne = foldr try (return mempty)     where     try q z = do         x <- q-        case x of-            Just h -> return h-            Nothing -> z+        maybe z return x  infixr 0 -?>, -->>, -?>>  -- | q \/=? x. if the result of q equals x, return False-(/=?) :: Eq a => Query a -> a -> Query Bool+(/=?) :: (Eq a, Functor m) => m a -> a -> m Bool q /=? x = fmap (/= x) q +-- | q ^? x. if the result of @x `isPrefixOf` q@, return True+(^?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool+q ^? x = fmap (x `isPrefixOf`) q++-- | q ~? x. if the result of @x `isInfixOf` q@, return True+(~?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool+q ~? x = fmap (x `isInfixOf`) q++-- | q $? x. if the result of @x `isSuffixOf` q@, return True+($?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool+q $? x = fmap (x `isSuffixOf`) q+ -- | q <==? x. if the result of q equals x, return True grouped with q-(<==?) :: Eq a => Query a -> a -> Query (Match a)+(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a) q <==? x = fmap (`eq` x) q     where     eq q' x' = Match (q' == x') q'  -- | q <\/=? x. if the result of q notequals x, return True grouped with q-(</=?) :: Eq a => Query a -> a -> Query (Match a)+(</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a) q </=? x = fmap (`neq` x) q     where     neq q' x' = Match (q' /= x') q'@@ -103,19 +139,19 @@ -- | A helper operator for use in 'composeOne'. It takes a condition and an action; -- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will -- go on and try the next rule.-(-?>) :: Query Bool -> ManageHook -> MaybeManageHook+(-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a) p -?> f = do     x <- p     if x then fmap Just f else return Nothing  -- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action.  If 'p' is true, it executes the resulting action.-(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook+(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b p -->> f = do     Match b m <- p-    if b then (f m) else mempty+    if b then f m else return mempty  -- | A helper operator for use in 'composeOne'.  It takes a condition and a function taking a groupdatum to action.  If 'p' is true, it executes the resulting action.  If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.-(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook+(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b) p -?>> f = do     Match b m <- p     if b then fmap  Just (f m) else return Nothing@@ -124,6 +160,10 @@ currentWs :: Query WorkspaceId currentWs = liftX (withWindowSet $ return . W.currentTag) +-- | Return the workspace tag of a window, if already managed+windowTag :: Query (Maybe WorkspaceId)+windowTag = ask >>= \w -> liftX $ withWindowSet $ return . W.findTag w+ -- | A predicate to check whether a window is a KDE system tray icon. isKDETrayWindow :: Query Bool isKDETrayWindow = ask >>= \w -> liftX $ do@@ -146,17 +186,42 @@ isFullscreen :: Query Bool isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN" +-- | A predicate to check whether a window is hidden (minimized).+-- See also "XMonad.Actions.Minimize".+isMinimized :: Query Bool+isMinimized = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"+ -- | A predicate to check whether a window is a dialog.+--+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>. isDialog :: Query Bool isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG" +-- | A predicate to check whether a window is a notification.+--+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.+isNotification :: Query Bool+isNotification =+  isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_NOTIFICATION"++-- | This function returns 'Just' the @_NET_WM_PID@ property for a+-- particular window if set, 'Nothing' otherwise.+--+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm45623487788432>. pid :: Query (Maybe ProcessID)-pid = ask >>= \w -> liftX $ do-    p <- getProp32s "_NET_WM_PID" w-    return $ case p of-        Just [x] -> Just (fromIntegral x)-        _        -> Nothing+pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w <&> \case+    Just [x] -> Just (fromIntegral x)+    _        -> Nothing +-- | This function returns 'Just' the @_NET_WM_DESKTOP@ property for a+-- particular window if set, 'Nothing' otherwise.+--+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46181547492704>.+desktop :: Query (Maybe Int)+desktop = ask >>= \w -> liftX $ getProp32s "_NET_WM_DESKTOP" w <&> \case+    Just [x] -> Just (fromIntegral x)+    _        -> Nothing+ -- | A predicate to check whether a window is Transient. -- It holds the result which might be the window it is transient to -- or it might be 'Nothing'.@@ -169,19 +234,50 @@ -- | A convenience 'MaybeManageHook' that will check to see if a window -- is transient, and then move it to its parent. transience :: MaybeManageHook-transience = transientTo </=? Nothing -?>> move-    where-    move mw = maybe idHook (doF . move') mw-    move' w s = maybe s (`W.shift` s) (W.findTag w s)+transience = transientTo </=? Nothing -?>> maybe idHook doShiftTo  -- | 'transience' set to a 'ManageHook' transience' :: ManageHook transience' = maybeToDefinite transience +-- | This function returns 'Just' the @WM_CLIENT_LEADER@ property for a+-- particular window if set, 'Nothing' otherwise. Note that, generally,+-- the window ID returned from this property (by firefox, for example)+-- corresponds to an unmapped or unmanaged dummy window. For this to be+-- useful in most cases, it should be used together with 'sameBy'.+--+-- See <https://tronche.com/gui/x/icccm/sec-5.html>.+clientLeader :: Query (Maybe Window)+clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w <&> \case+    Just [x] -> Just (fromIntegral x)+    _        -> Nothing++-- | For a given window, 'sameBy' returns all windows that have a matching+-- property (e.g. those obtained from Queries of 'clientLeader' and 'pid').+sameBy :: Eq prop => Query (Maybe prop) -> Query [Window]+sameBy prop = prop >>= \case+    Nothing -> pure []+    propVal -> ask >>= \w -> liftX . withWindowSet $ \s ->+        filterM (fmap (propVal ==) . runQuery prop) (W.allWindows s \\ [w])++-- | 'MaybeManageHook' that moves the window to the same workspace as the+-- first other window that has the same value of a given 'Query'. Useful+-- Queries for this include 'clientLeader' and 'pid'.+shiftToSame :: Eq prop => Query (Maybe prop) -> MaybeManageHook+shiftToSame prop = sameBy prop </=? [] -?>> maybe idHook doShiftTo . listToMaybe++-- | 'shiftToSame' set to a 'ManageHook'+shiftToSame' :: Eq prop => Query (Maybe prop) -> ManageHook+shiftToSame' = maybeToDefinite . shiftToSame+ -- | converts 'MaybeManageHook's to 'ManageHook's-maybeToDefinite :: MaybeManageHook -> ManageHook+maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a maybeToDefinite = fmap (fromMaybe mempty) +-- | Move the window to the same workspace as another window.+doShiftTo :: Window -> ManageHook+doShiftTo target = doF . shiftTo =<< ask+  where shiftTo w s = maybe s (\t -> W.shiftWin t w s) (W.findTag target s)  -- | Floats the new window in the given rectangle. doRectFloat :: W.RationalRect  -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h.@@ -212,12 +308,14 @@ doSideFloat side = doFloatDep move   where     move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h-      where cx =      if side `elem` [SC,C ,NC] then (1-w)/2-                 else if side `elem` [SW,CW,NW] then 0-                 else {- side `elem` [SE,CE,NE] -}   1-w-            cy =      if side `elem` [CE,C ,CW] then (1-h)/2-                 else if side `elem` [NE,NC,NW] then 0-                 else {- side `elem` [SE,SC,SW] -}   1-h+      where cx+              | side `elem` [SC,C ,NC] = (1-w)/2+              | side `elem` [SW,CW,NW] = 0+              | otherwise = {- side `elem` [SE,CE,NE] -} 1-w+            cy+              | side `elem` [CE,C ,CW] = (1-h)/2+              | side `elem` [NE,NC,NW] = 0+              | otherwise = {- side `elem` [SE,SC,SW] -} 1-h  -- | Floats a new window with its original size, but centered. doCenterFloat :: ManageHook@@ -226,3 +324,21 @@ -- | Hides window and ignores it. doHideIgnore :: ManageHook doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)++-- | Sinks a window+doSink :: ManageHook+doSink = doF . W.sink =<< ask++-- | Lower an unmanaged window. Useful together with 'doIgnore' to lower+-- special windows that for some reason don't do it themselves.+doLower :: ManageHook+doLower = ask >>= \w -> liftX $ withDisplay $ \dpy -> io (lowerWindow dpy w) >> mempty++-- | Raise an unmanaged window. Useful together with 'doIgnore' to raise+-- special windows that for some reason don't do it themselves.+doRaise :: ManageHook+doRaise = ask >>= \w -> liftX $ withDisplay $ \dpy -> io (raiseWindow dpy w) >> mempty++-- | Focus a window (useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook').+doFocus :: ManageHook+doFocus = doF . W.focusWindow =<< ask
XMonad/Hooks/Minimize.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.Minimize+-- Description :  Handle window manager hints to minimize and restore windows. -- Copyright   :  (c) Justin Bogner 2010 -- License     :  BSD3-style (see LICENSE) --@@ -19,14 +20,12 @@       minimizeEventHook     ) where -import Data.Monoid-import Control.Monad(when)- import XMonad import XMonad.Actions.Minimize+import XMonad.Prelude  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Minimize -- > import XMonad.Layout.Minimize@@ -37,17 +36,19 @@ -- >                   , handleEventHook = myHandleEventHook }  minimizeEventHook :: Event -> X All-minimizeEventHook (ClientMessageEvent {ev_window = w,-                                       ev_message_type = mt,-                                       ev_data = dt}) = do+minimizeEventHook ClientMessageEvent{ev_window = w,+                                     ev_message_type = mt,+                                     ev_data = dt} = do     a_aw <- getAtom "_NET_ACTIVE_WINDOW"     a_cs <- getAtom "WM_CHANGE_STATE"      when (mt == a_aw) $ maximizeWindow w-    when (mt == a_cs) $ do-      let message = fromIntegral . head $ dt-      when (message == normalState) $ maximizeWindow w-      when (message == iconicState) $ minimizeWindow w+    when (mt == a_cs) $ case listToMaybe dt of+      Nothing  -> pure ()+      Just dth -> do+        let message = fromIntegral dth+        when (message == normalState) $ maximizeWindow w+        when (message == iconicState) $ minimizeWindow w      return (All True) minimizeEventHook _ = return (All True)
+ XMonad/Hooks/Modal.hs view
@@ -0,0 +1,310 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.Modal+-- Description :  Implements true modality in xmonad key-bindings.+-- Copyright   :  (c) 2018  L. S. Leary+-- License     :  BSD3-style (see LICENSE)+--+-- Author      :  L. S. Leary+-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module implements modal keybindings for xmonad.+--+--------------------------------------------------------------------------------++-- --< Imports & Exports >-- {{{+module XMonad.Hooks.Modal+  (+ -- * Usage+ -- $Usage+    modal+  , modeWithExit+  , mode+  , Mode+  , mkKeysEz+  , setMode+  , exitMode+ -- * Provided Modes #ProvidedModes#+ -- $ProvidedModes+  , noModModeLabel+  , noModMode+  , floatModeLabel+  , floatMode+  , overlayedFloatModeLabel+  , overlayedFloatMode+  , floatMap+  , overlay+ -- * Logger+  , logMode+  ) where++-- core+import           XMonad+-- base+import           Data.Bits                     ( (.&.)+                                               , complement+                                               )+import           Data.List+import qualified Data.Map.Strict               as M+-- contrib+import           XMonad.Actions.FloatKeys      ( keysMoveWindow+                                               , keysResizeWindow+                                               )+import           XMonad.Prelude+import           XMonad.Util.EZConfig          ( parseKeyCombo+                                               , mkKeymap+                                               )+import qualified XMonad.Util.ExtensibleConf    as XC+import qualified XMonad.Util.ExtensibleState   as XS+import           XMonad.Util.Grab+import           XMonad.Util.Loggers+import           XMonad.Util.Parser            ( runParser )++-- }}}++-- Original Draft By L.S.Leary : https://gist.github.com/LSLeary/6741b0572d62db3f0cea8e6618141b2f++-- --< Usage >-- {{{++-- $Usage+--+-- This module provides modal keybindings in xmonad. If you're not familiar with+-- modal keybindings from Vim, you can think of modes as submaps from+-- "XMonad.Actions.Submap", but after each action you execute, you land back in+-- the submap until you explicitly exit the submap. To use this module you+-- should apply the 'modal' function to the config, which will setup the list of+-- modes (or rather, @XConfig Layout -> Mode@) you provide:+--+-- >+-- > import XMonad+-- > import XMonad.Hooks.Modal+-- > import XMonad.Util.EZConfig+-- > import qualified Data.Map as M+-- >+-- > main :: IO ()+-- > main =+-- >   xmonad+-- >     . modal [noModMode, floatMode 10, overlayedFloatMode 10, sayHelloMode]+-- >     $ def+-- >     `additionalKeysP` [ ("M-S-n", setMode noModModeLabel)+-- >                       , ("M-S-r", setMode floatModeLabel)+-- >                       , ("M-S-z", setMode overlayedFloatModeLabel)+-- >                       , ("M-S-h", setMode "Hello")+-- >                       ]+-- >+-- > sayHelloMode :: Mode+-- > sayHelloMode = mode "Hello" $ mkKeysEz+-- >   [ ("h", xmessage "Hello, World!")+-- >   , ("M-g", xmessage "Goodbye, World!")+-- >   ]+--+-- Alternatively, one could have defined @sayHelloMode@ as+--+-- > sayHelloMode :: Mode+-- > sayHelloMode = mode "Hello" $ \cfg ->+-- >   M.fromList [ ((noModMask, xK_h), xmessage "Hello, World!")+-- >              , ((modMask cfg, xK_g), xmessage "Goodbye, World!")+-- >              ]+--+-- In short, a 'Mode' has a label describing its purpose, as well as+-- attached keybindings. These are of the form+--+--   - @[(String, X ())]@, or+--+--   - @XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())@.+--+-- The former—accessible via 'mkKeysEz'—is how specifying keys work with+-- "XMonad.Util.EZConfig", while the latter is more geared towards how+-- defining keys works by default in xmonad. Note that, by default,+-- modes are exited with the Escape key. If one wishes to customise+-- this, the 'modeWithExit' function should be used instead of 'mode'+-- when defining a new mode.+--+-- The label of the active mode can be logged with 'logMode' to be+-- displayed in a status bar, for example (For more information check+-- "XMonad.Util.Loggers"). Some examples are included in [the provided+-- modes](#g:ProvidedModes).++-- }}}++-- --< Types >-- {{{++-- | From a list of "XMonad.Util.EZConfig"-style bindings, generate a+-- key representation.+--+-- >>> mkKeysEz [("h", xmessage "Hello, world!")]+mkKeysEz :: [(String, X ())] -> (XConfig Layout -> M.Map (ButtonMask, KeySym) (X ()))+mkKeysEz = flip mkKeymap++-- | The mode type. Use 'mode' or 'modeWithExit' to create modes.+data Mode = Mode+  { label     :: !String+  , boundKeys :: !(XConfig Layout -> M.Map (ButtonMask, KeySym) (X ()))+  }++-- | Newtype for the extensible config.+newtype ModeConfig = MC [Mode] deriving Semigroup++-- | Newtype for the extensible state.+newtype CurrentMode = CurrentMode+  { currentMode :: Maybe Mode+  }++instance ExtensionClass CurrentMode where+  initialValue = CurrentMode Nothing++-- }}}++-- --< Private >-- {{{++-- | The active keybindings corresponding to the active 'Mode' (or lack+-- thereof).+currentKeys :: X (M.Map (ButtonMask, KeySym) (X ()))+currentKeys = do+  cnf <- asks config+  XS.gets currentMode >>= \case+    Just m  -> pure (boundKeys m cnf)+    Nothing -> join keys <$> asks config++-- | Grab the keys corresponding to the active 'Mode' (or lack thereof).+regrab :: X ()+regrab = grab . M.keys =<< currentKeys++-- | Called after changing the mode. Grabs the correct keys and runs the+-- 'logHook'.+refreshMode :: X ()+refreshMode = regrab >> asks config >>= logHook++-- | Event hook to control the keybindings.+modalEventHook :: Event -> X All+modalEventHook = customRegrabEvHook regrab <> \case+  KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code }+    | t == keyPress -> withDisplay $ \dpy -> do+      kp  <- (,) <$> cleanMask m <*> io (keycodeToKeysym dpy code 0)+      kbs <- currentKeys+      userCodeDef () (whenJust (M.lookup kp kbs) id)+      pure (All False)+  _ -> pure (All True)++-- }}}++-- --< Public >-- {{{++-- | Adds the provided modes to the user's config, and sets up the bells+-- and whistles needed for them to work.+modal :: [Mode] -> XConfig l -> XConfig l+modal modes = XC.once+  (\cnf -> cnf { startupHook     = startupHook cnf <> initModes+               , handleEventHook = handleEventHook cnf <> modalEventHook+               }+  )+  (MC modes)+  where initModes = XS.put (CurrentMode Nothing) >> refreshMode++-- | Create a 'Mode' from the given binding to 'exitMode', label and+-- keybindings.+modeWithExit :: String -> String -> (XConfig Layout -> M.Map (KeyMask, KeySym) (X ())) -> Mode+modeWithExit exitKey mlabel keys = Mode mlabel $ \cnf ->+  let exit = fromMaybe (0, xK_Escape) $ runParser (parseKeyCombo cnf) exitKey+   in M.insert exit exitMode (keys cnf)++-- | Create a 'Mode' from the given label and keybindings. Sets the+-- @escape@ key to 'exitMode'.+mode :: String -> (XConfig Layout -> M.Map (KeyMask, KeySym) (X ())) -> Mode+mode = modeWithExit "<Escape>"++-- | Set the current 'Mode' based on its label.+setMode :: String -> X ()+setMode l = do+  XC.with $ \(MC ls) -> case find ((== l) . label) ls of+    Nothing -> mempty+    Just m  -> do+      XS.modify $ \cm -> cm { currentMode = Just m }+      refreshMode++-- | Exits the current mode.+exitMode :: X ()+exitMode = do+  XS.modify $ \m -> m { currentMode = Nothing }+  refreshMode++-- | A 'Logger' to display the current mode.+logMode :: Logger+logMode = fmap label <$> XS.gets currentMode++-- Provided modes+noModModeLabel, floatModeLabel, overlayedFloatModeLabel :: String+noModModeLabel = "NoMod"+floatModeLabel = "Float"+overlayedFloatModeLabel = "Overlayed Float"++-- | In this 'Mode', all keybindings are available without the need for pressing+-- the modifier. Pressing @escape@ exits the mode.+noModMode :: Mode+noModMode =+  mode noModModeLabel $ \cnf -> stripModifier (modMask cnf) (keys cnf cnf)++-- | Generates the keybindings for 'floatMode' and 'overlayedFloatMode'.+floatMap+  :: KeyMask -- ^ Move mask+  -> KeyMask -- ^ Enlarge mask+  -> KeyMask -- ^ Shrink mask+  -> Int -- ^ Step size+  -> M.Map (ButtonMask, KeySym) (X ())+floatMap move enlarge shrink s = M.fromList+  [ -- move+    ((move, xK_h)          , withFocused (keysMoveWindow (-s, 0)))+  , ((move, xK_j)          , withFocused (keysMoveWindow (0, s)))+  , ((move, xK_k)          , withFocused (keysMoveWindow (0, -s)))+  , ((move, xK_l)          , withFocused (keysMoveWindow (s, 0)))+  -- enlarge+  , ((enlarge, xK_h), withFocused (keysResizeWindow (s, 0) (1, 0)))+  , ((enlarge, xK_j), withFocused (keysResizeWindow (0, s) (0, 0)))+  , ((enlarge, xK_k), withFocused (keysResizeWindow (0, s) (0, 1)))+  , ((enlarge, xK_l), withFocused (keysResizeWindow (s, 0) (0, 0)))+  -- shrink+  , ((shrink, xK_h), withFocused (keysResizeWindow (-s, 0) (0, 0)))+  , ((shrink, xK_j), withFocused (keysResizeWindow (0, -s) (0, 1)))+  , ((shrink, xK_k), withFocused (keysResizeWindow (0, -s) (0, 0)))+  , ((shrink, xK_l), withFocused (keysResizeWindow (-s, 0) (1, 0)))+  , ((noModMask, xK_Escape), exitMode)+  ]++-- | A mode to control floating windows with @{hijk}@, @M-{hijk}@ and+-- @M-S-{hijk}@ in order to respectively move, enlarge and+-- shrink windows.+floatMode+  :: Int -- ^ Step size+  -> Mode+floatMode i = mode floatModeLabel $ \XConfig { modMask } ->+  floatMap noModMask modMask (modMask .|. shiftMask) i++-- | Similar to 'resizeMode', but keeps the bindings of the original+-- config active.+overlayedFloatMode+  :: Int -- ^ Step size+  -> Mode+overlayedFloatMode = overlay overlayedFloatModeLabel . floatMode++-- | Modifies a mode so that the keybindings are merged with those from+-- the config instead of replacing them.+overlay+  :: String  -- ^ Label for the new mode+  -> Mode -- ^ Base mode+  -> Mode+overlay label m = Mode label $ \cnf -> boundKeys m cnf <> keys cnf cnf++-- | Strips the modifier key from the provided keybindings.+stripModifier+  :: ButtonMask -- ^ Modifier to remove+  -> M.Map (ButtonMask, KeySym) (X ()) -- ^ Original keybinding map+  -> M.Map (ButtonMask, KeySym) (X ())+stripModifier mask = M.mapKeys $ \(m, k) -> (m .&. complement mask, k)++-- }}}
+ XMonad/Hooks/OnPropertyChange.hs view
@@ -0,0 +1,119 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.OnPropertyChange+-- Description :  Apply a manageHook on a property (e.g., @WM_CLASS@) change+-- Copyright   :  (c) Brandon S Allbery, 2015+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  allbery.b@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- Module to apply a ManageHook to an already-mapped window when a property+-- changes. This would commonly be used to match browser windows by title,+-- since the final title will only be set after (a) the window is mapped,+-- (b) its document has been loaded, (c) all load-time scripts have run.+-- (Don't blame browsers for this; it's inherent in HTML and the DOM. And+-- changing title dynamically is explicitly permitted by ICCCM and EWMH;+-- you don't really want to have your editor window umapped/remapped to+-- show the current document and modified state in the titlebar, do you?)+--+-- This is a handleEventHook that triggers on a PropertyChange event. It+-- currently ignores properties being removed, in part because you can't+-- do anything useful in a ManageHook involving nonexistence of a property.+--+-- This module could also be useful for Electron applications like Spotify+-- which sets its WM_CLASS too late for window manager to map it properly.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.OnPropertyChange (+  -- * Usage+  -- $usage+  onXPropertyChange,+  onTitleChange,+  onClassChange,+) where++import XMonad+import XMonad.Prelude++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Hooks.OnPropertyChange+--+-- Enable it by including in you handleEventHook definition:+--+-- >  main = xmonad $ def+-- >      { ...+-- >      , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")+-- >      , ...+-- >      }+--+-- Or you could create a dynamicManageHook as below:+--+-- > myDynamicManageHook :: ManageHook+-- > myDynamicManageHook =+-- >  composeAll+-- >    [ className =? "Spotify" --> doShift (myWorkspaces !! 4),+-- >      title =? "maybe_special_terminal" <||> title =? "special_terminal" --> doCenterFloat,+-- >      className =? "dynamicApp" <&&> title =? "dynamic_app" --> doCenterFloat+-- >    ]+--+-- And then use it in your handleEventHookDefinition:+--+-- >  main = xmonad $ def+-- >      { ...+-- >      , handleEventHook = onXPropertyChange "WM_NAME" myDynamicManageHook+-- >      , ...+-- >      }+--++-- |+-- Run a 'ManageHook' when a specific property is changed on a window. Note+-- that this will run on any window which changes the property, so you should+-- be very specific in your 'ManageHook' matching (lots of windows change+-- their titles on the fly!):+--+-- > onXPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2")+--+-- Note that the fixity of (-->) won't allow it to be mixed with ($), so you+-- can't use the obvious $ shorthand.+--+-- > onXPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work!+--+-- Consider instead phrasing it like any+-- other 'ManageHook':+--+-- >  main = xmonad $ def+-- >      { ...+-- >      , handleEventHook = onXPropertyChange "WM_NAME" myDynHook+-- >      , ...+-- >      }+-- >+-- >    myDynHook = composeAll [...]+--+onXPropertyChange :: String -> ManageHook -> Event -> X All+onXPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do+  pa <- getAtom prop+  when (ps == propertyNewValue && a == pa) $ do+    g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w)+    windows g+  return mempty -- so anything else also processes it+onXPropertyChange _ _ _ = return mempty++-- | A shorthand for dynamic titles; i.e., applications changing their+-- @WM_NAME@ property.+onTitleChange :: ManageHook -> Event -> X All+-- strictly, this should also check _NET_WM_NAME. practically, both will+-- change and each gets its own PropertyEvent, so we'd need to record that+-- we saw the event for that window and ignore the second one. Instead, just+-- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false,+-- since there's always someone who can't bother being compliant.)+onTitleChange = onXPropertyChange "WM_NAME"++-- | A shorthand for dynamic resource and class names; i.e.,+-- applications changing their @WM_CLASS@ property.+onClassChange :: ManageHook -> Event -> X All+onClassChange = onXPropertyChange "WM_CLASS"
XMonad/Hooks/Place.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.Place+-- Description :  Automatic placement of floating windows. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -34,18 +36,14 @@   import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as S  import XMonad.Layout.WindowArranger import XMonad.Actions.FloatKeys-import XMonad.Util.XUtils  import qualified Data.Map as M import Data.Ratio ((%))-import Data.List (sortBy, minimumBy, partition)-import Data.Maybe (fromMaybe, catMaybes)-import Data.Monoid (Endo(..))-import Control.Monad (guard, join) import Control.Monad.Trans (lift)  -- $usage@@ -53,17 +51,17 @@ -- floating windows at appropriate positions on the screen, as well -- as an 'X' action to manually trigger repositioning. ----- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Place -- -- and adding 'placeHook' to your 'manageHook', for example: -- -- > main = xmonad $ def { manageHook = placeHook simpleSmart--- >                                    <+> manageHook def }+-- >                                    <> manageHook def } -- -- Note that 'placeHook' should be applied after most other hooks, especially hooks--- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from+-- such as 'doFloat' and 'doShift'. Since hooks combined with '<>' are applied from -- right to left, this means that 'placeHook' should be the /first/ hook in your chain. -- -- You can also define a key to manually trigger repositioning with 'placeFocused' by@@ -166,16 +164,16 @@                       -- use X.A.FloatKeys if the window is floating, send                      -- a WindowArranger message otherwise.-                   case elem window floats of-                     True -> keysMoveWindowTo (x', y') (0, 0) window-                     False -> sendMessage $ SetGeometry r'+                   if window `elem` floats+                     then keysMoveWindowTo (x', y') (0, 0) window+                     else sendMessage $ SetGeometry r'   -- | Hook to automatically place windows when they are created. placeHook :: Placement -> ManageHook placeHook p = do window <- ask                  r <- Query $ lift $ getWindowRectangle window-                 allRs <- Query $ lift $ getAllRectangles+                 allRs <- Query $ lift getAllRectangles                  pointer <- Query $ lift $ getPointer window                   return $ Endo $ \theWS -> fromMaybe theWS $@@ -188,21 +186,22 @@                         -- spawned. Each of them also needs an associated screen                         -- rectangle; for hidden workspaces, we use the current                         -- workspace's screen.-                      let infos = filter ((window `elem`) . stackContents . S.stack . fst)+                      let infos = find ((window `elem`) . stackContents . S.stack . fst)                                      $ [screenInfo $ S.current theWS]-                                        ++ (map screenInfo $ S.visible theWS)-                                        ++ zip (S.hidden theWS) (repeat currentRect)--                      guard(not $ null infos)+                                        ++ map screenInfo (S.visible theWS)+                                        ++ map (, currentRect) (S.hidden theWS) -                      let (workspace, screen) = head infos-                          rs = catMaybes $ map (flip M.lookup allRs)-                               $ organizeClients workspace window floats-                          r' = purePlaceWindow p screen rs pointer r-                          newRect = r2rr screen r'-                          newFloats = M.insert window newRect (S.floating theWS)+                      case infos of+                        Nothing   -> empty+                        Just info -> do+                          let (workspace, screen) = info+                              rs = mapMaybe (`M.lookup` allRs)+                                   $ organizeClients workspace window floats+                              r' = purePlaceWindow p screen rs pointer r+                              newRect = r2rr screen r'+                              newFloats = M.insert window newRect (S.floating theWS) -                      return $ theWS { S.floating = newFloats }+                          return $ theWS { S.floating = newFloats }   placeWindow :: Placement -> Window@@ -225,7 +224,7 @@                 -> Rectangle -- ^ The window to be placed                 -> Rectangle purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w-  = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b))+  = let s' = Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)     in checkBounds s' $ purePlaceWindow p' s' rs p w  purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w@@ -279,7 +278,7 @@ stackContents = maybe [] S.integrate  screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)-screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s)+screenInfo S.Screen{ S.workspace = ws, S.screenDetail = (SD s)} = (ws, s)  getWindowRectangle :: Window -> X Rectangle getWindowRectangle window@@ -329,8 +328,7 @@ getNecessaryData window ws floats   = do r <- getWindowRectangle window -       rs <- return (organizeClients ws window floats)-             >>= mapM getWindowRectangle+       rs <- mapM getWindowRectangle (organizeClients ws window floats)         pointer <- getPointer window
XMonad/Hooks/PositionStoreHooks.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.PositionStoreHooks+-- Description :  Hooks for XMonad.Util.PositionStore. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -34,20 +35,17 @@     ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Util.PositionStore import XMonad.Hooks.ManageDocks import XMonad.Layout.Decoration  import System.Random(randomRIO)-import Control.Applicative((<$>))-import Control.Monad(when)-import Data.Maybe-import Data.Monoid import qualified Data.Set as S  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.PositionStoreHooks --@@ -58,7 +56,7 @@ -- otherwise use 'Just def' or similar to inform the module about the -- decoration theme used. ----- > myManageHook = positionStoreManageHook Nothing <+> manageHook def+-- > myManageHook = positionStoreManageHook Nothing <> manageHook def -- > myHandleEventHook = positionStoreEventHook -- > -- > main = xmonad def { manageHook = myManageHook@@ -70,10 +68,9 @@ positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook  positionStoreInit :: Maybe Theme -> Window -> X ()-positionStoreInit mDecoTheme w  = withDisplay $ \d -> do+positionStoreInit mDecoTheme w  = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do         let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current                                                     -- form - makes windows smaller to make room for it-        wa <- io $ getWindowAttributes d w         ws <- gets windowset         arbitraryOffsetX <- randomIntOffset         arbitraryOffsetY <- randomIntOffset@@ -95,12 +92,12 @@                                         (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)                                             (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )     where-        randomIntOffset :: X (Int)+        randomIntOffset :: X Int         randomIntOffset = io $ randomRIO (42, 242)  positionStoreEventHook :: Event -> X All-positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do-    when (et == destroyNotify) $ do-        modifyPosStore (\ps -> posStoreRemove ps w)+positionStoreEventHook DestroyWindowEvent{ev_window = w, ev_event_type = et} = do+    when (et == destroyNotify) $+        modifyPosStore (`posStoreRemove` w)     return (All True) positionStoreEventHook _ = return (All True)
+ XMonad/Hooks/RefocusLast.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.RefocusLast+-- Description :  Hooks and actions to refocus the previous window.+-- Copyright   :  (c) 2018  L. S. Leary+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  L. S. Leary+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides hooks and actions that keep track of recently focused windows on a+-- per workspace basis and automatically refocus the last window on loss of the+-- current (if appropriate as determined by user specified criteria).+--------------------------------------------------------------------------------++-- --< Imports & Exports >-- {{{++module XMonad.Hooks.RefocusLast (+  -- * Usage+  -- $Usage+  -- * Hooks+  refocusLastLogHook,+  refocusLastLayoutHook,+  refocusLastWhen,+  -- ** Predicates+  -- $Predicates+  refocusingIsActive,+  isFloat,+  -- * Actions+  toggleRefocusing,+  toggleFocus,+  swapWithLast,+  refocusWhen,+  shiftRLWhen,+  updateRecentsOn,+  -- * Types+  -- $Types+  RecentWins(..),+  RecentsMap(..),+  RefocusLastLayoutHook(..),+  RefocusLastToggle(..),+  -- * Library functions+  withRecentsIn,+) where++import XMonad+import XMonad.Prelude (All (..), asum, fromMaybe, when)+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Stack (findS, mapZ_)+import XMonad.Layout.LayoutModifier++import qualified Data.Map.Strict as M++-- }}}++-- --< Usage >-- {{{++-- $Usage+-- To use this module, you must either include 'refocusLastLogHook' in your log+-- hook __or__ 'refocusLastLayoutHook' in your layout hook; don't use both.+-- This suffices to make use of both 'toggleFocus' and 'shiftRLWhen' but will+-- not refocus automatically upon loss of the current window; for that you must+-- include in your event hook @'refocusLastWhen' pred@ for some valid @pred@.+--+-- The event hooks that trigger refocusing only fire when a window is lost+-- completely, not when it's simply e.g. moved to another workspace. Hence you+-- will need to use @'shiftRLWhen' pred@ or @'refocusWhen' pred@ as appropriate+-- if you want the same behaviour in such cases.+--+-- Example configuration:+--+-- > import XMonad+-- > import XMonad.Hooks.RefocusLast+-- > import qualified Data.Map.Strict as M+-- >+-- > main :: IO ()+-- > main = xmonad def+-- >     { handleEventHook = refocusLastWhen myPred <> handleEventHook def+-- >     , logHook         = refocusLastLogHook     <> logHook         def+-- > --  , layoutHook      = refocusLastLayoutHook   $  layoutHook      def+-- >     , keys            = refocusLastKeys        <> keys            def+-- >     } where+-- >         myPred = refocusingIsActive <||> isFloat+-- >         refocusLastKeys cnf+-- >           = M.fromList+-- >           $ ((modMask cnf              , xK_a), toggleFocus)+-- >           : ((modMask cnf .|. shiftMask, xK_a), swapWithLast)+-- >           : ((modMask cnf              , xK_b), toggleRefocusing)+-- >           : [ ( (modMask cnf .|. shiftMask, n)+-- >               , windows =<< shiftRLWhen myPred wksp+-- >               )+-- >             | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf)+-- >             ]+--++-- }}}++-- --< Types >-- {{{++-- $Types+-- The types and constructors used in this module are exported principally to+-- aid extensibility; typical users will have nothing to gain from this section.++-- | Data type holding onto the previous and current @Window@.+data RecentWins = Recent { previous :: !Window, current :: !Window }+  deriving (Show, Read, Eq)++-- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace.+--   Is an instance of @ExtensionClass@ with persistence of state.+newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)+  deriving (Show, Read, Eq)++instance ExtensionClass RecentsMap where+  initialValue = RecentsMap M.empty+  extensionType = PersistentExtension++-- | A 'LayoutModifier' that updates the 'RecentWins' for a workspace upon+--   relayout.+data RefocusLastLayoutHook a = RefocusLastLayoutHook+  deriving (Show, Read)++instance LayoutModifier RefocusLastLayoutHook a where+  modifyLayout _ w@(W.Workspace tg _ _) r = updateRecentsOn tg >> runLayout w r++-- | A newtype on @Bool@ to act as a universal toggle for refocusing.+newtype RefocusLastToggle = RefocusLastToggle { refocusing :: Bool }+  deriving (Show, Read, Eq)++instance ExtensionClass RefocusLastToggle where+  initialValue  = RefocusLastToggle { refocusing = True }+  extensionType = PersistentExtension++-- }}}++-- --< Public Hooks >-- {{{++-- | A log hook recording the current workspace's most recently focused windows+--   into extensible state.+refocusLastLogHook :: X ()+refocusLastLogHook = withWindowSet (updateRecentsOn . W.currentTag)++-- | Records a workspace's recently focused windows into extensible state upon+--   relayout. Potentially a less wasteful alternative to @refocusLastLogHook@,+--   as it does not run on @WM_NAME@ @propertyNotify@ events.+refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a+refocusLastLayoutHook = ModifiedLayout RefocusLastLayoutHook++-- | Given a predicate on the event window determining whether or not to act,+--   construct an event hook that runs iff the core xmonad event handler will+--   unmanage the window, and which shifts focus to the last focused window on+--   the appropriate workspace if desired.+refocusLastWhen :: Query Bool -> Event -> X All+refocusLastWhen p event = All True <$ case event of+  UnmapEvent { ev_send_event = synth, ev_window = w } -> do+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)+    when (synth || e == 0) (refocusLast w)+  DestroyWindowEvent {                ev_window = w } -> refocusLast w+  _                                                   -> return ()+  where+    refocusLast w = whenX (runQuery p w) . withWindowSet $ \ws ->+      whenJust (W.findTag w ws) $ \tag ->+        withRecentsIn tag () $ \lw cw ->+          when (w == cw) . modify $ \xs ->+            xs { windowset = tryFocusIn tag [lw] ws }++-- }}}++-- --< Predicates >-- {{{++-- $Predicates+-- Impure @Query Bool@ predicates on event windows for use as arguments to+-- 'refocusLastWhen', 'shiftRLWhen' and 'refocusWhen'. Can be combined with+-- '<||>' or '<&&>'. Use like e.g.+--+-- > , handleEventHook = refocusLastWhen refocusingIsActive+--+-- or in a keybinding:+--+-- > windows =<< shiftRLWhen (refocusingIsActive <&&> isFloat) "3"+--+-- It's also valid to use a property lookup like @className =? "someProgram"@ as+-- a predicate, and it should function as expected with e.g. @shiftRLWhen@.+-- In the event hook on the other hand, the window in question has already been+-- unmapped or destroyed, so external lookups to X properties don't work:+-- only the information fossilised in xmonad's state is available.++-- | Holds iff refocusing is toggled active.+refocusingIsActive :: Query Bool+refocusingIsActive = (liftX . XS.gets) refocusing++-- | Holds iff the event window is a float.+isFloat :: Query Bool+isFloat = ask >>= \w -> (liftX . gets) (M.member w . W.floating . windowset)++-- }}}++-- --< Public Actions >-- {{{++-- | Toggle automatic refocusing at runtime. Has no effect unless the+--   @refocusingIsActive@ predicate has been used.+toggleRefocusing :: X ()+toggleRefocusing = XS.modify (RefocusLastToggle . not . refocusing)++-- | Refocuses the previously focused window; acts as a toggle.+--   Is not affected by @toggleRefocusing@.+toggleFocus :: X ()+toggleFocus = withRecents $ \lw cw ->+  when (cw /= lw) . windows $ tryFocus [lw]++-- | Swaps the current and previous windows of the current workspace.+--   Is not affected by @toggleRefocusing@.+swapWithLast :: X ()+swapWithLast = withRecents $ \lw cw ->+  when (cw /= lw) . windows . modify''. mapZ_ $ \w ->+    if | (w == lw) -> cw+       | (w == cw) -> lw+       | otherwise ->  w+  where modify'' f = W.modify (f Nothing) (f . Just)++-- | Given a target workspace and a predicate on its current window, produce a+--   'windows' suitable function that will refocus that workspace appropriately.+--   Allows you to hook refocusing into any action you can run through+--   @windows@. See the implementation of @shiftRLWhen@ for a straight-forward+--   usage example.+refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)+refocusWhen p tag = withRecentsIn tag id $ \lw cw -> do+  b <- runQuery p cw+  return (if b then tryFocusIn tag [cw, lw] else id)++-- | Sends the focused window to the specified workspace, refocusing the last+--   focused window if the predicate holds on the current window. Note that the+--   native version of this, @windows . W.shift@, has a nice property that this+--   does not: shifting a window to another workspace then shifting it back+--   preserves its place in the stack. Can be used in a keybinding like e.g.+--+-- > windows =<< shiftRLWhen refocusingIsActive "3"+--+--   or+--+-- > (windows <=< shiftRLWhen refocusingIsActive) "3"+--+--   where '<=<' is imported from "Control.Monad".+shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)+shiftRLWhen p to = withWindowSet $ \ws -> do+  refocus <- refocusWhen p (W.currentTag ws)+  let shift = maybe id (W.shiftWin to) (W.peek ws)+  return (refocus . shift)++-- | Perform an update to the 'RecentWins' for the specified workspace.+--   The RefocusLast log and layout hooks are both implemented trivially in+--   terms of this function. Only exported to aid extensibility.+updateRecentsOn :: WorkspaceId -> X ()+updateRecentsOn tag = withWindowSet $ \ws ->+  whenJust (W.peek $ W.view tag ws) $ \fw -> do+    m <- getRecentsMap+    let insertRecent l c = XS.put . RecentsMap $ M.insert tag (Recent l c) m+    case M.lookup tag m of+      Just (Recent _ cw) -> when (cw /= fw) (insertRecent cw fw)+      Nothing            ->                  insertRecent fw fw++-- }}}++-- --< Utilities >-- {{{++-- | Focuses the first window in the list it can find on the current workspace.+tryFocus :: [Window] -> WindowSet -> WindowSet+tryFocus wins = W.modify' $ \s ->+  fromMaybe s . asum $ (\w -> findS (== w) s) <$> wins++-- | Operate the above on a specified workspace.+tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet+tryFocusIn tag wins ws =+  W.view (W.currentTag ws) . tryFocus wins . W.view tag $ ws++-- | Get the RecentsMap out of extensible state and remove its newtype wrapper.+getRecentsMap :: X (M.Map WorkspaceId RecentWins)+getRecentsMap = XS.get >>= \(RecentsMap m) -> return m++-- | Perform an X action dependent on successful lookup of the RecentWins for+--   the specified workspace, or return a default value.+withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a+withRecentsIn tag dflt f = maybe (return dflt) (\(Recent lw cw) -> f lw cw)+                         . M.lookup tag+                       =<< getRecentsMap++-- | The above specialised to the current workspace and unit.+withRecents :: (Window -> Window -> X ()) -> X ()+withRecents f = withWindowSet $ \ws -> withRecentsIn (W.currentTag ws) () f++-- }}}
+ XMonad/Hooks/Rescreen.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RecordWildCards #-}+-- |+-- Module      :  XMonad.Hooks.Rescreen+-- Description :  Custom hooks for screen (xrandr) configuration changes.+-- Copyright   :  (c) 2021 Tomáš Janoušek <tomi@nomi.cz>+-- License     :  BSD3+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>+--+-- Custom hooks for screen (xrandr) configuration changes.+--+module XMonad.Hooks.Rescreen (+    -- * Usage+    -- $usage+    addAfterRescreenHook,+    addRandrChangeHook,+    setRescreenWorkspacesHook,+    setRescreenDelay,+    RescreenConfig(..),+    rescreenHook,+    ) where++import Control.Concurrent (threadDelay)+import Graphics.X11.Xrandr+import XMonad+import XMonad.Prelude+import qualified XMonad.Util.ExtensibleConf as XC++-- $usage+-- This module provides a replacement for the screen configuration change+-- handling in core that enables attaching custom hooks to screen (xrandr)+-- configuration change events. These can be used to restart/reposition status+-- bars or systrays automatically after xrandr+-- ('XMonad.Hooks.StatusBar.dynamicSBs' uses this module internally), as well+-- as to actually invoke xrandr or autorandr when an output is (dis)connected.+--+-- To use this, include the following in your @xmonad.hs@:+--+-- > import XMonad.Hooks.Rescreen+--+-- define your custom hooks:+--+-- > myAfterRescreenHook :: X ()+-- > myAfterRescreenHook = spawn "fbsetroot -solid red"+--+-- > myRandrChangeHook :: X ()+-- > myRandrChangeHook = spawn "autorandr --change"+--+-- and hook them into your 'xmonad' config:+--+-- > main = xmonad $ …+-- >               . addAfterRescreenHook myAfterRescreenHook+-- >               . addRandrChangeHook myRandrChangeHook+-- >               . …+-- >               $ def{…}+--+-- See documentation of 'rescreenHook' for details about when these hooks are+-- called.++-- | Hook configuration for 'rescreenHook'.+data RescreenConfig = RescreenConfig+    { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen'+    , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects+    , rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen'+    , rescreenDelay :: Last Int -- ^ delay (in microseconds) to wait for events to settle+    }++instance Default RescreenConfig where+    def = RescreenConfig+        { afterRescreenHook = mempty+        , randrChangeHook = mempty+        , rescreenWorkspacesHook = mempty+        , rescreenDelay = mempty+        }++instance Semigroup RescreenConfig where+    RescreenConfig arh rch rwh rd <> RescreenConfig arh' rch' rwh' rd' =+        RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') (rd <> rd')++instance Monoid RescreenConfig where+    mempty = def++-- | Attach custom hooks to screen (xrandr) configuration change events.+-- Replaces the built-in rescreen handling of xmonad core with:+--+-- 1. listen to 'RRScreenChangeNotifyEvent' in addition to 'ConfigureEvent' on+--    the root window+-- 2. whenever such event is received:+-- 3. clear any other similar events (Xorg server emits them in bunches)+-- 4. if any event was 'ConfigureEvent', 'rescreen' and invoke 'afterRescreenHook'+-- 5. if there was no 'ConfigureEvent', invoke 'randrChangeHook' only+--+-- 'afterRescreenHook' is useful for restarting/repositioning status bars and+-- systray.+--+-- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps+-- autorandr) when outputs are (dis)connected.+--+-- 'rescreenWorkspacesHook' allows tweaking the 'rescreen' implementation,+-- to change the order workspaces are assigned to physical screens for+-- example.+--+-- 'rescreenDelay' makes xmonad wait a bit for events to settle (after the+-- first event is received) — useful when multiple @xrandr@ invocations are+-- being used to change the screen layout.+--+-- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still+-- done just once and hooks are invoked in sequence (except+-- 'rescreenWorkspacesHook', which has a replace rather than sequence+-- semantics), also just once.+rescreenHook :: RescreenConfig -> XConfig l -> XConfig l+rescreenHook = XC.once hook . catchUserCode+  where+    hook c = c+        { startupHook = startupHook c <> rescreenStartupHook+        , handleEventHook = handleEventHook c <> rescreenEventHook }+    catchUserCode rc@RescreenConfig{..} = rc+        { afterRescreenHook = userCodeDef () afterRescreenHook+        , randrChangeHook = userCodeDef () randrChangeHook+        , rescreenWorkspacesHook = flip catchX rescreen <$> rescreenWorkspacesHook+        }++-- | Shortcut for 'rescreenHook'.+addAfterRescreenHook :: X () -> XConfig l -> XConfig l+addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }++-- | Shortcut for 'rescreenHook'.+addRandrChangeHook :: X () -> XConfig l -> XConfig l+addRandrChangeHook h = rescreenHook def{ randrChangeHook = h }++-- | Shortcut for 'rescreenHook'.+setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l+setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure h }++-- | Shortcut for 'rescreenHook'.+setRescreenDelay :: Int -> XConfig l -> XConfig l+setRescreenDelay d = rescreenHook def{ rescreenDelay = pure d }++-- | Startup hook to listen for @RRScreenChangeNotify@ events.+rescreenStartupHook :: X ()+rescreenStartupHook = do+    dpy <- asks display+    root <- asks theRoot+    io $ xrrSelectInput dpy root rrScreenChangeNotifyMask++-- | Event hook with custom rescreen/randr hooks. See 'rescreenHook' for more.+rescreenEventHook :: Event -> X All+rescreenEventHook e = do+    shouldHandle <- case e of+        ConfigureEvent{ ev_window = w } -> isRoot w+        RRScreenChangeNotifyEvent{ ev_window = w } -> isRoot w+        _ -> pure False+    if shouldHandle+        then All False <$ handleEvent e+        else mempty++handleEvent :: Event -> X ()+handleEvent e = XC.with $ \RescreenConfig{..} -> do+    -- Xorg emits several events after every change, clear them to prevent+    -- triggering the hook multiple times.+    whenJust (getLast rescreenDelay) (io . threadDelay)+    moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify+    _ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify+    -- If there were any ConfigureEvents, this is an actual screen+    -- configuration change, so rescreen and fire rescreenHook. Otherwise,+    -- this is just a connect/disconnect, fire randrChangeHook.+    if ev_event_type e == configureNotify || moreConfigureEvents+        then fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook+        else randrChangeHook++-- | Remove all X events of a given window and type from the event queue,+-- return whether there were any.+clearTypedWindowEvents :: Window -> EventType -> X Bool+clearTypedWindowEvents w t = withDisplay $ \d -> io $ allocaXEvent (go d)+  where+    go d e' = do+        sync d False+        gotEvent <- checkTypedWindowEvent d w t e'+        e <- if gotEvent then Just <$> getEvent e' else pure Nothing+        gotEvent <$ if+            | not gotEvent -> mempty+            | (ev_window <$> e) == Just w -> void $ go d e'+            -- checkTypedWindowEvent checks ev_event instead of ev_window, so+            -- we may need to put some events back+            | otherwise -> allocaXEvent (go d) >> io (putBackEvent d e')++clearTypedWindowRREvents :: Window -> EventType -> X Bool+clearTypedWindowRREvents w t =+    rrEventBase >>= \case+        Just base -> clearTypedWindowEvents w (base + t)+        Nothing -> pure False++rrEventBase :: X (Maybe EventType)+rrEventBase = withDisplay $ \d ->+    fmap (fromIntegral . fst) <$> io (xrrQueryExtension d)
− XMonad/Hooks/RestoreMinimized.hs 
@@ -1,41 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  XMonad.Hooks.RestoreMinimized--- Copyright   :  (c) Jan Vornberger 2009--- License     :  BSD3-style (see LICENSE)------ Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de--- Stability   :  unstable--- Portability :  not portable------ (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized--- windows (see "XMonad.Layout.Minimize") by selecting them on a--- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).-----------------------------------------------------------------------------------module XMonad.Hooks.RestoreMinimized-    {-# DEPRECATED "Use XMonad.Hooks.Minimize instead, this module has no effect" #-}-    ( -- * Usage-      -- $usage-      RestoreMinimized (..)-    , restoreMinimizedEventHook-    ) where--import Data.Monoid--import XMonad---- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:------ > import XMonad.Hooks.RestoreMinimized--- >--- > myHandleEventHook = restoreMinimizedEventHook--- >--- > main = xmonad def { handleEventHook = myHandleEventHook }--data RestoreMinimized = RestoreMinimized deriving ( Show, Read )--restoreMinimizedEventHook :: Event -> X All-restoreMinimizedEventHook _ = return (All True)
XMonad/Hooks/ScreenCorners.hs view
@@ -1,131 +1,142 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}------------------------------------------------------------------------------+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+ -- | -- Module      :  XMonad.Hooks.ScreenCorners--- Copyright   :  (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky+-- Description :  Run X () actions by touching the edge of your screen with your mouse.+-- Copyright   :  (c) 2009-2025 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song -- License     :  BSD3-style (see LICENSE) ----- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>+-- Maintainer  :  Nils Schweinsberg <mail@nils.cc> -- Stability   :  unstable -- Portability :  unportable -- -- Run @X ()@ actions by touching the edge of your screen with your mouse.---------------------------------------------------------------------------------- module XMonad.Hooks.ScreenCorners-    (-    -- * Usage+  ( -- * Usage     -- $usage      -- * Adding screen corners-      ScreenCorner (..)-    , addScreenCorner-    , addScreenCorners+    ScreenCorner (..),+    addScreenCorner,+    addScreenCorners,      -- * Event hook-    , screenCornerEventHook+    screenCornerEventHook,      -- * Layout hook-    , screenCornerLayoutHook-    ) where+    screenCornerLayoutHook,+  )+where -import Data.Monoid-import Data.List (find)+import qualified Data.Map as M import XMonad-import XMonad.Util.XUtils (fi) import XMonad.Layout.LayoutModifier--import qualified Data.Map as M+import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS -data ScreenCorner = SCUpperLeft-                  | SCUpperRight-                  | SCLowerLeft-                  | SCLowerRight-                  deriving (Eq, Ord, Show)--+data ScreenCorner+  = SCUpperLeft+  | SCUpperRight+  | SCLowerLeft+  | SCLowerRight+  | SCTop+  | SCBottom+  | SCLeft+  | SCRight+  deriving (Eq, Ord, Show)  -------------------------------------------------------------------------------- -- ExtensibleState modifications --------------------------------------------------------------------------------  newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))-    deriving Typeable  instance ExtensionClass ScreenCornerState where-    initialValue = ScreenCornerState M.empty+  initialValue = ScreenCornerState M.empty  -- | Add one single @X ()@ action to a screen corner addScreenCorner :: ScreenCorner -> X () -> X () addScreenCorner corner xF = do--    ScreenCornerState m <- XS.get-    (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of--                        Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions-                        Nothing           -> flip (,) xF `fmap` createWindowAt corner+  ScreenCornerState m <- XS.get+  (win, xFunc) <- case find (\(_, (sc, _)) -> sc == corner) (M.toList m) of+    Just (w, (_, xF')) -> return (w, xF' >> xF) -- chain X actions+    Nothing -> (,xF) <$> createWindowAt corner -    XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'+  XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner, xFunc) m'  -- | Add a list of @(ScreenCorner, X ())@ tuples-addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()-addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)-+addScreenCorners :: [(ScreenCorner, X ())] -> X ()+addScreenCorners = mapM_ (uncurry addScreenCorner)  -------------------------------------------------------------------------------- -- Xlib functions -------------------------------------------------------------------------------- --- "Translate" a ScreenCorner to real (x,y) Positions+-- "Translate" a ScreenCorner to real (x,y) Positions with proper width and+-- height. createWindowAt :: ScreenCorner -> X Window-createWindowAt SCUpperLeft = createWindowAt' 0 0+createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1 createWindowAt SCUpperRight = withDisplay $ \dpy ->-    let w = displayWidth  dpy (defaultScreen dpy) - 1-    in createWindowAt' (fi w) 0-+  let w = displayWidth dpy (defaultScreen dpy) - 1+   in createWindowAt' (fi w) 0 1 1 createWindowAt SCLowerLeft = withDisplay $ \dpy ->-    let h = displayHeight dpy (defaultScreen dpy) - 1-    in createWindowAt' 0 (fi h)-+  let h = displayHeight dpy (defaultScreen dpy) - 1+   in createWindowAt' 0 (fi h) 1 1 createWindowAt SCLowerRight = withDisplay $ \dpy ->-    let w = displayWidth  dpy (defaultScreen dpy) - 1-        h = displayHeight dpy (defaultScreen dpy) - 1-    in createWindowAt' (fi w) (fi h)---- Create a new X window at a (x,y) Position-createWindowAt' :: Position -> Position -> X Window-createWindowAt' x y = withDisplay $ \dpy -> io $ do--    rootw <- rootWindow dpy (defaultScreen dpy)--    let-        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy-        attrmask = cWOverrideRedirect+  let w = displayWidth dpy (defaultScreen dpy) - 1+      h = displayHeight dpy (defaultScreen dpy) - 1+   in createWindowAt' (fi w) (fi h) 1 1+createWindowAt SCTop = withDisplay $ \dpy ->+  let w = displayWidth dpy (defaultScreen dpy) - 1+      -- leave some gap so corner and edge can work nicely when they overlap+      threshold = 150+   in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1+createWindowAt SCBottom = withDisplay $ \dpy ->+  let w = displayWidth dpy (defaultScreen dpy) - 1+      h = displayHeight dpy (defaultScreen dpy) - 1+      threshold = 150+   in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1+createWindowAt SCLeft = withDisplay $ \dpy ->+  let h = displayHeight dpy (defaultScreen dpy) - 1+      threshold = 150+   in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2)+createWindowAt SCRight = withDisplay $ \dpy ->+  let w = displayWidth dpy (defaultScreen dpy) - 1+      h = displayHeight dpy (defaultScreen dpy) - 1+      threshold = 150+   in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2) -    w <- allocaSetWindowAttributes $ \attributes -> do+-- Create a new X window at a (x,y) Position, with given width and height.+createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window+createWindowAt' x y width height = withDisplay $ \dpy -> io $ do+  rootw <- rootWindow dpy (defaultScreen dpy) -        set_override_redirect attributes True-        createWindow dpy        -- display-                     rootw      -- parent window-                     x          -- x-                     y          -- y-                     1          -- width-                     1          -- height-                     0          -- border width-                     0          -- depth-                     inputOnly  -- class-                     visual     -- visual-                     attrmask   -- valuemask-                     attributes -- attributes+  let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy+      attrmask = cWOverrideRedirect -    -- we only need mouse entry events-    selectInput dpy w enterWindowMask-    mapWindow dpy w-    sync dpy False-    return w+  w <- allocaSetWindowAttributes $ \attributes -> do+    set_override_redirect attributes True+    createWindow+      dpy -- display+      rootw -- parent window+      x -- x+      y -- y+      width -- width+      height -- height+      0 -- border width+      0 -- depth+      inputOnly -- class+      visual -- visual+      attrmask -- valuemask+      attributes -- attributes +  -- we only need mouse entry events+  selectInput dpy w enterWindowMask+  mapWindow dpy w+  sync dpy False+  return w  -------------------------------------------------------------------------------- -- Event hook@@ -133,42 +144,40 @@  -- | Handle screen corner events screenCornerEventHook :: Event -> X All-screenCornerEventHook CrossingEvent { ev_window = win } = do--    ScreenCornerState m <- XS.get--    case M.lookup win m of-         Just (_, xF) -> xF-         Nothing      -> return ()+screenCornerEventHook CrossingEvent {ev_window = win} = do+  ScreenCornerState m <- XS.get -    return (All True)+  case M.lookup win m of+    Just (_, xF) -> xF+    Nothing -> return () +  return (All True) screenCornerEventHook _ = return (All True) - -------------------------------------------------------------------------------- -- Layout hook --------------------------------------------------------------------------------  data ScreenCornerLayout a = ScreenCornerLayout-    deriving ( Read, Show )+  deriving (Read, Show)  instance LayoutModifier ScreenCornerLayout a where-    hook ScreenCornerLayout = withDisplay $ \dpy -> do-        ScreenCornerState m <- XS.get-        io $ mapM_ (raiseWindow dpy) $ M.keys m-    unhook = hook+  hook ScreenCornerLayout = withDisplay $ \dpy -> do+    ScreenCornerState m <- XS.get+    io $ mapM_ (raiseWindow dpy) $ M.keys m+  unhook = hook  screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout - --------------------------------------------------------------------------------+ -- $usage ----- This extension adds KDE-like screen corners to XMonad. By moving your cursor--- into one of your screen corners you can trigger an @X ()@ action, for--- example @"XMonad.Actions.GridSelect".goToSelected@ or+-- This extension adds KDE-like screen corners and GNOME Hot Edge like+-- features to XMonad. By moving your cursor into one of your screen corners+-- or edges, you can trigger an @X ()@ action, for example+-- @"XMonad.Actions.GridSelect".goToSelected@ or -- @"XMonad.Actions.CycleWS".nextWS@ etc. -- -- To use it, import it on top of your @xmonad.hs@:@@ -179,7 +188,8 @@ -- -- > myStartupHook = do -- >     ...--- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})+-- >     addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})+-- >     addScreenCorner SCBottom (goToSelected def) -- >     addScreenCorners [ (SCLowerRight, nextWS) -- >                      , (SCLowerLeft,  prevWS) -- >                      ]
XMonad/Hooks/Script.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      : XMonad.Hooks.Script+-- Description : Simple interface for running a ~\/.xmonad\/hooks script with the name of a hook. -- Copyright   : (c) Trevor Elliott <trevor@galois.com> -- License     : BSD3-style (see LICENSE) --@@ -44,8 +45,8 @@ -- @~\/.xmonad\/hooks startup@ will also.  -- | Execute a named script hook-execScriptHook :: MonadIO m => String -> m ()+execScriptHook :: String -> X () execScriptHook hook = do-  xmonadDir <- getXMonadDir+  xmonadDir <- asks (cfgDir . directories)   let script = xmonadDir ++ "/hooks "   spawn (script ++ hook)
XMonad/Hooks/ServerMode.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.ServerMode+-- Description :  Send commands to a running xmonad process. -- Copyright   :  (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007 -- License     :  BSD-style (see xmonad/LICENSE) --@@ -12,78 +14,7 @@ -- client. Also consider "XMonad.Hooks.EwmhDesktops" together with -- @wmctrl@. ----- This is the example of a client:------ > import Graphics.X11.Xlib--- > import Graphics.X11.Xlib.Extras--- > import System.Environment--- > import System.IO--- > import Data.Char--- > --- > main :: IO ()--- > main = parse True "XMONAD_COMMAND" =<< getArgs--- > --- > parse :: Bool -> String -> [String] -> IO ()--- > parse input addr args = case args of--- >         ["--"] | input -> repl addr--- >                | otherwise -> return ()--- >         ("--":xs) -> sendAll addr xs--- >         ("-a":a:xs) -> parse input a xs--- >         ("-h":_) -> showHelp--- >         ("--help":_) -> showHelp--- >         ("-?":_) -> showHelp--- >         (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a)--- > --- >         (x:xs) -> sendCommand addr x >> parse False addr xs--- >         [] | input -> repl addr--- >            | otherwise -> return ()--- > --- > --- > repl :: String -> IO ()--- > repl addr = do e <- isEOF--- >                case e of--- >                 True -> return ()--- >                 False -> do l <- getLine--- >                             sendCommand addr l--- >                             repl addr--- > --- > sendAll :: String -> [String] -> IO ()--- > sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss--- > --- > sendCommand :: String -> String -> IO ()--- > sendCommand addr s = do--- >   d   <- openDisplay ""--- >   rw  <- rootWindow d $ defaultScreen d--- >   a <- internAtom d addr False--- >   m <- internAtom d s False--- >   allocaXEvent $ \e -> do--- >                   setEventType e clientMessage--- >                   setClientMessageEvent e rw a 32 m currentTime--- >                   sendEvent d rw False structureNotifyMask e--- >                   sync d False--- > --- > showHelp :: IO ()--- > showHelp = do pn <- getProgName--- >               putStrLn ("Send commands to a running instance of xmonad. xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.\n-a atomname can be used at any point in the command line arguments to change which atom it is sending on.\nIf sent with no arguments or only -a atom arguments, it will read commands from stdin.\nEx:\n" ++ pn ++ " cmd1 cmd2\n" ++ pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world\n" ++ pn ++ " -a XMONAD_PRINT # will read data from stdin.\nThe atom defaults to XMONAD_COMMAND.")--------- compile with: @ghc --make xmonadctl.hs@------ run with------ > xmonadctl command------ or with------ > $ xmonadctl--- > command1--- > command2--- > .--- > .--- > .--- > ^D------ Usage will change depending on which event hook(s) you use. More examples are shown below.+-- See @scripts/xmonadctl.hs@ for the client. -- ----------------------------------------------------------------------------- @@ -97,17 +28,15 @@     , serverModeEventHookF     ) where -import Control.Monad (when)-import Data.Maybe-import Data.Monoid import System.IO  import XMonad+import XMonad.Prelude import XMonad.Actions.Commands  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode --@@ -118,7 +47,7 @@ -- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default. -- -- > main = xmonad def { handleEventHook = serverModeEventHook }--- +-- -- > xmonadctl 0 # tells xmonad to output command list -- > xmonadctl 1 # tells xmonad to switch to workspace 1 --@@ -128,12 +57,12 @@ -- | serverModeEventHook' additionally takes an action to generate the list of -- commands. serverModeEventHook' :: X [(String,X ())] -> Event -> X All-serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev+serverModeEventHook' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words)         where helper cmd = do cl <- cmdAction                               case lookup cmd (zip (map show [1 :: Integer ..]) cl) of                                 Just (_,action) -> action                                 Nothing         -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl-              listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl+              listOfCommands cl = zipWith (++) (map show [1 :: Int ..]) (map ((++) " - " . fst) cl)   -- | Executes a command of the list when receiving its name via a special ClientMessageEvent.@@ -148,7 +77,7 @@  -- | Additionally takes an action to generate the list of commands serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All-serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev+serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words)         where helper cmd = do cl <- cmdAction                               fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl) @@ -160,14 +89,15 @@ -- > xmonadctl -a XMONAD_PRINT "hello world" -- serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All-serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do-        d <- asks display-        atm <- io $ internAtom d key False-        when (mt == atm && dt /= []) $ do-         let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^(32::Int))) dt+serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do+  d <- asks display+  atm <- io $ internAtom d key False+  if | mt == atm, Just dth <- listToMaybe dt -> do+         let atom = fromIntegral dth          cmd <- io $ getAtomName d atom          case cmd of-              Just command -> func command-              Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))-        return (All True)+           Just command -> func command+           Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)+     | otherwise -> pure ()+  return (All True) serverModeEventHookF _ _ _ = return (All True)
XMonad/Hooks/SetWMName.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.SetWMName+-- Description :  Set the WM name to a given string. -- Copyright   :  © 2007 Ivan Tarasov <Ivan.Tarasov@gmail.com> -- License     :  BSD --@@ -11,10 +12,10 @@ -- Sets the WM name to a given string, so that it could be detected using -- _NET_SUPPORTING_WM_CHECK protocol. ----- May be useful for making Java GUI programs work, just set WM name to "LG3D"+-- May be useful for making Java GUI programs work, just set WM name to \"LG3D\" -- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later. ----- To your @~\/.xmonad\/xmonad.hs@ file, add the following line:+-- To your @xmonad.hs@ file, add the following line: -- -- > import XMonad.Hooks.SetWMName --@@ -32,21 +33,20 @@ -- fails miserably by guessing absolutely bogus values. -- -- For detailed instructions on editing your hooks, see--- "XMonad.Doc.Extending#4".+-- <https://xmonad.org/TUTORIAL.html the tutorial> and "XMonad.Doc.Extending". -----------------------------------------------------------------------------  module XMonad.Hooks.SetWMName (-    setWMName) where+      setWMName+    , getWMName+    )+  where -import Control.Monad (join)-import Data.Char (ord)-import Data.List (nub)-import Data.Maybe (fromJust, listToMaybe, maybeToList) import Foreign.C.Types (CChar)- import Foreign.Marshal.Alloc (alloca)  import XMonad+import XMonad.Prelude (fromJust, join, listToMaybe, maybeToList, nub, ord)  -- | sets WM name setWMName :: String -> X ()@@ -61,26 +61,26 @@     dpy <- asks display     io $ do         -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window-        mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow]+        mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW propModeReplace [fromIntegral supportWindow]) [root, supportWindow]         -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)-        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)+        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING propModeReplace (latin1StringToCCharList name)         -- declare which _NET protocols are supported (append to the list if it exists)-        supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root-        changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)+        supportedList <- join . maybeToList <$> getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root+        changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM propModeReplace (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)   where-    netSupportingWMCheckAtom :: X Atom-    netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"-     latin1StringToCCharList :: String -> [CChar]-    latin1StringToCCharList str = map (fromIntegral . ord) str+    latin1StringToCCharList = map (fromIntegral . ord) -    getSupportWindow :: X Window-    getSupportWindow = withDisplay $ \dpy -> do-        atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom-        root <- asks theRoot-        supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root-        validateWindow (fmap fromIntegral supportWindow)+netSupportingWMCheckAtom :: X Atom+netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" +getSupportWindow :: X Window+getSupportWindow = withDisplay $ \dpy -> do+    atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom+    root <- asks theRoot+    supportWindow <- (listToMaybe =<<) <$> io (getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root)+    validateWindow (fmap fromIntegral supportWindow)+  where     validateWindow :: Maybe Window -> X Window     validateWindow w = do         valid <- maybe (return False) isValidWindow w@@ -110,3 +110,7 @@         io $ mapWindow dpy window   -- not sure if this is needed         io $ lowerWindow dpy window -- not sure if this is needed         return window++-- | Get WM name.+getWMName :: X String+getWMName = getSupportWindow >>= runQuery title
+ XMonad/Hooks/ShowWName.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE InstanceSigs #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.ShowWName+-- Description :  Like 'XMonad.Layout.ShowWName', but as a logHook+-- Copyright   :  (c) 2022  Tony Zorman+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org>+--+-- Flash the names of workspaces name when switching to them.  This is a+-- reimplementation of "XMonad.Layout.ShowWName" as a logHook.+-----------------------------------------------------------------------------++module XMonad.Hooks.ShowWName (+  -- * Usage+  -- $usage+  showWNameLogHook,+  SWNConfig(..),+  flashName,+) where++import qualified XMonad.StackSet             as W+import qualified XMonad.Util.ExtensibleState as XS++import XMonad+import XMonad.Layout.ShowWName (SWNConfig (..))+import XMonad.Prelude+import XMonad.Util.XUtils (WindowConfig (..), showSimpleWindow)++import Control.Concurrent (threadDelay)++{- $usage++You can use this module with the following in your+@xmonad.hs@:++> import XMonad.Hooks.ShowWName+>+> main :: IO ()+> main = xmonad $ def+>   { logHook = showWNameLogHook def+>   }++Whenever a workspace gains focus, the above logHook will flash its name.+You can customise the duration of the flash, as well as colours by+customising the 'SWNConfig' argument that 'showWNameLogHook' takes.++Alternatively, you can also bind 'flashName' to a key and manually+invoke it when you want to know which workspace you are on.+-}++-- | LogHook for flashing the name of a workspace upon entering it.+showWNameLogHook :: SWNConfig -> X ()+showWNameLogHook cfg = do+  LastShown s <- XS.get+  foc         <- withWindowSet (pure . W.currentTag)+  unless (s == foc) $ do+    flashName cfg+    XS.put (LastShown foc)++-- | Flash the name of the currently focused workspace.+flashName :: SWNConfig -> X ()+flashName cfg = do+  n <- withWindowSet (pure . W.currentTag)+  showSimpleWindow cfg' [n] >>= \w -> void . xfork $ do+    dpy <- openDisplay ""+    threadDelay (fromEnum $ swn_fade cfg * 1000000) -- 1_000_000 needs GHC 8.6.x and up+    void $ destroyWindow dpy w+    closeDisplay dpy+ where+  cfg' :: WindowConfig+  cfg' = def{ winFont = swn_font cfg, winBg = swn_bgcolor cfg, winFg = swn_color cfg }++-- | Last shown workspace.+newtype LastShown = LastShown WorkspaceId+  deriving (Show, Read)++instance ExtensionClass LastShown where+  initialValue :: LastShown+  initialValue  = LastShown ""++  extensionType :: LastShown -> StateExtension+  extensionType = PersistentExtension
+ XMonad/Hooks/StatusBar.hs view
@@ -0,0 +1,573 @@+{-# LANGUAGE FlexibleContexts, TypeApplications, TupleSections  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.StatusBar+-- Description :  Composable and dynamic status bars.+-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- xmonad calls the logHook with every internal state update, which is+-- useful for (among other things) outputting status information to an+-- external status bar program such as xmobar or dzen.+--+-- This module provides a composable interface for (re)starting these status+-- bars and logging to them, either using pipes or X properties. There's also+-- "XMonad.Hooks.StatusBar.PP" which provides an abstraction and some+-- utilities for customization what is logged to a status bar. Together, these+-- are a modern replacement for "XMonad.Hooks.DynamicLog", which is now just a+-- compatibility wrapper.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.StatusBar (+  -- * Usage+  -- $usage+  StatusBarConfig(..),+  withSB,+  withEasySB,+  defToggleStrutsKey,++  -- * Available Configs+  -- $availableconfigs+  statusBarProp,+  statusBarPropTo,+  statusBarGeneric,+  statusBarPipe,++  -- * Multiple Status Bars+  -- $multiple++  -- * Dynamic Status Bars+  -- $dynamic+  dynamicSBs,+  dynamicEasySBs,++  -- * Property Logging utilities+  xmonadPropLog,+  xmonadPropLog',+  xmonadDefProp,++  -- * Managing status bar Processes+  -- $sbprocess+  spawnStatusBar,+  killStatusBar,+  killAllStatusBars,+  startAllStatusBars,+  ) where++import Control.Exception (SomeException, try)+import Data.IORef (newIORef, readIORef, writeIORef)+import qualified Codec.Binary.UTF8.String as UTF8 (encode)+import qualified Data.Map as M+import System.IO (hClose)+import System.Posix.Signals (sigTERM, signalProcessGroup)+import System.Posix.Types (ProcessID)++import Foreign.C (CChar)++import XMonad+import XMonad.Prelude++import XMonad.Util.Run+import qualified XMonad.Util.ExtensibleState as XS++import XMonad.Layout.LayoutModifier+import XMonad.Hooks.ManageDocks+import XMonad.Hooks.Rescreen+import XMonad.Hooks.StatusBar.PP+import qualified XMonad.StackSet as W++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Hooks.StatusBar+-- > import XMonad.Hooks.StatusBar.PP+--+-- The easiest way to use this module with xmobar, as well as any other+-- status bar that supports property logging, is to use 'statusBarProp'+-- with 'withEasySB'; these take care of the necessary plumbing:+--+-- > mySB = statusBarProp "xmobar" (pure xmobarPP)+-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def+--+-- You can read more about X11 properties+-- [here](https://en.wikipedia.org/wiki/X_Window_System_core_protocol#Properties)+-- or+-- [here](https://tronche.com/gui/x/xlib/window-information/properties-and-atoms.html),+-- although you don't have to understand them in order to use the functions+-- mentioned above.+--+-- Most users will, however, want to customize the logging and integrate it+-- into their existing custom xmonad configuration. The 'withSB'+-- function is more appropriate in this case: it doesn't touch your+-- keybindings, layout modifiers, or event hooks; instead, you're expected+-- to configure "XMonad.Hooks.ManageDocks" yourself. Here's what that might+-- look like:+--+-- > mySB = statusBarProp "xmobar" (pure myPP)+-- > main = xmonad . withSB mySB . ewmh . docks $ def {...}+--+-- You then have to tell your status bar to read from the @_XMONAD_LOG@ property+-- of the root window.  In the case of xmobar, this is achieved by simply using+-- the @XMonadLog@ plugin instead of @StdinReader@ in your @.xmobarrc@:+--+-- > Config { ...+-- >        , commands = [ Run XMonadLog, ... ]+-- >        , template = "%XMonadLog% }{ ..."+-- >        }+--+-- If you don't have an @.xmobarrc@, create it; the @XMonadLog@ plugin is not+-- part of the default xmobar configuration and your status bar will not show+-- workspace information otherwise!+--+-- With 'statusBarProp', you need to use property logging. Make sure the+-- status bar you use supports reading a property string from the root window,+-- or use some kind of wrapper that reads the property and pipes it into the+-- bar (e.g. @xmonadpropread | dzen2@, see @scripts/xmonadpropread.hs@). The+-- default property is @_XMONAD_LOG@, which is conveniently saved in 'xmonadDefProp'.+-- You can use another property by using the function 'statusBarPropTo'.+--+-- If your status bar does not support property-based logging, you may also try+-- 'statusBarPipe'.+-- It can be used in the same way as 'statusBarProp' above (for xmobar, you now+-- have to use the @StdinReader@ plugin in your @.xmobarrc@).  Instead of+-- writing to a property, this function opens a pipe and makes the given status+-- bar read from that pipe.+-- Please be aware that this kind of setup is very bug-prone and hence is+-- discouraged: if anything goes wrong with the bar, xmonad will freeze!+--+-- Also note that 'statusBarPipe' returns 'IO StatusBarConfig', so+-- you need to evaluate it before passing it to 'withSB' or 'withEasySB':+--+-- > main = do+-- >   mySB <- statusBarPipe "xmobar" (pure myPP)+-- >   xmonad $ withSB mySB myConf+++-- $plumbing+-- If you do not want to use any of the "batteries included" functions above,+-- you can also add all of the necessary plumbing yourself (the source of+-- 'withSB' might come in handy here).+--+-- 'xmonadPropLog' allows you to write a string to the @_XMONAD_LOG@ property of+-- the root window.  Together with 'dynamicLogString', you can now simply set+-- your 'logHook' to the appropriate function; for instance:+--+-- > main = xmonad $ def {+-- >    ...+-- >    , logHook = xmonadPropLog =<< dynamicLogString myPP+-- >    ...+-- >    }+--+-- If you want to define your own property name, use 'xmonadPropLog'' instead of+-- 'xmonadPropLog'.+--+-- If you just want to use the default pretty-printing format, you can replace+-- @myPP@ with 'def' in the above 'logHook'.+--+-- Note that setting 'logHook' only sets up xmonad's output; you are+-- responsible for starting your own status bar program and making sure it reads+-- from the property that xmonad writes to.  To start your bar, simply put it+-- into your 'startupHook'.  You will also have also have to add 'docks' and+-- 'avoidStruts' to your config.  Putting all of this together would look+-- something like+--+-- > import XMonad.Util.SpawnOnce (spawnOnce)+-- > import XMonad.Hooks.ManageDocks (avoidStruts, docks)+-- >+-- > main = do+-- >     xmonad $ docks $ def {+-- >       ...+-- >       , logHook     = xmonadPropLog =<< dynamicLogString myPP+-- >       , startupHook = spawnOnce "xmobar"+-- >       , layoutHook  = avoidStruts myLayout+-- >       ...+-- >       }+-- > myPP = def { ... }+-- > myLayout = ...+--+-- If you want a keybinding to toggle your bar, you will also need to add this+-- to the rest of your keybindings.+--+-- The above has the problem that xmobar will not get restarted whenever you+-- restart xmonad ('XMonad.Util.SpawnOnce.spawnOnce' will simply prevent your+-- chosen status bar from spawning again). Using 'statusBarProp', however, takes+-- care of the necessary plumbing /and/ keeps track of the started status bars, so+-- they can be correctly restarted with xmonad. This is achieved using+-- 'spawnStatusBar' to start them and 'killStatusBar' to kill+-- previously started bars.+--+-- Even if you don't use a status bar, you can still use 'dynamicLogString' to+-- show on-screen notifications in response to some events. For example, to show+-- the current layout when it changes, you could make a keybinding to cycle the+-- layout and display the current status:+--+-- > ((mod1Mask, xK_a), sendMessage NextLayout >> (dynamicLogString myPP >>= xmessage))+--+-- If you use a status bar that does not support reading from a property+-- (like dzen), and you don't want to use the 'statusBar' function, you can,+-- again, also manually add all of the required components, like this:+--+-- > import XMonad.Util.Run (hPutStrLn, spawnPipe)+-- >+-- > main = do+-- >     h <- spawnPipe "dzen2 -options -foo -bar"+-- >     xmonad $ def {+-- >       ...+-- >       , logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h }+-- >       ...+-- >       }+--+-- In the above, note that if you use @spawnPipe@ you need to redefine the+-- 'ppOutput' field of your pretty-printer; by default the status will be+-- printed to stdout rather than the pipe you create. This was meant to be+-- used together with running xmonad piped to a status bar like so: @xmonad |+-- dzen2@, and is what the old 'XMonad.Hooks.DynamicLog.dynamicLog' assumes,+-- but it isn't recommended in modern setups. Applications launched from+-- xmonad inherit its stdout and stderr, and will print their own garbage to+-- the status bar.+++-- | This datataype abstracts a status bar to provide a common interface+-- functions like 'statusBarPipe' or 'statusBarProp'. Once defined, a status+-- bar can be incorporated in 'XConfig' by using 'withSB' or+-- 'withEasySB', which take care of the necessary plumbing.+data StatusBarConfig = StatusBarConfig  { sbLogHook     :: X ()+                                        -- ^ What and how to log to the status bar.+                                        , sbStartupHook :: X ()+                                        -- ^ How to start the status bar.+                                        , sbCleanupHook :: X ()+                                        -- ^ How to kill the status bar.+                                        }++instance Semigroup StatusBarConfig where+    StatusBarConfig l s c <> StatusBarConfig l' s' c' =+      StatusBarConfig (l <> l') (s <> s') (c <> c')++instance Monoid StatusBarConfig where+    mempty = StatusBarConfig mempty mempty mempty++-- | Per default, all the hooks do nothing.+instance Default StatusBarConfig where+    def = mempty++-- | Incorporates a 'StatusBarConfig' into an 'XConfig' by taking care of the+-- necessary plumbing (starting, restarting and logging to it).+--+-- Using this function multiple times to combine status bars may result in+-- only one status bar working properly. See the section on using multiple+-- status bars for more details.+withSB :: LayoutClass l Window+       => StatusBarConfig    -- ^ The status bar config+       -> XConfig l          -- ^ The base config+       -> XConfig l+withSB (StatusBarConfig lh sh ch) conf = conf+    { logHook     = logHook conf *> lh+    , startupHook = startupHook conf *> ch *> sh+    }++-- | Like 'withSB', but takes an extra key to toggle struts. It also+-- applies the 'avoidStruts' layout modifier and the 'docks' combinator.+--+-- Using this function multiple times to combine status bars may result in+-- only one status bar working properly. See the section on using multiple+-- status bars for more details.+withEasySB :: LayoutClass l Window+           => StatusBarConfig -- ^ The status bar config+           -> (XConfig Layout -> (KeyMask, KeySym))+                              -- ^ The key binding+           -> XConfig l       -- ^ The base config+           -> XConfig (ModifiedLayout AvoidStruts l)+withEasySB sb k conf = docks . withSB sb $ conf+    { layoutHook = avoidStruts (layoutHook conf)+    , keys       = (<>) <$> keys' <*> keys conf+    }+  where+    k' conf' = case k conf' of+        (0, 0) ->+            -- This usually means the user passed 'def' for the keybinding+            -- function, and is otherwise meaningless to harmful depending on+            -- whether 383ffb7 has been applied to xmonad or not. So do what+            -- they probably intend.+            --+            -- A user who wants no keybinding function should probably use+            -- 'withSB' instead, especially since NoSymbol didn't do anything+            -- sane before 383ffb7. ++bsa+            defToggleStrutsKey conf'+        key -> key+    keys' = (`M.singleton` sendMessage ToggleStruts) . k'++-- | Default @mod-b@ key binding for 'withEasySB'+defToggleStrutsKey :: XConfig t -> (KeyMask, KeySym)+defToggleStrutsKey XConfig{modMask = modm} = (modm, xK_b)++-- | Creates a 'StatusBarConfig' that uses property logging to @_XMONAD_LOG@, which+-- is set in 'xmonadDefProp'+statusBarProp :: String -- ^ The command line to launch the status bar+              -> X PP   -- ^ The pretty printing options+              -> StatusBarConfig+statusBarProp = statusBarPropTo xmonadDefProp++-- | Like 'statusBarProp', but lets you define the property+statusBarPropTo :: String -- ^ Property to write the string to+                -> String -- ^ The command line to launch the status bar+                -> X PP   -- ^ The pretty printing options+                -> StatusBarConfig+statusBarPropTo prop cmd pp = statusBarGeneric cmd $+    xmonadPropLog' prop =<< dynamicLogString =<< pp++-- | A generic 'StatusBarConfig' that launches a status bar but takes a+-- generic @X ()@ logging function instead of a 'PP'. This has several uses:+--+-- * With 'xmonadPropLog' or 'xmonadPropLog'' in the logging function, a+--   custom non-'PP'-based logger can be used for logging into an @xmobar@.+--+-- * With 'mempty' as the logging function, it's possible to manage a status+--   bar that reads information from EWMH properties like @taffybar@.+--+-- * With 'mempty' as the logging function, any other dock like @trayer@ or+--   @stalonetray@ can be managed by this module.+statusBarGeneric :: String -- ^ The command line to launch the status bar+                 -> X ()   -- ^ What and how to log to the status bar ('sbLogHook')+                 -> StatusBarConfig+statusBarGeneric cmd lh = def+    { sbLogHook     = lh+    , sbStartupHook = spawnStatusBar cmd+    , sbCleanupHook = killStatusBar cmd+    }++-- | Like 'statusBarProp', but uses pipe-based logging instead.+statusBarPipe :: String -- ^ The command line to launch the status bar+              -> X PP   -- ^ The pretty printing options+              -> IO StatusBarConfig+statusBarPipe cmd xpp = do+    hRef <- newIORef Nothing+    return $ def+        { sbStartupHook = io (writeIORef hRef . Just =<< spawnPipe cmd)+        , sbLogHook     = do+              h' <- io (readIORef hRef)+              whenJust h' $ \h -> io . hPutStrLn h =<< dynamicLogString =<< xpp+        , sbCleanupHook = io+                          $   readIORef hRef+                          >>= (`whenJust` hClose)+                          >>  writeIORef hRef Nothing+        }+++-- $multiple+-- 'StatusBarConfig' is a 'Monoid', which means that multiple status bars can+-- be combined together using '<>' or 'mconcat' and passed to 'withSB'.+--+-- Here's an example of what such declarative configuration of multiple status+-- bars may look like:+--+-- > -- Make sure to setup the xmobar configs accordingly+-- > xmobarTop    = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"    (pure ppTop)+-- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)+-- > xmobar1      = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1"       (pure pp1)+-- >+-- > main = xmonad $ withSB (xmobarTop <> xmobarBottom <> xmobar1) myConfig+--+-- And here is an example of the related xmobar configuration for the multiple+-- status bars mentioned above:+--+-- > xmobarrc_top+-- > Config { ...+-- >        , commands = [ Run XPropertyLog "_XMONAD_LOG_1", ... ]+-- >        , template = "%_XMONAD_LOG_1% }{ ..."+-- >        }+--+-- The above example also works if the different status bars support different+-- logging methods: you could mix property logging and logging via pipes.+-- One thing to keep in mind is that if multiple bars read from the same+-- property, their content will be the same. If you want to use property-based+-- logging with multiple bars, they should read from different properties.+--+-- "XMonad.Util.Loggers" includes loggers that can be bound to specific screens,+-- like 'logCurrentOnScreen', that might be useful with multiple screens.+--+-- Long-time xmonad users will note that the above config is equivalent to+-- the following less robust and more verbose configuration that they might+-- find in their old configs:+--+-- > main = do+-- >   -- do not use this, this is an example of a deprecated config+-- >   xmproc0 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"+-- >   xmproc1 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom"+-- >   xmproc2 <- spawnPipe "xmobar -x 1 ~/.config/xmobar/xmobarrc1"+-- >   xmonad $ def {+-- >     ...+-- >     , logHook = dynamicLogWithPP ppTop { ppOutput = hPutStrLn xmproc0 }+-- >              >> dynamicLogWithPP ppBottom { ppOutput = hPutStrLn xmproc1 }+-- >              >> dynamicLogWithPP pp1 { ppOutput = hPutStrLn xmproc2 }+-- >     ...+-- >   }+--+-- By using the new interface, the config becomes more declarative and there's+-- less room for errors.+--+-- The only *problem* now is that the status bars will not be updated when your screen+-- configuration changes (by plugging in a monitor, for example). Check the section+-- on dynamic status bars for how to do that.++-- $dynamic+-- Using multiple status bars by just combining them with '<>' works well+-- as long as the screen configuration does not change often. If it does,+-- you should use 'dynamicSBs': by providing a function that creates+-- status bars, it takes care of setting up the event hook, the log hook+-- and the startup hook necessary to make the status bars, well, dynamic.+--+-- > xmobarTop    = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"    (pure ppTop)+-- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)+-- > xmobar1      = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1"       (pure pp1)+-- >+-- > barSpawner :: ScreenId -> StatusBarConfig+-- > barSpawner 0 = xmobarTop <> xmobarBottom -- two bars on the main screen+-- > barSpawner 1 = xmobar1+-- > barSpawner _ = mempty -- nothing on the rest of the screens+-- >+-- > main = xmonad $ dynamicSBs (pure . barSpawner) (def { ... })+--+-- Make sure you specify which screen to place the status bar on (in xmobar,+-- this is achieved by the @-x@ argument). In addition to making sure that your+-- status bar lands where you intended it to land, the commands are used+-- internally to keep track of the status bars.+--+-- Note also that this interface can be used with one screen, or if+-- the screen configuration doesn't change.++newtype ActiveSBs = ASB {getASBs :: [(ScreenId,  StatusBarConfig)]}++instance ExtensionClass ActiveSBs where+  initialValue = ASB []++-- | Given a function to create status bars, 'dynamicSBs'+-- adds the dynamic status bar capabilities to the config.+-- For a version of this function that applies 'docks' and+-- 'avoidStruts', check 'dynamicEasySBs'.+--+-- Heavily inspired by "XMonad.Hooks.DynamicBars"+dynamicSBs :: (ScreenId -> X StatusBarConfig) -> XConfig l -> XConfig l+dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf+  { startupHook = startupHook conf >> killAllStatusBars >> updateSBs f+  , logHook     = logHook conf >> logSBs+  }++-- | Like 'dynamicSBs', but applies 'docks' to the+-- resulting config and adds 'avoidStruts' to the+-- layout.+dynamicEasySBs :: LayoutClass l Window+               => (ScreenId -> X StatusBarConfig)+               -> XConfig l+               -> XConfig (ModifiedLayout AvoidStruts l)+dynamicEasySBs f conf =+  docks . dynamicSBs f $ conf { layoutHook = avoidStruts (layoutHook conf) }++-- | Given the function to create status bars, update+-- the status bars by killing those that shouldn't be+-- visible anymore and creates any missing status bars+updateSBs :: (ScreenId -> X StatusBarConfig) -> X ()+updateSBs f = do+  actualScreens    <- withWindowSet $ return . map W.screen . W.screens+  (toKeep, toKill) <-+    partition ((`elem` actualScreens) . fst) . getASBs <$> XS.get+  -- Kill the status bars+  cleanSBs (map snd toKill)+  -- Create new status bars if needed+  let missing = actualScreens \\ map fst toKeep+  added <- traverse (\s -> (s,) <$> f s) missing+  traverse_ (sbStartupHook . snd) added+  XS.put (ASB (toKeep ++ added))++-- | Run 'sbLogHook' for the saved 'StatusBarConfig's+logSBs :: X ()+logSBs = XS.get >>= traverse_ (sbLogHook . snd) . getASBs++-- | Kill the given 'StatusBarConfig's from the given+-- list+cleanSBs :: [StatusBarConfig] -> X ()+cleanSBs = traverse_ sbCleanupHook++-- | The default property xmonad writes to. (@_XMONAD_LOG@).+xmonadDefProp :: String+xmonadDefProp = "_XMONAD_LOG"++-- | Write a string to the @_XMONAD_LOG@ property on the root window.+xmonadPropLog :: String -> X ()+xmonadPropLog = xmonadPropLog' xmonadDefProp++-- | Write a string to a property on the root window.  This property is of type+-- @UTF8_STRING@.+xmonadPropLog' :: String  -- ^ Property name+               -> String  -- ^ Message to be written to the property+               -> X ()+xmonadPropLog' prop msg = do+    d <- asks display+    r <- asks theRoot+    xlog <- getAtom prop+    ustring <- getAtom "UTF8_STRING"+    io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)+ where+    encodeCChar :: String -> [CChar]+    encodeCChar = map fromIntegral . UTF8.encode+++-- This newtype wrapper, together with the ExtensionClass instance make use of+-- the extensible state to save the PIDs bewteen xmonad restarts.+newtype StatusBarPIDs = StatusBarPIDs { getPIDs :: M.Map String ProcessID }+  deriving (Show, Read)++instance ExtensionClass StatusBarPIDs where+  initialValue = StatusBarPIDs mempty+  extensionType = PersistentExtension++-- | Kills the status bar started with 'spawnStatusBar' using the given command+-- and resets the state. This could go for example at the beginning of the+-- startupHook, to kill the status bars that need to be restarted.+--+-- Concretely, this function sends a 'sigTERM' to the saved PIDs using+-- 'signalProcessGroup' to effectively terminate all processes, regardless+-- of how many were started by using  'spawnStatusBar'.+--+-- There is one caveat to keep in mind: to keep the implementation simple;+-- no checks are executed before terminating the processes. This means: if the+-- started process dies for some reason, and enough time passes for the PIDs+-- to wrap around, this function might terminate another process that happens+-- to have the same PID. However, this isn't a typical usage scenario.+killStatusBar :: String -- ^ The command used to start the status bar+                 -> X ()+killStatusBar cmd = do+    XS.gets (M.lookup cmd . getPIDs) >>= flip whenJust (io . killPid)+    XS.modify (StatusBarPIDs . M.delete cmd . getPIDs)++killPid :: ProcessID -> IO ()+killPid pidToKill = void $ try @SomeException (signalProcessGroup sigTERM pidToKill)++-- | Spawns a status bar and saves its PID together with the commands that was+-- used to start it. This is useful when the status bars should be restarted+-- with xmonad. Use this in combination with 'killStatusBar'.+--+-- Note: in some systems, multiple processes might start, even though one command is+-- provided. This means the first PID, of the group leader, is saved.+spawnStatusBar :: String -- ^ The command used to spawn the status bar+               -> X ()+spawnStatusBar cmd = do+  newPid <- spawnPID cmd+  XS.modify (StatusBarPIDs . M.insert cmd newPid . getPIDs)++-- | Kill all status bars started with 'spawnStatusBar'. Note the+-- caveats in 'cleanupStatusBar'+killAllStatusBars :: X ()+killAllStatusBars =+  XS.gets (M.elems . getPIDs) >>= io . traverse_ killPid >> XS.put (StatusBarPIDs mempty)++-- | Start all status bars. Note that you do not need this in your startup hook.+-- This can be bound to a keybinding for example to be used in tandem with+-- `killAllStatusBars`.+startAllStatusBars :: X ()+startAllStatusBars = XS.get >>= traverse_ (sbStartupHook . snd) . getASBs
+ XMonad/Hooks/StatusBar/PP.hs view
@@ -0,0 +1,559 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternGuards       #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE FlexibleContexts    #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.StatusBar.PP+-- Description :  The pretty-printing abstraction for handling status bars.+-- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>+-- Stability   :  unstable+-- Portability :  unportable+--+-- xmonad calls the logHook with every internal state update, which is+-- useful for (among other things) outputting status information to an+-- external status bar program such as xmobar or dzen.+--+-- This module provides a pretty-printing abstraction and utilities that can+-- be used to customize what is logged to a status bar. See+-- "XMonad.Hooks.StatusBar" for an abstraction over starting these status+-- bars. Together these are a modern replacement for+-- "XMonad.Hooks.DynamicLog", which is now just a compatibility wrapper.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.StatusBar.PP (+    -- * Usage+    -- $usage++    -- * Build your own formatter+    PP(..), def,+    dynamicLogString,+    dynamicLogString',+    dynamicLogWithPP,++    -- * Predicates and formatters+    -- $predicates+    WS(..), WSPP, WSPP', fallbackPrinters,+    isUrgent, isCurrent, isVisible, isVisibleNoWindows, isHidden,++    -- * Example formatters+    dzenPP, xmobarPP, sjanssenPP, byorgeyPP,++    -- * Formatting utilities+    wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft',+    xmobarColor, xmobarFont, xmobarAction, xmobarBorder,+    xmobarRaw, xmobarStrip, xmobarStripTags,+    dzenColor, dzenEscape, dzenStrip, filterOutWsPP,++    -- * Internal formatting functions+    pprWindowSet,+    pprWindowSetXinerama++    ) where++import Control.Monad.Reader+import Control.DeepSeq+import qualified Data.List.NonEmpty as NE++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as S++import XMonad.Util.NamedWindows+import XMonad.Util.WorkspaceCompare+import XMonad.Hooks.UrgencyHook++-- $usage+-- An example usage for this module would be:+--+-- > import XMonad+-- > import XMonad.Hooks.StatusBar+-- > import XMonad.Hooks.StatusBar.PP+-- >+-- > myPP = def { ppCurrent = xmobarColor "black" "white" }+-- > mySB = statusBarProp "xmobar" (pure myPP)+-- > main = xmonad . withEasySB mySB defToggleStrutsKey $ myConfig+--+-- Check "XMonad.Hooks.StatusBar" for more examples and an in depth+-- explanation.++-- | The 'PP' type allows the user to customize the formatting of+--   status information.+data PP = PP { ppCurrent :: WorkspaceId -> String+               -- ^ how to print the tag of the currently focused+               -- workspace+             , ppVisible :: WorkspaceId -> String+               -- ^ how to print tags of visible but not focused+               -- workspaces (xinerama only)+             , ppHidden  :: WorkspaceId -> String+               -- ^ how to print tags of hidden workspaces which+               -- contain windows+             , ppHiddenNoWindows :: WorkspaceId -> String+               -- ^ how to print tags of empty hidden workspaces+             , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)+               -- ^ how to print tags of empty visible workspaces+             , ppUrgent :: WorkspaceId -> String+               -- ^ format to be applied to tags of urgent workspaces.+             , ppRename :: String -> WindowSpace -> String+               -- ^ rename/augment the workspace tag+               --   (note that @WindowSpace -> …@ acts as a Reader monad)+             , ppSep :: String+               -- ^ separator to use between different log sections+               -- (window name, layout, workspaces)+             , ppWsSep :: String+               -- ^ separator to use between workspace tags+             , ppTitle :: String -> String+               -- ^ window title format for the focused window. To display+               -- the titles of all windows—even unfocused ones—check+               -- 'XMonad.Util.Loggers.logTitles'.+             , ppTitleSanitize :: String -> String+              -- ^ escape / sanitizes input to 'ppTitle'+             , ppLayout :: String -> String+               -- ^ layout name format+             , ppOrder :: [String] -> [String]+               -- ^ how to order the different log sections. By+               --   default, this function receives a list with three+               --   formatted strings, representing the workspaces,+               --   the layout, and the current window titles,+               --   respectively. If you have specified any extra+               --   loggers in 'ppExtras', their output will also be+               --   appended to the list.  To get them in the reverse+               --   order, you can just use @ppOrder = reverse@.  If+               --   you don't want to display the current layout, you+               --   could use something like @ppOrder = \\(ws:_:t:_) ->+               --   [ws,t]@, and so on.+             , ppSort :: X ([WindowSpace] -> [WindowSpace])+               -- ^ how to sort the workspaces.  See+               -- "XMonad.Util.WorkspaceCompare" for some useful+               -- sorts.+             , ppExtras :: [X (Maybe String)]+               -- ^ loggers for generating extra information such as+               -- time and date, system load, battery status, and so+               -- on.  See "XMonad.Util.Loggers" for examples, or create+               -- your own!+             , ppOutput :: String -> IO ()+               -- ^ applied to the entire formatted string in order to+               -- output it.  Can be used to specify an alternative+               -- output method (e.g. write to a pipe instead of+               -- stdout), and\/or to perform some last-minute+               -- formatting. Note that this is only used by+               -- 'dynamicLogWithPP'; it won't work with 'dynamicLogString' or+               -- "XMonad.Hooks.StatusBar".+             , ppPrinters :: WSPP+               -- ^ extend workspace types with custom predicates.+               -- Check $predicates for more details.+             }++-- | The default pretty printing options:+--+-- > 1 2 [3] 4 7 : full : title+--+-- That is, the currently populated workspaces, the current+-- workspace layout, and the title of the focused window.+instance Default PP where+  def = PP { ppCurrent          = wrap "[" "]"+           , ppVisible          = wrap "<" ">"+           , ppHidden           = id+           , ppHiddenNoWindows  = const ""+           , ppVisibleNoWindows = Nothing+           , ppUrgent           = id+           , ppRename           = pure+           , ppSep              = " : "+           , ppWsSep            = " "+           , ppTitle            = shorten 80+           , ppTitleSanitize    = xmobarStrip . dzenEscape+           , ppLayout           = id+           , ppOrder            = id+           , ppOutput           = putStrLn+           , ppSort             = getSortByIndex+           , ppExtras           = []+           , ppPrinters         = empty+           }++-- | Format the current status using the supplied pretty-printing format,+--   and write it to stdout.+dynamicLogWithPP :: PP -> X ()+dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp++-- | The same as 'dynamicLogWithPP', except it simply returns the status+--   as a formatted string without actually printing it to stdout, to+--   allow for further processing, or use in some application other than+--   a status bar.+dynamicLogString :: PP -> X String+dynamicLogString pp = userCodeDef "_|_" (dynamicLogString' pp)++-- | The guts of 'dynamicLogString'. Forces the result, so it may throw+--   an exception (most commonly because 'ppOrder' is non-total). Use+--   'dynamicLogString' for a version that catches the exception and+--   produces an error string.+dynamicLogString' :: PP -> X String+dynamicLogString' pp = do++    winset <- gets windowset+    urgents <- readUrgents+    sort' <- ppSort pp++    -- layout description+    let ld = description . S.layout . S.workspace . S.current $ winset++    -- workspace list+    let ws = pprWindowSet sort' urgents pp winset++    -- run extra loggers, ignoring any that generate errors.+    extras <- mapM (userCodeDef Nothing) $ ppExtras pp++    -- window title+    wt <- maybe (pure "") (fmap show . getName) . S.peek $ winset++    return $! force $ sepBy (ppSep pp) . ppOrder pp $+                        [ ws+                        , ppLayout pp ld+                        , ppTitle  pp $ ppTitleSanitize pp wt+                        ]+                        ++ catMaybes extras++-- | Format the workspace information, given a workspace sorting function,+--   a list of urgent windows, a pretty-printer format, and the current+--   WindowSet.+pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String+pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $+            map S.workspace (S.current s : S.visible s) ++ S.hidden s+  where+    fmt :: WindowSpace -> String+    fmt w = pr (ppRename pp (S.tag w) w)+      where+        printers = ppPrinters pp <|> fallbackPrinters+        pr = fromMaybe id $ runReaderT printers $+            WS{ wsUrgents = urgents, wsWindowSet = s, wsWS = w, wsPP = pp }++-- $predicates+-- Using 'WSPP' with 'ppPrinters' allows extension modules (and users) to+-- extend 'PP' with new workspace types beyond 'ppCurrent', 'ppUrgent', and+-- the rest.++-- | The data available to 'WSPP''.+data WS = WS{ wsUrgents :: [Window] -- ^ Urgent windows+            , wsWindowSet :: WindowSet -- ^ The entire 'WindowSet', for context+            , wsWS :: WindowSpace -- ^ The 'WindowSpace' being formatted+            , wsPP :: PP -- ^ The actual final 'PP'+            }++-- XXX: ReaderT instead of -> because there is no+--+-- > instance Alternative (Λa. r -> Maybe a)+--+-- (there cannot be, Haskell has no Λ), and there is no+--+-- > instance Alternative (Compose ((->) r) Maybe)+--+-- either, and even if there was, Compose isn't very practical.+--+-- But we don't need Alternative for WS -> Bool, so we use the simple+-- function-based reader for the condition functions, as their definitions are+-- much prettier that way. This may be a bit confusing. :-/+type WSPP' = ReaderT WS Maybe++-- | The type allowing to build formatters (and predicates). See+-- the source 'fallbackPrinters' for an example.+type WSPP = WSPP' (WorkspaceId -> String)++-- | For a 'PP' @pp@, @fallbackPrinters pp@ returns the default 'WSPP'+-- used to format workspaces: the formatter chosen corresponds to the+-- first matching workspace type, respecting the following precedence:+-- 'ppUrgent', 'ppCurrent', 'ppVisible', 'ppVisibleNoWindows', 'ppHidden',+-- 'ppHiddenNoWindows'.+--+-- This can be useful if one needs to use the default set of formatters and+-- post-process their output. (For pre-processing their input, there's+-- 'ppRename'.)+fallbackPrinters :: WSPP+fallbackPrinters = isUrgent            ?-> ppUrgent+               <|> isCurrent'          ?-> ppCurrent+               <|> isVisible'          ?-> ppVisible+               <|> isVisibleNoWindows' ?-> liftA2 fromMaybe ppVisible ppVisibleNoWindows+               <|> isHidden'           ?-> ppHidden+               <|> pure True           ?-> ppHiddenNoWindows+  where+    cond ?-> ppr = (asks cond >>= guard) *> asks (ppr . wsPP)++-- | Predicate for urgent workspaces.+isUrgent :: WS -> Bool+isUrgent WS{..} = any (\x -> (== Just (S.tag wsWS)) (S.findTag x wsWindowSet)) wsUrgents++-- | Predicate for the current workspace. Caution: assumes default+-- precedence is respected.+isCurrent' :: WS -> Bool+isCurrent' WS{..} = S.tag wsWS == S.currentTag wsWindowSet++-- | Predicate for the current workspace.+isCurrent :: WS -> Bool+isCurrent = (not <$> isUrgent) <&&> isCurrent'++-- | Predicate for visible workspaces. Caution: assumes default+-- precedence is respected.+isVisible' :: WS -> Bool+isVisible' = isVisibleNoWindows' <&&> isJust . S.stack . wsWS++-- | Predicate for visible workspaces.+isVisible :: WS -> Bool+isVisible = (not <$> isUrgent) <&&> (not <$> isCurrent') <&&> isVisible'++-- | Predicate for visible workspaces that have no windows. Caution:+-- assumes default precedence is respected.+isVisibleNoWindows' :: WS -> Bool+isVisibleNoWindows' WS{..} = S.tag wsWS `elem` visibles+  where visibles = map (S.tag . S.workspace) (S.visible wsWindowSet)++-- | Predicate for visible workspaces that have no windows.+isVisibleNoWindows :: WS -> Bool+isVisibleNoWindows =+    (not <$> isUrgent)+        <&&> (not <$> isCurrent')+        <&&> (not <$> isVisible')+        <&&> isVisibleNoWindows'++-- | Predicate for non-empty hidden workspaces. Caution: assumes default+-- precedence is respected.+isHidden' :: WS -> Bool+isHidden' = isJust . S.stack . wsWS++-- | Predicate for hidden workspaces.+isHidden :: WS -> Bool+isHidden =+    (not <$> isUrgent)+        <&&> (not <$> isCurrent')+        <&&> (not <$> isVisible')+        <&&> (not <$> isVisibleNoWindows')+        <&&> isHidden'++pprWindowSetXinerama :: WindowSet -> String+pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen+  where onscreen  = map (S.tag . S.workspace)+                        . sortOn S.screen $ S.current ws : S.visible ws+        offscreen = map S.tag . filter (isJust . S.stack)+                        . sortOn S.tag $ S.hidden ws++-- | Wrap a string in delimiters, unless it is empty.+wrap :: String  -- ^ left delimiter+     -> String  -- ^ right delimiter+     -> String  -- ^ output string+     -> String+wrap _ _ "" = ""+wrap l r m  = l ++ m ++ r++-- | Pad a string with a leading and trailing space.+pad :: String -> String+pad = wrap " " " "++-- | Trim leading and trailing whitespace from a string.+trim :: String -> String+trim = f . f+    where f = reverse . dropWhile isSpace++-- | Limit a string to a certain length, adding "..." if truncated.+shorten :: Int -> String -> String+shorten = shorten' "..."++-- | Limit a string to a certain length, adding @end@ if truncated.+shorten' :: String -> Int -> String -> String+shorten' end n xs | length xs < n = xs+                  | otherwise     = take (n - length end) xs ++ end++-- | Like 'shorten', but truncate from the left instead of right.+shortenLeft :: Int -> String -> String+shortenLeft = shortenLeft' "..."++-- | Like 'shorten'', but truncate from the left instead of right.+shortenLeft' :: String -> Int -> String -> String+shortenLeft' end n xs | l < n     = xs+                      | otherwise = end ++ drop (l - n + length end) xs+ where l = length xs++-- | Output a list of strings, ignoring empty ones and separating the+--   rest with the given separator.+sepBy :: String   -- ^ separator+      -> [String] -- ^ fields to output+      -> String+sepBy sep = intercalate sep . filter (not . null)++-- | Use dzen escape codes to output a string with given foreground+--   and background colors.+dzenColor :: String  -- ^ foreground color: a color name, or #rrggbb format+          -> String  -- ^ background color+          -> String  -- ^ output string+          -> String+dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)+ where (fg1,fg2) | null fg = ("","")+                 | otherwise = ("^fg(" ++ fg ++ ")","^fg()")+       (bg1,bg2) | null bg = ("","")+                 | otherwise = ("^bg(" ++ bg ++ ")","^bg()")++-- | Escape any dzen metacharacters.+dzenEscape :: String -> String+dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])++-- | Strip dzen formatting or commands.+dzenStrip :: String -> String+dzenStrip = strip [] where+    strip keep x+      | null x              = keep+      | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x)+      | "^"  `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= ')') $ x)+      | otherwise           = let (good,x') = span (/= '^') x+                              in strip (keep ++ good) x'++-- | Use xmobar escape codes to output a string with the font at the given index+xmobarFont :: Int     -- ^ index: index of the font to use (0: standard font)+           -> String  -- ^ output string+           -> String+xmobarFont index = wrap ("<fn=" ++ show index ++ ">") "</fn>"++-- | Use xmobar escape codes to output a string with given foreground+--   and background colors.+xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format+            -> String  -- ^ background color+            -> String  -- ^ output string+            -> String+xmobarColor fg bg = wrap t "</fc>"+ where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]++-- | Encapsulate text with an action. The text will be displayed, and the+-- action executed when the displayed text is clicked. Illegal input is not+-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new+-- syntax wherein the command is surrounded by backticks.+xmobarAction :: String+                -- ^ Command. Use of backticks (`) will cause a parse error.+             -> String+                -- ^ Buttons 1-5, such as "145". Other characters will cause a+                -- parse error.+             -> String+                -- ^ Displayed/wrapped text.+             -> String+xmobarAction command button = wrap l r+    where+        l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"+        r = "</action>"++-- | Use xmobar box to add a border to an arbitrary string.+xmobarBorder :: String -- ^ Border type. Possible values: VBoth, HBoth, Full,+                       -- Top, Bottom, Left or Right+             -> String -- ^ color: a color name, or #rrggbb format+             -> Int    -- ^ width in pixels+             -> String -- ^ output string+             -> String+xmobarBorder border color width = wrap prefix "</box>"+  where+    prefix = "<box type=" ++ border ++ " width=" ++ show width ++ " color="+      ++ color ++ ">"++-- | Encapsulate arbitrary text for display only, i.e. untrusted content if+-- wrapped (perhaps from window titles) will be displayed only, with all tags+-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not+-- to shorten the result.+xmobarRaw :: String -> String+xmobarRaw "" = ""+xmobarRaw s  = concat ["<raw=", show $ length s, ":", s, "/>"]++-- | Strip xmobar markup, specifically the \<fc\>, \<icon\> and \<action\> tags+-- and the matching tags like \</fc\>.+xmobarStrip :: String -> String+xmobarStrip = converge (xmobarStripTags ["fc","icon","action"])++converge :: (Eq a) => (a -> a) -> a -> a+converge f a+  = fst . NE.head . notEmpty -- If this function terminates, we will find a match.+  . dropWhile (uncurry (/=))+  . zip xs+  $ drop 1 xs+ where xs = iterate f a++xmobarStripTags :: [String] -- ^ tags+        -> String -> String -- ^ with all \<tag\>...\</tag\> removed+xmobarStripTags tags = strip [] where+    strip keep [] = keep+    strip keep x+        | rest: _ <- mapMaybe dropTag tags = strip keep rest+++        | '<':xs <- x = strip (keep ++ "<") xs+        | (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags+      where dropTag :: String -> Maybe String+            dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x),+                                                   closeTag tag `stripPrefix` x]++    dropTilClose, openTag, closeTag :: String -> String+    dropTilClose = drop 1 . dropWhile (/= '>')+    openTag str = "<" ++ str ++ "="+    closeTag str = "</" ++ str ++ ">"++-- | Transforms a pretty-printer into one not displaying the given workspaces.+--+-- For example, filtering out the @NSP@ workspace before giving the 'PP' to+-- 'dynamicLogWithPP':+--+-- > logHook = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] $ def+--+-- Here is another example, when using "XMonad.Layout.IndependentScreens".  If+-- you have handles @hLeft@ and @hRight@ for bars on the left and right screens,+-- respectively, and @pp@ is a pretty-printer function that takes a handle, you+-- could write+--+-- > logHook = let log screen handle = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] . marshallPP screen . pp $ handle+-- >           in log 0 hLeft >> log 1 hRight+filterOutWsPP :: [WorkspaceId] -> PP -> PP+filterOutWsPP ws pp = pp { ppSort = (. filterOutWs ws) <$> ppSort pp }++-- | Settings to emulate dwm's statusbar, dzen only.+dzenPP :: PP+dzenPP = def+  { ppCurrent         = dzenColor "white" "#2b4f98" . pad+  , ppVisible         = dzenColor "black" "#999999" . pad+  , ppHidden          = dzenColor "black" "#cccccc" . pad+  , ppHiddenNoWindows = const ""+  , ppUrgent          = dzenColor "red" "yellow" . pad+  , ppWsSep           = ""+  , ppSep             = ""+  , ppLayout          = dzenColor "black" "#cccccc"+                          . (\x -> pad $ case x of+                              "TilePrime Horizontal" -> "TTT"+                              "TilePrime Vertical"   -> "[]="+                              "Hinted Full"          -> "[ ]"+                              _                      -> x+                            )+  , ppTitle           = ("^bg(#324c80) " ++) . dzenEscape+  }++-- | Some nice xmobar defaults.+xmobarPP :: PP+xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"+               , ppTitle   = xmobarColor "green" "" . shorten 40+               , ppVisible = wrap "(" ")"+               , ppUrgent  = xmobarColor "red" "yellow"+               }++-- | The options that sjanssen likes to use with xmobar, as an+-- example.  Note the use of 'xmobarColor' and the record update on+-- 'def'.+sjanssenPP :: PP+sjanssenPP = def { ppCurrent = xmobarColor "white" "black"+                 , ppTitle   = xmobarColor "#00ee00" "" . shorten 120+                 }++-- | The options that byorgey likes to use with dzen, as another example.+byorgeyPP :: PP+byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces+                , ppHidden          = dzenColor "black" "#a8a3f7" . pad+                , ppCurrent         = dzenColor "yellow" "#a8a3f7" . pad+                , ppUrgent          = dzenColor "red" "yellow" . pad+                , ppSep             = " | "+                , ppWsSep           = ""+                , ppTitle           = shorten 70+                , ppOrder           = reverse+                }+ where+  showNamedWorkspaces wsId =+    if any (`elem` wsId) ['a' .. 'z'] then pad wsId else ""
+ XMonad/Hooks/StatusBar/WorkspaceScreen.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}++{- |+ Module      :  XMonad.Hooks.StatusBar.WorkspaceScreen+ Description :  Combine workspace names with screen information+ Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>+ License     :  BSD3-style (see LICENSE)++ Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>+ Stability   :  unstable+ Portability :  unportable++ In multi-head setup, it might be useful to have screen information of the+ visible workspaces combined with the workspace name, for example in a status+ bar. This module provides utility functions to do just that.+-}+module XMonad.Hooks.StatusBar.WorkspaceScreen+    (+    -- * Usage+    -- $usage+      combineWithScreen+    , combineWithScreenName+    , combineWithScreenNumber+    , WorkspaceScreenCombiner+    -- * Limitations+    -- $limitations+    ) where++import           Graphics.X11.Xrandr+import           XMonad+import           XMonad.Hooks.StatusBar.PP+import           XMonad.Prelude+import qualified XMonad.StackSet               as W++{- $usage+ You can use this module with the following in your @xmonad.hs@:++ > import XMonad+ > import XMonad.Hooks.StatusBar+ > import XMonad.Hooks.StatusBar.PP+ > import XMonad.Hooks.StatusBar.WorkspaceScreen++ For example, to add the screen number in parentheses to each visible+ workspace number, you can use 'combineWithScreenNumber':++ > myWorkspaceScreenCombiner :: WorkspaceId -> String -> String+ > myWorkspaceScreenCombiner w sc = w <> wrap "(" ")" sc+ >+ > mySB = statusBarProp "xmobar" (combineWithScreenNumber myWorkspaceScreenCombiner xmobarPP)+ > main = xmonad $ withEasySB mySB defToggleStrutsKey def++ This will annotate the workspace names as following:++ > [1(0)] 2 3 4 <5(1)> 6 7 8 9++ To use the screen's name instead, checkout 'combineWithScreenName':++ > [1(eDP-1)] 2 3 4 <5(HDMI-1)> 6 7 8 9++ For advanced cases, use 'combineWithScreen'.+-}++{- $limitations+ For simplicity, this module assumes xmonad screen ids match screen/monitor+ numbers as managed by the X server (for example, as given by @xrandr+ --listactivemonitors@). Thus, it may not work well when screens show an+ overlapping range of the framebuffer, e.g. when using a projector. This also+ means that it doesn't work with "XMonad.Layout.LayoutScreens".+ (This isn't difficult to fix, PRs welcome.)+-}++-- | Type synonym for a function that combines a workspace name with a screen.+type WorkspaceScreenCombiner = WorkspaceId -> WindowScreen -> String++-- | A helper function that returns a list of screen names.+screenNames :: X [Maybe String]+screenNames = do+    XConf { display, theRoot } <- ask+    let getName mi = getAtomName display (xrr_moninf_name mi)+    io+        $   maybe (pure []) (traverse getName)+        =<< xrrGetMonitors display theRoot True++-- | Combine a workspace name with the screen name it's visible on.+combineWithScreenName :: (WorkspaceId -> String -> String) -> PP -> X PP+combineWithScreenName c = combineWithScreen $ do+    screens <- screenNames+    return $ \w sc -> maybe w (c w) $ join (screens !? fi (W.screen sc))++-- | Combine a workspace name with the screen number it's visible on.+combineWithScreenNumber :: (WorkspaceId -> String -> String) -> PP -> X PP+combineWithScreenNumber c =+    combineWithScreen . return $ \w sc -> c w (show @Int . fi . W.screen $ sc)++-- | Combine a workspace name with a screen according to the given+-- 'WorkspaceScreenCombiner'.+combineWithScreen :: X WorkspaceScreenCombiner -> PP -> X PP+combineWithScreen xCombiner pp = do+    combiner <- xCombiner+    ss       <- withWindowSet (return . W.screens)+    return $ pp+        { ppRename = ppRename pp <=< \s w ->+            maybe s (combiner s) (find ((== W.tag w) . W.tag . W.workspace) ss)+        }
+ XMonad/Hooks/TaffybarPagerHints.hs view
@@ -0,0 +1,103 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.TaffybarPagerHints+-- Description :  Export additional X properties for [taffybar](https://github.com/taffybar/taffybar).+-- Copyright   :  (c) 2020 Ivan Malison+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ivan Malison <ivanmalison@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module exports additional X properties that allow+-- [taffybar](https://github.com/taffybar/taffybar) to understand the state of+-- XMonad.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.TaffybarPagerHints (+    -- $usage+    pagerHints,+    pagerHintsLogHook,+    pagerHintsEventHook,++    setCurrentLayoutProp,+    setVisibleWorkspacesProp,+    ) where++import Codec.Binary.UTF8.String (encode)+import Foreign.C.Types (CInt)++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W++-- $usage+--+-- You can use this module with the following in your @xmonad.hs@ file:+--+-- > import XMonad.Hooks.TaffybarPagerHints (pagerHints)+-- >+-- > main = xmonad $ ewmh $ pagerHints $ def+-- > ...++-- | The \"Current Layout\" custom hint.+xLayoutProp :: X Atom+xLayoutProp = getAtom "_XMONAD_CURRENT_LAYOUT"++-- | The \"Visible Workspaces\" custom hint.+xVisibleProp :: X Atom+xVisibleProp = getAtom "_XMONAD_VISIBLE_WORKSPACES"++-- | Add support for the \"Current Layout\" and \"Visible Workspaces\" custom+-- hints to the given config.+pagerHints :: XConfig a -> XConfig a+pagerHints c =+  c { handleEventHook = handleEventHook c <> pagerHintsEventHook+    , logHook = logHook c <> pagerHintsLogHook+    }++-- | Update the current values of both custom hints.+pagerHintsLogHook :: X ()+pagerHintsLogHook = do+  withWindowSet+    (setCurrentLayoutProp . description . W.layout . W.workspace . W.current)+  withWindowSet+    (setVisibleWorkspacesProp . map (W.tag . W.workspace) . W.visible)++-- | Set the value of the \"Current Layout\" custom hint to the one given.+setCurrentLayoutProp :: String -> X ()+setCurrentLayoutProp l = withDisplay $ \dpy -> do+  r <- asks theRoot+  a <- xLayoutProp+  c <- getAtom "UTF8_STRING"+  let l' = map fromIntegral (encode l)+  io $ changeProperty8 dpy r a c propModeReplace l'++-- | Set the value of the \"Visible Workspaces\" hint to the one given.+setVisibleWorkspacesProp :: [String] -> X ()+setVisibleWorkspacesProp vis = withDisplay $ \dpy -> do+  r  <- asks theRoot+  a  <- xVisibleProp+  c  <- getAtom "UTF8_STRING"+  let vis' = map fromIntegral $ concatMap ((++[0]) . encode) vis+  io $ changeProperty8 dpy r a c propModeReplace vis'++-- | Handle all \"Current Layout\" events received from pager widgets, and+-- set the current layout accordingly.+pagerHintsEventHook :: Event -> X All+pagerHintsEventHook ClientMessageEvent+                      { ev_message_type = mt+                      , ev_data = d+                      } = withWindowSet $ \_ -> do+  a <- xLayoutProp+  when (mt == a) $ sendLayoutMessage d+  return (All True)+pagerHintsEventHook _ = return (All True)++-- | Request a change in the current layout by sending an internal message+-- to XMonad.+sendLayoutMessage :: [CInt] -> X ()+sendLayoutMessage (x:_) | x < 0     = sendMessage FirstLayout+                        | otherwise = sendMessage NextLayout+sendLayoutMessage [] = return ()
XMonad/Hooks/ToggleHook.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.ToggleHook+-- Description :  Hook and keybindings for toggling hook behavior. -- Copyright   :  Ben Boeckel <mathstuf@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -30,7 +30,7 @@                                , willHookNext                                , willHookAllNew -                                 -- * 'DynamicLog' utilities+                                 -- * Status bar utilities                                  -- $pp                                , willHookNextPP                                , willHookAllNewPP@@ -39,10 +39,9 @@ import Prelude hiding (all)  import XMonad+import XMonad.Prelude (guard, join) import qualified XMonad.Util.ExtensibleState as XS -import Control.Monad (join,guard)-import Control.Applicative ((<$>)) import Control.Arrow (first, second)  import Data.Map@@ -63,7 +62,7 @@  {- The current state is kept here -} -data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)+newtype HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Read, Show)  instance ExtensionClass HookState where     initialValue = HookState empty@@ -78,19 +77,19 @@ -- This module provides actions (that can be set as keybindings) -- to be able to cause hooks to be occur on a conditional basis. ----- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use it by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.ToggleHook -- -- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the -- name of the hook and @hook@ is the hook to execute based on the state. ----- > myManageHook = toggleHook "float" doFloat <+> manageHook def+-- > myManageHook = toggleHook "float" doFloat <> manageHook def -- -- Additionally, toggleHook' is provided to toggle between two hooks (rather -- than on/off). ----- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def+-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <> manageHook def -- -- The 'hookNext' and 'toggleHookNext' functions can be used in key -- bindings to set whether the hook is applied or not.@@ -144,10 +143,10 @@ -- $pp -- The following functions are used to display the current -- state of 'hookNext' and 'hookAllNew' in your--- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.--- 'willHookNextPP' and 'willHookAllNewPP' should be added--- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your--- 'XMonad.Hooks.DynamicLog.PP'.+-- "XMonad.Hooks.StatusBar". 'willHookNextPP' and+-- 'willHookAllNewPP' should be added to the+-- 'XMonad.Hooks.StatusBar.PP.ppExtras' field of your+-- "XMonad.Hooks.StatusBar.PP". -- -- Use 'runLogHook' to refresh the output of your 'logHook', so -- that the effects of a 'hookNext'/... will be visible
XMonad/Hooks/UrgencyHook.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,-  FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.UrgencyHook+-- Description :  Configure an action to occur when a window demands your attention. -- Copyright   :  Devin Mullins <me@twifkak.com> -- License     :  BSD3-style (see LICENSE) --@@ -30,9 +30,6 @@                                  -- ** Useful keybinding                                  -- $keybinding -                                 -- ** Note-                                 -- $note-                                  -- * Troubleshooting                                  -- $troubleshooting @@ -61,10 +58,11 @@                                  NoUrgencyHook(..),                                  BorderUrgencyHook(..),                                  FocusHook(..),-                                 filterUrgencyHook,+                                 filterUrgencyHook, filterUrgencyHook',                                  minutes, seconds,+                                 askUrgent, doAskUrgent,                                  -- * Stuff for developers:-                                 readUrgents, withUrgents,+                                 readUrgents, withUrgents, clearUrgents',                                  StdoutUrgencyHook(..),                                  SpawnUrgencyHook(..),                                  UrgencyHook(urgencyHook),@@ -73,19 +71,17 @@                                  ) where  import XMonad+import XMonad.Prelude (fi, delete, fromMaybe, listToMaybe, maybeToList, when, (\\)) import qualified XMonad.StackSet as W +import XMonad.Hooks.ManageHelpers (windowTag) import XMonad.Util.Dzen (dzenWithArgs, seconds) import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.NamedWindows (getName) import XMonad.Util.Timer (TimerId, startTimer, handleTimer) import XMonad.Util.WindowProperties (getProp32) -import Control.Applicative ((<$>))-import Control.Monad (when) import Data.Bits (testBit)-import Data.List (delete, (\\))-import Data.Maybe (listToMaybe, maybeToList, fromMaybe) import qualified Data.Set as S import System.IO (hPutStrLn, stderr) import Foreign.C.Types (CLong)@@ -121,21 +117,16 @@ -- > main = xmonad $ withUrgencyHook NoUrgencyHook -- >               $ def ----- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent--- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,--- then you should be good. Otherwise, you want to figure out how to set--- 'ppUrgent'.+-- Now, your "XMonad.Hooks.StatusBar.PP" must be set up to display the urgent+-- windows. If you're using the 'dzen' (from "XMonad.Hooks.DynamicLog") or+-- 'dzenPP' functions from that module, then you should be good. Otherwise,+-- you want to figure out how to set 'ppUrgent'.  -- $keybinding -- -- You can set up a keybinding to jump to the window that was recently marked -- urgent. See an example at 'focusUrgent'. --- $note--- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your--- urgency hook and restart xmonad, you may need to rejigger your layout by--- hitting mod-shift-space.- -- $troubleshooting -- -- There are three steps to get right:@@ -206,21 +197,22 @@ -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>                    h -> XConfig l -> XConfig l-withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf+withUrgencyHook hook = withUrgencyHookC hook def  -- | This lets you modify the defaults set in 'urgencyConfig'. An example: ----- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused }+-- > withUrgencyHookC dzenUrgencyHook { ... } def { suppressWhen = Focused } -- -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration. withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>                     h -> UrgencyConfig -> XConfig l -> XConfig l withUrgencyHookC hook urgConf conf = conf {         handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e,-        logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf+        logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf,+        startupHook = cleanupStaleUrgents >> startupHook conf     } -data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)+newtype Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show)  onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents onUrgents f = Urgents . f . fromUrgents@@ -250,20 +242,25 @@ -- -- The interval arguments are in seconds. See the 'minutes' helper. data RemindWhen = Dont                    -- ^ triggering once is enough-                | Repeatedly Int Interval -- ^ repeat <arg1> times every <arg2> seconds-                | Every Interval          -- ^ repeat every <arg1> until the urgency hint is cleared+                | Repeatedly Int Interval -- ^ repeat \<arg1\> times every \<arg2\> seconds+                | Every Interval          -- ^ repeat every \<arg1\> until the urgency hint is cleared                 deriving (Read, Show)  -- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@. minutes :: Rational -> Rational minutes secs = secs * 60 --- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.--- Use a variation of this in your config just as you use a variation of--- 'def' for your xmonad definition.+-- | The default 'UrgencyConfig': @urgencyConfig = 'def'@. urgencyConfig :: UrgencyConfig-urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }+urgencyConfig = def+{-# DEPRECATED urgencyConfig "Use def insetad." #-} +-- | The default 'UrgencyConfig': @suppressWhen = 'Visible', remindWhen = 'Dont'@.+-- Use a variation of this in your config just as you would use any+-- other instance of 'def'.+instance Default UrgencyConfig where+  def = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }+ -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings. -- Example keybinding: --@@ -276,7 +273,7 @@ -- -- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) clearUrgents :: X ()-clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])+clearUrgents = withUrgents clearUrgents'  -- | X action that returns a list of currently urgent windows. You might use -- it, or 'withUrgents', in your custom logHook, to display the workspaces that@@ -288,6 +285,12 @@ withUrgents :: ([Window] -> X a) -> X a withUrgents f = readUrgents >>= f +-- | Cleanup urgency and reminders for windows that no longer exist.+cleanupStaleUrgents :: X ()+cleanupStaleUrgents = withWindowSet $ \ws -> do+    adjustUrgents (filter (`W.member` ws))+    adjustReminders (filter ((`W.member` ws) . window))+ adjustUrgents :: ([Window] -> [Window]) -> X () adjustUrgents = XS.modify . onUrgents @@ -299,7 +302,7 @@                          , window    :: Window                          , interval  :: Interval                          , remaining :: Maybe Int-                         } deriving (Show,Read,Eq,Typeable)+                         } deriving (Show,Read,Eq)  instance ExtensionClass [Reminder] where     initialValue = []@@ -321,14 +324,13 @@ changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X () changeNetWMState dpy w f = do    wmstate <- getAtom "_NET_WM_STATE"-   wstate  <- fromMaybe [] `fmap` getProp32 wmstate w-   let ptype = 4 -- atom property type for changeProperty-   io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)+   wstate  <- fromMaybe [] <$> getProp32 wmstate w+   io $ changeProperty32 dpy w wmstate aTOM propModeReplace (f wstate)    return ()  -- | Add an atom to the _NET_WM_STATE property. addNetWMState :: Display -> Window -> Atom -> X ()-addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):)+addNetWMState dpy w atom = changeNetWMState dpy w (fromIntegral atom :)  -- | Remove an atom from the _NET_WM_STATE property. removeNetWMState :: Display -> Window -> Atom -> X ()@@ -338,7 +340,7 @@ getNetWMState :: Window -> X [CLong] getNetWMState w = do     a_wmstate <- getAtom "_NET_WM_STATE"-    fromMaybe [] `fmap` getProp32 a_wmstate w+    fromMaybe [] <$> getProp32 a_wmstate w   -- The Non-ICCCM Manifesto:@@ -357,10 +359,10 @@ handleEvent wuh event =     case event of      -- WM_HINTS urgency flag-      PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do+      PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } ->           when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do               WMHints { wmh_flags = flags } <- io $ getWMHints dpy w-              if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w+              if testBit flags urgencyHintBit then markUrgent w else markNotUrgent w       -- Window destroyed       DestroyWindowEvent {ev_window = w} ->           markNotUrgent w@@ -384,7 +386,7 @@           mapM_ handleReminder =<< readReminders       where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder             markUrgent w = do-                adjustUrgents (\ws -> if elem w ws then ws else w : ws)+                adjustUrgents (\ws -> if w `elem` ws then ws else w : ws)                 callUrgencyHook wuh w                 userCodeDef () =<< asks (logHook . config)             markNotUrgent w = do@@ -421,12 +423,15 @@ shouldSuppress sw w = elem w <$> suppressibleWindows sw  cleanupUrgents :: SuppressWhen -> X ()-cleanupUrgents sw = do-    sw' <- suppressibleWindows sw+cleanupUrgents sw = clearUrgents' =<< suppressibleWindows sw++-- | Clear urgency status of selected windows.+clearUrgents' :: [Window] -> X ()+clearUrgents' ws = do     a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"-    dpy <- withDisplay (\dpy -> return dpy)-    mapM_ (\w -> removeNetWMState dpy w a_da) sw'-    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))+    dpy <- withDisplay return+    mapM_ (\w -> removeNetWMState dpy w a_da) ws+    adjustUrgents (\\ ws) >> adjustReminders (filter ((`notElem` ws) . window))  suppressibleWindows :: SuppressWhen -> X [Window] suppressibleWindows Visible  = gets $ S.toList . mapped@@ -492,7 +497,7 @@  borderUrgencyHook :: String -> Window -> X () borderUrgencyHook = urgencyHook . BorderUrgencyHook-data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }+newtype BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: String }                        deriving (Read, Show)  instance UrgencyHook BorderUrgencyHook where@@ -510,8 +515,12 @@ -- Defaults to a duration of five seconds, and no extra args to dzen. -- See 'DzenUrgencyHook'. dzenUrgencyHook :: DzenUrgencyHook-dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }+dzenUrgencyHook = def +-- | @'def' = 'dzenUrgencyHook'@.+instance Default DzenUrgencyHook where+  def = DzenUrgencyHook { duration = seconds 5, args = [] }+ -- | Spawn a commandline thing, appending the window id to the prefix string -- you provide. (Make sure to add a space if you need it.) Do your crazy -- xcompmgr thing.@@ -535,11 +544,36 @@ -- -- Useful for scratchpad workspaces perhaps: ----- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) defaultConfig)+-- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) def) filterUrgencyHook :: [WorkspaceId] -> Window -> X ()-filterUrgencyHook skips w = do-    ws <- gets windowset-    case W.findTag w ws of-        Just tag -> when (tag `elem` skips)-                        $ adjustUrgents (delete w)-        _ -> return ()+filterUrgencyHook skips = filterUrgencyHook' $ maybe False (`elem` skips) <$> windowTag++-- | 'filterUrgencyHook' that takes a generic 'Query' to select which windows+-- should never be marked urgent.+filterUrgencyHook' :: Query Bool -> Window -> X ()+filterUrgencyHook' q w = whenX (runQuery q w) (clearUrgents' [w])++-- | Mark the given window urgent.+--+-- (The implementation is a bit hacky: send a _NET_WM_STATE ClientMessage to+-- ourselves. This is so that we respect the 'SuppressWhen' of the configured+-- urgency hooks. If this module if ever migrated to the ExtensibleConf+-- infrastrcture, we'll then invoke markUrgent directly.)+askUrgent :: Window -> X ()+askUrgent w = withDisplay $ \dpy -> do+    rw <- asks theRoot+    a_wmstate <- getAtom "_NET_WM_STATE"+    a_da      <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"+    let state_add = 1+    let source_pager = 2+    io $ allocaXEvent $ \e -> do+        setEventType e clientMessage+        setClientMessageEvent' e w a_wmstate 32 [state_add, fi a_da, 0, source_pager]+        sendEvent dpy rw False (substructureRedirectMask .|. substructureNotifyMask) e++-- | Helper for 'ManageHook' that marks the window as urgent (unless+-- suppressed, see 'SuppressWhen'). Useful in+-- 'XMonad.Hooks.EwmhDesktops.setEwmhActivateHook' and also in combination+-- with "XMonad.Hooks.InsertPosition", "XMonad.Hooks.Focus".+doAskUrgent :: ManageHook+doAskUrgent = ask >>= \w -> liftX (askUrgent w) >> mempty
XMonad/Hooks/WallpaperSetter.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------- -- | -- Module      : XMonad.Hooks.WallpaperSetter+-- Description : Change the wallpapers depending on visible workspaces. -- Copyright   : (c) Anton Pirogov, 2014 -- License     : BSD3 --@@ -19,11 +19,12 @@ , Wallpaper(..) , WallpaperList(..) , defWallpaperConf-, defWPNames+, defWPNamesJpg, defWPNamesPng, defWPNames   -- *TODO   -- $todo ) where import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS @@ -34,16 +35,7 @@ import System.Random (randomRIO)  import qualified Data.Map as M-import Data.List (intersperse, sortBy)-import Data.Char (isAlphaNum)-import Data.Ord (comparing) -import Control.Monad-import Control.Applicative-import Data.Maybe-import Data.Monoid hiding ((<>))-import Data.Semigroup- -- $usage -- This module requires imagemagick and feh to be installed, as these are utilized -- for the required image transformations and the actual setting of the wallpaper.@@ -56,7 +48,7 @@ -- -- > myWorkspaces = ["1:main","2:misc","3","4"] -- > ...--- > main = xmonad $ defaultConfig {+-- > main = xmonad $ def { -- >   logHook = wallpaperSetter defWallpaperConf { -- >                                wallpapers = defWPNames myWorkspaces -- >                                          <> WallpaperList [("1:main",WallpaperDir "1")]@@ -70,7 +62,7 @@ -- * find out how to merge multiple images from stdin to one (-> for caching all pictures in memory)  -- | internal. to use XMonad state for memory in-between log-hook calls and remember PID of old external call-data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) deriving Typeable+data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) instance ExtensionClass WCState where   initialValue = WCState Nothing Nothing @@ -82,14 +74,13 @@ newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)]   deriving (Show,Read) +instance Semigroup WallpaperList where+  WallpaperList w1 <> WallpaperList w2 =+    WallpaperList $ M.toList $ M.fromList w2 `M.union` M.fromList w1+ instance Monoid WallpaperList where   mempty = WallpaperList []-  mappend (WallpaperList w1) (WallpaperList w2) =-    WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1) -instance Semigroup WallpaperList where-  (<>) = mappend- -- | Complete wallpaper configuration passed to the hook data WallpaperConf = WallpaperConf {     wallpaperBaseDir :: FilePath  -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)@@ -103,10 +94,18 @@ instance Default WallpaperConf where     def = defWallpaperConf --- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted)+{-# DEPRECATED defWPNames "Use defWPNamesJpg instead" #-} defWPNames :: [WorkspaceId] -> WallpaperList-defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x++".jpg"))) xs+defWPNames = defWPNamesJpg +-- | Return the default association list (maps @name@ to @name.jpg@, non-alphanumeric characters are omitted)+defWPNamesJpg :: [WorkspaceId] -> WallpaperList+defWPNamesJpg xs = WallpaperList $ map (\x -> (x, WallpaperFix (filter isAlphaNum x ++ ".jpg"))) xs++-- | Like 'defWPNamesJpg', but map @name@ to @name.png@ instead.+defWPNamesPng :: [WorkspaceId] -> WallpaperList+defWPNamesPng xs = WallpaperList $ map (\x -> (x, WallpaperFix (filter isAlphaNum x ++ ".png"))) xs+ -- | Add this to your log hook with the workspace configuration as argument. wallpaperSetter :: WallpaperConf -> X () wallpaperSetter wpconf = do@@ -141,7 +140,7 @@   direxists <- doesDirectoryExist $ wallpaperBaseDir conf </> dir   if direxists     then do files <- getDirectoryContents $ wallpaperBaseDir conf </> dir-            let files' = filter ((/='.').head) files+            let files' = filter (not . ("." `isPrefixOf`)) files             file <- pickFrom files'             return $ Just $ wallpaperBaseDir conf </> dir </> file     else return Nothing@@ -161,7 +160,6 @@     [[(w,"")],[(h,"")]] -> Just (w,h)     _ -> Nothing - -- |complete unset fields to default values (wallpaper directory = ~/.wallpapers, --  expects a file "NAME.jpg" for each workspace named NAME) completeWPConf :: WallpaperConf -> X WallpaperConf@@ -176,7 +174,7 @@ getVisibleWorkspaces :: X [WorkspaceId] getVisibleWorkspaces = do   winset <- gets windowset-  return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset+  return $ map (S.tag . S.workspace) . sortOn S.screen $ S.current winset : S.visible winset  getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)] getPicPathsAndWSRects wpconf = do@@ -185,9 +183,8 @@   visws <- getVisibleWorkspaces   let visscr = S.current winset : S.visible winset       visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr-      hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp)       getRect tag = screenRect $ fromJust $ M.lookup tag visrects-      foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths+      foundpaths = [ (getRect n, p) | (n, Just p) <- paths, n `elem` visws ]   return foundpaths   where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y                              >>= \p -> return (x,p)) wl@@ -199,20 +196,20 @@   winset <- gets windowset   let (vx,vy) = getVScreenDim winset   layers <- liftIO $ mapM layerCommand parts-  let basepart ="convert -size "++show vx++"x"++show vy++" xc:black "+  let basepart ="convert -size " ++ show vx ++ "x" ++ show vy ++ " xc:black"       endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -"-      cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart+      cmd = basepart ++ unwords layers ++ endpart   liftIO $ runCommand cmd   getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer)-getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens-  where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx-                                            , fromIntegral ((fromIntegral y)+h) `max` my )+getVScreenDim = foldr (maxXY . screenRect . S.screenDetail) (0,0) . S.screens+  where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral (fromIntegral x+w) `max` mx+                                            , fromIntegral (fromIntegral y+h) `max` my )  needsRotation :: Rectangle -> (Int,Int) -> Bool needsRotation rect (px,py) = let wratio, pratio :: Double-                                 wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect)+                                 wratio = fromIntegral (rect_width rect) / fromIntegral (rect_height rect)                                  pratio = fromIntegral px / fromIntegral py                              in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1 @@ -221,7 +218,7 @@   res <- getPicRes path   return $ case needsRotation rect <$> res of     Nothing -> ""-    Just rotate ->+    Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in                      " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")-                      ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"-                      ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "+                      ++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)"+                      ++ " -geometry +" ++ show (rect_x rect) ++ "+" ++ show (rect_y rect) ++ " -composite "
+ XMonad/Hooks/WindowSwallowing.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE NamedFieldPuns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.WindowSwallowing+-- Description :  Temporarily hide parent windows when opening other programs.+-- Copyright   :  (c) 2020 Leon Kowarschick+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides a handleEventHook that implements window swallowing.+--+-- If you open a GUI-window (i.e. feh) from the terminal,+-- the terminal will normally still be shown on screen, unnecessarily+-- taking up space on the screen.+-- With window swallowing, can detect that you opened a window from within another+-- window, and allows you "swallow" that parent window for the time the new+-- window is running.+--+-- __NOTE__ that this does not always work perfectly:+--+-- - Because window swallowing needs to check the process hierarchy, it requires+--   both the child and the parent to be distinct processes. This means that+--   applications which implement instance sharing cannot be supported by window swallowing.+--   Most notably, this excludes some terminal emulators as well as tmux+--   from functioning as the parent process. It also excludes a good amount of+--   child programs, because many graphical applications do implement instance sharing.+--   For example, window swallowing will probably not work with your browser.+--+-- - To check the process hierarchy, we need to be able to get the process ID+--   by looking at the window. This requires the @_NET_WM_PID@ X-property to be set.+--   If any application you want to use this with does not provide the @_NET_WM_PID@,+--   there is not much you can do except for reaching out to the author of that+--   application and asking them to set that property. Additionally,+--   applications running in their own PID namespace, such as those in+--   Flatpak, can't set a correct @_NET_WM_PID@ even if they wanted to.+-----------------------------------------------------------------------------+module XMonad.Hooks.WindowSwallowing+  ( -- * Usage+    -- $usage+    swallowEventHook, swallowEventHookSub+  )+where+import           XMonad+import           XMonad.Prelude+import qualified XMonad.StackSet               as W+import           XMonad.Layout.SubLayouts+import qualified XMonad.Util.ExtensibleState   as XS+import           XMonad.Util.WindowProperties+import           XMonad.Util.Process            ( getPPIDChain )+import qualified Data.Map.Strict               as M+import           System.Posix.Types             ( ProcessID )++-- $usage+-- You can use this module by including  the following in your @xmonad.hs@:+--+-- > import XMonad.Hooks.WindowSwallowing+--+-- and using 'swallowEventHook' somewhere in your 'handleEventHook', for example:+--+-- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True)+--+-- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layout.SubLayouts" is used;+-- instead of swallowing the window it will merge the child window with the parent. (this does not work with floating windows)+--+-- For more information on editing your handleEventHook and key bindings,+-- see <https://xmonad.org/TUTORIAL.html the tutorial> and "XMonad.Doc.Extending".++-- | Run @action@ iff both parent- and child queries match and the child+-- is a child by PID.+--+-- A 'MapRequestEvent' is called right before a window gets opened. We+-- intercept that call to possibly open the window ourselves, swapping+-- out it's parent processes window for the new window in the stack.+handleMapRequestEvent :: Query Bool -> Query Bool -> Window -> (Window -> X ()) -> X ()+handleMapRequestEvent parentQ childQ childWindow action =+  -- For a window to be opened from within another window, that other window+  -- must be focused. Thus the parent window that would be swallowed has to be+  -- the currently focused window.+  withFocused $ \parentWindow -> do+    -- First verify that both windows match the given queries+    parentMatches <- runQuery parentQ parentWindow+    childMatches  <- runQuery childQ childWindow+    when (parentMatches && childMatches) $ do+      -- read the windows _NET_WM_PID properties+      childWindowPid  <- getProp32s "_NET_WM_PID" childWindow+      parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow+      case (parentWindowPid, childWindowPid) of+        (Just (parentPid : _), Just (childPid : _)) -> do+          -- check if the new window is a child process of the last focused window+          -- using the process ids.+          isChild <- liftIO $ fi childPid `isChildOf` fi parentPid+          when isChild $ do+            action parentWindow+        _ -> return ()+      return ()++-- | handleEventHook that will merge child windows via+-- "XMonad.Layout.SubLayouts" when they are opened from another window.+swallowEventHookSub+  :: Query Bool -- ^ query the parent window has to match for window swallowing to occur.+                --   Set this to @return True@ to run swallowing for every parent.+  -> Query Bool -- ^ query the child window has to match for window swallowing to occur.+                --   Set this to @return True@ to run swallowing for every child+  -> Event      -- ^ The event to handle.+  -> X All+swallowEventHookSub parentQ childQ event =+  All True <$ case event of+    MapRequestEvent{ev_window=childWindow} ->+      handleMapRequestEvent parentQ childQ childWindow $ \parentWindow -> do+        manage childWindow+        sendMessage (Merge parentWindow childWindow)+    _ -> pure ()++-- | handleEventHook that will swallow child windows when they are+-- opened from another window.+swallowEventHook+  :: Query Bool -- ^ query the parent window has to match for window swallowing to occur.+                --   Set this to @return True@ to run swallowing for every parent.+  -> Query Bool -- ^ query the child window has to match for window swallowing to occur.+                --   Set this to @return True@ to run swallowing for every child+  -> Event      -- ^ The event to handle.+  -> X All+swallowEventHook parentQ childQ event = do+  case event of+    MapRequestEvent{ev_window=childWindow} ->+      handleMapRequestEvent parentQ childQ childWindow $ \parentWindow -> do+        -- We set the newly opened window as the focused window, replacing the parent window.+        -- If the parent window was floating, we transfer that data to the child,+        -- such that it shows up at the same position, with the same dimensions.+        windows+          ( W.modify' (\x -> x { W.focus = childWindow })+          . moveFloatingState parentWindow childWindow+          )+        XS.modify (addSwallowedParent parentWindow childWindow)++    -- This is called in many circumstances, most notably for us:+    -- right before a window gets closed. We store the current+    -- state of the window stack here, such that we know where the+    -- child window was on the screen when restoring the swallowed parent process.+    ConfigureEvent{} -> withWindowSet $ \ws -> do+      XS.modify . setStackBeforeWindowClosing . currentStack $ ws+      XS.modify . setFloatingBeforeWindowClosing . W.floating $ ws++    -- This is called right after any window closes.+    DestroyWindowEvent { ev_event = eventId, ev_window = childWindow } ->+      -- Because DestroyWindowEvent is emitted a lot more often then you think,+      -- this check verifies that the event is /actually/ about closing a window.+      when (eventId == childWindow) $ do+        -- we get some data from the extensible state, most notably we ask for+        -- the \"parent\" window of the now closed window.+        maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow)+        maybeOldStack        <- XS.gets stackBeforeWindowClosing+        oldFloating          <- XS.gets floatingBeforeClosing+        case (maybeSwallowedParent, maybeOldStack) of+          -- If there actually is a corresponding swallowed parent window for this window,+          -- we will try to restore it.+          -- Because there are some cases where the stack-state is not stored correctly in the ConfigureEvent hook,+          -- we have to first check if the stack-state is valid.+          -- If it is, we can restore the parent exactly where the child window was before being closed.+          -- If the stored stack-state is invalid however, we still restore the window+          -- by just inserting it as the focused window in the stack.+          --+          -- After restoring, we remove the information about the swallowing from the state.+          (Just parent, Nothing) -> do+            windows (insertIntoStack parent)+            deleteState childWindow+          (Just parent, Just oldStack) -> do+            stackStoredCorrectly <- do+              curStack <- withWindowSet (return . currentStack)+              let oldLen = length (W.integrate oldStack)+              let curLen = length (W.integrate' curStack)+              return (oldLen - 1 == curLen && childWindow == W.focus oldStack)++            if stackStoredCorrectly+              then windows+                (\ws ->+                  updateCurrentStack+                      (const $ Just $ oldStack { W.focus = parent })+                    $ moveFloatingState childWindow parent+                    $ ws { W.floating = oldFloating }+                )+              else windows (insertIntoStack parent)+            deleteState childWindow+          _ -> return ()+    _ -> return ()+  return $ All True+ where+  deleteState :: Window -> X ()+  deleteState childWindow = do+    XS.modify $ removeSwallowed childWindow+    XS.modify $ setStackBeforeWindowClosing Nothing++-- | insert a window as focused into the current stack, moving the previously focused window down the stack+insertIntoStack :: a -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd+insertIntoStack win = W.modify+  (Just $ W.Stack win [] [])+  (\s -> Just $ s { W.focus = win, W.down = W.focus s : W.down s })++-- | run a pure transformation on the Stack of the currently focused workspace.+updateCurrentStack+  :: (Maybe (W.Stack a) -> Maybe (W.Stack a))+  -> W.StackSet i l a sid sd+  -> W.StackSet i l a sid sd+updateCurrentStack f = W.modify (f Nothing) (f . Just)++currentStack :: W.StackSet i l a sid sd -> Maybe (W.Stack a)+currentStack = W.stack . W.workspace . W.current+++-- | move the floating state from one window to another, sinking the original window+moveFloatingState+  :: Ord a+  => a -- ^ window to move from+  -> a -- ^ window to move to+  -> W.StackSet i l a s sd+  -> W.StackSet i l a s sd+moveFloatingState from to ws = ws+  { W.floating = M.delete from $ maybe (M.delete to (W.floating ws))+                                       (\r -> M.insert to r (W.floating ws))+                                       (M.lookup from (W.floating ws))+  }++-- | check if a given process is a child of another process. This depends on "pstree" being in the PATH+-- NOTE: this does not work if the child process does any kind of process-sharing.+isChildOf+  :: ProcessID -- ^ child PID+  -> ProcessID -- ^ parent PID+  -> IO Bool+isChildOf child parent = (parent `elem`) <$> getPPIDChain child++data SwallowingState =+  SwallowingState+    { currentlySwallowed       :: M.Map Window Window         -- ^ mapping from child window window to the currently swallowed parent window+    , stackBeforeWindowClosing :: Maybe (W.Stack Window)      -- ^ current stack state right before DestroyWindowEvent is sent+    , floatingBeforeClosing    :: M.Map Window W.RationalRect -- ^ floating map of the stackset right before DestroyWindowEvent is sent+    } deriving (Show)++getSwallowedParent :: Window -> SwallowingState -> Maybe Window+getSwallowedParent win SwallowingState { currentlySwallowed } =+  M.lookup win currentlySwallowed++addSwallowedParent :: Window -> Window -> SwallowingState -> SwallowingState+addSwallowedParent parent child s@SwallowingState { currentlySwallowed } =+  s { currentlySwallowed = M.insert child parent currentlySwallowed }++removeSwallowed :: Window -> SwallowingState -> SwallowingState+removeSwallowed child s@SwallowingState { currentlySwallowed } =+  s { currentlySwallowed = M.delete child currentlySwallowed }++setStackBeforeWindowClosing+  :: Maybe (W.Stack Window) -> SwallowingState -> SwallowingState+setStackBeforeWindowClosing stack s = s { stackBeforeWindowClosing = stack }++setFloatingBeforeWindowClosing+  :: M.Map Window W.RationalRect -> SwallowingState -> SwallowingState+setFloatingBeforeWindowClosing x s = s { floatingBeforeClosing = x }++instance ExtensionClass SwallowingState where+  initialValue = SwallowingState { currentlySwallowed       = mempty+                                 , stackBeforeWindowClosing = Nothing+                                 , floatingBeforeClosing    = mempty+                                 }
XMonad/Hooks/WorkspaceByPos.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE LambdaCase #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.WorkspaceByPos+-- Description :  Move new window to non-focused screen based on its requested geometry. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -21,19 +23,18 @@     ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W-import XMonad.Util.XUtils (fi) -import Data.Maybe-import Control.Applicative((<$>))-import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)+import Control.Monad.Except (runExceptT, throwError)+import Control.Monad.Trans (lift)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceByPos -- >--- > myManageHook = workspaceByPos <+> manageHook def+-- > myManageHook = workspaceByPos <> manageHook def -- > -- > main = xmonad def { manageHook = myManageHook } @@ -41,10 +42,10 @@ workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask  needsMoving :: Window -> X (Maybe WorkspaceId)-needsMoving w = withDisplay $ \d -> do-    -- only relocate windows with non-zero position-    wa <- io $ getWindowAttributes d w-    fmap (const Nothing `either` Just) . runErrorT $ do+needsMoving w = safeGetWindowAttributes w >>= \case+    Nothing -> pure Nothing+    Just wa -> fmap (either (const Nothing) Just) . runExceptT $ do+        -- only relocate windows with non-zero position         guard $ wa_x wa /= 0 || wa_y wa /= 0         ws <- gets windowset         sc <- lift $ fromMaybe (W.current ws)
XMonad/Hooks/WorkspaceHistory.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}-+{-# LANGUAGE DerivingVia #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.WorkspaceHistory+-- Description :  Keep track of workspace viewing order. -- Copyright   :  (c) 2013 Dmitri Iouchtchenko -- License     :  BSD3-style (see LICENSE) --@@ -19,25 +19,27 @@       -- $usage       -- * Hooking     workspaceHistoryHook+  , workspaceHistoryHookExclude       -- * Querying   , workspaceHistory   , workspaceHistoryByScreen   , workspaceHistoryWithScreen     -- * Handling edits   , workspaceHistoryTransaction+  , workspaceHistoryModify   ) where -import           Control.Applicative-import           Prelude-+import Control.Applicative+import Control.DeepSeq+import Prelude import XMonad-import XMonad.StackSet hiding (filter, delete)-import Data.List+import XMonad.StackSet hiding (delete, filter, new)+import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy, listToMaybe) import qualified XMonad.Util.ExtensibleState as XS  -- $usage -- To record the order in which you view workspaces, you can use this--- module with the following in your @~\/.xmonad\/xmonad.hs@:+-- module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook) --@@ -49,12 +51,22 @@ -- >      , ... -- >      } --+-- If you want to completely exclude certain workspaces from entering+-- the history, you can use 'workspaceHistoryHookExclude' instead.  For+-- example, to ignore the named scratchpad workspace:+--+-- > import XMonad.Util.NamedScratchpad (scratchpadWorkspaceTag)+-- > ...+-- > , logHook = ... >> workspaceHistoryHookExclude [scratchpadWorkspaceTag] >> ...+-- -- To make use of the collected data, a query function is provided. -data WorkspaceHistory = WorkspaceHistory+newtype WorkspaceHistory = WorkspaceHistory   { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in                                          -- reverse-chronological order.-  } deriving (Typeable, Read, Show)+  }+  deriving (Read, Show)+  deriving NFData via [(Int, WorkspaceId)]  instance ExtensionClass WorkspaceHistory where     initialValue = WorkspaceHistory []@@ -63,14 +75,22 @@ -- | A 'logHook' that keeps track of the order in which workspaces have -- been viewed. workspaceHistoryHook :: X ()-workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen)+workspaceHistoryHook = workspaceHistoryHookExclude [] +-- | Like 'workspaceHistoryHook', but with the ability to exclude+-- certain workspaces.+workspaceHistoryHookExclude :: [WorkspaceId] -> X ()+workspaceHistoryHookExclude ws = XS.modify' . update =<< gets windowset+  where+    update :: WindowSet -> WorkspaceHistory -> WorkspaceHistory+    update s = force . updateLastActiveOnEachScreenExclude ws s+ workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)] workspaceHistoryWithScreen = XS.gets history  workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])] workspaceHistoryByScreen =-  map (\wss -> (fst $ head wss, map snd wss)) .+  map (\wss -> (maybe 0 fst (listToMaybe wss), map snd wss)) .   groupBy (\a b -> fst a == fst b) .   sortBy (\a b -> compare (fst a) $ fst b)<$>   workspaceHistoryWithScreen@@ -85,19 +105,29 @@ workspaceHistoryTransaction action = do   startingHistory <- XS.gets history   action-  new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset-  XS.put new+  new <- flip updateLastActiveOnEachScreen (WorkspaceHistory startingHistory) <$> gets windowset+  XS.put $! force new  -- | Update the last visible workspace on each monitor if needed -- already there, or move it to the front if it is. updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory-updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =-  WorkspaceHistory { history = doUpdate cur $ foldl updateLastForScreen (history wh) $ vis ++ [cur] }+updateLastActiveOnEachScreen = updateLastActiveOnEachScreenExclude []++-- | Like 'updateLastActiveOnEachScreen', but with the ability to+-- exclude certain workspaces.+updateLastActiveOnEachScreenExclude :: [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory+updateLastActiveOnEachScreenExclude ws StackSet {current = cur, visible = vis} wh =+  WorkspaceHistory { history = doUpdate cur $ foldl' updateLastForScreen (history wh) $ vis ++ [cur] }   where     firstOnScreen sid = find ((== sid) . fst)     doUpdate Screen {workspace = Workspace { tag = wid }, screen = sid} curr =-      let newEntry = (sid, wid) in newEntry:delete newEntry curr+      let newEntry = (sid, wid)+       in if wid `elem` ws then curr else newEntry : delete newEntry curr     updateLastForScreen curr Screen {workspace = Workspace { tag = wid }, screen = sid} =       let newEntry = (sid, wid)-          alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr-      in if alreadyCurrent then curr else newEntry:delete newEntry curr+          alreadyCurrent = Just newEntry == firstOnScreen sid curr+      in if alreadyCurrent || wid `elem` ws then curr else newEntry : delete newEntry curr++-- | Modify a the workspace history with a given pure function.+workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()+workspaceHistoryModify action = XS.modify' $ force . WorkspaceHistory . action . history
XMonad/Hooks/XPropManage.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.XPropManage+-- Description  : ManageHook matching on XProperties. -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de> -- License      : BSD --@@ -19,15 +20,13 @@                  ) where  import Control.Exception as E-import Data.Char (chr)-import Data.Monoid (mconcat, Endo(..))- import Control.Monad.Trans (lift)  import XMonad+import XMonad.Prelude (Endo (..), chr)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.XPropManage -- > import qualified XMonad.StackSet as W@@ -58,7 +57,7 @@ -- should work fine. Others might not work. -- -type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet)))+type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet))  pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet) pmX f w = f w >> return id@@ -73,10 +72,10 @@       mkQuery (a, tf)    = fmap tf (getQuery a)       mkHook func        = ask >>= Query . lift . fmap Endo . func -getProp :: Display -> Window -> Atom -> X ([String])+getProp :: Display -> Window -> Atom -> X [String] getProp d w p = do     prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])-    let filt q | q == wM_COMMAND = concat . map splitAtNull+    let filt q | q == wM_COMMAND = concatMap splitAtNull                | otherwise       = id     return (filt p prop) @@ -84,7 +83,7 @@ getQuery p = ask >>= \w ->  Query . lift $ withDisplay $ \d -> getProp d w p  splitAtNull :: String -> [String]-splitAtNull s = case dropWhile (== (chr 0)) s of+splitAtNull s = case dropWhile (== chr 0) s of     "" -> []     s' -> w : splitAtNull s''-          where (w, s'') = break (== (chr 0)) s'+          where (w, s'') = break (== chr 0) s'
XMonad/Layout/Accordion.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Accordion+-- Description :  Put non-focused windows in ribbons at the top and bottom of the screen. -- Copyright   :  (c) glasser@mit.edu -- License     :  BSD --@@ -24,7 +25,7 @@ import Data.Ratio  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Accordion --@@ -33,9 +34,9 @@ -- > myLayout = Accordion ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data Accordion a = Accordion deriving ( Read, Show )
XMonad/Layout/AutoMaster.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.AutoMaster+-- Description :  Change size of the stack area depending on the number of its windows. -- Copyright   :  (c) 2009 Ilya Portnov -- License     :  BSD3-style (see LICENSE) --@@ -20,19 +21,21 @@                              -- $usage                              autoMaster, AutoMaster                             ) where-import Control.Monad- import XMonad-import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier+import XMonad.Prelude+import qualified XMonad.StackSet as W +import Control.Arrow (first)++ -- $usage -- This module defines layout modifier named autoMaster. It separates -- screen in two parts - master and slave. Master windows are arranged -- in one row, in slave area underlying layout is run. Size of slave area -- automatically increases when number of slave windows is increasing. ----- You can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.AutoMaster --@@ -57,7 +60,7 @@ autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m),                                              fmap incmastern (fromMessage m)]     where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta-          resize Expand = AutoMaster k (min ( 0.4)  $ bias+delta) delta+          resize Expand = AutoMaster k (min 0.4  $ bias+delta) delta           resize Shrink = AutoMaster k (max (-0.4)  $ bias-delta) delta  -- | Main layout function@@ -73,33 +76,33 @@     let n = length ws     if null ws then         runLayout wksp rect-        else do-          if (n<=k) then-              return ((divideRow rect ws),Nothing)+        else+          if n<=k then+              return (divideRow rect ws,Nothing)               else do               let master = take k ws-              let filtStack = stack >>= W.filter (\w -> not (w `elem` master))+              let filtStack = stack >>= W.filter (`notElem` master)               wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias)-              return ((divideRow (masterRect rect n bias) master) ++ (fst wrs),-                      snd wrs)+              return $ first (divideRow (masterRect rect n bias) master ++)+                             wrs  -- | Calculates height of master area, depending on number of windows. masterHeight :: Int -> Float -> Float-masterHeight n bias = (calcHeight n) + bias+masterHeight n bias = calcHeight n + bias     where calcHeight :: Int -> Float           calcHeight 1 = 1.0-          calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3)+          calcHeight m = if m<9 then (43/45) - fromIntegral m*(7/90) else 1/3  -- | Rectangle for master area masterRect :: Rectangle -> Int -> Float -> Rectangle masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h-    where h = round $ (fromIntegral sh)*(masterHeight n bias)+    where h = round $ fromIntegral sh*masterHeight n bias  -- | Rectangle for slave area slaveRect :: Rectangle -> Int -> Float -> Rectangle slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h-    where mh = round $ (fromIntegral sh)*(masterHeight n bias)-          h  = round $ (fromIntegral sh)*(1-masterHeight n bias)+    where mh = round $ fromIntegral sh*masterHeight n bias+          h  = round $ fromIntegral sh*(1-masterHeight n bias)  -- | Divide rectangle between windows divideRow :: Rectangle -> [a] -> [(a, Rectangle)]@@ -120,4 +123,3 @@               l a ->               ModifiedLayout AutoMaster l a autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta)-
XMonad/Layout/AvoidFloats.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-}+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.AvoidFloats+-- Description :  Avoid floats when placing tiled windows. -- Copyright   :  (c) 2014 Anders Engstrom <ankaan@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -26,16 +27,15 @@  import XMonad import XMonad.Layout.LayoutModifier+import XMonad.Prelude (fi, mapMaybe, maximumBy, sortOn) import qualified XMonad.StackSet as W -import Data.List import Data.Ord-import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S  -- $usage--- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Layout.AvoidFloats --@@ -44,8 +44,9 @@ -- -- > layoutHook = ... ||| avoidFloats Full ||| ... ----- For more detailed instructions on editing the layoutHook see:--- "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Then add appropriate key bindings, for example: --@@ -54,7 +55,7 @@ -- > ,((modm .|. shiftMask .|. controlMask, xK_b), sendMessage (AvoidFloatSet False) >> sendMessage AvoidFloatClearItems) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- Note that this module is incompatible with an old way of configuring -- "XMonad.Actions.FloatSnap". If you are having problems, please update your@@ -91,15 +92,12 @@     = AvoidFloatToggle        -- ^ Toggle between avoiding all or only selected.     | AvoidFloatSet Bool      -- ^ Set if all all floating windows should be avoided.     | AvoidFloatClearItems    -- ^ Clear the set of windows to specifically avoid.-    deriving (Typeable) - -- | Change the state of the avoid float layout modifier conserning a specific window. data AvoidFloatItemMsg a     = AvoidFloatAddItem a     -- ^ Add a window to always avoid.     | AvoidFloatRemoveItem a  -- ^ Stop always avoiding selected window.     | AvoidFloatToggleItem a  -- ^ Toggle between always avoiding selected window.-    deriving (Typeable)  instance Message AvoidFloatMsg instance Typeable a => Message (AvoidFloatItemMsg a)@@ -108,24 +106,24 @@     modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do         floating <- gets $ W.floating . windowset         case cache lm of-            Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer-            _ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)+            Just (key, mer) | key == (floating,r) -> (, Nothing) <$> runLayout w mer+            _ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)                     let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs-                    flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer+                    (, Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer         where             toRect :: WindowAttributes -> Rectangle             toRect wa = let b = fi $ wa_border_width wa                         in Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa + 2*b) (fi $ wa_height wa + 2*b)-            +             bigEnough :: Rectangle -> Bool             bigEnough rect = rect_width rect >= fi (minw lm) && rect_height rect >= fi (minh lm)              shouldAvoid a = avoidAll lm || a `S.member` chosen lm      pureMess lm m-        | Just (AvoidFloatToggle) <- fromMessage m =                               Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }+        | Just AvoidFloatToggle <- fromMessage m =                                 Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }         | Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm =              Just $ lm { avoidAll = s, cache = Nothing }-        | Just (AvoidFloatClearItems) <- fromMessage m =                           Just $ lm { chosen = S.empty, cache = Nothing }+        | Just AvoidFloatClearItems <- fromMessage m =                             Just $ lm { chosen = S.empty, cache = Nothing }         | Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing }         | Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing }         | Just (AvoidFloatToggleItem a) <- fromMessage m =                         let op = if a `S.member` chosen lm then S.delete else S.insert@@ -135,7 +133,7 @@ pruneWindows :: AvoidFloats Window -> AvoidFloats Window pruneWindows lm = case cache lm of     Nothing -> lm-    Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) }+    Just ((floating,_),_) -> lm { chosen = S.filter (`M.member` floating) (chosen lm) }  -- | Find all maximum empty rectangles (MERs) that are axis aligned. This is --   done in O(n^2) time using a modified version of the algoprithm MERAlg 1@@ -145,9 +143,9 @@ maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge     where         upAndDownEdge = findGaps br rectangles-        noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms-        downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms-        bottoms = sortBy (comparing bottom) $ splitContainers rectangles+        noneOrUpEdge = concatMap (everyLower br bottoms) bottoms+        downEdge = mapMaybe (bottomEdge br bottoms) bottoms+        bottoms = sortOn bottom $ splitContainers rectangles  everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle] everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms@@ -178,8 +176,8 @@  bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms-                              boundLeft = maximum $ left br : (filter (< right r) $ map right rs)-                              boundRight = minimum $ right br : (filter (> left r) $ map left rs)+                              boundLeft = maximum $ left br : filter (< right r) (map right rs)+                              boundRight = minimum $ right br : filter (> left r) (map left rs)                           in if any (\a -> left a <= left r && right r <= right a) rs                              then Nothing                              else mkRect boundLeft boundRight (bottom r) (bottom br)@@ -187,11 +185,11 @@ -- | Split rectangles that horizontally fully contains another rectangle --   without sharing either the left or right side. splitContainers :: [Rectangle] -> [Rectangle]-splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects+splitContainers rects = splitContainers' [] $ sortOn rect_width rects     where         splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]         splitContainers' res [] = res-        splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs+        splitContainers' res (r:rs) = splitContainers' (r:res) $ concatMap (doSplit r) rs          doSplit :: Rectangle -> Rectangle -> [Rectangle]         doSplit guide r@@ -207,7 +205,7 @@     :: Rectangle    -- ^ Bounding rectangle.     -> [Rectangle]  -- ^ List of all rectangles that can cover areas in the bounding rectangle.     -> [Rectangle]-findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs+findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortOn (Down . left) $ filter inBounds rs                      lastgap = mkRect end (right br) (top br) (bottom br)                  in lastgap?:gaps     where@@ -217,9 +215,6 @@          inBounds :: Rectangle -> Bool         inBounds r = left r < right br && left br < right r--fi :: (Integral a, Num b) => a -> b-fi x = fromIntegral x  (?:) :: Maybe a -> [a] -> [a] Just x ?: xs = x:xs
XMonad/Layout/BinaryColumn.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.BinaryColumn+-- Description :  A layout that places all windows in one column. -- Copyright   :  (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton -- License     :  BSD3-style (see LICENSE) --@@ -13,7 +14,7 @@ -- Each window is half the height of the previous, -- except for the last pair of windows. ----- Note: Originally based on 'XMonad.Layout.Column' with changes:+-- Note: Originally based on "XMonad.Layout.Column" with changes: -- -- * Adding/removing windows doesn't resize all other windows. -- (last window pair exception).@@ -82,55 +83,51 @@     heights_noflip =       let         -- Regular case: check for min size.-        f n size div False = let-          n_fl = (fromIntegral n)-          n_prev_fl = (fromIntegral (n + 1))-          div_test = min (div) (n_prev_fl)-          value_test = (toInteger (round ((fromIntegral size) / div_test)))-          value_max = size - (toInteger (min_size * n))+        f m size divide False = let+          m_fl = fromIntegral m+          m_prev_fl = fromIntegral (m + 1)+          div_test = min divide m_prev_fl+          value_test = round (fromIntegral size / div_test) :: Integer+          value_max = size - toInteger (min_size * m)           (value, divide_next, no_room) =             if value_test < value_max then-              (value_test, div, False)+              (value_test, divide, False)             else-              (value_max, n_fl, True)+              (value_max, m_fl, True)           size_next = size - value-          n_next = n - 1+          m_next = m - 1           in value-          : f n_next size_next divide_next no_room+          : f m_next size_next divide_next no_room         -- Fallback case: when windows have reached min size         -- simply create an even grid with the remaining space.-        f n size div True = let-          n_fl = (fromIntegral n)-          value_even = ((fromIntegral size) / div)-          value = (toInteger (round value_even))+        f m size divide True = let+          divide_next = fromIntegral m+          value_even = (fromIntegral size / divide)+          value = round value_even :: Integer -          n_next = n - 1+          m_next = m - 1           size_next = size - value-          divide_next = n_fl           in value-          : f n_next size_next n_fl True-        -- Last item: included twice.-        f 0 size div no_room_prev =-          [size];+          : f m_next size_next divide_next True       in f          n_init size_init divide_init False       where         n_init = n - 1-        size_init = (toInteger (rect_height rect))+        size_init = toInteger (rect_height rect)         divide_init =           if scale_abs == 0.0 then-            (fromIntegral n)+            fromIntegral n           else-            (1.0 / (0.5 * scale_abs))+            1.0 / (0.5 * scale_abs)      heights =-      if (scale < 0.0) then+      if scale < 0.0 then         Data.List.reverse (take n heights_noflip)       else         heights_noflip      ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]]-    rects = map (mkRect rect) $ zip heights ys+    rects = zipWith (curry (mkRect rect)) heights ys  mkRect :: XMonad.Rectangle   -> (Integer,XMonad.Position)
XMonad/Layout/BinarySpacePartition.hs view
@@ -1,11 +1,14 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.BinarySpacePartition+-- Description :  New windows split the focused window in half; based off of BSPWM. -- Copyright   :  (c) 2013 Ben Weitzman    <benweitzman@gmail.com> --                    2015 Anton Pirogov   <anton.pirogov@gmail.com>+--                    2019 Mateusz Karbowy <obszczymucha@gmail.com -- License     :  BSD3-style (see LICENSE) -- -- Maintainer  :  Ben Weitzman <benweitzman@gmail.com>@@ -23,16 +26,19 @@   , BinarySpacePartition   , Rotate(..)   , Swap(..)-  , ResizeDirectional(..)+  , ResizeDirectional(.., ExpandTowards, ShrinkFrom, MoveSplit)   , TreeRotate(..)   , TreeBalance(..)   , FocusParent(..)   , SelectMoveNode(..)   , Direction2D(..)+  , SplitShiftDirectional(..)   ) where  import XMonad+import XMonad.Prelude hiding (insert) import qualified XMonad.StackSet as W+import XMonad.Hooks.ManageHelpers (isMinimized) import XMonad.Util.Stack hiding (Zipper) import XMonad.Util.Types @@ -43,14 +49,10 @@  import qualified Data.Map as M import qualified Data.Set as S-import Data.List ((\\), elemIndex, foldl')-import Data.Maybe (fromMaybe, isNothing, isJust, mapMaybe, catMaybes)-import Control.Applicative-import Control.Monad import Data.Ratio ((%))  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.BinarySpacePartition --@@ -66,19 +68,21 @@ -- -- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard: ----- > , ((modm .|. altMask,               xK_l     ), sendMessage $ ExpandTowards R)--- > , ((modm .|. altMask,               xK_h     ), sendMessage $ ExpandTowards L)--- > , ((modm .|. altMask,               xK_j     ), sendMessage $ ExpandTowards D)--- > , ((modm .|. altMask,               xK_k     ), sendMessage $ ExpandTowards U)--- > , ((modm .|. altMask .|. ctrlMask , xK_l     ), sendMessage $ ShrinkFrom R)--- > , ((modm .|. altMask .|. ctrlMask , xK_h     ), sendMessage $ ShrinkFrom L)--- > , ((modm .|. altMask .|. ctrlMask , xK_j     ), sendMessage $ ShrinkFrom D)--- > , ((modm .|. altMask .|. ctrlMask , xK_k     ), sendMessage $ ShrinkFrom U)--- > , ((modm,                           xK_r     ), sendMessage Rotate)--- > , ((modm,                           xK_s     ), sendMessage Swap)--- > , ((modm,                           xK_n     ), sendMessage FocusParent)--- > , ((modm .|. ctrlMask,              xK_n     ), sendMessage SelectNode)--- > , ((modm .|. shiftMask,             xK_n     ), sendMessage MoveNode)+-- > , ((modm .|. altMask,                 xK_l     ), sendMessage $ ExpandTowards R)+-- > , ((modm .|. altMask,                 xK_h     ), sendMessage $ ExpandTowards L)+-- > , ((modm .|. altMask,                 xK_j     ), sendMessage $ ExpandTowards D)+-- > , ((modm .|. altMask,                 xK_k     ), sendMessage $ ExpandTowards U)+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_l     ), sendMessage $ ShrinkFrom R)+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_h     ), sendMessage $ ShrinkFrom L)+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_j     ), sendMessage $ ShrinkFrom D)+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_k     ), sendMessage $ ShrinkFrom U)+-- > , ((modm,                             xK_r     ), sendMessage Rotate)+-- > , ((modm,                             xK_s     ), sendMessage Swap)+-- > , ((modm,                             xK_n     ), sendMessage FocusParent)+-- > , ((modm .|. ctrlMask,                xK_n     ), sendMessage SelectNode)+-- > , ((modm .|. shiftMask,               xK_n     ), sendMessage MoveNode)+-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j     ), sendMessage $ SplitShift Prev)+-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k     ), sendMessage $ SplitShift Next) -- -- Here's an alternative key mapping, this time using additionalKeysP, -- arrow keys, and slightly different behavior when resizing windows@@ -91,9 +95,15 @@ -- > , ("M-M1-C-<Right>", sendMessage $ ExpandTowards R) -- > , ("M-M1-C-<Up>",    sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-<Down>",  sendMessage $ ExpandTowards D)--- > , ("M-s",            sendMessage $ BSP.Swap)--- > , ("M-M1-s",         sendMessage $ Rotate) ]+-- > , ("M-s",            sendMessage $ Swap)+-- > , ("M-M1-s",         sendMessage $ Rotate)+-- > , ("M-S-C-j",        sendMessage $ SplitShift Prev)+-- > , ("M-S-C-k",        sendMessage $ SplitShift Next) --+-- Note that @ExpandTowards x@, @ShrinkFrom x@, and @MoveSplit x@ are+-- the same as respectively @ExpandTowardsBy x 0.05@, @ShrinkFromBy x 0.05@+-- and @MoveSplitBy x 0.05@.+-- -- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance' -- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that -- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree,@@ -103,36 +113,55 @@ -- > , ((myModMask .|. shiftMask, xK_a),     sendMessage Equalize) -- --- |Message for rotating the binary tree around the parent node of the window to the left or right-data TreeRotate = RotateL | RotateR deriving Typeable+-- | Message for rotating the binary tree around the parent node of the window to the left or right+data TreeRotate = RotateL | RotateR instance Message TreeRotate --- |Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)-data TreeBalance = Balance | Equalize deriving Typeable+-- | Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)+data TreeBalance = Balance | Equalize instance Message TreeBalance --- |Message for resizing one of the cells in the BSP-data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D | MoveSplit Direction2D deriving Typeable+-- | Message for resizing one of the cells in the BSP+data ResizeDirectional =+        ExpandTowardsBy Direction2D Rational+      | ShrinkFromBy Direction2D Rational+      | MoveSplitBy Direction2D Rational instance Message ResizeDirectional --- |Message for rotating a split (horizontal/vertical) in the BSP-data Rotate = Rotate deriving Typeable+-- | @ExpandTowards x@ is now the equivalent of @ExpandTowardsBy x 0.05@+pattern ExpandTowards :: Direction2D -> ResizeDirectional+pattern ExpandTowards d = ExpandTowardsBy d 0.05++-- | @ShrinkFrom x@ is now the equivalent of @ShrinkFromBy x 0.05@+pattern ShrinkFrom :: Direction2D -> ResizeDirectional+pattern ShrinkFrom d = ShrinkFromBy d 0.05++-- | @MoveSplit x@ is now the equivalent of @MoveSplitBy x 0.05@+pattern MoveSplit :: Direction2D -> ResizeDirectional+pattern MoveSplit d = MoveSplitBy d 0.05++-- | Message for rotating a split (horizontal/vertical) in the BSP+data Rotate = Rotate instance Message Rotate --- |Message for swapping the left child of a split with the right child of split-data Swap = Swap deriving Typeable+-- | Message for swapping the left child of a split with the right child of split+data Swap = Swap instance Message Swap --- |Message to cyclically select the parent node instead of the leaf-data FocusParent = FocusParent deriving Typeable+-- | Message to cyclically select the parent node instead of the leaf+data FocusParent = FocusParent instance Message FocusParent --- |Message to move nodes inside the tree-data SelectMoveNode = SelectNode | MoveNode deriving Typeable+-- | Message to move nodes inside the tree+data SelectMoveNode = SelectNode | MoveNode instance Message SelectMoveNode  data Axis = Horizontal | Vertical deriving (Show, Read, Eq) +-- | Message for shifting window by splitting its neighbour+newtype SplitShiftDirectional = SplitShift Direction1D+instance Message SplitShiftDirectional+ oppositeDirection :: Direction2D -> Direction2D oppositeDirection U = D oppositeDirection D = U@@ -169,10 +198,6 @@ increaseRatio :: Split -> Rational -> Split increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta))) -resizeDiff :: Rational-resizeDiff = 0.05-- data Tree a = Leaf Int | Node { value :: a                           , left :: Tree a                           , right :: Tree a@@ -230,9 +255,7 @@ goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft  top :: Zipper a -> Zipper a-top z = case goUp z of-          Nothing -> z-          Just z' -> top z'+top z = maybe z top (goUp z)  toTree :: Zipper a -> Tree a toTree = fst . top@@ -260,10 +283,10 @@ removeCurrent (Leaf _, LeftCrumb _ r:cs) = Just (r, cs) removeCurrent (Leaf _, RightCrumb _ l:cs) = Just (l, cs) removeCurrent (Leaf _, []) = Nothing-removeCurrent (Node _ (Leaf _) r@(Node _ _ _), cs) = Just (r, cs)-removeCurrent (Node _ l@(Node _ _ _) (Leaf _), cs) = Just (l, cs)+removeCurrent (Node _ (Leaf _) r@Node{}, cs) = Just (r, cs)+removeCurrent (Node _ l@Node{} (Leaf _), cs) = Just (l, cs) removeCurrent (Node _ (Leaf _) (Leaf _), cs) = Just (Leaf 0, cs)-removeCurrent z@(Node _ _ _, _) = goLeft z >>= removeCurrent+removeCurrent z@(Node{}, _) = goLeft z >>= removeCurrent  rotateCurrent :: Zipper Split -> Maybe (Zipper Split) rotateCurrent l@(_, []) = Just l@@ -273,69 +296,109 @@ swapCurrent l@(_, []) = Just l swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs) -isAllTheWay :: Direction2D -> Zipper Split -> Bool-isAllTheWay _ (_, []) = True-isAllTheWay R (_, LeftCrumb s _:_)+insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)+insertLeftLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)+insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs)+insertLeftLeaf Node{} z = Just z+insertLeftLeaf _ _ = Nothing++insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)+insertRightLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)+insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs)+insertRightLeaf Node{} z = Just z+insertRightLeaf _ _ = Nothing++findRightLeaf :: Zipper Split -> Maybe (Zipper Split)+findRightLeaf n@(Node{}, _) = goRight n >>= findRightLeaf+findRightLeaf l@(Leaf _, _) = Just l++findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)+findLeftLeaf n@(Node{}, _) = goLeft n+findLeftLeaf l@(Leaf _, _) = Just l++findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)+findTheClosestLeftmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= goLeft >>= findRightLeaf+findTheClosestLeftmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= findTheClosestLeftmostLeaf+findTheClosestLeftmostLeaf _ = Nothing++findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)+findTheClosestRightmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= findTheClosestRightmostLeaf+findTheClosestRightmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= goRight >>= findLeftLeaf+findTheClosestRightmostLeaf _ = Nothing++splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)+splitShiftLeftCurrent l@(_, []) = Just l+splitShiftLeftCurrent l@(_, (RightCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.+splitShiftLeftCurrent l@(n, _) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n++splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)+splitShiftRightCurrent l@(_, []) = Just l+splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.+splitShiftRightCurrent l@(n, _) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n++isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool+isAllTheWay _ _ (_, []) = True+isAllTheWay R _ (_, LeftCrumb s _:_)   | axis s == Vertical = False-isAllTheWay L (_, RightCrumb s _:_)+isAllTheWay L _ (_, RightCrumb s _:_)   | axis s == Vertical = False-isAllTheWay D (_, LeftCrumb s _:_)+isAllTheWay D _ (_, LeftCrumb s _:_)   | axis s == Horizontal = False-isAllTheWay U (_, RightCrumb s _:_)+isAllTheWay U _ (_, RightCrumb s _:_)   | axis s == Horizontal = False-isAllTheWay dir z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir+isAllTheWay dir diff z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir diff -expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split)-expandTreeTowards _ z@(_, []) = Just z-expandTreeTowards dir z-  | isAllTheWay dir z = shrinkTreeFrom (oppositeDirection dir) z-expandTreeTowards R (t, LeftCrumb s r:cs)-  | axis s == Vertical = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs)-expandTreeTowards L (t, RightCrumb s l:cs)-  | axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs)-expandTreeTowards D (t, LeftCrumb s r:cs)-  | axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs)-expandTreeTowards U (t, RightCrumb s l:cs)-  | axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs)-expandTreeTowards dir z = goUp z >>= expandTreeTowards dir+expandTreeTowards :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)+expandTreeTowards _ _ z@(_, []) = Just z+expandTreeTowards dir diff z+  | isAllTheWay dir diff z = shrinkTreeFrom (oppositeDirection dir) diff z+expandTreeTowards R diff (t, LeftCrumb s r:cs)+  | axis s == Vertical = Just (t, LeftCrumb (increaseRatio s diff) r:cs)+expandTreeTowards L diff (t, RightCrumb s l:cs)+  | axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-diff)) l:cs)+expandTreeTowards D diff (t, LeftCrumb s r:cs)+  | axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s diff) r:cs)+expandTreeTowards U diff (t, RightCrumb s l:cs)+  | axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-diff)) l:cs)+expandTreeTowards dir diff z = goUp z >>= expandTreeTowards dir diff -shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split)-shrinkTreeFrom _ z@(_, []) = Just z-shrinkTreeFrom R z@(_, LeftCrumb s _:_)-  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L-shrinkTreeFrom L z@(_, RightCrumb s _:_)-  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R-shrinkTreeFrom D z@(_, LeftCrumb s _:_)-  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U-shrinkTreeFrom U z@(_, RightCrumb s _:_)-  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D-shrinkTreeFrom dir z = goUp z >>= shrinkTreeFrom dir+shrinkTreeFrom :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)+shrinkTreeFrom _ _ z@(_, []) = Just z+shrinkTreeFrom R diff z@(_, LeftCrumb s _:_)+  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L diff+shrinkTreeFrom L diff z@(_, RightCrumb s _:_)+  | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R diff+shrinkTreeFrom D diff z@(_, LeftCrumb s _:_)+  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U diff+shrinkTreeFrom U diff z@(_, RightCrumb s _:_)+  | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D diff+shrinkTreeFrom dir diff z = goUp z >>= shrinkTreeFrom dir diff  -- Direction2D refers to which direction the divider should move.-autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)-autoSizeTree _ z@(_, []) = Just z-autoSizeTree d z =-    Just z >>= getSplit (toAxis d) >>= resizeTree d+autoSizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)+autoSizeTree _ _ z@(_, []) = Just z+autoSizeTree d f z =+    Just z >>= getSplit (toAxis d) >>= resizeTree d f  -- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST.-resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)-resizeTree _ z@(_, []) = Just z-resizeTree R z@(_, LeftCrumb _ _:_) =-  Just z >>= expandTreeTowards R-resizeTree L z@(_, LeftCrumb _ _:_) =-  Just z >>= shrinkTreeFrom    R-resizeTree U z@(_, LeftCrumb _ _:_) =-  Just z >>= shrinkTreeFrom    D-resizeTree D z@(_, LeftCrumb _ _:_) =-  Just z >>= expandTreeTowards D-resizeTree R z@(_, RightCrumb _ _:_) =-  Just z >>= shrinkTreeFrom    L-resizeTree L z@(_, RightCrumb _ _:_) =-  Just z >>= expandTreeTowards L-resizeTree U z@(_, RightCrumb _ _:_) =-  Just z >>= expandTreeTowards U-resizeTree D z@(_, RightCrumb _ _:_) =-  Just z >>= shrinkTreeFrom    U+resizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)+resizeTree _ _ z@(_, []) = Just z+resizeTree R diff z@(_, LeftCrumb _ _:_) =+  Just z >>= expandTreeTowards R diff+resizeTree L diff z@(_, LeftCrumb _ _:_) =+  Just z >>= shrinkTreeFrom    R diff+resizeTree U diff z@(_, LeftCrumb _ _:_) =+  Just z >>= shrinkTreeFrom    D diff+resizeTree D diff z@(_, LeftCrumb _ _:_) =+  Just z >>= expandTreeTowards D diff+resizeTree R diff z@(_, RightCrumb _ _:_) =+  Just z >>= shrinkTreeFrom    L diff+resizeTree L diff z@(_, RightCrumb _ _:_) =+  Just z >>= expandTreeTowards L diff+resizeTree U diff z@(_, RightCrumb _ _:_) =+  Just z >>= expandTreeTowards U diff+resizeTree D diff z@(_, RightCrumb _ _:_) =+  Just z >>= shrinkTreeFrom    U diff  getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split) getSplit _ (_, []) = Nothing@@ -363,13 +426,15 @@ resizeSplit _ _ z@(_, []) = Just z resizeSplit dir (xsc,ysc) z = case goToBorder dir z of   Nothing -> Just z-  Just (t, crumb) -> Just $ case dir of+  Just (t@Node{}, crumb) -> Just $ case dir of     R -> (t{value=sp{ratio=scaleRatio (ratio sp) xsc}}, crumb)     D -> (t{value=sp{ratio=scaleRatio (ratio sp) ysc}}, crumb)     L -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) xsc}}, crumb)     U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb)     where sp = value t           scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac+  Just (Leaf{}, _) ->+    undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf)  -- starting from a leaf, go to node representing a border of the according window goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)@@ -445,7 +510,7 @@ nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int nodeRefToLeaf n (Just z) = case goToNode n z of   Just (Leaf l, _) -> Just l-  Just (Node _ _ _, _) -> Nothing+  Just (Node{}, _) -> Nothing   Nothing -> Nothing nodeRefToLeaf _ Nothing = Nothing @@ -513,21 +578,27 @@ swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b swapNth b = doToNth swapCurrent b -growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a-growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP-growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b-growNthTowards dir b = doToNth (expandTreeTowards dir) b+splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a+splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP+splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b+splitShiftNth Prev b = doToNth splitShiftLeftCurrent b+splitShiftNth Next b = doToNth splitShiftRightCurrent b -shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a-shrinkNthFrom _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP-shrinkNthFrom _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b-shrinkNthFrom dir b = doToNth (shrinkTreeFrom dir) b+growNthTowards :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a+growNthTowards _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP+growNthTowards _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b+growNthTowards dir diff b = doToNth (expandTreeTowards dir diff) b -autoSizeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a-autoSizeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP-autoSizeNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b-autoSizeNth dir b = doToNth (autoSizeTree dir) b+shrinkNthFrom :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a+shrinkNthFrom _ _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP+shrinkNthFrom _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b+shrinkNthFrom dir diff b = doToNth (shrinkTreeFrom dir diff) b +autoSizeNth :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a+autoSizeNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP+autoSizeNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b+autoSizeNth dir diff b = doToNth (autoSizeTree dir diff) b+ resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP resizeSplitNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b@@ -624,22 +695,25 @@ -- some helpers to filter windows -- getFloating :: X [Window]-getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows+getFloating = M.keys . W.floating <$> gets windowset -- all floating windows +getHidden :: X [Window]+getHidden = getStackSet >>= filterM (runQuery isMinimized) . W.integrate'+ getStackSet :: X (Maybe (W.Stack Window))-getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating)+getStackSet = W.stack . W.workspace . W.current <$> gets windowset -- windows on this WS (with floating)  getScreenRect :: X Rectangle-getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset+getScreenRect = screenRect . W.screenDetail . W.current <$> gets windowset -withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)-withoutFloating fs = maybe Nothing (unfloat fs)+withoutFloating :: [Window] -> [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)+withoutFloating fs hs = maybe Nothing (unfloat fs hs)  -- ignore messages if current focus is on floating window, otherwise return stack without floating-unfloat :: [Window] -> W.Stack Window -> Maybe (W.Stack Window)-unfloat fs s = if W.focus s `elem` fs+unfloat :: [Window] -> [Window] -> W.Stack Window -> Maybe (W.Stack Window)+unfloat fs hs s = if W.focus s `elem` fs       then Nothing-      else Just $ s{W.up = W.up s \\ fs, W.down = W.down s \\ fs}+      else Just $ s{W.up = W.up s \\ (fs ++ hs), W.down = W.down s \\ (fs ++ hs)}  instance LayoutClass BinarySpacePartition Window where   doLayout b r s = do@@ -673,9 +747,10 @@    | otherwise = do        ws <- getStackSet        fs <- getFloating+       hs <- getHidden        r <- getScreenRect        -- removeBorder $ refWins $ getSelectedNode b-       let lws = withoutFloating fs ws                                    -- tiled windows on WS+       let lws = withoutFloating fs hs ws                                 -- tiled windows on WS            lfs = maybe [] W.integrate ws \\ maybe [] W.integrate lws      -- untiled windows on WS            b'  = handleMesg r                -- transform tree (concerns only tiled windows)            ws' = adjustStack ws lws lfs b'   -- apply transformation to window stack, reintegrate floating wins@@ -687,10 +762,11 @@                               , fmap rotateTr      (fromMessage m)                               , fmap (balanceTr r) (fromMessage m)                               , fmap move          (fromMessage m)+                              , fmap splitShift    (fromMessage m)                               ]-          resize (ExpandTowards dir) = growNthTowards dir b-          resize (ShrinkFrom dir) = shrinkNthFrom dir b-          resize (MoveSplit dir) = autoSizeNth dir b+          resize (ExpandTowardsBy dir diff) = growNthTowards dir diff b+          resize (ShrinkFromBy dir diff) = shrinkNthFrom dir diff b+          resize (MoveSplitBy dir diff) = autoSizeNth dir diff b           rotate Rotate = resetFoc $ rotateNth b           swap Swap = resetFoc $ swapNth b           rotateTr RotateL = resetFoc $ rotateTreeNth L b@@ -699,10 +775,11 @@           balanceTr r Balance  = resetFoc $ rebalanceNth b r           move MoveNode = resetFoc $ moveNode b           move SelectNode = b --should not happen here, is done above, as we need X monad+          splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b            b = numerateLeaves b_orig-          resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}-                            ,getSelectedNode=(getSelectedNode bsp){refLeaf=(-1)}}+          resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf= -1}+                            ,getSelectedNode=(getSelectedNode bsp){refLeaf= -1}}    description _  = "BSP" @@ -711,6 +788,7 @@ handleResize b (SetGeometry newrect@(Rectangle _ _ w h)) = do   ws <- getStackSet   fs <- getFloating+  hs <- getHidden   case W.focus <$> ws of     Nothing -> return Nothing     Just win -> do@@ -719,7 +797,7 @@       let (xsc,ysc)   = (fi w % fi ow, fi h % fi oh)           (xsc',ysc') = (rough xsc, rough ysc)           dirs = changedDirs oldrect newrect (fi mx,fi my)-          n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs ws+          n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs hs ws       -- unless (isNothing dir) $ debug $       --       show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh)       --       ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my)@@ -750,7 +828,7 @@             else return b     b'' <- if force then return b'{getSelectedNode=noRef} else return b'     renderBorders r b''-  where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getStackSet)+  where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getHidden <*> getStackSet)  -- create border around focused node if necessary renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)@@ -779,8 +857,8 @@               ]   ws <- mapM (\r -> createNewWindow r Nothing bc False) rects   showWindows ws-  maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) <$> getStackSet >>= replaceStack-  M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset <$> get >>= replaceFloating+  replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) =<< getStackSet+  replaceFloating . M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset =<< get   modify (\s -> s{mapped=mapped s `S.union` S.fromList ws})   -- show <$> mapM isClient ws >>= debug   return ws@@ -790,6 +868,6 @@ removeBorder :: [Window] -> X () removeBorder ws = do   modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws})-  flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating-  maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack+  replaceFloating . flip (foldl (flip M.delete)) ws . W.floating . windowset =<< get+  replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) =<< getStackSet   deleteWindows ws
XMonad/Layout/BorderResize.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.BorderResize+-- Description :  Resize windows by dragging their borders with the mouse. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -23,6 +24,7 @@     ( -- * Usage       -- $usage       borderResize+    , borderResizeNear     , BorderResize (..)     , RectWithBorders, BorderInfo,     ) where@@ -31,12 +33,12 @@ import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils-import Control.Monad(when)+import XMonad.Prelude(when) import qualified Data.Map as M  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.BorderResize -- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...)@@ -57,27 +59,34 @@  type RectWithBorders = (Rectangle, [BorderInfo]) -data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)--brBorderSize :: Dimension-brBorderSize = 2+data BorderResize a = BR+  { brBorderSize  :: !Dimension+  -- ^ Still resize when this number of pixels around the border.+  , brWrsLastTime :: !(M.Map Window RectWithBorders)+  }+  deriving (Show, Read)  borderResize :: l a -> ModifiedLayout BorderResize l a-borderResize = ModifiedLayout (BR M.empty)+borderResize = borderResizeNear 2 +-- | Like 'borderResize', but takes the number of pixels near the border+-- up to which dragging still resizes a window.+borderResizeNear :: Dimension -> l a -> ModifiedLayout BorderResize l a+borderResizeNear borderSize = ModifiedLayout (BR borderSize M.empty)+ instance LayoutModifier BorderResize Window where     redoLayout _       _ Nothing  wrs = return (wrs, Nothing)-    redoLayout (BR wrsLastTime) _ _ wrs = do+    redoLayout (BR borderSize wrsLastTime) _ _ wrs = do             let correctOrder = map fst wrs                 wrsCurrent = M.fromList wrs                 wrsGone = M.difference wrsLastTime wrsCurrent                 wrsAppeared = M.difference wrsCurrent wrsLastTime                 wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent             handleGone wrsGone-            wrsCreated <- handleAppeared wrsAppeared-            let wrsChanged = handleStillThere wrsStillThere+            wrsCreated <- handleAppeared borderSize wrsAppeared+            let wrsChanged = handleStillThere borderSize wrsStillThere                 wrsThisTime = M.union wrsChanged wrsCreated-            return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime)+            return (compileWrs wrsThisTime correctOrder, Just $ BR borderSize wrsThisTime)             -- What we return is the original wrs with the new border             -- windows inserted at the correct positions - this way, the core             -- will restack the borders correctly.@@ -90,16 +99,16 @@                     then (Nothing, entry)                     else (Just rCurrent, entry) -    handleMess (BR wrsLastTime) m+    handleMess (BR borderSize wrsLastTime) m         | Just e <- fromMessage m :: Maybe Event =             handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing         | Just _ <- fromMessage m :: Maybe LayoutMessages =-            handleGone wrsLastTime >> return (Just $ BR M.empty)+            handleGone wrsLastTime >> return (Just $ BR borderSize M.empty)     handleMess _ _ = return Nothing  compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder-                                      in concat $ map compileWr wrs+                                      in concatMap compileWr wrs  compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)] compileWr (w, (r, borderInfos)) =@@ -109,73 +118,73 @@ handleGone :: M.Map Window RectWithBorders -> X () handleGone wrsGone = mapM_ deleteWindow borderWins     where-        borderWins = map bWin . concat . map snd . M.elems $ wrsGone+        borderWins = map bWin . concatMap snd . M.elems $ wrsGone -handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders)-handleAppeared wrsAppeared = do+handleAppeared :: Dimension -> M.Map Window Rectangle -> X (M.Map Window RectWithBorders)+handleAppeared borderSize wrsAppeared = do     let wrs = M.toList wrsAppeared-    wrsCreated <- mapM handleSingleAppeared wrs+    wrsCreated <- mapM (handleSingleAppeared borderSize) wrs     return $ M.fromList wrsCreated -handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders)-handleSingleAppeared (w, r) = do-    let borderBlueprints = prepareBorders r+handleSingleAppeared :: Dimension ->(Window, Rectangle) -> X (Window, RectWithBorders)+handleSingleAppeared borderSize (w, r) = do+    let borderBlueprints = prepareBorders borderSize r     borderInfos <- mapM createBorder borderBlueprints     return (w, (r, borderInfos)) -handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders-handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere+handleStillThere :: Dimension -> M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders+handleStillThere borderSize = M.map (handleSingleStillThere borderSize) -handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders-handleSingleStillThere (Nothing, entry) = entry-handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)+handleSingleStillThere :: Dimension -> (Maybe Rectangle, RectWithBorders) -> RectWithBorders+handleSingleStillThere _            (Nothing, entry)                  = entry+handleSingleStillThere borderSize (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)     where-        changedBorderBlueprints = prepareBorders rCurrent-        updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints+        changedBorderBlueprints = prepareBorders borderSize rCurrent+        updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints           -- assuming that the four borders are always in the same order  updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r }  createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))]-createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime+createBorderLookupTable wrsLastTime = concatMap processSingleEntry (M.toList wrsLastTime)     where         processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]         processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) -prepareBorders :: Rectangle -> [BorderBlueprint]-prepareBorders (Rectangle x y wh ht) =-    [((Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder),-     ((Rectangle x y brBorderSize ht)                            , xC_left_side  , LeftSideBorder),-     ((Rectangle x y wh brBorderSize)                            , xC_top_side   , TopSideBorder),-     ((Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize), xC_bottom_side, BottomSideBorder)+prepareBorders :: Dimension -> Rectangle -> [BorderBlueprint]+prepareBorders borderSize (Rectangle x y wh ht) =+    [(Rectangle (x + fi wh - fi borderSize) y borderSize ht, xC_right_side , RightSideBorder),+     (Rectangle x y borderSize ht                          , xC_left_side  , LeftSideBorder),+     (Rectangle x y wh borderSize                          , xC_top_side   , TopSideBorder),+     (Rectangle x (y + fi ht - fi borderSize) wh borderSize, xC_bottom_side, BottomSideBorder)     ]  handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }     | et == buttonPress, Just edge <- lookup ew borders =     case edge of-        (RightSideBorder, hostWin, (Rectangle hx hy _ hht)) ->+        (RightSideBorder, hostWin, Rectangle hx hy _ hht) ->             mouseDrag (\x _ -> do                             let nwh = max 1 $ fi (x - hx)                                 rect = Rectangle hx hy nwh hht                             focus hostWin                             when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)-        (LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->+        (LeftSideBorder, hostWin, Rectangle hx hy hwh hht) ->             mouseDrag (\x _ -> do-                            let nx = max 0 $ min (hx + fi hwh) $ x+                            let nx = max 0 $ min (hx + fi hwh) x                                 nwh = max 1 $ hwh + fi (hx - x)                                 rect = Rectangle nx hy nwh hht                             focus hostWin                             when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin)-        (TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->+        (TopSideBorder, hostWin, Rectangle hx hy hwh hht) ->             mouseDrag (\_ y -> do-                            let ny = max 0 $ min (hy + fi hht) $ y+                            let ny = max 0 $ min (hy + fi hht) y                                 nht = max 1 $ hht + fi (hy - y)                                 rect = Rectangle hx ny hwh nht                             focus hostWin                             when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin)-        (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) ->+        (BottomSideBorder, hostWin, Rectangle hx hy hwh _) ->             mouseDrag (\_ y -> do                             let nht = max 1 $ fi (y - hy)                                 rect = Rectangle hx hy hwh nht@@ -183,7 +192,7 @@                             when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) handleResize _ _ = return () -createBorder :: BorderBlueprint -> X (BorderInfo)+createBorder :: BorderBlueprint -> X BorderInfo createBorder (borderRect, borderCursor, borderType) = do     borderWin <- createInputWindow borderCursor borderRect     return BI { bWin = borderWin, bRect = borderRect, bType = borderType }@@ -214,10 +223,10 @@  reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order =-    let ordered = concat $ map (pickElem wrs) order-        rest = filter (\(w, _) -> not (w `elem` order)) wrs+    let ordered = concatMap (pickElem wrs) order+        rest = filter (\(w, _) -> w `notElem` order) wrs     in ordered ++ rest     where-        pickElem list e = case (lookup e list) of+        pickElem list e = case lookup e list of                                 Just result -> [(e, result)]                                 Nothing -> []
XMonad/Layout/BoringWindows.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.BoringWindows+-- Description :  Mark windows as boring. -- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -18,8 +19,10 @@                                    -- * Usage                                    -- $usage                                    boringWindows, boringAuto,-                                   markBoring, clearBoring,-                                   focusUp, focusDown, focusMaster,+                                   markBoring, markBoringEverywhere,+                                   clearBoring, focusUp, focusDown,+                                   focusMaster, swapUp, swapDown,+                                   siftUp, siftDown,                                     UpdateBoring(UpdateBoring),                                    BoringMessage(Replace,Merge),@@ -32,17 +35,17 @@  import XMonad.Layout.LayoutModifier(ModifiedLayout(..),                                     LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))-import XMonad(Typeable, LayoutClass, Message, X, fromMessage,-              sendMessage, windows, withFocused, Window)-import Control.Applicative((<$>))-import Data.List((\\), union)-import Data.Maybe(fromMaybe, listToMaybe, maybeToList)+import XMonad(LayoutClass, Message, X, fromMessage,+              broadcastMessage, sendMessage, windows, withFocused, Window)+import XMonad.Prelude+import XMonad.Util.Stack (reverseS)+import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import qualified XMonad.StackSet as W  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.BoringWindows --@@ -57,36 +60,48 @@ -- > , ((modm, xK_k), focusDown) -- > , ((modm, xK_m), focusMaster) ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".   data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring                      | Replace String [Window]                      | Merge String [Window]-                     deriving ( Read, Show, Typeable )+                     | SwapUp+                     | SwapDown+                     | SiftUp+                     | SiftDown+                     deriving ( Read, Show )  instance Message BoringMessage  -- | UpdateBoring is sent before attempting to view another boring window, so -- that layouts have a chance to mark boring windows. data UpdateBoring = UpdateBoring-    deriving (Typeable) instance Message UpdateBoring -markBoring, clearBoring, focusUp, focusDown, focusMaster :: X ()+markBoring, clearBoring, focusUp, focusDown, focusMaster, swapUp, swapDown, siftUp, siftDown :: X () markBoring = withFocused (sendMessage . IsBoring) clearBoring = sendMessage ClearBoring focusUp = sendMessage UpdateBoring >> sendMessage FocusUp focusDown = sendMessage UpdateBoring >> sendMessage FocusDown focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster+swapUp = sendMessage UpdateBoring >> sendMessage SwapUp+swapDown = sendMessage UpdateBoring >> sendMessage SwapDown+siftUp = sendMessage UpdateBoring >> sendMessage SiftUp+siftDown = sendMessage UpdateBoring >> sendMessage SiftDown +-- | Mark current focused window boring for all layouts.+-- This is useful in combination with the "XMonad.Actions.CopyWindow" module.+markBoringEverywhere :: X ()+markBoringEverywhere = withFocused (broadcastMessage . IsBoring)+ data BoringWindows a = BoringWindows     { namedBoring :: M.Map String [a] -- ^ store borings with a specific source     , chosenBoring :: [a]             -- ^ user-chosen borings     , hiddenBoring :: Maybe [a]       -- ^ maybe mark hidden windows-    } deriving (Show,Read,Typeable)+    } deriving (Show,Read)  boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing)@@ -96,13 +111,13 @@ boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just []))  instance LayoutModifier BoringWindows Window where-    redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do+    redoLayout b@BoringWindows{ hiddenBoring = bs } _r mst arrs = do         let bs' = W.integrate' mst \\ map fst arrs-        return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } )+        return (arrs, Just $ b { hiddenBoring = bs' <$ bs } )      handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m         | Just (Replace k ws) <- fromMessage m-        , maybe True (ws/=) (M.lookup k nbs) =+        , Just ws /= M.lookup k nbs =             let nnb = if null ws then M.delete k nbs                           else M.insert k ws nbs             in rjl bst { namedBoring = nnb }@@ -125,10 +140,27 @@                                             . skipBoring W.focusUp'   -- no boring window gets the focus                                             . focusMaster'                                return Nothing-        where skipBoring f st = fromMaybe st $ listToMaybe-                                $ filter ((`notElem` W.focus st:bs) . W.focus)-                                $ take (length $ W.integrate st)-                                $ iterate f st+        | Just SwapUp <- fromMessage m =+                            do windows $ W.modify' skipBoringSwapUp+                               return Nothing+        | Just SwapDown <- fromMessage m =+                            do windows $ W.modify' (reverseS . skipBoringSwapUp . reverseS)+                               return Nothing+        | Just SiftUp <- fromMessage m =+                            do windows $ W.modify' (siftUpSkipping bs)+                               return Nothing+        | Just SiftDown <- fromMessage m =+                            do windows $ W.modify' (reverseS . siftUpSkipping bs . reverseS)+                               return Nothing+        where skipBoring = skipBoring' ((`notElem` bs) . W.focus)+              skipBoringSwapUp = skipBoring'+                                   (maybe True (`notElem` bs) . listToMaybe . W.down)+                                   swapUp'+              skipBoring' p f st = fromMaybe st+                                   $ find p+                                   $ drop 1+                                   $ take (length $ W.integrate st)+                                   $ iterate f st               bs = concat $ cbs:maybeToList lbs ++ M.elems nbs               rjl = return . Just . Left     handleMessOrMaybeModifyIt _ _ = return Nothing@@ -137,7 +169,20 @@ -- 'Stack' rather than an entire 'StackSet'. focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c-focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls+focusMaster' (W.Stack t (l:ls) rs) = W.Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls)++swapUp' :: W.Stack a -> W.Stack a+swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)+swapUp' (W.Stack t []     rs) = W.Stack t (reverse rs) []++siftUpSkipping :: Eq a => [a] -> W.Stack a -> W.Stack a+siftUpSkipping bs (W.Stack t ls rs)+  | (skips, l:ls') <- spanLeft  = W.Stack t ls' (reverse skips ++ l : rs)+  | (skips, r:rs') <- spanRight = W.Stack t (rs' ++ r : ls) (reverse skips)+  | otherwise                   = W.Stack t ls rs+  where+    spanLeft  = span (`elem` bs) ls+    spanRight = span (`elem` bs) (reverse rs)  {- $simplest
XMonad/Layout/ButtonDecoration.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ButtonDecoration+-- Description :  Decoration that includes buttons, executing actions when clicked on. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -32,7 +33,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationAddons -- > import XMonad.Layout.ButtonDecoration@@ -48,9 +49,9 @@            -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a buttonDeco s c = decoration s c $ NFD True -data ButtonDecoration a = NFD Bool deriving (Show, Read)+newtype ButtonDecoration a = NFD Bool deriving (Show, Read)  instance Eq a => DecorationStyle ButtonDecoration a where     describeDeco _ = "ButtonDeco"-    decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR+    decorationCatchClicksHook _ = titleBarButtonHandler     decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()
+ XMonad/Layout/CenterMainFluid.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.CenterMainFluid+-- Description :  Three column layout with master in center and unoccupied spaces reserved.+-- Copyright   :  (c) 2023 Mahdi Seyedan+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  Mahdi Seyedan. <mahdisn78@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A three column layout with main column in the center and+-- two stack columns surrounding it. There will be always+-- a pane in the center column and unoccupied spaces on the+-- sides are reserved.+-- It's best suited for ultrawide montiors, where a single+-- stretched window might be annoying.+-----------------------------------------------------------------------------++module XMonad.Layout.CenterMainFluid+  ( -- * Usage+    -- $usage+    CenterMainFluid (..)+  ) where++import XMonad+import qualified XMonad.StackSet as W+import Control.Monad (msum)++-- $usage+-- You can use this module by adding following in your @xmonad.hs@:+--+-- > import XMonad.Layout.CenterMainFluid+--+-- Then edit your @layoutHook@ by adding the CenterMainFluid layout:+--+-- > myLayoutHook = CenterMainFluid 1 (3/100) (70/100) ||| ...+-- > main = xmonad def { layoutHook = myLayout }+--+-- The first argument specifies how many windows initially appear in the center+-- column. The second argument specifies the amount to resize while resizing+-- and the third argument specifies the initial size of the center column.+--+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".+++-- | Arguments are nmaster, delta, fraction. Supports 'Shrink', 'Expand' and+-- 'IncMasterN'+data CenterMainFluid a = CenterMainFluid+  { cmfNMaster :: !Int             -- ^ The default number of windows in the center pane (default: 1)+  , cmfRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100)+  , cmfRatio :: !Rational          -- ^ Default proportion of screen occupied by the center pane (default: 70/100)+  }+  deriving (Show,Read)++instance LayoutClass CenterMainFluid a where++    pureLayout (CenterMainFluid nmaster _ frac) r s+        | frac == 0 = drop nmaster layout+        | frac == 1 = take nmaster layout+        | otherwise = layout+      where layout = zip ws rs+            ws = W.integrate s+            rs = tile3 frac r nmaster (length ws)++    pureMessage (CenterMainFluid nmaster delta frac) m =+            msum [fmap resize     (fromMessage m)+                 ,fmap incmastern (fromMessage m)]++      where resize Shrink             = CenterMainFluid nmaster delta (max 0 $ frac-delta)+            resize Expand             = CenterMainFluid nmaster delta (min 1 $ frac+delta)+            incmastern (IncMasterN d) = CenterMainFluid (max 0 (nmaster+d)) delta frac++    description _ = "CenterMainFluid"++tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle]+tile3 f r nmaster n+  | nmaster <= 0 || n <= nmaster = splitVertically n middleR+  | otherwise = masters ++ rights ++ lefts+      where (leftR, middleR, rightR) = split3HorizontallyBy f r+            (halfN, remaining) = (n - nmaster) `divMod` 2+            masters = splitVertically nmaster middleR+            lefts = splitVertically halfN leftR+            rights = splitVertically (halfN + remaining) rightR++-- | Divide the screen into three rectangles, using a rational to specify the ratio of center one+split3HorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle, Rectangle)+split3HorizontallyBy f (Rectangle sx sy sw sh) =+  ( Rectangle sx sy sidew sh+  , Rectangle (sx + fromIntegral sidew) sy middlew sh+  , Rectangle (sx + fromIntegral sidew + fromIntegral middlew) sy sidew sh+  )+  where middlew = floor $ fromIntegral sw * f+        sidew = (sw - fromIntegral middlew) `div` 2
+ XMonad/Layout/CenteredIfSingle.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances  #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.CenteredIfSingle+-- Description :  If only a single window is shown, center it on screen+-- Copyright   :  (c) 2021 Leon Kowarschick+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  Leon Kowarschick. <TheElkOfWar@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier that, if there is only a single window on screen, places+-- that window in the center of the screen.+-- This is especially useful on wide screen setups, where the window would otherwise+-- be unnecessarily far away from the center of your field of vision.+--+-----------------------------------------------------------------------------++module XMonad.Layout.CenteredIfSingle+  ( -- * Usage+    -- $usage+    centeredIfSingle, CenteredIfSingle+  ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Prelude (fi)++-- $usage+-- You can use this module by including  the following in your @xmonad.hs@:+--+-- > import XMonad.Layout.CenteredIfSingle+--+-- and adding the 'centeredIfSingle' layoutmodifier to your layouts.+--+-- > myLayoutHook = centeredIfSingle 0.7 0.8 Grid ||| ...+--+-- For more information on configuring your layouts see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>+-- and "XMonad.Doc.Extending".+++-- | Layout Modifier that places a window in the center of the screen,+-- leaving room on the left and right if there is only a single window.+-- The first argument is the horizontal and the second one the vertical+-- ratio of the screen the centered window should take up.  Both numbers+-- should be between 0.0 and 1.0.+data CenteredIfSingle a = CenteredIfSingle !Double !Double+  deriving (Show, Read)++instance LayoutModifier CenteredIfSingle Window where+  pureModifier (CenteredIfSingle ratioX ratioY) r _ [(onlyWindow, _)] = ([(onlyWindow, rectangleCenterPiece ratioX ratioY r)], Nothing)+  pureModifier _ _ _ winRects = (winRects, Nothing)++-- | Layout Modifier that places a window in the center of the screen,+-- leaving room on all sides if there is only a single window+centeredIfSingle :: Double -- ^ Horizontal ratio of the screen the centered window should take up; should be a value between 0.0 and 1.0+                 -> Double -- ^ Vertical ratio; should also be a value between 0.0 and 1.0+                 -> l a    -- ^ The layout that will be used if more than one window is open+                 -> ModifiedLayout CenteredIfSingle l a+centeredIfSingle ratioX ratioY = ModifiedLayout (CenteredIfSingle ratioX ratioY)++-- | Calculate the center piece of a rectangle given the percentage of the outer rectangle it should occupy.+rectangleCenterPiece :: Double -> Double -> Rectangle -> Rectangle+rectangleCenterPiece ratioX ratioY (Rectangle rx ry rw rh) = Rectangle startX startY width height+  where+    startX = rx + left+    startY = ry + top++    width  = newSize rw left+    height = newSize rh top++    left = rw `scaleBy` ratioX+    top  = rh `scaleBy` ratioY++newSize :: Dimension -> Position -> Dimension+newSize dim pos = fi $ fi dim - pos * 2++scaleBy :: Dimension -> Double -> Position+scaleBy dim ratio = floor $ fi dim * (1.0 - ratio) / 2
XMonad/Layout/CenteredMaster.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.CenteredMaster+-- Description :  Place the master pane on top of other windows; in the center or top right. -- Copyright   :  (c) 2009 Ilya Portnov -- License     :  BSD-style (see xmonad/LICENSE) --@@ -29,13 +30,15 @@ import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W +import Control.Arrow (first)+ -- $usage -- This module defines two new layout modifiers: centerMaster and topRightMaster. -- centerMaster places master window at center of screen, on top of others. -- All other windows in background are managed by base layout. -- topRightMaster is like centerMaster, but places master window in top right corner instead of center. ----- Yo can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.CenteredMaster --@@ -76,15 +79,13 @@  applyPosition pos wksp rect = do   let stack = W.stack wksp-  let ws = W.integrate' $ stack-  if null ws then-     runLayout wksp rect-     else do-       let first = head ws-       let other = tail ws-       let filtStack = stack >>= W.filter (first /=)+  let ws = W.integrate' stack+  case ws of+    []               -> runLayout wksp rect+    (firstW : other) -> do+       let filtStack = stack >>= W.filter (firstW /=)        wrs <- runLayout (wksp {W.stack = filtStack}) rect-       return ((first, place pos other rect) : fst wrs, snd wrs)+       return $ first ((firstW, place pos other rect) :) wrs  -- | Place master window (it's Rectangle is given), using the given Positioner. -- If second argument is empty (that is, there is only one window on workspace),@@ -107,5 +108,3 @@         h = round (fromIntegral sh * ry)         x = sx + fromIntegral (sw-w) `div` 2         y = sy + fromIntegral (sh-h) `div` 2--
XMonad/Layout/Circle.hs view
@@ -1,8 +1,10 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Circle+-- Description :  An elliptical, overlapping layout. -- Copyright   :  (c) Peter De Wachter -- License     :  BSD-style (see LICENSE) --@@ -14,18 +16,17 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.Circle (-                             -- * Usage-                             -- $usage-                             Circle (..)-                            ) where -- actually it's an ellipse+module XMonad.Layout.Circle {-# DEPRECATED "Use XMonad.Layout.CircleEx instead" #-}+  ( -- * Usage+    -- $usage+    pattern Circle+  ) where -- actually it's an ellipse -import Data.List-import XMonad-import XMonad.StackSet (integrate, peek)+import GHC.Real (Ratio(..))+import XMonad.Layout.CircleEx  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Circle --@@ -34,42 +35,10 @@ -- > myLayout = Circle ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"--data Circle a = Circle deriving ( Read, Show )--instance LayoutClass Circle Window where-    doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s-                             return (layout, Nothing)--circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]-circleLayout _ []     = []-circleLayout r (w:ws) = master : rest-    where master = (w, center r)-          rest   = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..]--raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]-raiseFocus xs = do focused <- withWindowSet (return . peek)-                   return $ case find ((== focused) . Just . fst) xs of-                              Just x  -> x : delete x xs-                              Nothing -> xs--center :: Rectangle -> Rectangle-center (Rectangle sx sy sw sh) = Rectangle x y w h-    where s = sqrt 2 :: Double-          w = round (fromIntegral sw / s)-          h = round (fromIntegral sh / s)-          x = sx + fromIntegral (sw - w) `div` 2-          y = sy + fromIntegral (sh - h) `div` 2+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -satellite :: Rectangle -> Double -> Rectangle-satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a))-                                                (sy + round (ry + ry * sin a))-                                                w h-    where rx = fromIntegral (sw - w) / 2-          ry = fromIntegral (sh - h) / 2-          w = sw * 10 `div` 25-          h = sh * 10 `div` 25+pattern Circle :: CircleEx a+pattern Circle = CircleEx 1 (70 :% 99) (2 :% 5) 1 0
+ XMonad/Layout/CircleEx.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.CircleEx+-- Description :  An elliptical, overlapping layout—extended version.+-- Copyright   :  (c) Peter De Wachter, Ilya V. Portnov+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Ilya V. Portnov <portnov84@rambler.ru>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Circle is an elliptical, overlapping layout. Original code by Peter De Wachter,+-- extended by Ilya Porntov.+-----------------------------------------------------------------------------++module XMonad.Layout.CircleEx (+    -- * Usage+    -- $usage+    CircleEx (..), circle, circleEx,+    CircleExMsg (..)+  )+  where++import Data.Ratio++import XMonad+import XMonad.StackSet (Stack)+import XMonad.Prelude+import qualified XMonad.StackSet as W++-- $usage+--+-- The layout puts the first N windows (called master) into the center of+-- screen. All others (called secondary, or stack) are organized in a circle+-- (well, ellipse). When opening a new secondary window, its size will be+-- slightly smaller than that of its predecessor (this is configurable). If+-- the number of master windows is set to zero, all windows will be arranged+-- in a circle. If there is more than one master window, they will be stacked+-- in the center on top of each other. The size of each additional master+-- window will again be slightly smaller than that of the former.+--+-- Since a picture says more than a thousand words, you see one+-- <https://github.com/xmonad/xmonad-contrib/assets/50166980/90ef1273-5201-4380-8b94-9e62d3c98e1c here>.+--+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Layout.CircleEx+--+-- Then edit your @layoutHook@ by adding the 'CircleEx' layout:+--+-- > myCircle = circleEx {cDelta = -3*pi/4}+-- > myLayout = myCircle ||| Full ||| etc..+-- > main = xmonad def { layoutHook = myLayout }+--+-- This layout understands standard messages:+--+-- * 'IncMasterN': increase or decrease the number of master windows.+-- * 'Shrink' and 'Expand': change the size of master windows.+--+-- More layout-specific messages are also supported, see 'CircleExMsg' below.+--+-- For more detailed instructions on editing the layoutHook see:+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | The layout data type. It is recommended to not use the 'CircleEx' data+-- constructor directly, and instead rely on record update syntax; for+-- example: @circleEx {cMasterRatio = 4%5}@. In this way you can avoid nasty+-- surprises if one day additional fields are added to @CircleEx@.+data CircleEx a = CircleEx+    { cNMaster :: !Int          -- ^ Number of master windows. Default value is 1.+    , cMasterRatio :: !Rational -- ^ Size of master window in relation to screen size.+                                --   Default value is @4%5@.+    , cStackRatio :: !Rational  -- ^ Size of first secondary window in relation to screen size.+                                --   Default value is @3%5@.+    , cMultiplier :: !Rational  -- ^ Coefficient used to calculate the sizes of subsequent secondary+                                --   windows. The size of the next window is calculated as the+                                --   size of the previous one multiplied by this value.+                                --   This value is also used to scale master windows, in case+                                --   there is more than one.+                                --   Default value is @5%6@. Set this to 1 if you want all secondary+                                --   windows to have the same size.+    , cDelta :: !Double         -- ^ Angle of rotation of the whole circle layout. Usual values+                                --   are from 0 to 2π, although it will work outside+                                --   this range as well. Default value of 0 means that the first+                                --   secondary window will be placed at the right side of screen.+    } deriving (Eq, Show, Read)++-- | Circle layout with default settings:+--+-- * Number of master windows is set to 1+-- * @cMasterRatio@ is set to @70/99@, which is nearly @1/sqrt(2)@+-- * @cStackRatio@ is set to @2/5@+-- * @cMultiplier@ is set to 1, which means all secondary windows+--   will have the same size+--+-- This can be used as a drop-in replacement for "XMonad.Layout.Circle".+circle :: CircleEx a+circle = CircleEx 1 (70%99) (2%5) 1 0++-- | Another variant of default settings for circle layout:+--+-- * Number of master windows is set to 1+-- * @cMasterRatio@ is set to @4/5@+-- * @cStackRatio@ is set to @3/5@+-- * @cMultiplier@ is set to @5/6@+--+circleEx :: CircleEx a+circleEx = CircleEx 1 (4%5) (3%5) (5%6) 0++-- | Specific messages understood by CircleEx layout.+data CircleExMsg+  = Rotate !Double            -- ^ Rotate secondary windows by specific angle+  | IncStackRatio !Rational   -- ^ Increase (or decrease, with negative value) sizes of secondary windows+  | IncMultiplier !Rational   -- ^ Increase 'cMultiplier'.+  deriving (Eq, Show)++instance Message CircleExMsg++instance LayoutClass CircleEx Window where+  doLayout :: CircleEx Window -> Rectangle -> Stack Window -> X ([(Window, Rectangle)], Maybe (CircleEx Window))+  doLayout layout rect stack = do+    result <- raiseFocus $ circleLayout layout rect $ W.integrate stack+    return (result, Nothing)++  pureMessage :: CircleEx Window -> SomeMessage -> Maybe (CircleEx Window)+  pureMessage layout m =+      msum [changeMasterN <$> fromMessage m,+            resize <$> fromMessage m,+            specific <$> fromMessage m]+    where+      deltaSize = 11 % 10++      resize :: Resize -> CircleEx a+      resize Shrink = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout / deltaSize}+      resize Expand = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout * deltaSize}++      changeMasterN :: IncMasterN -> CircleEx a+      changeMasterN (IncMasterN d) = layout {cNMaster = max 0 (cNMaster layout + d)}++      specific :: CircleExMsg -> CircleEx a+      specific (Rotate delta) = layout {cDelta = delta + cDelta layout}+      specific (IncStackRatio delta) = layout {cStackRatio = max 0.1 $ min 2.0 $ delta + cStackRatio layout}+      specific (IncMultiplier delta) = layout {cMultiplier = max 0.1 $ min 2.0 $ delta + cMultiplier layout}++circleLayout :: CircleEx a -> Rectangle -> [a] -> [(a, Rectangle)]+circleLayout _ _ [] = []+circleLayout (CircleEx {..}) rectangle wins =+    master (take cNMaster wins) ++ rest (drop cNMaster wins)+  where+    master :: [a] -> [(a, Rectangle)]+    master ws = zip ws $ map (placeCenter cMasterRatio cMultiplier rectangle)+                           [cNMaster-1, cNMaster-2 .. 0]+    rest :: [a] -> [(a, Rectangle)]+    rest ws = zip ws $ zipWith (placeSatellite cStackRatio cMultiplier rectangle)+                        (map (+ cDelta) [0, pi*2 / fromIntegral (length ws) ..])+                        [0 ..]+++raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]+raiseFocus wrs = do+  focused <- withWindowSet (return . W.peek)+  return $ case find ((== focused) . Just . fst) wrs of+             Just x  -> x : delete x wrs+             Nothing -> wrs++placeCenter :: Rational -> Rational -> Rectangle -> Int -> Rectangle+placeCenter ratio multiplier (Rectangle x y width height) n = Rectangle x' y' width' height'+  where+    m = ratio * multiplier ^ n+    width' = round (m * fromIntegral width)+    height' = round (m * fromIntegral height)+    x' = x + fromIntegral (width - width') `div` 2+    y' = y + fromIntegral (height - height') `div` 2++placeSatellite :: Rational -> Rational -> Rectangle -> Double -> Int -> Rectangle+placeSatellite ratio multiplier (Rectangle x y width height) alpha n =+    Rectangle x' y' width' height'+  where+    m = ratio * multiplier ^ n+    x' = x + round (rx + rx * cos alpha)+    y' = y + round (ry + ry * sin alpha)+    rx = fromIntegral (width - width') / 2+    ry = fromIntegral (height - height') / 2+    width' = round (fromIntegral width * m)+    height' = round (fromIntegral height * m)
XMonad/Layout/Column.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Column+-- Description :  Layout that places all windows in one column. -- Copyright   :  (c) 2009 Ilya Portnov -- License     :  BSD3-style (see LICENSE) --@@ -10,7 +11,7 @@ -- Portability :  unportable -- -- Provides Column layout that places all windows in one column. Windows--- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is+-- heights are calculated from the equation: H1/H2 = H2/H3 = ... = q, where q is -- given. With Shrink/Expand messages you can change the q value. -- -----------------------------------------------------------------------------@@ -24,12 +25,12 @@ import qualified XMonad.StackSet as W  -- $usage--- This module defines layot named Column. It places all windows in one--- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... =+-- This module defines layout named Column. It places all windows in one+-- column. Windows heights are calculated from the equation: H1/H2 = H2/H3 = ... = -- q, where `q' is given (thus, windows heights are members of geometric -- progression). With Shrink/Expand messages one can change the `q' value. ----- You can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.Column --@@ -40,7 +41,7 @@ -- In this example, each next window will have height 1.6 times less then -- previous window. -data Column a = Column Float deriving (Read,Show)+newtype Column a = Column Float deriving (Read,Show)  instance LayoutClass Column a where     pureLayout = columnLayout@@ -57,15 +58,13 @@           n = length ws           heights = map (xn n rect q) [1..n]           ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]]-          rects = map (mkRect rect) $ zip heights ys+          rects = zipWith (curry (mkRect rect)) heights ys  mkRect :: Rectangle -> (Dimension,Position) -> Rectangle mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h  xn :: Int -> Rectangle -> Float -> Int -> Dimension xn n (Rectangle _ _ _ h) q k = if q==1 then-                                  h `div` (fromIntegral n)+                                  h `div` fromIntegral n                                else-                                  round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n))--+                                  round (fromIntegral h*q^(n-k)*(1-q)/(1-q^n))
+ XMonad/Layout/Columns.hs view
@@ -0,0 +1,480 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module: XMonad.Layout.Columns+-- Description: A layout which tiles the windows in columns.+-- Copyright: Jean-Charles Quillet+-- License: BSD-style (see LICENSE)+--+-- Maintainer: none+-- Stability: unstable+-- Portability: unportable+--+-- A layout which tiles the windows in columns. The windows can be moved and+-- resized in every directions.+--+-- The first window appears in a single column in the center of the screen. Its+-- width is configurable (See 'coOneWindowWidth').+--+-- The second window appears in a second column. Starting with two columns, they+-- fill up the screen.+--+-- Subsequent windows appear on the bottom of the last columns.+module XMonad.Layout.Columns+  ( -- * Usage+    -- $usage+    ColumnsLayout (..),++    -- * Messages+    Focus (..),+    Move (..),+    Resize (..),++    -- * Tools+    focusDown,+    focusUp,+  )+where++import Control.Applicative ((<|>))+import Control.Arrow (Arrow (first), second)+import Control.Monad (guard)+import Control.Monad.State (modify)+import Control.Monad.Trans.Maybe (MaybeT (..))+import Data.Foldable (Foldable (..))+import Data.List (scanl')+import Data.Maybe (listToMaybe)+import Data.Ratio ((%))+import XMonad+  ( LayoutClass (..),+    Message,+    Rectangle (..),+    SomeMessage,+    Window,+    WindowSet,+    X,+    XState (..),+    fromMessage,+    gets,+    scaleRationalRect,+    sendMessage,+  )+import qualified XMonad.Operations as O+import XMonad.StackSet+  ( RationalRect (..),+    Screen (..),+    Stack (..),+    StackSet (..),+    integrate,+    peek,+  )+import qualified XMonad.StackSet as StackSet++-- $usage+-- Add 'Columns' to your @layoutHook@ with an initial empty state:+--+-- > myLayout = Full ||| Columns 1 []+--+-- Here is an example of keybindings:+--+-- > -- Focus up/down+-- > ((modm, xK_Tab), focusDown),+-- > ((modm .|. shiftMask, xK_Tab), focusUp),+-- > -- Move windows around+-- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight),+-- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft),+-- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp),+-- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown),+-- > -- Resize them+-- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand),+-- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink),+-- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand),+-- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink),+--+-- This layout is known to work with:+--+-- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using+-- 'XMonad.Layout.WindowNavigation.Go' messages.+-- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with+-- tabs. Note that sometimes when undocking windows, the layout is reset. This is+-- a minor annoyance caused by the difficulty to track windows in the sublayout.++-- | The windows can be moved in every directions.+--+-- Horizontally, a window alone in its column cannot be moved before the first+-- or after the last column. If not alone, moving the window outside those+-- limits will create a new column.+-- The windows can also be moved vertically in their column.+data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Show, Read)++instance Message Move++-- | The windows can be resized in every directions.+--+-- When resizing horizontally:+--+-- * if the window to be resized is not in the last column+--+--      * then the right side of the window will be moved+--      * the last column will compensate the size change+--+-- * if the window is in the last column+--+--      * then the left side of the window will be moved+--      * the column on the left of the current one will compensate the size change+--+-- The same applies when resizing vertically using the bottom side of the+-- window unless it is the last window in the column in which case we use the+-- top side.+data Resize+  = VerticalShrink+  | VerticalExpand+  | HorizontalShrink+  | HorizontalExpand+  deriving (Show, Read)++instance Message Resize++-- | The layout handles focus change messages.+--+-- Built-in focus cannot be used here because @XMonad@ does not make it easy to+-- change the order of windows in the focus list. See also 'focusUp' and+-- 'focusDown' functions.+data Focus = FocusUp | FocusDown+  deriving (Show, Read)++instance Message Focus++-- | A column is a list of windows with their relative vertical dimensions.+type Column = [(Rational, Window)]++-- | The layout is a list of 'Column' with their relative horizontal dimensions.+type Columns = [(Rational, Column)]++data ColumnsLayout a = Columns+  { -- | With of the first column when there is only one window. Usefull on wide+    -- screens.+    coOneWindowWidth :: Rational,+    -- | The current state+    coColumns :: Columns+  }+  deriving (Show, Read)++instance LayoutClass ColumnsLayout Window where+  description _ = layoutDescription++  doLayout (Columns oneWindowWidth columns) rectangle stack =+    pure (rectangles, Just (Columns oneWindowWidth columns'))+    where+      hackedColumns = hackForTabs columns stack+      columns' = updateWindowList hackedColumns stack+      rectangles = toRectangles rectangle' columns'+      -- If there is only one window, we set the destination rectangle according+      -- to the width in the layout setting.+      rectangle'+        | (length . toList $ stack) == 1 =+            scaleRationalRect rectangle singleColumnRR+        | otherwise = rectangle+      singleColumnOffset = (1 - oneWindowWidth) / 2+      singleColumnRR = RationalRect singleColumnOffset 0 oneWindowWidth 1++  handleMessage layout@(Columns oneWindowWidth columns) message = do+    mbStack <- runMaybeT $ handleFocus' =<< getStack+    changedFocus <- traverse updateStack' mbStack++    movedOrResized <-+      runMaybeT $+        Columns oneWindowWidth+          <$> (handleMoveOrResize' =<< peekFocus)++    pure $ movedOrResized <|> changedFocus+    where+      getStack = MaybeT . gets $ StackSet.stack . workspace . current . windowset+      handleFocus' = hoistMaybe . handleFocus columns message+      -- A 'Just' needs to be return for the new stack to be taken into account+      updateStack' s = modify (setStack s) >> pure layout+      peekFocus = MaybeT . gets $ peek . windowset+      handleMoveOrResize' = hoistMaybe . handleMoveOrResize columns message+      hoistMaybe = MaybeT . pure++layoutDescription :: String+layoutDescription = "Columns"++-- | Change the keyboard focus to the previous window+focusUp :: X ()+focusUp =+  sendMsgOrOnWindowsSet FocusUp StackSet.focusUp+    =<< getCurrentLayoutDescription++-- | Change the keyboard focus to the next window+focusDown :: X ()+focusDown =+  sendMsgOrOnWindowsSet FocusDown StackSet.focusDown+    =<< getCurrentLayoutDescription++sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X ()+sendMsgOrOnWindowsSet message f description'+  | description' == layoutDescription = sendMessage message+  | otherwise = O.windows f++getCurrentLayoutDescription :: X String+getCurrentLayoutDescription =+  gets+    ( description+        . StackSet.layout+        . workspace+        . current+        . windowset+    )++setStack :: Stack Window -> XState -> XState+setStack stack state =+  state+    { windowset =+        (windowset state)+          { current =+              (current $ windowset state)+                { workspace =+                    (workspace . current $ windowset state)+                      { StackSet.stack = Just stack+                      }+                }+          }+    }++handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)+handleFocus columns message stack+  | Just FocusDown <- fromMessage message = setFocus' stack <$> mbNext+  | Just FocusUp <- fromMessage message = setFocus' stack <$> mbPrevious+  | otherwise = Nothing+  where+    focused = focus stack+    windows = columnsToWindows columns+    exists = focused `elem` windows+    mbNext = guard exists >> next focused windows+    mbPrevious = guard exists >> previous focused windows+    setFocus' = flip setFocus+    previous a = next a . reverse+    setFocus w = until ((==) w . focus) StackSet.focusDown'+    next _ [] = Nothing+    next a (x : xs)+      | a == x = listToMaybe xs+      | otherwise = next a (xs <> [x])++oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])+oldNewWindows columns stack = (old, new)+  where+    old = filter (`notElem` stackList) windows+    new = filter (`notElem` windows) stackList+    stackList = toList stack+    windows = columnsToWindows columns++-- | Add the new windows to the layout and remove the old ones.+updateWindowList :: Columns -> Stack Window -> Columns+updateWindowList columns stack = addWindows newWindows (removeWindows oldWindows columns)+  where+    (oldWindows, newWindows) = oldNewWindows columns stack++-- | If one window disappeared and another appeared, we assume that the sublayout+-- tabs just changed focused.+hackForTabs :: Columns -> Stack Window -> Columns+hackForTabs columns stack = mapWindow replace columns+  where+    replace window+      | (w1 : _, [w2]) <- oldNewWindows columns stack =+          if window == w1+            then w2+            else window+      | otherwise = window++toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]+toRectangles rectangle columns =+  second (scaleRationalRect rectangle) <$> windowsAndRectangles+  where+    offsetsAndRatios = toOffsetRatio (second toOffsetRatio <$> columns)+    windowsAndRectangles = foldMap toWindowAndRectangle offsetsAndRatios+    toWindowAndRectangle (x, w, cs) = (\(y, h, ws) -> (ws, RationalRect x y w h)) <$> cs++onFocused :: (a -> a) -> Stack a -> Stack a+onFocused f (Stack a before after) = Stack (f a) before after++onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a)+onFocusedM f (Stack a before after) = Stack <$> f a <*> pure before <*> pure after++onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a+onFocusedOrPrevious f (Stack a (a' : others) []) = Stack a (f a' : others) []+onFocusedOrPrevious f stack = onFocused f stack++handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns+handleMoveOrResize columns message window+  | Just msg <- fromMessage message = move msg window columns+  | Just HorizontalShrink <- fromMessage message =+      onFocusedOrPrevious' shrink <$> findInColumns window columns+  | Just HorizontalExpand <- fromMessage message =+      onFocusedOrPrevious' expand <$> findInColumns window columns+  | Just VerticalExpand <- fromMessage message =+      onFocusedM'+        (fmap (onFocusedOrPrevious' shrink) . findInColumn window)+        =<< findInColumns window columns+  | Just VerticalShrink <- fromMessage message =+      onFocusedM'+        (fmap (onFocusedOrPrevious' expand) . findInColumn window)+        =<< findInColumns window columns+  | otherwise = Nothing+  where+    expand = first $ flip (+) (3 / 100)+    shrink = first $ flip (-) (3 / 100)+    onFocusedM' f = fmap integrate . onFocusedM (sequence . second f)+    onFocusedOrPrevious' f = sanitize . integrate . onFocusedOrPrevious f++move :: Move -> Window -> Columns -> Maybe Columns+move direction window columns =+  case (direction, findInColumns window columns) of+    (MoveRight, Just (Stack (_, [(_, _)]) _ [])) -> Nothing+    (MoveLeft, Just (Stack (_, [(_, _)]) [] _)) -> Nothing+    (MoveRight, Just (Stack column@(_, [(_, _)]) before (next : others))) ->+      let (column', next') = swapWindowBetween window column next+       in Just . integrate $ Stack column' before (next' : others)+    (MoveLeft, Just (Stack column@(_, [(_, _)]) (previous : others) after)) ->+      let (column', previous') = swapWindowBetween window column previous+       in Just . integrate $ Stack column' (previous' : others) after+    (MoveRight, Just stack) ->+      let (newColumns', Stack column before after) = rationalize newColumns stack+          windows = removeWindow window column+       in Just . integrate $ Stack windows before (newColumns' <> after)+    (MoveLeft, Just stack) ->+      let (newColumns', Stack column before after) = rationalize newColumns stack+          windows = removeWindow window column+       in Just . integrate $ Stack windows (newColumns' <> before) after+    (MoveUp, Just stack) -> integrate <$> onFocusedM (swapWindowUp window) stack+    (MoveDown, Just stack) -> integrate <$> onFocusedM (swapWindowDown window) stack+    _ -> Nothing+  where+    newColumns = [[(1, window)]]++mapWindow :: (Window -> Window) -> Columns -> Columns+mapWindow = fmap . fmap . fmap . fmap++columnsToWindows :: Columns -> [Window]+columnsToWindows = foldMap ((: []) . snd) . foldMap snd++swapWindowBetween ::+  Window ->+  (Rational, Column) ->+  (Rational, Column) ->+  ((Rational, Column), (Rational, Column))+swapWindowBetween window from to = (removed, added)+  where+    removed = removeWindow window from+    added = appendWindows [window] to++swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column)+swapWindowUp window (width, column)+  | Just (Stack (height, _) (previous : before') after) <- findInColumn window column =+      Just (width, integrate $ Stack previous ((height, window) : before') after)+  | otherwise = Nothing++swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column)+swapWindowDown window (width, column)+  | Just (Stack (height, _) before (next : others)) <- findInColumn window column =+      Just (width, integrate $ Stack next before ((height, window) : others))+  | otherwise = Nothing++-- | Adjust the ratio of a list or a stack of elts so that when adding new+--  elements:+-- - the new elements are distributed according to the total number of elements+-- - the existing elements keep their proportion in the remaining space+rationalize ::+  (Functor f, Foldable f) =>+  [a] ->+  f (Rational, a) ->+  ([(Rational, a)], f (Rational, a))+rationalize new existing = (new', existing')+  where+    nbNew = fromIntegral $ length new+    nbInColumn = fromIntegral $ length existing+    newRatio = nbNew % (nbNew + nbInColumn)+    existingRatio = 1 - newRatio+    new' = fitElements newRatio new+    existing' = first (* existingRatio) <$> existing++append :: [a] -> [(Rational, a)] -> [(Rational, a)]+append new existing = uncurry (flip mappend) (rationalize new existing)++appendWindows ::+  [Window] ->+  (Rational, [(Rational, Window)]) ->+  (Rational, [(Rational, Window)])+appendWindows windows = second (append windows)++fitElements :: Rational -> [a] -> [(Rational, a)]+fitElements dimension elts = (dimension',) <$> elts+  where+    dimension' = dimension / fromIntegral (length elts)++singleColumn :: Rational -> Rational -> [Window] -> Columns+singleColumn width height windows = [(width, fitElements height windows)]++findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))+findElement' predicate list+  | (before, c : after) <- break (predicate . snd) list =+      Just $ Stack c (reverse before) after+  | otherwise = Nothing++findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column))+findInColumns window = findElement' (any ((== window) . snd))++findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window))+findInColumn window = findElement' (== window)++removeWindows :: [Window] -> Columns -> Columns+removeWindows windows = removeEmptyColumns . fmap (second removeWindows')+  where+    inWindows (_, window) = window `notElem` windows+    removeWindows' = normalize . filter inWindows+    removeEmptyColumns = normalize . filter (not . null . snd)++removeWindow :: Window -> (Rational, Column) -> (Rational, Column)+removeWindow window = second (normalize . filter ((/= window) . snd))++addWindows :: [Window] -> Columns -> Columns+addWindows [] columns = columns+-- When there is only one column, create a new one on the right+addWindows windows [(_, windows')] = (1 % 2, windows') : singleColumn (1 % 2) 1 windows+-- When there is more, append the windows to the last column+addWindows windows columns+  | Just (columns', column) <- unsnoc columns =+      sanitizeColumns $ columns' <> [appendWindows windows column]+  | otherwise = singleColumn 1 1 windows++-- | Make sure the sum of all dimensions is 1+normalize :: [(Rational, a)] -> [(Rational, a)]+normalize elts = fmap (first (/ total)) elts+  where+    total = sum (fst <$> elts)++-- | Update the last dimension so that the sum of all dimensions is 1+sanitize :: [(Rational, a)] -> [(Rational, a)]+sanitize list+  | Just (elts, (_, a)) <- unsnoc list = elts <> [(1 - sum (fst <$> elts), a)]+  | otherwise = []++-- | Same on the whole layout+sanitizeColumns :: Columns -> Columns+sanitizeColumns = sanitize . fmap (second sanitize)++toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)]+toOffsetRatio ra = zipWith toTruple ra positions+  where+    toTruple (dimension, a) position = (position, dimension, a)+    positions = scanl' (\position (dimension, _) -> position + dimension) 0 ra++unsnoc :: [a] -> Maybe ([a], a)+unsnoc [] = Nothing+unsnoc (x : xs)+  | Just (is, l) <- unsnoc xs = Just (x : is, l)+  | otherwise = Just ([], x)
XMonad/Layout/Combo.hs view
@@ -1,9 +1,13 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,-             UndecidableInstances, PatternGuards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE UndecidableInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Combo+-- Description :  A layout that combines multiple layouts. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD-style (see LICENSE) --@@ -22,27 +26,26 @@                             CombineTwo                            ) where -import Data.List ( delete, intersect, (\\) )-import Data.Maybe ( isJust ) import XMonad hiding (focus)-import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )-import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )-import qualified XMonad.StackSet as W ( differentiate )+import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..))+import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe)+import XMonad.StackSet (Stack (..), Workspace (..), integrate')+import XMonad.Util.Stack (zipperFocusedAtFirstOf)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Combo -- -- and add something like ----- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)+-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) -- -- to your layouts. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- combineTwo is a new simple layout combinator. It allows the -- combination of two layouts using a third to split the screen@@ -57,7 +60,7 @@ -- >    , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- These bindings will move a window into the sublayout that is -- up\/down\/left\/right of its current position.  Note that there is some@@ -77,42 +80,42 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)     => LayoutClass (CombineTwo (l ()) l1 l2) a where     runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)-        where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)-                              l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)-                              super' <- maybe super id `fmap`+        where arrange [] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources)+                              l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources)+                              super' <- fromMaybe super <$>                                         handleMessage super (SomeMessage ReleaseResources)                               return ([], Just $ C2 [] [] super' l1' l2')-              arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)-                               l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)-                               super' <- maybe super id `fmap`+              arrange [w] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources)+                               l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources)+                               super' <- fromMaybe super <$>                                          handleMessage super (SomeMessage ReleaseResources)                                return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')               arrange origws =-                  do let w2' = case origws `intersect` w2 of [] -> [head origws]+                  do let w2' = case origws `intersect` w2 of [] -> take 1 origws                                                              [x] -> [x]                                                              x -> case origws \\ x of                                                                   [] -> init x                                                                   _ -> x                          superstack = Stack { focus=(), up=[], down=[()] }-                         s1 = differentiate f' (origws \\ w2')-                         s2 = differentiate f' w2'+                         s1 = zipperFocusedAtFirstOf f' (origws \\ w2')+                         s2 = zipperFocusedAtFirstOf f' w2'                          f' = case s of (Just s') -> focus s':delete (focus s') f                                         Nothing -> f                      ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput                      (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1                      (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2                      return (wrs1++wrs2, Just $ C2 f' w2'-                                     (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))+                                     (fromMaybe super msuper') (fromMaybe l1 ml1') (fromMaybe l2 ml2'))     handleMessage (C2 f ws2 super l1 l2) m         | Just (MoveWindowToWindow w1 w2) <- fromMessage m,           w1 `notElem` ws2,-          w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m-                             l2' <- maybe l2 id `fmap` handleMessage l2 m+          w2 `elem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m+                             l2' <- fromMaybe l2 <$> handleMessage l2 m                              return $ Just $ C2 f (w1:ws2) super l1' l2'         | Just (MoveWindowToWindow w1 w2) <- fromMessage m,           w1 `elem` ws2,-          w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m-                                l2' <- maybe l2 id `fmap` handleMessage l2 m+          w2 `notElem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m+                                l2' <- fromMaybe l2 <$> handleMessage l2 m                                 let ws2' = case delete w1 ws2 of [] -> [w2]                                                                  x -> x                                 return $ Just $ C2 f ws2' super l1' l2'@@ -121,24 +124,16 @@                          msuper' <- broadcastPrivate m [super]                          if isJust msuper' || isJust ml1' || isJust ml2'                             then return $ Just $ C2 f ws2-                                                 (maybe super head msuper')-                                                 (maybe l1 head ml1')-                                                 (maybe l2 head ml2')+                                                 (fromMaybe super (listToMaybe =<< msuper'))+                                                 (fromMaybe l1    (listToMaybe =<< ml1'))+                                                 (fromMaybe l2    (listToMaybe =<< ml2'))                             else return Nothing     description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++                                        description l2 ++" with "++ description super --differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)-differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z-                                                     , up = reverse $ takeWhile (/=z) xs-                                                     , down = tail $ dropWhile (/=z) xs }-                        | otherwise = differentiate zs xs-differentiate [] xs = W.differentiate xs- broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b]) broadcastPrivate a ol = do nml <- mapM f ol                            if any isJust nml-                              then return $ Just $ zipWith ((flip maybe) id) ol nml+                              then return $ Just $ zipWith (`maybe` id) ol nml                               else return Nothing     where f l = handleMessage l a `catchX` return Nothing
XMonad/Layout/ComboP.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ComboP+-- Description :  Combine multiple layouts and specify where to put new windows. -- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -24,30 +25,29 @@                              Property(..)                             ) where -import Data.List ( delete, intersect, (\\) )-import Data.Maybe ( isJust )-import Control.Monad import XMonad hiding (focus)-import XMonad.StackSet ( Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation-import XMonad.Util.WindowProperties+import XMonad.Prelude+import XMonad.StackSet ( Workspace (..), Stack(..) ) import qualified XMonad.StackSet as W+import XMonad.Util.Stack (zipperFocusedAtFirstOf)+import XMonad.Util.WindowProperties  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ComboP -- -- and add something like ----- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox")+-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) (ClassName "Firefox") -- -- to your layouts. This way all windows with class = \"Firefox\" will always go -- to the left pane, all others - to the right. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with -- addition of a 'Property' which tells where to put new windows. Windows mathing@@ -65,11 +65,11 @@ -- >    , ((modm .|. controlMask .|. shiftMask, xK_s    ), sendMessage $ SwapWindow) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data SwapWindow =  SwapWindow        -- ^ Swap window between panes                  | SwapWindowN Int   -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow-                 deriving (Read, Show, Typeable)+                 deriving (Read, Show) instance Message SwapWindow  data PartitionWins = PartitionWins  -- ^ Reset the layout and@@ -79,7 +79,7 @@                                     -- changed and you want ComboP to                                     -- update which layout a window                                     -- belongs to.-                   deriving (Read, Show, Typeable)+                   deriving (Read, Show) instance Message PartitionWins  data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property@@ -99,16 +99,16 @@             superstack = Just Stack { focus=(), up=[], down=[()] }             f' = focus s:delete (focus s) f  -- list of focused windows, contains 2 elements at most         in do-            matching <- (hasProperty prop) `filterM` new  -- new windows matching predecate-            let w1' = w1c ++ matching                     -- updated first pane windows-                w2' = w2c ++ (new \\ matching)            -- updated second pane windows-                s1 = differentiate f' w1'                 -- first pane stack-                s2 = differentiate f' w2'                 -- second pane stack+            matching <- hasProperty prop `filterM` new  -- new windows matching predecate+            let w1' = w1c ++ matching                   -- updated first pane windows+                w2' = w2c ++ (new \\ matching)          -- updated second pane windows+                s1 = zipperFocusedAtFirstOf f' w1'      -- first pane stack+                s2 = zipperFocusedAtFirstOf f' w2'      -- second pane stack             ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput             (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1             (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2-            return  (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper')-                (maybe l1 id ml1') (maybe l2 id ml2') prop)+            return  (wrs1++wrs2, Just $ C2P f' w1' w2' (fromMaybe super msuper')+                (fromMaybe l1 ml1') (fromMaybe l2 ml2') prop)      handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m         | Just PartitionWins   <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop@@ -129,13 +129,13 @@                          msuper' <- handleMessage super m                          if isJust msuper' || isJust ml1' || isJust ml2'                             then return $ Just $ C2P f ws1 ws2-                                                 (maybe super id msuper')-                                                 (maybe l1 id ml1')-                                                 (maybe l2 id ml2') prop+                                                 (fromMaybe super msuper')+                                                 (fromMaybe l1 ml1')+                                                 (fromMaybe l2 ml2') prop                             else return Nothing      description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++-                                description l2 ++ " with " ++ description super ++ " using "++ (show prop)+                                description l2 ++ " with " ++ description super ++ " using "++ show prop  -- send focused window to the other pane. Does nothing if we don't -- own the focused window@@ -166,7 +166,7 @@             then return Nothing             else handleMessage super m     if isJust ml1 || isJust ml2 || isJust ms-        then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop+        then return $ Just $ C2P f ws1 ws2 (fromMaybe super ms) (fromMaybe l1 ml1) (fromMaybe l2 ml2) prop         else return Nothing  -- forwards message m to layout l if focused window is among w@@ -174,19 +174,8 @@ forwardIfFocused l w m = do     mst <- gets (W.stack . W.workspace . W.current . windowset)     maybe (return Nothing) send mst where-    send st = if (W.focus st) `elem` w+    send st = if W.focus st `elem` w                 then handleMessage l m                 else return Nothing---- code from CombineTwo--- given two sets of zs and xs takes the first z from zs that also belongs to xs--- and turns xs into a stack with z being current element. Acts as--- StackSet.differentiate if zs and xs don't intersect-differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)-differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z-                                                     , up = reverse $ takeWhile (/=z) xs-                                                     , down = tail $ dropWhile (/=z) xs }-                        | otherwise = differentiate zs xs-differentiate [] xs = W.differentiate xs  -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
XMonad/Layout/Cross.hs view
@@ -2,6 +2,7 @@  -- | -- Module      :  XMonad.Layout.Cross+-- Description :  A Cross Layout with the main window in the center. -- Copyright   :  (c) Luis Cabellos <zhen.sydow@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -11,7 +12,7 @@ -- -- A Cross Layout with the main window in the center. ---module XMonad.Layout.Cross(+module XMonad.Layout.Cross {-# DEPRECATED "Use XMonad.Layout.Circle or XMonad.Layout.ThreeColumn.ThreeColMid instead" #-} (                           -- * Usage                           -- $usage                           simpleCross@@ -19,10 +20,10 @@  import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage ) import XMonad.StackSet( focus, up, down )-import Control.Monad( msum )+import XMonad.Prelude( msum )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Cross --@@ -34,7 +35,7 @@  -- apply a factor to a Rectangle Dimension (<%>) :: Dimension -> Rational -> Dimension-d <%> f = floor $ f * (fromIntegral d)+d <%> f = floor $ f * fromIntegral d  -- | The Cross Layout draws the focused window in the center of the screen --   and part of the other windows on the sides. The 'Shrink' and 'Expand'@@ -57,10 +58,10 @@ simpleCross = Cross (4/5) (1/100)  instance LayoutClass Cross a where-    pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++-                                 (zip winCycle (upRects r f)) ++-                                 (zip (reverse winCycle) (downRects r f))-        where winCycle = (up s) ++ (reverse (down s))+    pureLayout (Cross f _) r s = [(focus s, mainRect r f)]+                              ++ zip winCycle (upRects r f)+                              ++ zip (reverse winCycle) (downRects r f)+        where winCycle = up s ++ reverse (down s)      pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)]         where resize Shrink = Cross (max (1/100) $ f - d) d@@ -71,8 +72,8 @@ -- get the Rectangle for the focused window mainRect :: Rectangle -> Rational -> Rectangle mainRect (Rectangle rx ry rw rh) f = Rectangle-                                     (rx + (fromIntegral (rw <%> invf)))-                                     (ry + (fromIntegral (rh <%> invf)))+                                     (rx + fromIntegral (rw <%> invf))+                                     (ry + fromIntegral (rh <%> invf))                                      (rw <%> f) (rh <%> f)     where invf = (1/2) * (1-f) @@ -88,25 +89,24 @@  topRectangle :: Rectangle -> Rational -> Rectangle topRectangle (Rectangle rx ry rw rh) f = Rectangle-                                         (rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))+                                         (rx + fromIntegral (rw <%> ((1-f)*(1/2))))                                          ry                                          (rw <%> f) (rh <%> ((1-f)*(1/2)))  rightRectangle :: Rectangle -> Rational -> Rectangle rightRectangle (Rectangle rx ry rw rh) f = Rectangle-                                           (rx + (fromIntegral (rw - (rw <%> (1/2)))))-                                           (ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))+                                           (rx + fromIntegral (rw - (rw <%> (1/2))))+                                           (ry + fromIntegral (rh <%> ((1-f)*(1/2))))                                            (rw <%> (1/2)) (rh <%> f)  bottomRectangle :: Rectangle -> Rational -> Rectangle bottomRectangle (Rectangle rx ry rw rh) f = Rectangle-                                            (rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))-                                            (ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2))))))+                                            (rx + fromIntegral (rw <%> ((1-f)*(1/2))))+                                            (ry + fromIntegral (rh - (rh <%> ((1-f)*(1/2)))))                                             (rw <%> f) (rh <%> ((1-f)*(1/2)))  leftRectangle :: Rectangle -> Rational -> Rectangle leftRectangle (Rectangle rx ry rw rh) f = Rectangle                                           rx-                                           (ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))+                                           (ry + fromIntegral (rh <%> ((1-f)*(1/2))))                                            (rw <%> (1/2)) (rh <%> f)-
XMonad/Layout/Decoration.hs view
@@ -1,7 +1,13 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE TupleSections         #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Decoration+-- Description :  A layout modifier and a class for easily creating decorated layouts. -- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger -- License     :  BSD-style (see xmonad/LICENSE) --@@ -17,7 +23,7 @@     ( -- * Usage:       -- $usage       decoration-    , Theme (..), defaultTheme, def+    , Theme (..), def     , Decoration     , DecorationMsg (..)     , DecorationStyle (..)@@ -30,12 +36,10 @@     , DecorationState, OrigWin     ) where -import Control.Monad (when)-import Data.Maybe-import Data.List import Foreign.C.Types(CInt)  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.UrgencyHook import XMonad.Layout.LayoutModifier@@ -68,24 +72,28 @@ -- -- For a collection of 'Theme's see "XMonad.Util.Themes" data Theme =-    Theme { activeColor        :: String                   -- ^ Color of the active window-          , inactiveColor       :: String                   -- ^ Color of the inactive window-          , urgentColor         :: String                   -- ^ Color of the urgent window-          , activeBorderColor   :: String                   -- ^ Color of the border of the active window-          , inactiveBorderColor :: String                   -- ^ Color of the border of the inactive window-          , urgentBorderColor   :: String                   -- ^ Color of the border of the urgent window-          , activeTextColor     :: String                   -- ^ Color of the text of the active window-          , inactiveTextColor   :: String                   -- ^ Color of the text of the inactive window-          , urgentTextColor     :: String                   -- ^ Color of the text of the urgent window-          , fontName            :: String                   -- ^ Font name-          , decoWidth           :: Dimension                -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')-          , decoHeight          :: Dimension                -- ^ Height of the decorations+    Theme { activeColor         :: String                  -- ^ Color of the active window+          , inactiveColor       :: String                  -- ^ Color of the inactive window+          , urgentColor         :: String                  -- ^ Color of the urgent window+          , activeBorderColor   :: String                  -- ^ Color of the border of the active window+          , inactiveBorderColor :: String                  -- ^ Color of the border of the inactive window+          , urgentBorderColor   :: String                  -- ^ Color of the border of the urgent window+          , activeBorderWidth   :: Dimension               -- ^ Width of the border of the active window+          , inactiveBorderWidth :: Dimension               -- ^ Width of the border of the inactive window+          , urgentBorderWidth   :: Dimension               -- ^ Width of the border of the urgent window+          , activeTextColor     :: String                  -- ^ Color of the text of the active window+          , inactiveTextColor   :: String                  -- ^ Color of the text of the inactive window+          , urgentTextColor     :: String                  -- ^ Color of the text of the urgent window+          , fontName            :: String                  -- ^ Font name+          , decoWidth           :: Dimension               -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')+          , decoHeight          :: Dimension               -- ^ Height of the decorations           , windowTitleAddons   :: [(String, Align)]       -- ^ Extra text to appear in a window's title bar.                                                            --    Refer to for a use "XMonad.Layout.ImageButtonDecoration"           , windowTitleIcons    :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.                                                            --    Inner @[Bool]@ is a row in a icon bitmap.           } deriving (Show, Read) +-- | The default xmonad 'Theme'. instance Default Theme where   def =     Theme { activeColor         = "#999999"@@ -94,24 +102,26 @@           , activeBorderColor   = "#FFFFFF"           , inactiveBorderColor = "#BBBBBB"           , urgentBorderColor   = "##00FF00"+          , activeBorderWidth   = 1+          , inactiveBorderWidth = 1+          , urgentBorderWidth   = 1           , activeTextColor     = "#FFFFFF"           , inactiveTextColor   = "#BFBFBF"           , urgentTextColor     = "#FF0000"+#ifdef XFT+          , fontName            = "xft:monospace"+#else           , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+#endif           , decoWidth           = 200           , decoHeight          = 20           , windowTitleAddons   = []           , windowTitleIcons    = []           } -{-# DEPRECATED defaultTheme "Use def (from Data.Default, and re-exported by XMonad.Layout.Decoration) instead." #-}--- | The default xmonad 'Theme'.-defaultTheme :: Theme-defaultTheme = def- -- | A 'Decoration' layout modifier will handle 'SetTheme', a message -- to dynamically change the decoration 'Theme'.-data DecorationMsg = SetTheme Theme deriving ( Typeable )+newtype DecorationMsg = SetTheme Theme instance Message DecorationMsg  -- | The 'Decoration' state component, where the list of decorated@@ -143,7 +153,7 @@      -- | The description that the 'Decoration' modifier will display.     describeDeco :: ds a -> String-    describeDeco ds = show ds+    describeDeco = show      -- | Shrink the window's rectangle when applying a decoration.     shrink :: ds a -> Rectangle -> Rectangle -> Rectangle@@ -151,7 +161,7 @@      -- | The decoration event hook     decorationEventHook :: ds a -> DecorationState -> Event -> X ()-    decorationEventHook ds s e = handleMouseFocusDrag ds s e+    decorationEventHook = handleMouseFocusDrag      -- | A hook that can be used to catch the cases when the user     -- clicks on the decoration. If you return True here, the click event@@ -167,7 +177,7 @@     -- The hook can be overwritten if a different way of handling the dragging     -- is required.     decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()-    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y+    decorationWhileDraggingHook _ = handleDraggingInProgress      -- | This hoook is called after a window has been dragged using the decoration.     decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()@@ -232,10 +242,9 @@                                     toDel = todel d dwrs                                     toAdd = toadd a wrs                                 deleteDecos (map snd toDel)-                                let ndwrs = zip toAdd $ repeat (Nothing,Nothing)+                                let ndwrs = map (, (Nothing,Nothing)) toAdd                                 ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs                                 processState (s {decos = ndecos })-        | otherwise        = return (wrs, Nothing)          where           ws        = map fst wrs@@ -276,7 +285,7 @@                               updateDecos sh t (font s) ndwrs                               return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) -    handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m+    handleMess (Decoration (I (Just s@DS{decos = dwrs})) sh t ds) m         | Just e <- fromMessage m                = do decorationEventHook ds s e                                                       handleEvent sh t s e                                                       return Nothing@@ -295,9 +304,9 @@ handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X () handleEvent sh t (DS dwrs fs) e     | PropertyEvent {ev_window = w} <- e-    , Just i <- w `elemIndex`             (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i)+    , Just i <- w `elemIndex` map (fst . fst) dwrs      = updateDeco sh t fs (dwrs !! i)     | ExposeEvent   {ev_window = w} <- e-    , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i)+    , Just i <- w `elemIndex` mapMaybe (fst . snd) dwrs = updateDeco sh t fs (dwrs !! i) handleEvent _ _ _ _ = return ()  -- | Mouse focus and mouse drag are handled by the same function, this@@ -309,11 +318,11 @@                                                 , ev_y_root     = ey }     | et == buttonPress     , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do-        let Just (Rectangle dx _ dwh _) = decoRectM+        let Rectangle dx _ dwh _ = fromJust decoRectM             distFromLeft = ex - fi dx             distFromRight = fi dwh - (ex - fi dx)         dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)-        when (not dealtWith) $ do+        unless dealtWith $             mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)                         (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return ()@@ -368,17 +377,21 @@ createDecos _ _ _ _ _ [] = return []  createDecoWindow :: Theme -> Rectangle -> X Window-createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in-                       createNewWindow r mask (inactiveColor t) True+createDecoWindow t r = do+  let mask = Just (exposureMask .|. buttonPressMask)+  w <- createNewWindow r mask (inactiveColor t) True+  d <- asks display+  io $ setClassHint d w (ClassHint "xmonad-decoration" "xmonad")+  pure w  showDecos :: [DecoWin] -> X ()-showDecos = showWindows . catMaybes . map fst . filter (isJust . snd)+showDecos = showWindows . mapMaybe fst . filter (isJust . snd)  hideDecos :: [DecoWin] -> X ()-hideDecos = hideWindows . catMaybes . map fst+hideDecos = hideWindows . mapMaybe fst  deleteDecos :: [DecoWin] -> X ()-deleteDecos = deleteWindows . catMaybes . map fst+deleteDecos = deleteWindows . mapMaybe fst  updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X () updateDecos s t f = mapM_ $ updateDeco s t f@@ -387,25 +400,30 @@ -- structure and the needed 'Rectangle's updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X () updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do-  nw  <- getName w+  -- xmonad-contrib #809+  -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@+  -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is+  -- quadratic due to using 'init'+  nw  <- fmap (take 2048 . takeWhile (/= '\n') . show) (getName w)   ur  <- readUrgents   dpy <- asks display-  let focusColor win ic ac uc = (maybe ic (\focusw -> case () of-                                                       _ | focusw == win -> ac-                                                         | win `elem` ur -> uc-                                                         | otherwise     -> ic) . W.peek)-                                `fmap` gets windowset-  (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)-                                  (activeColor   t, activeBorderColor   t, activeTextColor   t)-                                  (urgentColor   t, urgentBorderColor   t, urgentTextColor   t)+  let focusColor win ic ac uc = maybe ic (\focusw -> case () of+                                                      _ | focusw == win -> ac+                                                        | win `elem` ur -> uc+                                                        | otherwise     -> ic) . W.peek+                                <$> gets windowset+  (bc,borderc,borderw,tc) <-+    focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t)+                 (activeColor   t, activeBorderColor   t, activeBorderWidth   t, activeTextColor   t)+                 (urgentColor   t, urgentBorderColor   t, urgentBorderWidth   t, urgentTextColor   t)   let s = shrinkIt sh   name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n-                                  return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)+                                  return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) nw   let als = AlignCenter : map snd (windowTitleAddons t)       strs = name : map fst (windowTitleAddons t)       i_als = map snd (windowTitleIcons t)       icons = map fst (windowTitleIcons t)-  paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons+  paintTextAndIcons dw fs wh ht borderw bc borderc tc bc als strs i_als icons updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w updateDeco _ _ _ _ = return ()
XMonad/Layout/DecorationAddons.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.DecorationAddons+-- Description :  Various stuff that can be added to the decoration. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -30,8 +31,7 @@ import XMonad.Util.Font import XMonad.Util.PositionStore -import Control.Applicative((<$>))-import Data.Maybe+import XMonad.Prelude import qualified Data.Set as S  minimizeButtonOffset :: Int@@ -52,18 +52,15 @@ -- See 'defaultThemeWithButtons' below. titleBarButtonHandler :: Window -> Int -> Int -> X Bool titleBarButtonHandler mainw distFromLeft distFromRight = do-    let action = if (fi distFromLeft <= 3 * buttonSize)-                        then focus mainw >> windowMenu >> return True-                  else if (fi distFromRight >= closeButtonOffset &&-                           fi distFromRight <= closeButtonOffset + buttonSize)-                              then focus mainw >> kill >> return True-                  else if (fi distFromRight >= maximizeButtonOffset &&-                           fi distFromRight <= maximizeButtonOffset + (2 * buttonSize))-                             then focus mainw >> sendMessage (maximizeRestore mainw) >> return True-                  else if (fi distFromRight >= minimizeButtonOffset &&-                           fi distFromRight <= minimizeButtonOffset + buttonSize)-                             then focus mainw >> minimizeWindow mainw >> return True-                  else return False+    let action+          | fi distFromLeft <= 3 * buttonSize = focus mainw >> windowMenu >> return True+          | fi distFromRight >= closeButtonOffset &&+            fi distFromRight <= closeButtonOffset + buttonSize = focus mainw >> kill >> return True+          | fi distFromRight >= maximizeButtonOffset &&+            fi distFromRight <= maximizeButtonOffset + (2 * buttonSize) = focus mainw >> sendMessage (maximizeRestore mainw) >> return True+          | fi distFromRight >= minimizeButtonOffset &&+            fi distFromRight <= minimizeButtonOffset + buttonSize = focus mainw >> minimizeWindow mainw >> return True+          | otherwise = return False     action  -- | Intended to be used together with 'titleBarButtonHandler'. See above.@@ -89,7 +86,7 @@     maybeWksp <- screenWorkspace $ W.screen sc     let targetWksp = maybeWksp >>= \wksp ->                         W.findTag w ws >>= \currentWksp ->-                        if (currentWksp /= wksp)+                        if currentWksp /= wksp                             then Just wksp                             else Nothing     case targetWksp of
+ XMonad/Layout/DecorationEx.hs view
@@ -0,0 +1,106 @@++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx+-- Description :  Advanced window decorations module for XMonad+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This set of modules contains a set of type classes and their implementations+-- which define a flexible and extensible mechanism of window decorations.+--+-- <<https://github.com/xmonad/xmonad-contrib/assets/50166980/ccc20e1b-6762-48d9-8195-579f77a98396>>+-- Click <https://github.com/xmonad/xmonad-contrib/assets/50166980/64847a85-33c4-4b5f-8ec8-df73d3e4d58d here>+-- for a larger version.+--+-- Within this mechanism, there are the following entities which define+-- how decorations will look and work:+--+-- * Main object is @DecorationEx@ layout modifier. It is from where everything+--   starts. It creates, shows and hides decoration windows (rectangles) when+--   needed. It is parameterized with decoration geometry, decoration engine and+--   theme. It calls these components to do their parts of the work.+-- * @DecorationGeometry@ defines where decoration rectangles should be placed.+--   For example, standard horizontal bar above each window; or tab bar.+-- * @DecorationEngine@ defines how decorations look and how they react on clicks.+--   Different implementations of the decoration engine can use different APIs+--   to draw decorations. Within this package, there is one implementation +--   (@TextDecoration@), which uses plain Xlib calls, and displays decoration+--   widgets with text fragments, like @[X]@ or @[_]@. Other engines can, for+--   example, use the Cairo library to draw nice gradients and image-based widgets.+-- * A Decoration widget is an element placed on a window decoration. It defines how+--   it looks and how it responds to clicks. Examples include usual window +--   buttons (minimize, maximize, close), window icon, window title.+-- * A Decoration theme defines colors and fonts for the decoration engine. It also+--   contains a list of decoration widgets and says where to place them (at the+--   left, at the right or in the center).+-- +-- This mechanism makes major use of parameterized data types and type families,+-- in order to make it possible to define different types of decorations, and+-- easily combine different aspects of decorations. For example, each decoration+-- engine can be combined with each decoration geometry.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx (+  -- * Usage:+  -- $usage++  -- * Standard decoration settings+  decorationEx,+  textDecoration, textTabbed, dwmStyleDeco,+  -- * Decoration-related types+  TextDecoration (..), DefaultGeometry (..),+  TabbedGeometry (..), DwmGeometry (..),+  DecorationEx,+  -- * Theme types+  BoxBorders (..), BorderColors,+  SimpleStyle (..), GenericTheme (..),+  ThemeEx,+  -- * Widget types+  StandardCommand (..), GenericWidget (..),+  StandardWidget,+  -- * Utility functions for themes+  themeEx, borderColor, shadowBorder,+  -- * Convinience re-exports+  Shrinker (..), shrinkText,+  -- * Standard widgets+  titleW, toggleStickyW, minimizeW,+  maximizeW, closeW, dwmpromoteW,+  moveToNextGroupW, moveToPrevGroupW+  ) where++import XMonad.Layout.Decoration+import XMonad.Layout.DecorationEx.Common+import XMonad.Layout.DecorationEx.Widgets+import XMonad.Layout.DecorationEx.Geometry+import XMonad.Layout.DecorationEx.LayoutModifier+import XMonad.Layout.DecorationEx.TextEngine+import XMonad.Layout.DecorationEx.TabbedGeometry+import XMonad.Layout.DecorationEx.DwmGeometry++-- $usage+--+-- You can use this module with the following in your+-- @xmonad.hs@:+--+-- > import XMonad.Layout.DecorationEx+-- Then edit your @layoutHook@ by adding the DwmStyle decoration to+-- your layout:+--+-- > myTheme = ThemeEx {...}+-- > myL = textDecoration shrinkText myTheme (layoutHook def)+-- > main = xmonad def { layoutHook = myL }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- This module exports only some definitions from it's submodules,+-- most likely to be used from user configurations. To define+-- your own decoration types you will likely have to import specific+-- submodules.+
+ XMonad/Layout/DecorationEx/Common.hs view
@@ -0,0 +1,272 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.Common+-- Description :  Declaration of types used by DecorationEx module,+--                and commonly used utility functions.+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module exposes a number of types which are used by other sub-modules+-- of "XMonad.Layout.DecorationEx" module.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.Common (+    -- * Common types+    WindowDecoration (..)+  , WindowCommand (..)+  , DecorationWidget (..)+  , WidgetPlace (..)+  , WidgetLayout (..)+  , HasWidgets (..)+  , ClickHandler (..)+  , ThemeAttributes (..)+  , XPaintingContext+  , BoxBorders (..)+  , BorderColors+  , ThemeStyleType (..)+  , SimpleStyle (..)+  , GenericTheme (..)+  , ThemeEx +  -- * Utilities+  , widgetLayout+  , windowStyleType+  , genericWindowStyle+  , themeEx+  , borderColor+  , shadowBorder+  ) where++import qualified Data.Map as M+import Data.Bits (testBit)++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Hooks.UrgencyHook+import qualified XMonad.Layout.Decoration as D++-- | Information about decoration of one window+data WindowDecoration = WindowDecoration {+    wdOrigWindow :: !Window         -- ^ Original window (one being decorated)+  , wdOrigWinRect :: !Rectangle     -- ^ Rectangle of original window+  , wdDecoWindow :: !(Maybe Window) -- ^ Decoration window, or Nothing if this window should not be decorated+  , wdDecoRect :: !(Maybe Rectangle) -- ^ Rectangle for decoration window+  , wdWidgets :: ![WidgetPlace]      -- ^ Places for widgets+  }++-- | Type class for window commands (such as maximize or close window)+class (Read cmd, Show cmd) => WindowCommand cmd where+  -- | Execute the command+  executeWindowCommand :: cmd -> Window -> X Bool++  -- | Is the command currently in `checked' state. +  -- For example, for 'sticky' command, check if the+  -- window is currently sticky.+  isCommandChecked :: cmd -> Window -> X Bool++-- | Type class for decoration widgets+class (WindowCommand (WidgetCommand widget), Read widget, Show widget)+  => DecorationWidget widget where+  -- | Type of window commands which this type of widgets can execute+  type WidgetCommand widget++  -- | Get window command which is associated with this widget.+  widgetCommand :: widget -> Int -> WidgetCommand widget++  -- | Check if the widget is shrinkable, i.e. if it's width+  -- can be reduced if there is not enough place in the decoration.+  isShrinkable :: widget -> Bool++-- | Layout of widgets+data WidgetLayout a = WidgetLayout {+    wlLeft :: ![a]     -- ^ Widgets that should be aligned to the left side of decoration+  , wlCenter :: ![a]   -- ^ Widgets that should be in the center of decoration+  , wlRight :: ![a]    -- ^ Widgets taht should be aligned to the right side of decoration+  }++-- | Data type describing where the decoration widget (e.g. window button)+-- should be placed.+-- All coordinates are relative to decoration rectangle.+data WidgetPlace = WidgetPlace {+    wpTextYPosition :: !Position -- ^ Y position of text base line+                                 -- (for widgets like window title or text-based buttons)+  , wpRectangle :: !Rectangle    -- ^ Rectangle where to place the widget+  }+  deriving (Show)++-- | Generic data type which is used to+-- describe characteristics of rectangle borders.+data BoxBorders a = BoxBorders {+    bxTop :: !a+  , bxRight :: !a+  , bxBottom :: !a+  , bxLeft :: !a+  } deriving (Eq, Read, Show)++-- | Convinience data type describing colors of decoration rectangle borders.+type BorderColors = BoxBorders String++-- | Data type describing look of window decoration+-- in particular state (active or inactive)+data SimpleStyle = SimpleStyle {+    sBgColor :: !String                 -- ^ Decoration background color+  , sTextColor :: !String               -- ^ Text (foreground) color+  , sTextBgColor :: !String             -- ^ Text background color+  , sDecoBorderWidth :: !Dimension      -- ^ Width of border of decoration rectangle. Set to 0 to disable the border.+  , sDecorationBorders :: !BorderColors -- ^ Colors of borders of decoration rectangle.+  }+  deriving (Show, Read)++-- | Type class for themes, which claims that+-- the theme contains the list of widgets and their alignments.+class HasWidgets theme widget where+  themeWidgets :: theme widget -> WidgetLayout widget++-- | Type class for themes, which claims that+-- the theme can describe how the decoration should respond+-- to clicks on decoration itself (between widgets).+class ClickHandler theme widget where+  -- | This is called when the user clicks on the decoration rectangle+  -- (not on one of widgets).+  onDecorationClick :: theme widget+                    -> Int                          -- ^ Mouse button number+                    -> Maybe (WidgetCommand widget)++  -- | Determine if it is possible to drag window by it's decoration+  -- with mouse button.+  isDraggingEnabled :: theme widget+                    -> Int          -- ^ Mouse button number+                    -> Bool++-- | Type class for themes, which claims that the theme+-- is responsible for determining looks of decoration.+class (Read theme, Show theme) => ThemeAttributes theme where+  -- | Type which describes looks of decoration in one+  -- of window states (active, inactive, urgent, etc).+  type Style theme++  -- | Select style based on window state.+  selectWindowStyle :: theme -> Window -> X (Style theme)++  -- | Define padding between decoration rectangle and widgets.+  widgetsPadding :: theme -> BoxBorders Dimension+  +  -- | Initial background color of decoration rectangle.+  -- When decoration widget is created, it is initially filled+  -- with this color.+  defaultBgColor :: theme -> String++  -- | Font name defined in the theme.+  themeFontName :: theme -> String++-- | Generic Theme data type. This is used+-- by @TextEngine@ and can be used by other relatively+-- simple decoration engines.+data GenericTheme style widget = GenericTheme {+    exActive :: !style                                  -- ^ Decoration style for active (focused) windows+  , exInactive :: !style                                -- ^ Decoration style for inactive (unfocused) windows+  , exUrgent :: !style                                  -- ^ Decoration style for urgent windows+  , exPadding :: !(BoxBorders Dimension)                -- ^ Padding between decoration rectangle and widgets+  , exFontName :: !String                               -- ^ Font name+  , exOnDecoClick :: !(M.Map Int (WidgetCommand widget)) -- ^ Correspondence between mouse button number and window command.+  , exDragWindowButtons :: ![Int]                       -- ^ For which mouse buttons dragging is enabled+  , exWidgetsLeft :: ![widget]                          -- ^ Widgets that should appear at the left of decoration rectangle (listed left to right)+  , exWidgetsCenter :: ![widget]                        -- ^ Widgets that should appear in the center of decoration rectangle (listed left to right)+  , exWidgetsRight :: ![widget]                         -- ^ Widgets that should appear at the right of decoration rectangle (listed left to right)+  }++deriving instance (Show widget, Show (WidgetCommand widget), Show style) => Show (GenericTheme style widget)+deriving instance (Read widget, Read (WidgetCommand widget), Read style) => Read (GenericTheme style widget)++-- | Convience type for themes used by @TextDecoration@.+type ThemeEx widget = GenericTheme SimpleStyle widget++instance HasWidgets (GenericTheme style) widget where+  themeWidgets theme = WidgetLayout (exWidgetsLeft theme) (exWidgetsCenter theme) (exWidgetsRight theme)++-- | Supported states of windows (on which looks of decorations can depend).+data ThemeStyleType = ActiveWindow | UrgentWindow | InactiveWindow+  deriving (Eq, Show, Read)++-- | Utility function to convert WidgetLayout to plain list of widgets.+widgetLayout :: WidgetLayout widget -> [widget]+widgetLayout ws = wlLeft ws ++ wlCenter ws ++ wlRight ws++-- | Painting context for decoration engines based on plain X11 calls.+type XPaintingContext = (Display, Pixmap, GC)++instance (Show widget, Read widget, Read (WidgetCommand widget), Show (WidgetCommand widget))+        => ThemeAttributes (ThemeEx widget) where+  type Style (ThemeEx widget) = SimpleStyle+  selectWindowStyle theme w = genericWindowStyle w theme+  defaultBgColor t = sBgColor $ exInactive t+  widgetsPadding = exPadding+  themeFontName = exFontName++instance ClickHandler (GenericTheme SimpleStyle) widget where+  onDecorationClick theme button = M.lookup button (exOnDecoClick theme)+  isDraggingEnabled theme button = button `elem` exDragWindowButtons theme++-- | Generic utility function to select style from @GenericTheme@+-- based on current state of the window.+genericWindowStyle :: Window -> GenericTheme style widget -> X style+genericWindowStyle win theme = do+  styleType <- windowStyleType win+  return $ case styleType of+             ActiveWindow -> exActive theme+             InactiveWindow -> exInactive theme+             UrgentWindow -> exUrgent theme++-- | Detect type of style to be used from current state of the window.+windowStyleType :: Window -> X ThemeStyleType+windowStyleType win = do+  mbFocused <- W.peek <$> gets windowset+  isWmStateUrgent <- (win `elem`) <$> readUrgents+  isUrgencyBitSet <- withDisplay $ \dpy -> do+                       hints <- io $ getWMHints dpy win+                       return $ wmh_flags hints `testBit` urgencyHintBit+  if isWmStateUrgent || isUrgencyBitSet+    then return UrgentWindow+    else return $+      case mbFocused of+        Nothing -> InactiveWindow+        Just focused+          | focused == win -> ActiveWindow+          | otherwise -> InactiveWindow++-- | Convert Theme type from "XMonad.Layout.Decoration" to +-- theme type used by "XMonad.Layout.DecorationEx.TextEngine".+themeEx :: Default (WidgetCommand widget) => D.Theme -> ThemeEx widget+themeEx t =+    GenericTheme {+          exActive = SimpleStyle (D.activeColor t) (D.activeTextColor t) (D.activeColor t) (D.activeBorderWidth t) (borderColor $ D.activeColor t)+        , exInactive = SimpleStyle (D.inactiveColor t) (D.inactiveTextColor t) (D.inactiveColor t) (D.inactiveBorderWidth t) (borderColor $ D.inactiveColor t)+        , exUrgent = SimpleStyle (D.urgentColor t) (D.urgentTextColor t) (D.urgentColor t) (D.urgentBorderWidth t) (borderColor $ D.urgentColor t)+        , exPadding = BoxBorders 0 4 0 4+        , exFontName = D.fontName t+        , exOnDecoClick = M.fromList [(1, def)]+        , exDragWindowButtons = [1]+        , exWidgetsLeft = []+        , exWidgetsCenter = []+        , exWidgetsRight = []+      }++instance Default (WidgetCommand widget) => Default (ThemeEx widget) where+  def = themeEx (def :: D.Theme)++borderColor :: String -> BorderColors+borderColor c = BoxBorders c c c c++shadowBorder :: String -> String -> BorderColors+shadowBorder highlight shadow = BoxBorders highlight shadow shadow highlight+
+ XMonad/Layout/DecorationEx/DwmGeometry.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.DwmGeometry+-- Description :  DWM-style window decoration geometry+-- Copyright   :  (c) 2007 Andrea Rossato, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This defines window decorations which are shown as a bar of fixed width+-- on top of window.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.DwmGeometry (+    -- * Usage:+    -- $usage+    DwmGeometry (..),+    dwmStyleDeco, dwmStyleDecoEx+  ) where ++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutModifier+import qualified XMonad.Layout.Decoration as D++import XMonad.Layout.DecorationEx.LayoutModifier+import XMonad.Layout.DecorationEx.Common+import XMonad.Layout.DecorationEx.Geometry+import XMonad.Layout.DecorationEx.Widgets+import XMonad.Layout.DecorationEx.TextEngine++-- $usage+-- You can use this module with the following in your+-- @xmonad.hs@:+--+-- > import XMonad.Layout.DecorationEx.DwmStyle+-- Then edit your @layoutHook@ by adding the DwmStyle decoration to+-- your layout:+--+-- > myL = dwmStyleDeco shrinkText (layoutHook def)+-- > main = xmonad def { layoutHook = myL }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | Decoration geometry data type+data DwmGeometry a = DwmGeometry {+      dwmShowForFocused :: !Bool         -- ^ Whether to show decorations on focused windows+    , dwmHorizontalPosition :: !Rational -- ^ Horizontal position of decoration rectangle.+                                         -- 0 means place it at left corner, 1 - place it at+                                         -- right corner, @1%2@ - place it at center.+    , dwmDecoHeight :: !Dimension        -- ^ Height of decoration rectangle+    , dwmDecoWidth :: !Dimension         -- ^ Width of decoration rectangle+  }+  deriving (Show, Read)++instance Default (DwmGeometry a) where+  def = DwmGeometry False 1 20 200++instance DecorationGeometry DwmGeometry Window where+  describeGeometry _ = "DwmStyle"++  pureDecoration (DwmGeometry {..}) _ stack _ (w, Rectangle x y windowWidth _) =+    let width = min windowWidth dwmDecoWidth+        halfWidth = width `div` 2+        minCenterX = x + fi halfWidth+        maxCenterX = x + fi windowWidth - fromIntegral halfWidth+        centerX = round ((1 - dwmHorizontalPosition)*fi minCenterX + dwmHorizontalPosition*fi maxCenterX) :: Position+        decoX = centerX - fi halfWidth+        focusedWindow = W.focus stack+        isFocused = focusedWindow == w+    in  if (not dwmShowForFocused && isFocused) || not (D.isInStack stack w)+          then Nothing+          else Just $ Rectangle decoX y width dwmDecoHeight++  shrinkWindow _ _ windowRect = windowRect++-- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration;+-- decoration placement can be adjusted.+dwmStyleDecoEx :: D.Shrinker shrinker    +             => shrinker               -- ^ Strings shrinker, for example @shrinkText@+             -> DwmGeometry Window+             -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc)+             -> l Window               -- ^ Layout to be decorated+             -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window+dwmStyleDecoEx shrinker geom theme = decorationEx shrinker theme TextDecoration geom++-- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration;+-- decoration placement is similar to DWM.+dwmStyleDeco :: D.Shrinker shrinker    +             => shrinker               -- ^ Strings shrinker, for example @shrinkText@+             -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc)+             -> l Window               -- ^ Layout to be decorated+             -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window+dwmStyleDeco shrinker = dwmStyleDecoEx shrinker def+
+ XMonad/Layout/DecorationEx/Engine.hs view
@@ -0,0 +1,511 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DefaultSignatures #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.Engine+-- Description :  Type class and its default implementation for window decoration engines.+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module defines @DecorationEngine@ type class, and default implementation for it.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.Engine (+    -- * DecorationEngine class+    DecorationEngine (..),+    -- * Auxiliary data types+    DrawData (..), +    DecorationLayoutState (..),+    -- * Re-exports from X.L.Decoration+    Shrinker (..), shrinkText,+    -- * Utility functions+    mkDrawData,+    paintDecorationSimple+  ) where++import Control.Monad+import Data.Kind+import Foreign.C.Types (CInt)++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W+import XMonad.Layout.Decoration (Shrinker (..), shrinkWhile, shrinkText)+import XMonad.Layout.DraggingVisualizer (DraggingVisualizerMsg (..))+import XMonad.Layout.DecorationAddons (handleScreenCrossing)+import XMonad.Util.Font+import XMonad.Util.NamedWindows (getName)++import XMonad.Layout.DecorationEx.Common++-- | Auxiliary type for data which are passed from+-- decoration layout modifier to decoration engine.+data DrawData engine widget = DrawData {+    ddEngineState :: !(DecorationEngineState engine)     -- ^ Decoration engine state+  , ddStyle :: !(Style (Theme engine widget))  -- ^ Graphics style of the decoration. This defines colors, fonts etc+                                                        -- which are to be used for this particular window in it's current state.+  , ddOrigWindow :: !Window                             -- ^ Original window to be decorated+  , ddWindowTitle :: !String                            -- ^ Original window title (not shrinked yet)+  , ddDecoRect :: !Rectangle                            -- ^ Decoration rectangle+  , ddWidgets :: !(WidgetLayout widget)         -- ^ Widgets to be placed on decoration+  , ddWidgetPlaces :: !(WidgetLayout WidgetPlace)       -- ^ Places where widgets must be shown+  }++-- | State of decoration engine+data DecorationLayoutState engine = DecorationLayoutState {+    dsStyleState :: !(DecorationEngineState engine) -- ^ Engine-specific state+  , dsDecorations :: ![WindowDecoration]            -- ^ Mapping between decoration windows and original windows+  }++-- | Decoration engines type class.+-- Decoration engine is responsible for drawing something inside decoration rectangle.+-- It is also responsible for handling X11 events (such as clicks) which happen+-- within decoration rectangle.+-- Decoration rectangles are defined by DecorationGeometry implementation.+class (Read (engine widget a), Show (engine widget a),+       Eq a,+       DecorationWidget widget,+       HasWidgets (Theme engine) widget,+       ClickHandler (Theme engine) widget,+       ThemeAttributes (Theme engine widget))+    => DecorationEngine engine widget a where++    -- | Type of themes used by decoration engine.+    -- This type must be parameterized over a widget type,+    -- because a theme will contain a list of widgets.+    type Theme engine :: Type -> Type           +                                          +    -- | Type of data used by engine as a context during painting;+    -- for plain X11-based implementation this is Display, Pixmap+    -- and GC.+    type DecorationPaintingContext engine + +    -- | Type of state used by the decoration engine.+    -- This can contain some resources that should be initialized+    -- and released at time, such as X11 fonts.+    type DecorationEngineState engine     ++    -- | Give a name to decoration engine.+    describeEngine :: engine widget a -> String++    -- | Initialize state of the engine.+    initializeState :: engine widget a       -- ^ Decoration engine instance+                    -> geom a                -- ^ Decoration geometry instance+                    -> Theme engine widget   -- ^ Theme to be used+                    -> X (DecorationEngineState engine)++    -- | Release resources held in engine state.+    releaseStateResources :: engine widget a              -- ^ Decoration engine instance+                          -> DecorationEngineState engine -- ^ Engine state+                          -> X ()++    -- | Calculate place which will be occupied by one widget.+    -- NB: X coordinate of the returned rectangle will be ignored, because+    -- the rectangle will be moved to the right or to the left for proper alignment+    -- of widgets.+    calcWidgetPlace :: engine widget a         -- ^ Decoration engine instance+                    -> DrawData engine widget  -- ^ Information about window and decoration+                    -> widget                  -- ^ Widget to be placed+                    -> X WidgetPlace++    -- | Place widgets along the decoration bar.+    placeWidgets :: Shrinker shrinker+                 => engine widget a              -- ^ Decoration engine instance+                 -> Theme engine widget          -- ^ Theme to be used+                 -> shrinker                     -- ^ Strings shrinker+                 -> DecorationEngineState engine -- ^ Current state of the engine+                 -> Rectangle                    -- ^ Decoration rectangle+                 -> Window                       -- ^ Original window to be decorated+                 -> WidgetLayout widget          -- ^ Widgets layout+                 -> X (WidgetLayout WidgetPlace)+    placeWidgets engine theme _ decoStyle decoRect window wlayout = do+        let leftWidgets = wlLeft wlayout+            rightWidgets = wlRight wlayout+            centerWidgets = wlCenter wlayout++        dd <- mkDrawData engine theme decoStyle window decoRect+        let paddedDecoRect = pad (widgetsPadding theme) (ddDecoRect dd)+            paddedDd = dd {ddDecoRect = paddedDecoRect}+        rightRects <- alignRight engine paddedDd rightWidgets+        leftRects <- alignLeft engine paddedDd leftWidgets+        let wantedLeftWidgetsWidth = sum $ map (rect_width . wpRectangle) leftRects+            wantedRightWidgetsWidth = sum $ map (rect_width . wpRectangle) rightRects+            hasShrinkableOnLeft = any isShrinkable leftWidgets+            hasShrinkableOnRight = any isShrinkable rightWidgets+            decoWidth = rect_width decoRect+            (leftWidgetsWidth, rightWidgetsWidth)+              | hasShrinkableOnLeft = +                  (min (decoWidth - wantedRightWidgetsWidth) wantedLeftWidgetsWidth,+                      wantedRightWidgetsWidth)+              | hasShrinkableOnRight =+                  (wantedLeftWidgetsWidth,+                      min (decoWidth - wantedLeftWidgetsWidth) wantedRightWidgetsWidth)+              | otherwise = (wantedLeftWidgetsWidth, wantedRightWidgetsWidth)+            ddForCenter = paddedDd {ddDecoRect = padCenter leftWidgetsWidth rightWidgetsWidth paddedDecoRect}+        centerRects <- alignCenter engine ddForCenter centerWidgets+        let shrinkedLeftRects = packLeft (rect_x paddedDecoRect) $ shrinkPlaces leftWidgetsWidth $ zip leftRects (map isShrinkable leftWidgets)+            shrinkedRightRects = packRight (rect_width paddedDecoRect) $ shrinkPlaces rightWidgetsWidth $ zip rightRects (map isShrinkable rightWidgets)+        return $ WidgetLayout shrinkedLeftRects centerRects shrinkedRightRects+      where+        shrinkPlaces targetWidth ps =+          let nShrinkable = length (filter snd ps)+              totalUnshrinkedWidth = sum $ map (rect_width . wpRectangle . fst) $ filter (not . snd) ps+              shrinkedWidth = (targetWidth - totalUnshrinkedWidth) `div` fi nShrinkable++              resetX place = place {wpRectangle = (wpRectangle place) {rect_x = 0}}++              adjust (place, True) = resetX $ place {wpRectangle = (wpRectangle place) {rect_width = shrinkedWidth}}+              adjust (place, False) = resetX place+          in  map adjust ps++        pad p (Rectangle _ _ w h) =+          Rectangle (fi (bxLeft p)) (fi (bxTop p))+                    (w - bxLeft p - bxRight p)+                    (h - bxTop p - bxBottom p)+      +        padCenter left right (Rectangle x y w h) =+          Rectangle (x + fi left) y+                    (w - left - right) h++    -- | Shrink window title so that it would fit in decoration.+    getShrinkedWindowName :: Shrinker shrinker+                          => engine widget a              -- ^ Decoration engine instance+                          -> shrinker                     -- ^ Strings shrinker+                          -> DecorationEngineState engine -- ^ State of decoration engine+                          -> String                       -- ^ Original window title+                          -> Dimension                    -- ^ Width of rectangle in which the title should fit+                          -> Dimension                    -- ^ Height of rectangle in which the title should fit+                          -> X String++    default getShrinkedWindowName :: (Shrinker shrinker, DecorationEngineState engine ~ XMonadFont)+                                  => engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String+    getShrinkedWindowName _ shrinker font name wh _ = do+      let s = shrinkIt shrinker+      dpy <- asks display+      shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy font n+                              return $ size > fromIntegral wh) name++    -- | Mask of X11 events on which the decoration engine should do something.+    -- @exposureMask@ should be included here so that decoration engine could+    -- repaint decorations when they are shown on screen.+    -- @buttonPressMask@ should be included so that decoration engine could+    -- response to mouse clicks.+    -- Other events can be added to custom implementations of DecorationEngine.+    decorationXEventMask :: engine widget a -> EventMask+    decorationXEventMask _ = exposureMask .|. buttonPressMask++    -- | List of X11 window property atoms of original (client) windows,+    -- change of which should trigger repainting of decoration.+    -- For example, if @WM_NAME@ changes it means that we have to redraw+    -- window title.+    propsToRepaintDecoration :: engine widget a -> X [Atom]+    propsToRepaintDecoration _ =+      mapM getAtom ["WM_NAME", "_NET_WM_NAME", "WM_STATE", "WM_HINTS"]++    -- | Generic event handler, which recieves X11 events on decoration+    -- window.+    -- Default implementation handles mouse clicks and drags.+    decorationEventHookEx :: Shrinker shrinker+                          => engine widget a+                          -> Theme engine widget+                          -> DecorationLayoutState engine+                          -> shrinker+                          -> Event+                          -> X ()+    decorationEventHookEx = handleMouseFocusDrag++    -- | Event handler for clicks on decoration window.+    -- This is called from default implementation of "decorationEventHookEx".+    -- This should return True, if the click was handled (something happened+    -- because of that click). If this returns False, the click can be considered+    -- as a beginning of mouse drag.+    handleDecorationClick :: engine widget a      -- ^ Decoration engine instance+                          -> Theme engine widget  -- ^ Decoration theme+                          -> Rectangle            -- ^ Decoration rectangle+                          -> [Rectangle]          -- ^ Rectangles where widgets are placed+                          -> Window               -- ^ Original (client) window+                          -> Int                  -- ^ Mouse click X coordinate+                          -> Int                  -- ^ Mouse click Y coordinate+                          -> Int                  -- ^ Mouse button number+                          -> X Bool+    handleDecorationClick = decorationHandler++    -- | Event handler which is called during mouse dragging.+    -- This is called from default implementation of "decorationEventHookEx".+    decorationWhileDraggingHook :: engine widget a      -- ^ Decoration engine instance+                                -> CInt                 -- ^ Event X coordinate+                                -> CInt                 -- ^ Event Y coordinate+                                -> (Window, Rectangle)  -- ^ Original window and it's rectangle+                                -> Position             -- ^ X coordinate of new pointer position during dragging+                                -> Position             -- ^ Y coordinate of new pointer position during dragging+                                -> X ()+    decorationWhileDraggingHook _ = handleDraggingInProgress++    -- | This hoook is called after a window has been dragged using the decoration.+    -- This is called from default implementation of "decorationEventHookEx".+    decorationAfterDraggingHook :: engine widget a     -- ^ Decoration engine instance+                                -> (Window, Rectangle) -- ^ Original window and its rectangle+                                -> Window              -- ^ Decoration window+                                -> X ()+    decorationAfterDraggingHook _ds (w, _r) decoWin = do+      focus w+      hasCrossed <- handleScreenCrossing w decoWin+      unless hasCrossed $ do+        sendMessage DraggingStopped+        performWindowSwitching w++    -- | Draw everything required on the decoration window.+    -- This method should draw background (flat or gradient or whatever),+    -- borders, and call @paintWidget@ method to draw window widgets+    -- (buttons and title).+    paintDecoration :: Shrinker shrinker+                    => engine widget a         -- ^ Decoration engine instance+                    -> a                       -- ^ Decoration window+                    -> Dimension               -- ^ Decoration window width+                    -> Dimension               -- ^ Decoration window height+                    -> shrinker                -- ^ Strings shrinker instance+                    -> DrawData engine widget  -- ^ Details about what to draw+                    -> Bool                    -- ^ True when this method is called during Expose event+                    -> X ()++    -- | Paint one widget on the decoration window.+    paintWidget :: Shrinker shrinker+                => engine widget a                  -- ^ Decoration engine instance+                -> DecorationPaintingContext engine -- ^ Decoration painting context+                -> WidgetPlace                      -- ^ Place (rectangle) where the widget should be drawn+                -> shrinker                         -- ^ Strings shrinker instance+                -> DrawData engine widget           -- ^ Details about window decoration+                -> widget                           -- ^ Widget to be drawn+                -> Bool                             -- ^ True when this method is called during Expose event+                -> X ()++handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+handleDraggingInProgress ex ey (mainw, r) x y = do+    let rect = Rectangle (x - (fi ex - rect_x r))+                         (y - (fi ey - rect_y r))+                         (rect_width  r)+                         (rect_height r)+    sendMessage $ DraggingWindow mainw rect++performWindowSwitching :: Window -> X ()+performWindowSwitching win =+    withDisplay $ \d -> do+       root <- asks theRoot+       (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root+       ws <- gets windowset+       let allWindows = W.index ws+       -- do a little double check to be sure+       when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do+                let allWindowsSwitched = map (switchEntries win selWin) allWindows+                let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched+                let newStack = W.Stack t (reverse ls) rs+                windows $ W.modify' $ const newStack+    where+        switchEntries a b x+            | x == a    = b+            | x == b    = a+            | otherwise = x++ignoreX :: WidgetPlace -> WidgetPlace+ignoreX place = place {wpRectangle = (wpRectangle place) {rect_x = 0}}++alignLeft :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]+alignLeft engine dd widgets = do+    places <- mapM (calcWidgetPlace engine dd) widgets+    return $ packLeft (rect_x $ ddDecoRect dd) $ map ignoreX places++packLeft :: Position -> [WidgetPlace] -> [WidgetPlace]+packLeft _ [] = []+packLeft x0 (place : places) =+  let rect = wpRectangle place+      x' = x0 + rect_x rect+      rect' = rect {rect_x = x'}+      place' = place {wpRectangle = rect'}+  in  place' : packLeft (x' + fi (rect_width rect)) places++alignRight :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]+alignRight engine dd widgets = do+    places <- mapM (calcWidgetPlace engine dd) widgets+    return $ packRight (rect_width $ ddDecoRect dd) $ map ignoreX places++packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace]+packRight x0 places = reverse $ go x0 places+  where+    go _ [] = []+    go x (place : rest) = +      let rect = wpRectangle place+          x' = x - rect_width rect+          rect' = rect {rect_x = fi x'}+          place' = place {wpRectangle = rect'}+      in  place' : go x' rest++alignCenter :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace]+alignCenter engine dd widgets = do+    places <- alignLeft engine dd widgets+    let totalWidth = sum $ map (rect_width . wpRectangle) places+        availableWidth = fi (rect_width (ddDecoRect dd)) :: Position+        x0 = max 0 $ (availableWidth - fi totalWidth) `div` 2+        places' = map (shift x0) places+    return $ pack (fi availableWidth) places'+  where+    shift x0 place =+      let rect = wpRectangle place+          rect' = rect {rect_x = rect_x rect + fi x0}+      in  place {wpRectangle = rect'}+    +    pack _ [] = []+    pack available (place : places) =+      let rect = wpRectangle place+          placeWidth = rect_width rect+          widthToUse = min available placeWidth+          remaining = available - widthToUse+          rect' = rect {rect_width = widthToUse}+          place' = place {wpRectangle = rect'}+      in  place' : pack remaining places++-- | Build an instance of 'DrawData' type.+mkDrawData :: (DecorationEngine engine widget a, ThemeAttributes (Theme engine widget), HasWidgets (Theme engine) widget)+           => engine widget a+           -> Theme engine widget            -- ^ Decoration theme+           -> DecorationEngineState engine   -- ^ State of decoration engine+           -> Window                         -- ^ Original window (to be decorated)+           -> Rectangle                      -- ^ Decoration rectangle+           -> X (DrawData engine widget)+mkDrawData _ theme decoState origWindow decoRect = do+    -- xmonad-contrib #809+    -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@+    -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is+    -- quadratic due to using 'init'+    name  <- fmap (take 2048 . takeWhile (/= '\n') . show) (getName origWindow)+    style <- selectWindowStyle theme origWindow+    return $ DrawData {+                   ddEngineState = decoState,+                   ddStyle = style,+                   ddOrigWindow = origWindow,+                   ddWindowTitle = name,+                   ddDecoRect = decoRect,+                   ddWidgets = themeWidgets theme,+                   ddWidgetPlaces = WidgetLayout [] [] []+                  }++-- | Mouse focus and mouse drag are handled by the same function, this+-- way we can start dragging unfocused windows too.+handleMouseFocusDrag :: (DecorationEngine engine widget a, Shrinker shrinker) => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X ()+handleMouseFocusDrag ds theme (DecorationLayoutState {dsDecorations}) _ (ButtonEvent {ev_window, ev_x_root, ev_y_root, ev_event_type, ev_button})+    | ev_event_type == buttonPress+    , Just (WindowDecoration {..}) <- findDecoDataByDecoWindow ev_window dsDecorations = do+        let decoRect@(Rectangle dx dy _ _) = fromJust wdDecoRect+            x = fi $ ev_x_root - fi dx+            y = fi $ ev_y_root - fi dy+            button = fi ev_button+        dealtWith <- handleDecorationClick ds theme decoRect (map wpRectangle wdWidgets) wdOrigWindow x y button+        unless dealtWith $ when (isDraggingEnabled theme button) $+            mouseDrag (\dragX dragY -> focus wdOrigWindow >> decorationWhileDraggingHook ds ev_x_root ev_y_root (wdOrigWindow, wdOrigWinRect) dragX dragY)+                      (decorationAfterDraggingHook ds (wdOrigWindow, wdOrigWinRect) ev_window)+handleMouseFocusDrag _ _ _ _ _ = return ()++-- | Given a window and the state, if a matching decoration is in the+-- state return it with its ('Maybe') 'Rectangle'.+findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration+findDecoDataByDecoWindow decoWin = find (\dd -> wdDecoWindow dd == Just decoWin)++decorationHandler :: forall engine widget a.+                     (DecorationEngine engine widget a,+                      ClickHandler (Theme engine) widget)+                  => engine widget a+                  -> Theme engine widget+                  -> Rectangle+                  -> [Rectangle]+                  -> Window+                  -> Int+                  -> Int+                  -> Int+                  -> X Bool+decorationHandler _ theme _ widgetPlaces window x y button = do+    widgetDone <- go $ zip (widgetLayout $ themeWidgets theme) widgetPlaces+    if widgetDone+      then return True+      else case onDecorationClick theme button of+             Just cmd -> do+               executeWindowCommand cmd window+             Nothing -> return False+  where+    go :: [(widget, Rectangle)] -> X Bool+    go [] = return False+    go ((w, rect) : rest) = do+      if pointWithin (fi x) (fi y) rect+        then do+          executeWindowCommand (widgetCommand w button) window+        else go rest++-- | Simple implementation of @paintDecoration@ method.+-- This is used by @TextEngine@ and can be re-used by other decoration+-- engines.+paintDecorationSimple :: forall engine shrinker widget.+                          (DecorationEngine engine widget Window,+                           DecorationPaintingContext engine ~ XPaintingContext,+                           Shrinker shrinker,+                           Style (Theme engine widget) ~ SimpleStyle)+                       => engine widget Window+                       -> Window+                       -> Dimension+                       -> Dimension+                       -> shrinker+                       -> DrawData engine widget+                       -> Bool+                       -> X ()+paintDecorationSimple deco win windowWidth windowHeight shrinker dd isExpose = do+    dpy <- asks display+    let widgets = widgetLayout $ ddWidgets dd+        style = ddStyle dd+    pixmap  <- io $ createPixmap dpy win windowWidth windowHeight (defaultDepthOfScreen $ defaultScreenOfDisplay dpy)+    gc <- io $ createGC dpy pixmap+    -- draw+    io $ setGraphicsExposures dpy gc False+    bgColor <- stringToPixel dpy (sBgColor style)+    -- we start with the border+    let borderWidth = sDecoBorderWidth style+        borderColors = sDecorationBorders style+    when (borderWidth > 0) $ do+      drawLineWith dpy pixmap gc 0 0 windowWidth borderWidth (bxTop borderColors)+      drawLineWith dpy pixmap gc 0 0 borderWidth windowHeight (bxLeft borderColors)+      drawLineWith dpy pixmap gc 0 (fi (windowHeight - borderWidth)) windowWidth borderWidth (bxBottom borderColors)+      drawLineWith dpy pixmap gc (fi (windowWidth - borderWidth)) 0 borderWidth windowHeight (bxRight borderColors)++    -- and now again+    io $ setForeground dpy gc bgColor+    io $ fillRectangle dpy pixmap gc (fi borderWidth) (fi borderWidth) (windowWidth - (borderWidth * 2)) (windowHeight - (borderWidth * 2))++    -- paint strings+    forM_ (zip widgets $ widgetLayout $ ddWidgetPlaces dd) $ \(widget, place) ->+        paintWidget deco (dpy, pixmap, gc) place shrinker dd widget isExpose++    -- debug+    -- black <- stringToPixel dpy "black"+    -- io $ setForeground dpy gc black+    -- forM_ (ddWidgetPlaces dd) $ \(WidgetPlace {wpRectangle = Rectangle x y w h}) ->+    --   io $ drawRectangle dpy pixmap gc x y w h++    -- copy the pixmap over the window+    io $ copyArea      dpy pixmap win gc 0 0 windowWidth windowHeight 0 0+    -- free the pixmap and GC+    io $ freePixmap    dpy pixmap+    io $ freeGC        dpy gc+  where+    drawLineWith dpy pixmap gc x y w h colorName = do+      color <- stringToPixel dpy colorName+      io $ setForeground dpy gc color+      io $ fillRectangle dpy pixmap gc x y w h+
+ XMonad/Layout/DecorationEx/Geometry.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.Geometry+-- Description :  Type class which is responsible for defining the placement+--                of window decorations+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module defines @DecorationGeometry@ type class, and default implementation for it.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.Geometry (+    DecorationGeometry (..),+    DefaultGeometry (..)+  ) where++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W+import qualified XMonad.Layout.Decoration as D++-- | Decoration geometry class.+-- Decoration geometry is responsible for placement of window decorations: whether+-- they should be on the top of the window or on the bottom, should they go for +-- full window width or only be of certain width, etc.+-- This does not know what will be drawn inside decorations.+class (Read (geom a), Show (geom a),+       Eq a)+    => DecorationGeometry geom a where++    -- | Give a name to decoration geometry implementation.+    describeGeometry :: geom a -> String++    -- | Reduce original window size to make space for decoration, if necessary.+    shrinkWindow :: geom a -> Rectangle -> Rectangle -> Rectangle+    shrinkWindow _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh)++    -- | The pure version of the main method, 'decorate'.+    -- The method should return a rectangle where to place window decoration,+    -- or 'Nothing' if this window is not to be decorated.+    pureDecoration :: geom a          -- ^ Decoration geometry instance+                   -> Rectangle       -- ^ Screen rectangle+                   -> W.Stack a       -- ^ Current stack of windows being displayed+                   -> [(a,Rectangle)] -- ^ Set of all windows with their corresponding rectangle+                   -> (a,Rectangle)   -- ^ Window being decorated and its rectangle+                   -> Maybe Rectangle++    -- | The method should return a rectangle where to place window decoration,+    -- or 'Nothing' if this window is not to be decorated.+    decorateWindow :: geom a           -- ^ Decoration geometry instance+                   -> Rectangle        -- ^ Screen rectangle+                   -> W.Stack a        -- ^ Current stack of windows being displayed+                   -> [(a, Rectangle)] -- ^ Set of all windows with their corresponding rectangle+                   -> (a, Rectangle)   -- ^ Window being decorated and its rectangle+                   -> X (Maybe Rectangle)+    decorateWindow geom r s wrs wr = return $ pureDecoration geom r s wrs wr++-- | Data type for default implementation of 'DecorationGeometry'.+-- This defines simple decorations: a horizontal bar at the top of each window,+-- running for full width of the window.+newtype DefaultGeometry a = DefaultGeometry {+    gDecorationHeight :: Dimension+  }+  deriving (Read, Show)++instance Eq a => DecorationGeometry DefaultGeometry a where+  describeGeometry _ = "Default"++  pureDecoration (DefaultGeometry {..}) _ s _ (w, Rectangle x y windowWidth windowHeight) =+      if D.isInStack s w && (gDecorationHeight < windowHeight)+        then Just $ Rectangle x y windowWidth gDecorationHeight+        else Nothing++instance Default (DefaultGeometry a) where+  def = DefaultGeometry 20+
+ XMonad/Layout/DecorationEx/LayoutModifier.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.LayoutModifier+-- Description :  Layout modifier which adds decorations to windows.+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layout modifier, which is responsible for creation of decoration rectangles+-- (windows), updating and removing them when needed. It is parameterized by+-- @DecorationGeometry@, which says where decorations should be placed, and by+-- @DecorationEngine@, which says how decorations should look.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.LayoutModifier (+    -- * Usage+    --+    -- $usage+    decorationEx,+    DecorationEx+  ) where++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutModifier+import XMonad.Layout.WindowArranger (diff, listFromList)+import XMonad.Util.Invisible+import XMonad.Util.XUtils hiding (paintTextAndIcons)++import XMonad.Layout.DecorationEx.Common+import XMonad.Layout.DecorationEx.Engine+import XMonad.Layout.DecorationEx.Geometry++-- $usage+--+-- This module exports @decorationEx@ function, which is a generic function for+-- adding decorations to your layouts. It can be used to use different+-- decoration geometries and engines in any combination.+-- For most used combinations, there are convenience functions in+-- "XMonad.Layout.DecorationEx.TextEngine", "XMonad.Layout.DecorationEx.TabbedGeometry",+-- and "XMonad.Layout.DecorationEx.DwmGeometry".+--+-- You can use this module with the following in your+-- @xmonad.hs@:+--+-- > import XMonad.Layout.DecorationEx.LayoutModifier+-- Then edit your @layoutHook@ by adding the DwmStyle decoration to+-- your layout:+--+-- > myL = decorationEx shrinkText myTheme myEngine myGeometry (layoutHook def)+-- >         where+-- >           myGeometry = DefaultGeometry -- or another geometry type+-- >           myEngine = TextDecoration    -- or another decoration engine+-- >           myTheme = GenericTheme {...} -- theme type should correspond to selected engine type+-- >+-- > main = xmonad def { layoutHook = myL }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+++-- | The 'DecorationEx' 'LayoutModifier'. This data type is an instance+-- of the 'LayoutModifier' class. This data type will be passed,+-- together with a layout, to the 'ModifiedLayout' type constructor+-- to modify the layout by adding decorations according to a+-- 'DecorationEngine'.+data DecorationEx engine widget geom shrinker a =+    DecorationEx (Invisible Maybe (DecorationLayoutState engine)) shrinker (Theme engine widget) (engine widget a) (geom a)++deriving instance (Show (Theme engine widget), Show shrinker, Show (engine widget a), Show (geom a)) => Show (DecorationEx engine widget geom shrinker a)+deriving instance (Read (Theme engine widget), Read shrinker, Read (engine widget a), Read (geom a)) => Read (DecorationEx engine widget geom shrinker a)++-- | The long 'LayoutModifier' instance for the 'DecorationEx' type.+--+-- In 'redoLayout' we check the state: if there is no state we+-- initialize it.+--+-- The state is @diff@ed against the list of windows produced by the+-- underlying layout: removed windows get deleted and new ones+-- decorated by 'createDecos', which will call 'decorate' to decide if+-- a window must be given a 'Rectangle', in which case a decoration+-- window will be created.+--+-- After that we resync the updated state with the windows' list and+-- then we process the resynced stated (as we do with a new state).+--+-- First we map the decoration windows, we update each decoration to+-- reflect any decorated window's change, and we insert, in the list+-- of windows and rectangles returned by the underlying layout, the+-- decoration for each window. This way xmonad will restack the+-- decorations and their windows accordingly. At the end we remove+-- invisible\/stacked windows.+--+-- Message handling is quite simple: when needed we release the state+-- component of the 'DecorationEx' 'LayoutModifier'. Otherwise we call+-- 'handleEvent', which will call the appropriate 'DecorationEngine'+-- methods to perform its tasks.+instance (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => LayoutModifier (DecorationEx engine widget geom shrinker) Window where+    redoLayout (DecorationEx (I (Just decoState)) shrinker theme engine geom) _ Nothing _ = do+        releaseResources engine decoState+        return ([], Just $ DecorationEx (I Nothing) shrinker theme engine geom)+    redoLayout _ _ Nothing _  = return ([], Nothing)++    redoLayout (DecorationEx invState shrinker theme engine geom) screenRect (Just stack) srcPairs+        | I Nothing  <- invState = initState theme engine geom shrinker screenRect stack srcPairs >>= processState+        | I (Just s) <- invState = do+            let decorations  = dsDecorations s+                (d,a) = curry diff (getOrigWindows decorations) srcWindows+                toDel = todel d decorations+                toAdd = toadd a srcPairs+            deleteDecos toDel+            let decosToBeAdded = [WindowDecoration win rect Nothing Nothing [] | (win, rect) <- toAdd]+            newDecorations <- resync (dsStyleState s) (decosToBeAdded ++ del_dwrs d decorations) srcPairs+            processState (s {dsDecorations = newDecorations})++        where+          srcWindows = map fst srcPairs++          getOrigWindows :: [WindowDecoration] -> [Window]+          getOrigWindows = map wdOrigWindow++          del_dwrs :: [Window] -> [WindowDecoration] -> [WindowDecoration]+          del_dwrs = listFromList wdOrigWindow notElem++          findDecoWindow :: Int -> [WindowDecoration] -> Maybe Window+          findDecoWindow i d = wdDecoWindow $ d !! i++          todel :: [Window] -> [WindowDecoration] -> [WindowDecoration]+          todel d = filter (\dd -> wdOrigWindow dd `elem` d)++          toadd :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]+          toadd a = filter (\p -> fst p `elem` a)++          createDecoWindowIfNeeded :: Maybe Window -> Maybe Rectangle -> X (Maybe Window)+          createDecoWindowIfNeeded mbDecoWindow mbDecoRect =+            case (mbDecoWindow, mbDecoRect) of+              (Nothing, Just decoRect) -> do+                decoWindow <- createDecoWindow engine theme decoRect+                return $ Just decoWindow+              _ -> return mbDecoWindow++          resync :: DecorationEngineState engine -> [WindowDecoration] -> [(Window,Rectangle)] -> X [WindowDecoration]+          resync _ _ [] = return []+          resync decoState dd ((window,rect):xs) =+            case  window `elemIndex` getOrigWindows dd of+              Just i  -> do+                mbDecoRect <- decorateWindow geom screenRect stack srcPairs (window,rect)+                widgetPlaces <- case mbDecoRect of+                                  Nothing -> return $ WidgetLayout [] [] []+                                  Just decoRect -> placeWidgets engine theme shrinker decoState decoRect window (themeWidgets theme)+                mbDecoWindow  <- createDecoWindowIfNeeded (findDecoWindow i dd) mbDecoRect+                let newDd = WindowDecoration window rect mbDecoWindow mbDecoRect (widgetLayout widgetPlaces)+                restDd <- resync decoState dd xs+                return $ newDd : restDd+              Nothing -> resync decoState dd xs++          -- We drop any windows that are *precisely* stacked underneath+          -- another window: these must be intended to be tabbed!+          removeTabbed :: [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)]+          removeTabbed _ [] = []+          removeTabbed rs ((w,r):xs)+              | r `elem` rs = removeTabbed rs xs+              | otherwise   = (w,r) : removeTabbed (r:rs) xs++          insertDwr :: WindowDecoration -> [(Window, Rectangle)] -> [(Window, Rectangle)]+          insertDwr dd wrs =+            case (wdDecoWindow dd, wdDecoRect dd) of+              (Just decoWindow, Just decoRect) -> (decoWindow, decoRect) : (wdOrigWindow dd, shrinkWindow geom decoRect (wdOrigWinRect dd)) : wrs+              _ -> (wdOrigWindow dd, wdOrigWinRect dd) : wrs++          dwrs_to_wrs :: [WindowDecoration] -> [(Window, Rectangle)]+          dwrs_to_wrs = removeTabbed [] . foldr insertDwr []++          processState :: DecorationLayoutState engine -> X ([(Window, Rectangle)], Maybe (DecorationEx engine widget geom shrinker Window))+          processState st = do+            let decorations = dsDecorations st+            showDecos decorations+            updateDecos engine shrinker theme (dsStyleState st) decorations+            return (dwrs_to_wrs decorations, Just (DecorationEx (I (Just (st {dsDecorations = decorations}))) shrinker theme engine geom))++    handleMess (DecorationEx (I (Just st)) shrinker theme engine geom) m+        | Just Hide <- fromMessage m = do+            hideDecos $ dsDecorations st+            return Nothing+--         | Just (SetTheme nt) <- fromMessage m = do+--             releaseResources engine st+--             let t' = themeEx nt+--             return $ Just $ DecorationEx (I Nothing) shrinker t' engine+        | Just ReleaseResources <- fromMessage m = do+            releaseResources engine st+            return $ Just $ DecorationEx (I Nothing) shrinker theme  engine geom+        | Just e <- fromMessage m = do+            decorationEventHookEx engine theme st shrinker e+            handleEvent engine shrinker theme st e+            return Nothing+    handleMess _ _ = return Nothing++    modifierDescription (DecorationEx _ _ _ engine geom) = describeEngine engine ++ describeGeometry geom++-- | By default 'DecorationEx' handles 'PropertyEvent' and 'ExposeEvent'+-- only.+handleEvent :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationLayoutState engine -> Event -> X ()+handleEvent engine shrinker theme (DecorationLayoutState {..}) e+    | PropertyEvent {ev_window = w, ev_atom = atom} <- e+    , Just i <- w `elemIndex` map wdOrigWindow dsDecorations = do+        supportedAtoms <- propsToRepaintDecoration engine+        when (atom `elem` supportedAtoms) $ do+          -- io $ putStrLn $ "property event on " ++ show w -- ++ ": " ++ fromMaybe "<?>" atomName+          updateDeco engine shrinker theme dsStyleState (dsDecorations !! i) False+    | ExposeEvent   {ev_window = w} <- e+    , Just i <- w `elemIndex` mapMaybe wdDecoWindow dsDecorations = do+        -- io $ putStrLn $ "expose event on " ++ show w+        updateDeco engine shrinker theme dsStyleState (dsDecorations !! i) True+handleEvent _ _ _ _ _ = return ()++-- | Initialize the 'DecorationState' by initializing the font+-- structure and by creating the needed decorations.+initState :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker)+          => Theme engine widget+          -> engine widget Window+          -> geom Window+          -> shrinker+          -> Rectangle+          -> W.Stack Window+          -> [(Window,Rectangle)] -> X (DecorationLayoutState engine)+initState theme engine geom shrinker screenRect stack wrs = do+  styleState <- initializeState engine geom theme+  decorations <- createDecos theme engine geom shrinker styleState screenRect stack wrs wrs+  return $ DecorationLayoutState styleState decorations++-- | Delete windows stored in the state and release the font structure.+releaseResources :: DecorationEngine engine widget Window => engine widget Window -> DecorationLayoutState engine -> X ()+releaseResources engine st = do+  deleteDecos (dsDecorations st)+  releaseStateResources engine (dsStyleState st)++-- | Create the decoration windows of a list of windows and their+-- rectangles, by calling the 'decorate' method of the+-- 'DecorationStyle' received.+createDecos :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker)+            => Theme engine widget+            -> engine widget Window+            -> geom Window+            -> shrinker+            -> DecorationEngineState engine+            -> Rectangle+            -> W.Stack Window+            -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [WindowDecoration]+createDecos theme engine geom shrinker decoState screenRect stack wrs ((w,r):xs) = do+  mbDecoRect <- decorateWindow geom screenRect stack wrs (w,r)+  case mbDecoRect of+    Just decoRect -> do+      decoWindow <- createDecoWindow engine theme decoRect+      widgetPlaces <- placeWidgets engine theme shrinker decoState decoRect w (themeWidgets theme)+      restDd <- createDecos theme engine geom shrinker decoState screenRect stack wrs xs+      let newDd = WindowDecoration w r (Just decoWindow) (Just decoRect) $ widgetLayout widgetPlaces+      return $ newDd : restDd+    Nothing -> do+      restDd <- createDecos theme engine geom shrinker decoState screenRect stack wrs xs+      let newDd = WindowDecoration w r Nothing Nothing []+      return $ newDd : restDd+createDecos _ _ _ _ _ _ _ _ [] = return []++createDecoWindow :: (DecorationEngine engine widget Window) => engine widget Window -> Theme engine widget -> Rectangle -> X Window+createDecoWindow engine theme rect = do+  let mask = Just $ decorationXEventMask engine+  w <- createNewWindow rect mask (defaultBgColor theme) True+  d <- asks display+  io $ setClassHint d w (ClassHint "xmonad-decoration" "xmonad")+  return w++showDecos :: [WindowDecoration] -> X ()+showDecos dd =+  showWindows $ mapMaybe wdDecoWindow $ filter (isJust . wdDecoRect) dd++hideDecos :: [WindowDecoration] -> X ()+hideDecos = hideWindows . mapMaybe wdDecoWindow++deleteDecos :: [WindowDecoration] -> X ()+deleteDecos = deleteWindows . mapMaybe wdDecoWindow++updateDecos :: (Shrinker shrinker, DecorationEngine engine widget Window)+            => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> [WindowDecoration] -> X ()+updateDecos engine shrinker theme decoState = mapM_ (\wd -> updateDeco engine shrinker theme decoState wd False)++-- | Update a decoration window given a shrinker, a theme, the font+-- structure and the needed 'Rectangle's+updateDeco :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> WindowDecoration -> Bool -> X ()+updateDeco engine shrinker theme decoState wd isExpose =+  case (wdDecoWindow wd, wdDecoRect wd) of+    (Just decoWindow, Just decoRect@(Rectangle _ _ wh ht)) -> do+      let origWin = wdOrigWindow wd+      drawData <- mkDrawData engine theme decoState origWin decoRect+      widgetPlaces <- placeWidgets engine theme shrinker decoState decoRect (wdOrigWindow wd) (themeWidgets theme)+      -- io $ print widgetPlaces+      paintDecoration engine decoWindow wh ht shrinker (drawData {ddWidgetPlaces = widgetPlaces}) isExpose+    (Just decoWindow, Nothing) -> hideWindow decoWindow+    _ -> return ()++-- | Apply a DecorationEx modifier to an underlying layout+decorationEx :: (DecorationEngine engine widget a, DecorationGeometry geom a, Shrinker shrinker)+             => shrinker             -- ^ Strings shrinker, for example @shrinkText@+             -> Theme engine widget  -- ^ Decoration theme+             -> engine widget a      -- ^ Decoration engine instance+             -> geom a               -- ^ Decoration geometry instance+             -> l a                  -- ^ Underlying layout to be decorated+             -> ModifiedLayout (DecorationEx engine widget geom shrinker) l a+decorationEx shrinker theme engine geom = ModifiedLayout (DecorationEx (I Nothing) shrinker theme engine geom)+
+ XMonad/Layout/DecorationEx/TabbedGeometry.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.TabbedGeometry+-- Description :  Tab-based window decoration geometry+-- Copyright   :  (c) 2007 Andrea Rossato, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module defines window decoration geometry based on tabs.+-- The tabs can follow horizontally and be placed above or below windows;+-- in such case, tabs can occupy full width of the window or be aligned to+-- left or right. Or tabs can go vertically near left or right side of+-- the window.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.TabbedGeometry (+    textTabbed,+    TabbedGeometry (..),+    HorizontalTabPlacement (..),+    VerticalTabPlacement (..),+    HorizontalTabWidth (..),+    HorizontalTabsAlignment (..),+    SingleTabMode (..)+  ) where ++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Prelude+import XMonad.Layout.Decoration (ModifiedLayout, Shrinker (..))++import XMonad.Layout.DecorationEx.LayoutModifier+import XMonad.Layout.DecorationEx.Common+import XMonad.Layout.DecorationEx.Geometry+import XMonad.Layout.DecorationEx.Widgets+import XMonad.Layout.DecorationEx.TextEngine++-- | Placement of tabs when they go horizontally:+-- should they be placed above or below the window.+data HorizontalTabPlacement = Top | Bottom+  deriving (Eq, Read, Show)++-- | Placement of tabs when they go vertically:+-- should they appear at left or at right side of the window.+data VerticalTabPlacement = TabsAtLeft | TabsAtRight+  deriving (Eq, Read, Show)++-- | Width of tabs when they go horizontally.+data HorizontalTabWidth =+      AutoWidth             -- ^ Define the width automatically by evenly dividing windows' width+    | FixedWidth !Dimension -- ^ Use fixed width of the tab+  deriving (Eq, Read, Show)++-- | Alignment of tabs when they go horizontally.+data HorizontalTabsAlignment = AlignTabsLeft | AlignTabsCenter | AlignTabsRight+  deriving (Eq, Read, Show)++-- | What to do if there is only one tab.+data SingleTabMode = ShowTab | HideTab+  deriving (Eq, Read, Show)++data TabbedGeometry a =+      HorizontalTabs {+          showIfSingleWindow :: !SingleTabMode      -- ^ What to do if there is only one tab+        , hTabPlacement :: !HorizontalTabPlacement  -- ^ Where to place horizontal tabs+        , hTabAlignment :: !HorizontalTabsAlignment -- ^ How to align horizontal tabs (makes sense with fixed width of tabs).+        , hTabWidth :: !HorizontalTabWidth          -- ^ Width of horizontal tabs+        , hTabHeight :: !Dimension                  -- ^ Height of horizontal tabs+      }+    | VerticalTabs {+          showIfSingleWindow :: !SingleTabMode      -- ^ What to do if there is only one tab+        , vTabPlacement :: !VerticalTabPlacement    -- ^ Where to place vertical tabs+        , vTabWidth :: !Dimension                   -- ^ Width of vertical tabs+        , vTabHeight :: !Dimension                  -- ^ Height of vertical tabs+      }+  deriving (Show, Read)++instance Default (TabbedGeometry a) where+  def = HorizontalTabs ShowTab Top AlignTabsLeft AutoWidth 20 ++instance DecorationGeometry TabbedGeometry Window where++  describeGeometry _ = "Tabbed"++  pureDecoration tabs _ stack wrs (window, windowRect) =+    let Rectangle windowX windowY windowWidth windowHeight = windowRect+        -- windows that are mapped onto the same rectangle as current one are considered to+        -- be in one tabs group+        tabbedWindows = filter (`elem` map fst (filter ((==windowRect) . snd) wrs)) (W.integrate stack)+        mbWindowIndex = window `elemIndex` tabbedWindows+        numWindows = length tabbedWindows+    in  if numWindows > 1 || (showIfSingleWindow tabs == ShowTab && numWindows > 0)+          then+            case tabs of+              HorizontalTabs {..} ->+                  Just $ case hTabPlacement of+                            Top    -> Rectangle decoX windowY effectiveTabWidth hTabHeight+                            Bottom -> Rectangle decoX (windowY + fi (windowHeight - hTabHeight)) effectiveTabWidth hTabHeight+                where+                  decoX = maybe windowX tabX mbWindowIndex++                  -- If there are too many windows or configured tab width+                  -- is too big, then we have to switch to 'auto' mode.+                  hTabWidth' =+                    case hTabWidth of+                      AutoWidth -> AutoWidth+                      FixedWidth tabWidth+                        | tabWidth * fi numWindows > windowWidth -> AutoWidth+                        | otherwise -> FixedWidth tabWidth++                  effectiveTabWidth =+                    case hTabWidth' of+                      AutoWidth -> fi $ maybe windowX (\i -> tabX (i+1) - tabX i) mbWindowIndex+                      FixedWidth tabWidth -> tabWidth++                  allTabsWidth =+                    case hTabWidth' of+                      AutoWidth -> fi windowWidth+                      FixedWidth _ -> fi $ min windowWidth $ effectiveTabWidth * max 1 (fi numWindows)++                  tabsStartX =+                    case hTabAlignment of+                      AlignTabsLeft -> windowX+                      AlignTabsRight -> windowX + fi windowWidth - allTabsWidth+                      AlignTabsCenter -> windowX + (fi windowWidth - allTabsWidth) `div` 2++                  -- X coordinate of i'th window in horizontal tabs layout+                  tabX i = tabsStartX ++                        case hTabWidth' of+                          AutoWidth -> fi ((windowWidth * fi i) `div` max 1 (fi numWindows))+                          FixedWidth _ -> fi effectiveTabWidth * fi i++              VerticalTabs {..} ->+                  Just $ case vTabPlacement of+                            TabsAtLeft  -> fixHeightTab windowX+                            TabsAtRight -> fixHeightTab (windowX + fi (windowWidth - vTabWidth))+                where+                  fixHeightLoc i = windowY + fi vTabHeight * fi i+                  fixHeightTab x = Rectangle x+                        (maybe windowY fixHeightLoc mbWindowIndex) vTabWidth vTabHeight+          else Nothing++  shrinkWindow tabs (Rectangle _ _ dw dh) (Rectangle x y w h) =+    case tabs of+      HorizontalTabs {..} ->+        case hTabPlacement of+            Top -> Rectangle x (y + fi dh) w (h - dh)+            Bottom -> Rectangle x y w (h - dh)+      VerticalTabs {..} ->+        case vTabPlacement of+            TabsAtLeft  -> Rectangle (x + fi dw) y (w - dw) h+            TabsAtRight -> Rectangle x y (w - dw) h++-- | Add tabbed decorations (with default settings) with text-based widgets to a layout.+textTabbed :: (Shrinker shrinker)+           => shrinker               -- ^ Strings shrinker, e.g. @shrinkText@+           -> ThemeEx StandardWidget -- ^ Decoration theme+           -> l Window               -- ^ Layout to be decorated+           -> ModifiedLayout (DecorationEx TextDecoration StandardWidget TabbedGeometry shrinker) l Window+textTabbed shrinker theme = decorationEx shrinker theme TextDecoration def+
+ XMonad/Layout/DecorationEx/TextEngine.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.TextEngine+-- Description :  Text-based window decoration engine+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- Window decoration engine, that uses text fragments (like @"[X]"@) to indicate+-- widgets (window buttons).+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.TextEngine (+    textDecoration,+    TextDecoration (..)+  ) where ++import XMonad+import XMonad.Prelude+import XMonad.Layout.LayoutModifier+import XMonad.Util.Font++import XMonad.Layout.DecorationEx.LayoutModifier+import XMonad.Layout.DecorationEx.Common+import XMonad.Layout.DecorationEx.Engine+import XMonad.Layout.DecorationEx.Geometry+import XMonad.Layout.DecorationEx.Widgets++-- | Decoration engine data type+data TextDecoration widget a = TextDecoration+  deriving (Show, Read)++instance (TextWidget widget, ClickHandler (GenericTheme SimpleStyle) widget)+  => DecorationEngine TextDecoration widget Window where+  type Theme TextDecoration = GenericTheme SimpleStyle+  type DecorationPaintingContext TextDecoration = XPaintingContext+  type DecorationEngineState TextDecoration = XMonadFont++  describeEngine _ = "TextDecoration"++  calcWidgetPlace = calcTextWidgetPlace++  paintWidget = paintTextWidget++  paintDecoration = paintDecorationSimple++  initializeState _ _ theme = initXMF (themeFontName theme)+  releaseStateResources _ = releaseXMF++-- | Implementation of @paintWidget@ for decoration engines based on @TextDecoration@.+paintTextWidget :: (TextWidget widget,+                    Style (Theme engine widget) ~ SimpleStyle,+                    DecorationPaintingContext engine ~ XPaintingContext,+                    DecorationEngineState engine ~ XMonadFont,+                    Shrinker shrinker,+                    DecorationEngine engine widget Window)+                => engine widget Window+                -> DecorationPaintingContext engine+                -> WidgetPlace+                -> shrinker+                -> DrawData engine widget+                -> widget+                -> Bool+                -> X ()+paintTextWidget engine (dpy, pixmap, gc) place shrinker dd widget _ = do+    let style = ddStyle dd+        rect = wpRectangle place+        x = rect_x rect+        y = wpTextYPosition place+    str <- widgetString dd widget+    str' <- if isShrinkable widget+              then getShrinkedWindowName engine shrinker (ddEngineState dd) str (rect_width rect) (rect_height rect)+              else return str+    printStringXMF dpy pixmap (ddEngineState dd) gc (sTextColor style) (sTextBgColor style) x y str'++-- | Implementation of @calcWidgetPlace@ for decoration engines based on @TextDecoration@.+calcTextWidgetPlace :: (TextWidget widget,+                        DecorationEngineState engine ~ XMonadFont,+                        DecorationEngine engine widget Window)+                    => engine widget Window+                    -> DrawData engine widget+                    -> widget+                    -> X WidgetPlace+calcTextWidgetPlace _ dd widget = do+    str <- widgetString dd widget+    let h = rect_height (ddDecoRect dd)+        font = ddEngineState dd+    withDisplay $ \dpy -> do+      width <- fi <$> textWidthXMF dpy (ddEngineState dd) str+      (a, d) <- textExtentsXMF font str+      let height = a + d+          y = fi $ (h - fi height) `div` 2+          y0 = y + fi a+          rect = Rectangle 0 y width (fi height)+      return $ WidgetPlace y0 rect++-- | Add decoration to existing layout. Widgets are indicated by text fragments, like @"[+]"@.+-- Geometry is simple: a horizontal panel at the top of each window, going for the full width+-- of the window.+textDecoration :: (Shrinker shrinker)+               => shrinker                -- ^ String shrinker, for example @shrinkText@+               -> Theme TextDecoration StandardWidget  -- ^ Decoration theme (font, colors, widgets, etc)+               -> l Window                -- ^ Layout to be decorated+             -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window+textDecoration shrinker theme = decorationEx shrinker theme TextDecoration def+
+ XMonad/Layout/DecorationEx/Widgets.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationEx.Widgets+-- Description :  Definitions for decoration widgets (window buttons etc)+-- Copyright   :  2023 Ilya Portnov+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  portnov84@rambler.ru+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module contains data types and utilities to deal with decoration+-- widgets. A widget is anything that is displayed on window decoration,+-- and, optionally, can react on clicks. Examples of widgets are usual+-- window buttons (minimize, maximize, close), window icon and window title.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationEx.Widgets (+    -- * Data types+    StandardCommand (..),+    TextWidget (..),+    GenericWidget (..),+    StandardWidget,+    -- * Utility functions+    isWidgetChecked,+    -- * Presets for standard widgets+    titleW, toggleStickyW, minimizeW,+    maximizeW, closeW, dwmpromoteW,+    moveToNextGroupW,moveToPrevGroupW+  ) where ++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Actions.DwmPromote+import qualified XMonad.Actions.CopyWindow as CW+import qualified XMonad.Layout.Groups.Examples as Ex+import XMonad.Layout.Maximize+import XMonad.Actions.Minimize+import XMonad.Actions.WindowMenu++import XMonad.Layout.DecorationEx.Common+import XMonad.Layout.DecorationEx.Engine++-- | Standard window commands.+--+-- One can extend this list by simply doing+--+-- > data MyWindowCommand =+-- >     Std StandardCommand+-- >   | SomeFancyCommand+--+-- > instance WindowCommand MyWindowCommand where ...+--+-- > type MyWidget = GenericWidget MyWindowCommand+--+data StandardCommand =+      FocusWindow      -- ^ Focus the window+    | FocusUp          -- ^ Move focus to previous window+    | FocusDown        -- ^ Move focus to following window+    | MoveToNextGroup  -- ^ Move the window to the next group (see "XMonad.Layout.Groups")+    | MoveToPrevGroup  -- ^ Move the window to the previous group+    | DwmPromote       -- ^ Execute @dwmpromote@ (see "XMonad.Actions.DwmPromote")+    | ToggleSticky     -- ^ Make window sticky or unstick it (see "XMonad.Actions.CopyWindow")+    | ToggleMaximize   -- ^ Maximize or restore window (see "XMonad.Layout.Maximize")+    | Minimize         -- ^ Minimize window (see "XMonad.Actions.Minimize")+    | CloseWindow      -- ^ Close the window+    | GridWindowMenu   -- ^ Show window menu via "XMonad.Actions.GridSelect" (see "XMonad.Actions.WindowMenu")+  deriving (Eq, Show, Read)++instance Default StandardCommand where+  def = FocusWindow++instance WindowCommand StandardCommand where+  executeWindowCommand FocusWindow w = do+    focus w+    return False+  executeWindowCommand FocusUp _ = do+    windows W.focusUp+    withFocused maximizeWindowAndFocus+    return True+  executeWindowCommand FocusDown _ = do+    windows W.focusDown+    withFocused maximizeWindowAndFocus+    return True+  executeWindowCommand MoveToNextGroup w = do+    focus w+    Ex.moveToGroupDown False+    return True+  executeWindowCommand MoveToPrevGroup w = do+    focus w+    Ex.moveToGroupUp False+    return True+  executeWindowCommand CloseWindow w = do+    killWindow w+    return True+  executeWindowCommand DwmPromote w = do+    focus w+    dwmpromote+    return True+  executeWindowCommand ToggleSticky w = do+    focus w+    copies <- CW.wsContainingCopies+    if null copies+      then windows CW.copyToAll+      else CW.killAllOtherCopies+    return True+  executeWindowCommand ToggleMaximize w = do+    sendMessage $ maximizeRestore w+    focus w+    return True+  executeWindowCommand Minimize w = do+    minimizeWindow w+    return True+  executeWindowCommand GridWindowMenu w = do+    focus w+    windowMenu+    return True++  isCommandChecked FocusWindow _ = return False+  isCommandChecked DwmPromote w = do+      withWindowSet $ \ws -> return $ Just w == master ws+    where+      master ws =+        case W.integrate' $ W.stack $ W.workspace $ W.current ws of+          [] -> Nothing+          (x:_) -> Just x+  isCommandChecked ToggleSticky w = do+    ws <- gets windowset+    let copies = CW.copiesOfOn (Just w) (CW.taggedWindows $ W.hidden ws)+    return $ not $ null copies+  isCommandChecked _ _ = return False++-- | Generic data type for decoration widgets.+data GenericWidget cmd =+      TitleWidget                      -- ^ Window title (just text label)+    | WindowIcon { swCommand :: !cmd } -- ^ Window icon with some associated command+    -- | Other widgets+    | GenericWidget {+        swCheckedText :: !String       -- ^ Text for checked widget state+      , swUncheckedText :: !String     -- ^ Text for unchecked widget state+      , swCommand :: !cmd              -- ^ Window command+    }+    deriving (Show, Read)++-- | Generic widget type specialized for 'StandardCommand'+type StandardWidget = GenericWidget StandardCommand++instance (Default cmd, Read cmd, Show cmd, WindowCommand cmd) => DecorationWidget (GenericWidget cmd) where++  type WidgetCommand (GenericWidget cmd) = cmd++  widgetCommand TitleWidget _ = def+  widgetCommand w 1 = swCommand w+  widgetCommand _ _ = def++  isShrinkable TitleWidget = True+  isShrinkable _ = False++-- | Check if the widget should be displayed in `checked' state.+isWidgetChecked :: DecorationWidget widget => widget -> Window -> X Bool+isWidgetChecked wdt = isCommandChecked (widgetCommand wdt 1)++-- | Type class for widgets that can be displayed as+-- text fragments by 'TextDecoration' engine.+class DecorationWidget widget => TextWidget widget where+  widgetString :: DrawData engine widget -> widget -> X String++instance TextWidget StandardWidget where+    widgetString dd TitleWidget = return $ ddWindowTitle dd+    widgetString _ (WindowIcon {}) = return "[*]"+    widgetString dd w = do+      checked <- isWidgetChecked w (ddOrigWindow dd)+      if checked+        then return $ swCheckedText w+        else return $ swUncheckedText w++-- | Widget for window title+titleW :: StandardWidget+titleW = TitleWidget++-- | Widget for ToggleSticky command.+toggleStickyW :: StandardWidget+toggleStickyW = GenericWidget "[S]" "[s]" ToggleSticky++-- | Widget for Minimize command+minimizeW :: StandardWidget+minimizeW = GenericWidget "" "[_]" Minimize++-- | Widget for ToggleMaximize command+maximizeW :: StandardWidget+maximizeW = GenericWidget "" "[O]" ToggleMaximize++-- | Widget for CloseWindow command+closeW :: StandardWidget+closeW = GenericWidget "" "[X]" CloseWindow++dwmpromoteW :: StandardWidget+dwmpromoteW = GenericWidget "[M]" "[m]" DwmPromote++moveToNextGroupW :: StandardWidget+moveToNextGroupW = GenericWidget "" "[>]" MoveToNextGroup++moveToPrevGroupW :: StandardWidget+moveToPrevGroupW = GenericWidget "" "[<]" MoveToPrevGroup+
XMonad/Layout/DecorationMadness.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.DecorationMadness+-- Description :  A collection of decorated layouts. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -16,7 +17,7 @@     ( -- * Usage       -- $usage -      -- * Decorated layouts based on Circle+      -- * Decorated layouts based on CircleEx       -- $circle       circleSimpleDefault     , circleDefault@@ -82,7 +83,7 @@     , floatDwmStyle     , floatSimpleTabbed     , floatTabbed-    , def, defaultTheme, shrinkText+    , def, shrinkText     ) where  import XMonad@@ -93,13 +94,13 @@ import XMonad.Layout.TabBarDecoration  import XMonad.Layout.Accordion-import XMonad.Layout.Circle+import XMonad.Layout.CircleEx import XMonad.Layout.WindowArranger import XMonad.Layout.SimpleFloat  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationMadness --@@ -107,9 +108,9 @@ -- -- > main = xmonad def { layoutHook = someMadLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default theme: --@@ -131,39 +132,39 @@ -- "XMonad.Util.Themes"  -- $circle--- Here you will find 'Circle' based decorated layouts.+-- Here you will find 'CircleEx' based decorated layouts. --- | A 'Circle' layout with the xmonad default decoration, default+-- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefault.png>-circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window-circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle+circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) CircleEx Window+circleSimpleDefault = decoration shrinkText def DefaultDecoration circle  -- | Similar to 'circleSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. circleDefault :: Shrinker s => s -> Theme-              -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window-circleDefault s t = decoration s t DefaultDecoration Circle+              -> ModifiedLayout (Decoration DefaultDecoration s) CircleEx Window+circleDefault s t = decoration s t DefaultDecoration circle --- | A 'Circle' layout with the xmonad simple decoration, default+-- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDeco.png>-circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window-circleSimpleDeco = decoration shrinkText def (Simple True) Circle+circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) CircleEx Window+circleSimpleDeco = decoration shrinkText def (Simple True) circle  -- | Similar to 'circleSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. circleDeco :: Shrinker s => s -> Theme-           -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window-circleDeco s t = decoration s t (Simple True) Circle+           -> ModifiedLayout (Decoration SimpleDecoration s) CircleEx Window+circleDeco s t = decoration s t (Simple True) circle --- | A 'Circle' layout with the xmonad default decoration, default+-- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. --@@ -171,17 +172,17 @@ -- -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefaultResizable.png> circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)-                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window-circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle)+                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window+circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange circle)  -- | Similar to 'circleSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDefaultResizable :: Shrinker s => s -> Theme                        -> ModifiedLayout (Decoration DefaultDecoration s)-                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window-circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle)+                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window+circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange circle) --- | A 'Circle' layout with the xmonad simple decoration, default+-- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. --@@ -189,45 +190,45 @@ -- -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDecoResizable.png> circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)-                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window-circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle)+                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window+circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange circle)  -- | Similar to 'circleSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDecoResizable :: Shrinker s => s -> Theme                     -> ModifiedLayout (Decoration SimpleDecoration s)-                       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window-circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle)+                       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window+circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange circle) --- | A 'Circle' layout with the xmonad DwmStyle decoration, default+-- | A 'CircleEx' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDwmStyle.png>-circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window-circleSimpleDwmStyle = decoration shrinkText def Dwm Circle+circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) CircleEx Window+circleSimpleDwmStyle = decoration shrinkText def Dwm circle  -- | Similar to 'circleSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. circleDwmStyle :: Shrinker s => s -> Theme-               -> ModifiedLayout (Decoration DwmStyle s) Circle Window-circleDwmStyle s t = decoration s t Dwm Circle+               -> ModifiedLayout (Decoration DwmStyle s) CircleEx Window+circleDwmStyle s t = decoration s t Dwm circle --- | A 'Circle' layout with the xmonad tabbed decoration, default+-- | A 'CircleEx' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleTabbed.png>-circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window-circleSimpleTabbed = simpleTabBar Circle+circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen CircleEx) Window+circleSimpleTabbed = simpleTabBar circle  -- | Similar to 'circleSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. circleTabbed :: Shrinker s => s -> Theme-             -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window-circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle)+             -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen CircleEx) Window+circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) circle)   -- $accordion
XMonad/Layout/Dishes.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Dishes+-- Description :  A layout that stacks extra windows underneath the master windows. -- Copyright   :  (c) Jeremy Apthorp -- License     :  BSD-style (see LICENSE) --@@ -23,10 +24,10 @@  import XMonad import XMonad.StackSet (integrate)-import Control.Monad (ap)+import XMonad.Prelude (ap)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Dishes --@@ -35,14 +36,14 @@ -- > myLayout = Dishes 2 (1/6) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data Dishes a = Dishes Int Rational deriving (Show, Read) instance LayoutClass Dishes a where     doLayout (Dishes nmaster h) r =-        return . (\x->(x,Nothing)) .+        return . (, Nothing) .         ap zip (dishes h r nmaster . length) . integrate     pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m)         where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h@@ -52,5 +53,5 @@                         then splitHorizontally n s                         else ws  where-    (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s+    (m,rest) = splitVerticallyBy (1 - fromIntegral (n - nmaster) * h) s     ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest
XMonad/Layout/DragPane.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.DragPane+-- Description :  Split the screen either horizontally or vertically and show two windows. -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com> --                    David Roundy <droundy@darcs.net>, --                    Andrea Rossato <andrea.rossato@unibz.it>@@ -34,7 +35,7 @@ import XMonad.Util.XUtils  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.DragPane --@@ -43,9 +44,9 @@ -- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  halfHandleWidth :: Integral a => a halfHandleWidth = 1@@ -54,7 +55,7 @@ handleColor = "#000000"  dragPane :: DragType -> Double -> Double -> DragPane a-dragPane t x y = DragPane (I Nothing) t x y+dragPane = DragPane (I Nothing)  data DragPane a =     DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double@@ -67,7 +68,7 @@     doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d     handleMessage = handleMess -data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )+data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq) instance Message SetFrac  handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))@@ -81,18 +82,18 @@     -- layout specific messages     | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))     | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))-    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do+    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =                                      return $ Just (DragPane mb ty delta frac) handleMess _ _ = return Nothing  handleEvent :: DragPane a -> Event -> X () handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)-            (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })-    | t == buttonPress && thisw == win || thisbw == win  = do+            ButtonEvent{ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }+    | t == buttonPress && thisw == win || thisbw == win  =   mouseDrag (\ex ey -> do              let frac = case ty of-                        Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)-                        Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)+                        Vertical   -> (fromIntegral ex - fromIntegral (rect_x r))/fromIntegral (rect_width  r)+                        Horizontal -> (fromIntegral ey - fromIntegral (rect_x r))/fromIntegral (rect_width r)              sendMessage (SetFrac ident frac))             (return ()) handleEvent _ _  = return ()@@ -121,7 +122,7 @@                     return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)             I Nothing -> do                     w <- newDragWin handr-                    i <- io $ newUnique+                    i <- io newUnique                     return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)      else return (wrs, Nothing)
XMonad/Layout/DraggingVisualizer.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.DraggingVisualizer+-- Description :  Visualize the process of dragging a window. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -24,19 +25,19 @@ import XMonad import XMonad.Layout.LayoutModifier -data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show )+newtype DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show ) draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing  data DraggingVisualizerMsg = DraggingWindow Window Rectangle                                 | DraggingStopped-                                deriving ( Typeable, Eq )+                                deriving Eq instance Message DraggingVisualizerMsg  instance LayoutModifier DraggingVisualizer Window where     modifierDescription (DraggingVisualizer _) = "DraggingVisualizer"     pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs =-            if draggedWin `elem` (map fst wrs)+            if draggedWin `elem` map fst wrs                 then (dragged : rest, Nothing)                 else (wrs, Just $ DraggingVisualizer Nothing)         where@@ -45,5 +46,5 @@      pureMess (DraggingVisualizer _) m = case fromMessage m of         Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect)-        Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing+        Just DraggingStopped -> Just $ DraggingVisualizer Nothing         _ -> Nothing
XMonad/Layout/Drawer.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Drawer+-- Description :  A layout modifier to put windows in a "drawer". -- Copyright   :  (c) 2009 Max Rabkin -- License     :  BSD-style (see xmonad/LICENSE) --@@ -40,7 +41,7 @@ import XMonad.Layout.Reflect  -- $usage--- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:+-- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Layout.Drawer --@@ -71,7 +72,7 @@     modifyLayout (Drawer rs rb p l) ws rect =         case stack ws of             Nothing -> runLayout ws rect-            Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do+            Just stk@Stack{ up=up_, down=down_, S.focus=w } -> do                     (upD, upM) <- partitionM (hasProperty p) up_                     (downD, downM) <- partitionM (hasProperty p) down_                     b <- hasProperty p w@@ -94,7 +95,7 @@         mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys })          rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb }-        rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) }+        rectS = rectB { rect_x=rect_x rectB - round ((rb - rs) * fromIntegral (rect_width rect)) }         rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs)                      , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) } @@ -114,7 +115,7 @@ drawer ::    Rational   -- ^ The portion of the screen taken up by the drawer when closed           -> Rational   -- ^ The portion of the screen taken up by the drawer when open           -> Property   -- ^ Which windows to put in the drawer-          -> (l a)      -- ^ The layout of windows in the drawer+          -> l a        -- ^ The layout of windows in the drawer           -> Drawer l a drawer = Drawer
XMonad/Layout/Dwindle.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Dwindle+-- Description :  Various spirally layouts. -- Copyright   :  (c) Norbert Zeh <norbert.zeh@gmail.com> -- License     :  BSD3 --@@ -27,7 +28,7 @@                              , Chirality(..)                              ) where -import Data.List ( unfoldr )+import XMonad.Prelude ( unfoldr ) import XMonad import XMonad.StackSet ( integrate, Stack ) import XMonad.Util.Types ( Direction2D(..) )@@ -67,9 +68,9 @@ -- 1.1, is the factor by which the third parameter increases or decreases in -- response to Expand or Shrink messages. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | Layouts with geometrically decreasing window sizes.  'Spiral' and 'Dwindle' -- split the screen into a rectangle for the first window and a rectangle for@@ -110,7 +111,7 @@ -- -- * First split chirality ----- * Size ratio between rectangle allocated to current window and rectangle +-- * Size ratio between rectangle allocated to current window and rectangle -- allocated to remaining windows -- -- * Factor by which the size ratio is changed in response to 'Expand' or 'Shrink'@@ -143,12 +144,12 @@   where f Expand = ratio * delta         f Shrink = ratio / delta -dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a -> +dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a ->            [(a, Rectangle)] dwindle trans dir rot ratio rect st = unfoldr genRects (integrate st, rect, dirAxes dir, rot)-  where genRects ([],     _, _, _)  = Nothing-        genRects ([w],    r, a, rt) = Just ((w, r),  ([], r,   a,  rt))-        genRects ((w:ws), r, a, rt) = Just ((w, r'), (ws, r'', a', rt'))+  where genRects ([],   _, _, _ ) = Nothing+        genRects ([w],  r, a, rt) = Just ((w, r),  ([], r,   a,  rt))+        genRects (w:ws, r, a, rt) = Just ((w, r'), (ws, r'', a', rt'))           where (r', r'') = splitRect r ratio a                 (a', rt') = trans a rt @@ -158,9 +159,9 @@         nwins   = length wins         sizes   = take nwins $ unfoldr (\r -> Just (r * ratio, r * ratio)) 1         totals' = 0 : zipWith (+) sizes totals'-        totals  = tail totals'-        splits  = zip (tail sizes) totals-        ratios  = reverse $ map (\(l, r) -> l / r) splits+        totals  = drop 1 totals'+        splits  = zip (drop 1 sizes) totals+        ratios  = reverse $ map (uncurry (/)) splits         rects   = genRects rect ratios         genRects r []     = [r]         genRects r (x:xs) = r' : genRects r'' xs
XMonad/Layout/DwmStyle.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.DwmStyle+-- Description :  A layout modifier for decorating windows in a dwm like style. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -18,7 +19,6 @@       dwmStyle     , Theme (..)     , def-    , defaultTheme     , DwmStyle (..)     , shrinkText, CustomShrink(CustomShrink)     , Shrinker(..)@@ -30,7 +30,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.DwmStyle --@@ -40,9 +40,9 @@ -- > myL = dwmStyle shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. --
+ XMonad/Layout/FixedAspectRatio.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.FixedAspectRatio+-- Description :  A layout modifier for user provided per-window aspect ratios.+-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layout modifier for user provided per-window aspect ratios.+--+-----------------------------------------------------------------------------++module XMonad.Layout.FixedAspectRatio+  (+    -- * Usage+    -- $usage+    fixedAspectRatio+  , FixedAspectRatio+  , ManageAspectRatio(..)+  , doFixAspect+  ) where+++import           Control.Arrow+import qualified Data.Map                      as M+import           Data.Ratio++import           XMonad+import           XMonad.Actions.MessageFeedback+import           XMonad.Layout.Decoration+import           XMonad.Layout.LayoutHints++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Layout.FixedAspectRatio+-- Then add it to your layout:+--+-- > myLayout = fixedAspectRatio (0.5, 0.5) $ Tall 1 (3/100) (1/2)  ||| Full ||| etc..+-- > main = xmonad def { layoutHook = myLayout }+--+-- Which will center the (eventually) shrinked windows in their assigned+-- rectangle.+--+-- For a layout modifier that automatically sets the aspect ratio+-- depending on the size hints (for example for programs like mpv),+-- see "XMonad.Layout.LayoutHints"+--+-- See <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook" for more info on the 'layoutHook'.+--+-- You also want to add keybindings to set and clear the aspect ratio:+--+-- >      -- Set the aspect ratio of the focused window to 16:9+-- >   ,((modm, xK_a), withFocused $ sendMessage . FixRatio (16 / 9))+-- >+-- >      -- Clear the aspect ratio from the focused window+-- >   ,((modm .|. shiftMask, xK_a), withFocused $ sendMessage . ResetRatio)+--+-- There's one caveat: to keep the usage of the modifier simple, it+-- doesn't remove a window from its cache automatically. Which means+-- that if you close a program window that has some fixed aspect ratios+-- and relaunch it, sometimes it'll still have the fixed aspect ratio.+-- You can try to avoid this by changing they keybinding used to kill+-- the window:+--+-- >  , ((modMask .|. shiftMask, xK_c), withFocused (sendMessage . ResetRatio) >> kill)+--+-- See <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> for more info+-- on customizing the keybindings.+--+-- This layout also comes with a 'ManageHook' 'doFixAspect' to+-- automatically fix the aspect ratio:+--+-- > myManageHook = composeOne [+-- >   title =? "Netflix" <||> className =? "vlc" --> doFixAspect (16 / 9)+-- >   ...+-- > ]+--+-- Check <https://xmonad.org/TUTORIAL.html#final-touches the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on+-- customizing the manage hook.++-- | Similar to 'layoutHintsWithReplacement', but relies on the user to+-- provide the ratio for each window. @aspectRatio (rx, ry) layout@ will+-- adapt the sizes of a layout's windows according to the provided aspect+-- ratio, and position them inside their originally assigned area+-- according to the @rx@ and @ry@ parameters.+-- (0, 0) places the window at the top left, (1, 0) at the top right,+-- (0.5, 0.5) at the center, etc.+fixedAspectRatio+  :: (Double, Double) -> l a -> ModifiedLayout FixedAspectRatio l a+fixedAspectRatio = ModifiedLayout . FixedAspectRatio mempty++data FixedAspectRatio a = FixedAspectRatio (M.Map Window Rational)+                                           (Double, Double)+  deriving (Read, Show)++instance LayoutModifier FixedAspectRatio Window where+  -- | Note: this resembles redoLayout from "XMonad.Layout.LayoutHints".+  -- The only difference is relying on user defined aspect ratios, and+  -- using the 'adj' function defined below instead of 'mkAdjust'+  pureModifier (FixedAspectRatio ratios placement) _ (Just s) xs =+    (xs', Nothing)+   where+    xs' =+      map (\x@(_, r) -> second (placeRectangle placement r) $ applyHint x) xs+    applyHint (win, r@(Rectangle x y w h)) =+      let ar       = M.lookup win ratios+          (w', h') = maybe (w, h) (adj (w, h)) ar+      in  (win, if isInStack s win then Rectangle x y w' h' else r)++  pureModifier _ _ _ xs = (xs, Nothing)++  handleMess (FixedAspectRatio ratios placement) mess+    | Just DestroyWindowEvent { ev_window = w } <- fromMessage mess+    = return . Just $ FixedAspectRatio (deleted w) placement+    | otherwise+    = case fromMessage mess of+      Just (FixRatio r w) ->+        return . Just $ FixedAspectRatio (inserted w r) placement+      Just (ResetRatio w) ->+        return . Just $ FixedAspectRatio (deleted w) placement+      Just (ToggleRatio r w) ->+        return+          . Just+          . flip FixedAspectRatio placement+          . maybe (inserted w r) (const $ deleted w)+          $ M.lookup w ratios+      _ -> return Nothing+   where+    inserted w r = M.insert w r ratios+    deleted w = M.delete w ratios++-- | A 'ManageHook' to set the aspect ratio for newly spawned windows+doFixAspect+  :: Rational -- ^ The aspect ratio+  -> ManageHook+doFixAspect r = ask+  >>= \w -> liftX (sendMessageWithNoRefreshToCurrent (FixRatio r w)) >> mempty++-- | Calculates the new width and height so they respect the+-- aspect ratio.+adj :: (Dimension, Dimension) -> Rational -> (Dimension, Dimension)+adj (w, h) ar | ar' > ar  = (ceiling $ fi h * ar, h)+              | otherwise = (w, ceiling $ fi w / ar)+  where ar' = fi w % fi h++--- Message handling+data ManageAspectRatio =+    FixRatio Rational Window    -- ^ Set the aspect ratio for the window+  | ResetRatio Window           -- ^ Remove the aspect ratio for the window+  | ToggleRatio Rational Window -- ^ Toggle the reatio++instance Message ManageAspectRatio
XMonad/Layout/FixedColumn.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.FixedColumn+-- Description :  Like Tall, but split at a fixed column (or a window's smallest resize amount). -- Copyright   :  (c) 2008 Justin Bogner <mail@justinbogner.com> -- License     :  BSD3-style (as xmonad) --@@ -22,21 +23,12 @@         FixedColumn(..) ) where -import Control.Monad (msum)-import Data.Maybe (fromMaybe)-import Graphics.X11.Xlib (Window, rect_width)-import Graphics.X11.Xlib.Extras ( getWMNormalHints-                                , getWindowAttributes-                                , sh_base_size-                                , sh_resize_inc-                                , wa_border_width)--import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)-import XMonad.Layout (Resize(..), IncMasterN(..), tile)-import XMonad.StackSet as W+import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.FixedColumn --@@ -45,9 +37,9 @@ -- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | A tiling mode based on preserving a nice fixed width --   window. Supports 'Shrink', 'Expand' and 'IncMasterN'.@@ -62,7 +54,7 @@             fws <- mapM (widthCols fallback ncol) ws             let frac = maximum (take nmaster fws) // rect_width r                 rs   = tile frac r nmaster (length ws)-            return $ (zip ws rs, Nothing)+            return (zip ws rs, Nothing)         where ws     = W.integrate s               x // y = fromIntegral x / fromIntegral y @@ -82,10 +74,11 @@ --   columns wide, using @inc@ as a resize increment for windows that --   don't have one widthCols :: Int -> Int -> Window -> X Int-widthCols inc n w = withDisplay $ \d -> io $ do-    sh <- getWMNormalHints d w-    bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w-    let widthHint f = f sh >>= return . fromIntegral . fst+widthCols inc n w = do+    d  <- asks display+    bw <- asks $ fi . borderWidth . config+    sh <- io $ getWMNormalHints d w+    let widthHint f = f sh <&> fromIntegral . fst         oneCol      = fromMaybe inc $ widthHint sh_resize_inc         base        = fromMaybe 0 $ widthHint sh_base_size     return $ 2 * bw + base + n * oneCol
+ XMonad/Layout/FocusTracking.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}+{- |++Module      :  XMonad.Layout.FocusTracking+Description :  Track focus in the tiled layer.+Copyright   :  (c) 2010 & 2013 Adam Vogt+                   2011 Willem Vanlint+                   2018 & 2022 L.S.Leary+License     :  BSD-style (see xmonad/LICENSE)++Maintainer  :  @LSLeary (on github)+Stability   :  unstable+Portability :  unportable++FocusTracking simply holds onto the last true focus it was given and continues+to use it as the focus for the transformed layout until it sees another. It can+be used to improve the behaviour of a child layout that has not been given the+focused window, or equivalently, that of the layout itself when a float has+focus.++Relevant issues:++  * <http://code.google.com/p/xmonad/issues/detail?id=4>+  * <http://code.google.com/p/xmonad/issues/detail?id=306>++--------------------------------------------------------------------------------+-}+module XMonad.Layout.FocusTracking+    ( -- * Usage+      -- $usage+      FocusTracking(..)+    , focusTracking+    ) where++import XMonad.Prelude+import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Util.Stack (findZ)+import qualified XMonad.StackSet as W++-- $usage+--+-- To use the module, first import it:+--+-- > import XMonad.Layout.FocusTracking+--+-- Then, a focus-dependent layout can be made to fall back on the last focus it+-- saw, for example:+--+-- > main = xmonad def+-- >  { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild)+-- >  , ...+-- >  }+--+-- Or in a simpler case:+--+-- > main = xmonad def+-- >  { layoutHook = myTiledLayout ||| focusTracking Full+-- >  , ...+-- >  }+--++-- | A 'LayoutModifier' that remembers the last focus it saw.+newtype FocusTracking a = FocusTracking (Maybe Window)+    deriving (Read, Show)++instance LayoutModifier FocusTracking Window where+    modifyLayoutWithUpdate (FocusTracking mw) ws@W.Workspace{ W.stack = ms } r+      = do+        xCur <- gets (W.peek . W.view (W.tag ws) . windowset)+        let isF = xCur /= (W.focus <$> ms)+            -- use the remembered focus point when true focus differs from+            -- what this (sub)layout is given, which happens e.g. when true+            -- focus is in floating layer or when another sublayout has focus+            newStack | isF = (mw >>= \w -> findZ (w==) ms) <|> ms+                     | otherwise = ms+            newState | isF = mw+                     | otherwise = xCur+        ran <- runLayout ws{ W.stack = newStack } r+        return (ran, guard (newState /= mw) $> FocusTracking newState)++-- | Transform a layout into one that remembers and uses the last focus it saw.+focusTracking ::  l a -> ModifiedLayout FocusTracking l a+focusTracking = ModifiedLayout (FocusTracking Nothing)+
XMonad/Layout/Fullscreen.hs view
@@ -1,7 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}+{-# OPTIONS_GHC -Wno-deprecations #-} -- FIXME: fullscreenStartup temporarily silenced ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Fullscreen+-- Description :  Send messages about fullscreen windows to layouts. -- Copyright   :  (c) 2010 Audun Skaugen -- License     :  BSD-style (see xmonad/LICENSE) --@@ -16,6 +18,7 @@     ( -- * Usage:       -- $usage      fullscreenSupport+    ,fullscreenSupportBorder     ,fullscreenFull     ,fullscreenFocus     ,fullscreenFullRect@@ -31,17 +34,16 @@     ) where  import           XMonad+import           XMonad.Prelude import           XMonad.Layout.LayoutModifier+import           XMonad.Layout.NoBorders        (SmartBorder, smartBorders)+import           XMonad.Hooks.EwmhDesktops      (fullscreenStartup) import           XMonad.Hooks.ManageHelpers     (isFullscreen) import           XMonad.Util.WindowProperties import qualified XMonad.Util.Rectangle          as R import qualified XMonad.StackSet                as W -import           Data.List-import           Data.Maybe-import           Data.Monoid import qualified Data.Map                       as M-import           Control.Monad import           Control.Arrow                  (second)  -- $usage@@ -71,15 +73,31 @@ -- -- > main = xmonad -- >      $ fullscreenSupport--- >      $ defaultConfig { ... }+-- >      $ def { ... } fullscreenSupport :: LayoutClass l Window =>   XConfig l -> XConfig (ModifiedLayout FullscreenFull l) fullscreenSupport c = c {     layoutHook = fullscreenFull $ layoutHook c,-    handleEventHook = handleEventHook c <+> fullscreenEventHook,-    manageHook = manageHook c <+> fullscreenManageHook+    handleEventHook = handleEventHook c <> fullscreenEventHook,+    manageHook = manageHook c <> fullscreenManageHook,+    startupHook = startupHook c <> fullscreenStartup   } +-- | fullscreenSupport with smartBorders support so the border doesn't+-- show when the window is fullscreen+--+-- > main = xmonad+-- >      $ fullscreenSupportBorder+-- >      $ def { ... }+fullscreenSupportBorder :: LayoutClass l Window =>+    XConfig l -> XConfig (ModifiedLayout FullscreenFull+    (ModifiedLayout SmartBorder (ModifiedLayout FullscreenFull l)))+fullscreenSupportBorder c =+    fullscreenSupport c { layoutHook = smartBorders+                                       $ fullscreenFull+                                       $ layoutHook c+                        }+ -- | Messages that control the fullscreen state of the window. -- AddFullscreen and RemoveFullscreen are sent to all layouts -- when a window wants or no longer wants to be fullscreen.@@ -88,7 +106,6 @@ data FullscreenMessage = AddFullscreen Window                        | RemoveFullscreen Window                        | FullscreenChanged-     deriving (Typeable)  instance Message FullscreenMessage @@ -104,7 +121,7 @@ instance LayoutModifier FullscreenFull Window where   pureMess ff@(FullscreenFull frect fulls) m = case fromMessage m of     Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls-    Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls+    Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win fulls     Just FullscreenChanged -> Just ff     _ -> Nothing @@ -120,11 +137,11 @@ instance LayoutModifier FullscreenFocus Window where   pureMess ff@(FullscreenFocus frect fulls) m = case fromMessage m of     Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls-    Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls+    Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win fulls     Just FullscreenChanged -> Just ff     _ -> Nothing -  pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list+  pureModifier (FullscreenFocus frect fulls) rect (Just W.Stack {W.focus = f}) list      | f `elem` fulls = ((f, rect') : rest, Nothing)      | otherwise = (list, Nothing)      where rest = filter (not . orP (== f) (R.supersetOf rect')) list@@ -134,7 +151,7 @@ instance LayoutModifier FullscreenFloat Window where   handleMess (FullscreenFloat frect fulls) m = case fromMessage m of     Just (AddFullscreen win) -> do-      mrect <- (M.lookup win . W.floating) `fmap` gets windowset+      mrect <- M.lookup win . W.floating <$> gets windowset       return $ case mrect of         Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls         Nothing -> Nothing@@ -196,15 +213,12 @@ fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do   wmstate <- getAtom "_NET_WM_STATE"   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"-  wstate <- fromMaybe [] `fmap` getProp32 wmstate win-  let fi :: (Integral i, Num n) => i -> n-      fi = fromIntegral-      isFull = fi fullsc `elem` wstate+  wstate <- fromMaybe [] <$> getProp32 wmstate win+  let isFull = fi fullsc `elem` wstate       remove = 0       add = 1       toggle = 2-      ptype = 4-      chWState f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)+      chWState f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate)   when (typ == wmstate && fi fullsc `elem` dats) $ do     when (action == add || (action == toggle && not isFull)) $ do       chWState (fi fullsc:)@@ -216,11 +230,11 @@       sendMessage FullscreenChanged   return $ All True -fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do+fullscreenEventHook DestroyWindowEvent{ev_window = w} = do   -- When a window is destroyed, the layouts should remove that window   -- from their states.   broadcastMessage $ RemoveFullscreen w-  cw <- (W.workspace . W.current) `fmap` gets windowset+  cw <- W.workspace . W.current <$> gets windowset   sendMessageWithNoRefresh FullscreenChanged cw   return $ All True @@ -241,7 +255,7 @@   w <- ask   liftX $ do     broadcastMessage $ AddFullscreen w-    cw <- (W.workspace . W.current) `fmap` gets windowset+    cw <- W.workspace . W.current <$> gets windowset     sendMessageWithNoRefresh FullscreenChanged cw   idHook
XMonad/Layout/Gaps.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Gaps+-- Description :  Create manually-sized gaps along edges of the screen. -- Copyright   :  (c) 2008 Brent Yorgey -- License     :  BSD3 --@@ -35,17 +36,15 @@                           weakModifyGaps, modifyGap, setGaps, setGap                           ) where +import XMonad.Prelude (delete, fi) import XMonad.Core import Graphics.X11 (Rectangle(..))  import XMonad.Layout.LayoutModifier import XMonad.Util.Types (Direction2D(..))-import XMonad.Util.XUtils (fi) -import Data.List (delete)- -- $usage--- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.Gaps --@@ -92,6 +91,10 @@ -- -- To configure gaps differently per-screen, use -- "XMonad.Layout.PerScreen" (coming soon).+--+-- __Warning__: If you also use the 'avoidStruts' layout modifier, it+-- must come /before/ any of these modifiers. See the documentation of+-- 'avoidStruts' for details.  -- | A manual gap configuration.  Each side of the screen on which a --   gap is enabled is paired with a size in pixels.@@ -109,7 +112,6 @@                 | IncGap !Int !Direction2D    -- ^ Increase a gap by a certain number of pixels.                 | DecGap !Int !Direction2D    -- ^ Decrease a gap.                 | ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily.-  deriving (Typeable)  instance Message GapMessage @@ -179,7 +181,7 @@  toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D] toggleGap conf cur d | d `elem` cur            = delete d cur-                     | d `elem` (map fst conf) = d:cur+                     | d `elem` map fst conf = d:cur                      | otherwise               = cur  -- | Add togglable manual gaps to a layout.
XMonad/Layout/Grid.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Grid+-- Description :  A simple layout that attempts to put all windows in a square grid. -- Copyright   :  (c) Lukas Mai -- License     :  BSD-style (see LICENSE) --@@ -24,7 +25,7 @@ import XMonad.StackSet  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Grid --@@ -39,9 +40,9 @@ -- -- > myLayout = GridRatio (4/3) ||| etc. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data Grid a = Grid | GridRatio Double deriving (Read, Show) @@ -60,7 +61,7 @@     mincs = max 1 $ nwins `div` ncols     extrs = nwins - ncols * mincs     chop :: Int -> Dimension -> [(Position, Dimension)]-    chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'+    chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (, k) . drop 1 . reverse . take n . drop 1 . iterate (subtract k') $ m'         where         k :: Dimension         k = m `div` fromIntegral n
XMonad/Layout/GridVariants.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ---------------------------------------------------------------------- -- | -- Module      : XMonad.Layout.GridVariants+-- Description : Two grid layouts. -- Copyright   : (c) Norbert Zeh -- License     : BSD-style (see LICENSE) --@@ -27,7 +28,7 @@                                   , Orientation(..)                                   ) where -import Control.Monad+import XMonad.Prelude import XMonad import qualified XMonad.StackSet as W @@ -58,7 +59,7 @@ -- > ((modm .|. controlMask,  xK_minus), sendMessage $ IncMasterRows (-1))  -- | Grid layout.  The parameter is the desired x:y aspect ratio of windows-data Grid a = Grid !Rational+newtype Grid a = Grid Rational               deriving (Read, Show)  instance LayoutClass Grid a where@@ -82,7 +83,6 @@ data ChangeGridGeom     = SetGridAspect !Rational     | ChangeGridAspect !Rational-      deriving Typeable  instance Message ChangeGridGeom @@ -125,7 +125,6 @@     | SetMasterRows     !Int      -- ^Set the number of master rows to absolute value     | SetMasterCols     !Int      -- ^Set the number of master columns to absolute value     | SetMasterFraction !Rational -- ^Set the fraction of the screen used by the master grid-    deriving Typeable  instance Message ChangeMasterGridGeom @@ -133,8 +132,8 @@ arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect     | nwins <= mwins = arrangeMasterGrid rect nwins mcols     | mwins == 0     = arrangeAspectGrid rect nwins saspect-    | otherwise      = (arrangeMasterGrid mrect mwins mcols) ++-                       (arrangeAspectGrid srect swins saspect)+    | otherwise      = arrangeMasterGrid mrect mwins mcols +++                       arrangeAspectGrid srect swins saspect     where       mwins            = mrows * mcols       swins            = nwins - mwins@@ -179,7 +178,7 @@       y_slabs       = [splitIntoSlabs (fromIntegral rh) nrows | nrows <- nrows_in_cols]       rects_in_cols = [[(x, y, w, h) | (y, h) <- lst]                        | ((x, w), lst) <- zip x_slabs y_slabs]-      rects         = foldr (++) [] rects_in_cols+      rects         = concat rects_in_cols  splitIntoSlabs :: Int -> Int -> [(Int, Int)] splitIntoSlabs width nslabs = zip (0:xs) widths@@ -196,7 +195,7 @@       size    = ceiling ( (fromIntegral n / fromIntegral parts) :: Double )       extra   = size*parts - n       sizes   = [i*size | i <- [1..parts]]-      offsets = (take (fromIntegral extra) [1..]) ++ [extra,extra..]+      offsets = take (fromIntegral extra) [1..] ++ [extra,extra..]  resizeMaster :: SplitGrid a -> Resize -> SplitGrid a resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink =@@ -244,8 +243,8 @@           rects = arrangeSplitGrid rect L nwins mrows mcols mfrac saspect      pureMessage layout msg =-        msum [ fmap ((tallGridAdapter resizeMaster) layout) (fromMessage msg)-             , fmap ((tallGridAdapter changeMasterGrid) layout) (fromMessage msg) ]+        msum [ fmap (tallGridAdapter resizeMaster layout) (fromMessage msg)+             , fmap (tallGridAdapter changeMasterGrid layout) (fromMessage msg) ]      description _ = "TallGrid"
XMonad/Layout/Groups.hs view
@@ -1,11 +1,10 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}-{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable-  , UndecidableInstances, FlexibleInstances, LambdaCase, MultiParamTypeClasses-  , PatternGuards, Rank2Types, TypeSynonymInstances #-}+{-# LANGUAGE StandaloneDeriving, FlexibleContexts, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, PatternGuards, Rank2Types #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Groups+-- Description :  Split windows in layout groups that are managed by another layout. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -54,15 +53,12 @@                             ) where  import XMonad+import XMonad.Prelude hiding (group) import qualified XMonad.StackSet as W  import XMonad.Util.Stack -import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)-import Data.List ((\\)) import Control.Arrow ((>>>))-import Control.Applicative ((<$>),(<|>),(<$))-import Control.Monad (forM,void)  -- $usage -- This module provides a layout combinator that allows you@@ -109,8 +105,8 @@ -- seed. All keys generated with this method will be different -- provided you don't use 'gen' again with a key from the list. -- (if you need to do that, see 'split' instead)-gen :: Uniq -> (Uniq, [Uniq])-gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..])+gen :: Uniq -> (Uniq, Stream Uniq)+gen (U i1 i2) = (U (i1+1) i2, fmap (U i1) (fromList [i2..]))  -- | Split an infinite list into two. I ended up not -- needing this, but let's keep it just in case.@@ -122,7 +118,7 @@ -- | Add a unique identity to a layout so we can -- follow it around. data WithID l a = ID { getID :: Uniq-                     , unID :: (l a)}+                     , unID :: l a}   deriving (Show, Read)  -- | Compare the ids of two 'WithID' values@@ -134,8 +130,7 @@  instance LayoutClass l a => LayoutClass (WithID l) a where     runLayout ws@W.Workspace { W.layout = ID id l } r-        = do (placements, ml') <- flip runLayout r-                                     ws { W.layout = l}+        = do (placements, ml') <- runLayout ws{ W.layout = l} r              return (placements, ID id <$> ml')     handleMessage (ID id l) sm = do ml' <- handleMessage l sm                                     return $ ID id <$> ml'@@ -188,7 +183,6 @@                    | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing                                        -- of windows according to a 'ModifySpec'                    | ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad-                     deriving Typeable  instance Show GroupsMessage where     show (ToEnclosing _) = "ToEnclosing {...}"@@ -197,21 +191,22 @@     show (ToAll _) = "ToAll {...}"     show Refocus = "Refocus"     show (Modify _) = "Modify {...}"+    show (ModifyX _) = "ModifyX {...}"  instance Message GroupsMessage  modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a))              -> Groups l l2 a -> Groups l l2 a-modifyGroups f g = let (seed', id:_) = gen (seed g)-                       defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ+modifyGroups f g = let (seed', ident :~ _) = gen (seed g)+                       defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ                    in g { groups = fromMaybe defaultGroups . f . Just $ groups g                         , seed = seed' }  modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))               -> Groups l l2 a -> X (Groups l l2 a) modifyGroupsX f g = do-  let (seed', id:_) = gen (seed g)-      defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ+  let (seed', ident :~ _) = gen (seed g)+      defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ   g' <- f . Just $ groups g   return g { groups = fromMaybe defaultGroups g', seed = seed' } @@ -223,28 +218,28 @@ -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt z g = let mf = getFocusZ z-                  (seed', id:_) = gen $ seed g+                  (seed', ident :~ _) = gen $ seed g                   g' = g { seed = seed' }               in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z)                                         >>> filterKeepLast (isJust . gZipper)                                         >>> findNewWindows (W.integrate' z)-                                        >>> addWindows (ID id $ baseLayout g)+                                        >>> addWindows (ID ident $ baseLayout g)                                         >>> focusGroup mf                                         >>> onFocusedZ (onZipper $ focusWindow mf)     where filterKeepLast _ Nothing = Nothing-          filterKeepLast f z@(Just s) = maybe (singletonZ $ W.focus s) Just-                                            $ filterZ_ f z+          filterKeepLast f z@(Just s) =  filterZ_ f z+                                     <|> singletonZ (W.focus s)  -- | Remove the windows from a group which are no longer present in -- the stack. removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a-removeDeleted z = filterZ_ (flip elemZ z)+removeDeleted z = filterZ_ (`elemZ` z)  -- | Identify the windows not already in a group. findNewWindows :: Eq a => [a] -> Zipper (Group l a)                -> (Zipper (Group l a), [a]) findNewWindows as gs = (gs, foldrZ_ removePresent as gs)-    where removePresent g as' = filter (not . flip elemZ (gZipper g)) as'+    where removePresent g = filter (not . flip elemZ (gZipper g))  -- | Add windows to the focused group. If you need to create one, -- use the given layout and an id from the given list.@@ -288,7 +283,7 @@                let placements = concatMap fst results                    newL = justMakeNew l mpart' (map snd results ++ hidden') -               return $ (placements, newL)+               return (placements, newL)          handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm             = do mp' <- handleMessage p sm'@@ -323,7 +318,7 @@                       where step True (G l _) = handleMessage l sm                             step False _ = return Nothing                   handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate z-                      where step (j, (G l _)) | i == j = handleMessage l sm+                      where step (j, G l _) | i == j = handleMessage l sm                             step _ = return Nothing  @@ -384,44 +379,43 @@ -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g =-    let (seed', id:ids) =  gen $ seed g-        g' = flip modifyGroups g $ f (ID id $ baseLayout g)+    let (seed', ident :~ ids) =  gen $ seed g -- gen generates an infinite list+        g' = flip modifyGroups g $ f (ID ident $ baseLayout g)                                    >>> toTags                                    >>> foldr (reID g) ((ids, []), [])                                    >>> snd                                    >>> fromTags-    in case groups g == groups g' of-      True -> Nothing-      False -> Just g' { seed = seed' }+    in if groups g == groups g'+       then Nothing+       else Just g' { seed = seed' }  applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window)) applySpecX f g = do-    let (seed', id:ids) = gen $ seed g-    g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)+    let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list+    g' <- flip modifyGroupsX g $ f (ID ident $ baseLayout g)                                 >>> fmap toTags                                 >>> fmap (foldr (reID g) ((ids, []), []))                                 >>> fmap snd                                 >>> fmap fromTags-    return $ case groups g == groups g' of-      True -> Nothing-      False -> Just g' { seed = seed' }+    return $ if groups g == groups g'+             then Nothing+             else Just g' { seed = seed' }  reID :: Groups l l2 Window      -> Either (Group l Window) (Group l Window)-     -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])-     -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])-reID _ _ (([], _), _) = undefined -- The list of ids is infinite-reID g eg ((id:ids, seen), egs) = case elem myID seen of-                                    False -> ((id:ids, myID:seen), eg:egs)-                                    True -> ((ids, seen), mapE_ (setID id) eg:egs)-    where myID = getID $ gLayout $ fromE eg-          setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z+     -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)])+     -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)])+reID g eg ((ident :~ ids, seen), egs)+    | myID `elem` seen = ((ids, seen), mapE_ (setID ident) eg:egs)+    | otherwise = ((ident :~ ids, myID:seen), eg:egs)+  where myID = getID $ gLayout $ fromE eg+        setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z  -- ** Misc. ModifySpecs  -- | helper onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec-onFocused f _ gs = onFocusedZ (onZipper f) gs+onFocused f _ = onFocusedZ (onZipper f)  -- | Swap the focused window with the previous one. swapUp :: ModifySpec
XMonad/Layout/Groups/Examples.hs view
@@ -1,9 +1,13 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE MultiParamTypeClasses, Rank2Types, TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Groups.Examples+-- Description :  Example layouts for "XMonad.Layout.Groups". -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -37,7 +41,6 @@                                      , fullTabs                                      , TiledTabsConfig(..)                                      , def-                                     , defaultTiledTabsConfig                                      , increaseNMasterGroups                                      , decreaseNMasterGroups                                      , shrinkMasterGroups@@ -48,21 +51,18 @@                                        -- * Useful re-exports and utils                                      , module XMonad.Layout.Groups.Helpers                                      , shrinkText-                                     , defaultTheme                                      , GroupEQ(..)                                      , zoomRowG                                      ) where -import XMonad hiding ((|||))+import XMonad  import qualified XMonad.Layout.Groups as G import XMonad.Layout.Groups.Helpers  import XMonad.Layout.ZoomRow import XMonad.Layout.Tabbed-import XMonad.Layout.Named import XMonad.Layout.Renamed-import XMonad.Layout.LayoutCombinators import XMonad.Layout.Decoration import XMonad.Layout.Simplest @@ -76,7 +76,7 @@ -- -- > import XMonad.Layout.Groups.Examples ----- to the top of your @.\/.xmonad\/xmonad.hs@.+-- to the top of your @xmonad.hs@. -- -- For more information on using any of the layouts, jump directly --   to its \"Example\" section.@@ -87,8 +87,8 @@ --   the "XMonad.Layout.Groups.Helpers" module, which are all --   re-exported by this module. ----- For more information on how to extend your layour hook and key bindings, see---   "XMonad.Doc.Extending".+-- For more information on how to extend your layoutHook and key bindings, see+-- <https://xmonad.org/TUTORIAL.html the tutorial> and "XMonad.Doc.Extending".   -- * Helper: ZoomRow of Group elements@@ -135,20 +135,20 @@  -- | Increase the width of the focused column zoomColumnIn :: X ()-zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomIn+zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage zoomIn  -- | Decrease the width of the focused column zoomColumnOut :: X ()-zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomOut+zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage zoomOut  -- | Reset the width of the focused column zoomColumnReset :: X ()-zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomReset+zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage zoomReset  -- | Toggle whether the currently focused column should -- take up all available space whenever it has focus toggleColumnFull :: X ()-toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage $ ZoomFullToggle+toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage ZoomFullToggle  -- | Increase the heigth of the focused window zoomWindowIn :: X ()@@ -205,23 +205,19 @@ instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where     def = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText def -{-# DEPRECATED defaultTiledTabsConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.Groups) instead." #-}-defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker-defaultTiledTabsConfig = def- fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c  tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full  mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c -_tabs = named "Tabs" Simplest+_tabs = renamed [Replace "Tabs"] Simplest  _tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l -_vert c = named "Vertical" $ Tall (vNMaster c) (vIncrement c) (vRatio c)+_vert c = renamed [Replace "Vertical"] $ Tall (vNMaster c) (vIncrement c) (vRatio c) -_horiz c = named "Horizontal" $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c)+_horiz c = renamed [Replace "Horizontal"] $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c)  -- | Increase the number of master groups by one increaseNMasterGroups :: X ()@@ -233,13 +229,12 @@  -- | Shrink the master area shrinkMasterGroups :: X ()-shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Shrink+shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage Shrink  -- | Expand the master area expandMasterGroups :: X ()-expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Expand+expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage Expand  -- | Rotate the available outer layout algorithms nextOuterLayout :: X ()-nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage $ NextLayout-+nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage NextLayout
XMonad/Layout/Groups/Helpers.hs view
@@ -1,9 +1,10 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ViewPatterns #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Groups.Helpers+-- Description :  Utility functions for "XMonad.Layout.Groups". -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -47,7 +48,7 @@  import XMonad.Actions.MessageFeedback (sendMessageB) -import Control.Monad (unless)+import XMonad.Prelude (unless) import qualified Data.Map as M  -- $usage@@ -57,7 +58,7 @@ -- -- > import XMonad.Layout.Groups.Helpers ----- to the top of your @.\/.xmonad\/xmonad.hs@.+-- to the top of your @xmonad.hs@. -- -- "XMonad.Layout.Groups"-based layouts do not have the same notion -- of window ordering as the rest of XMonad. For this reason, the usual@@ -82,8 +83,8 @@ -- -- > import qualified XMonad.Layout.Groups as G ----- For more information on how to extend your layour hook and key bindings, see--- "XMonad.Doc.Extending".+-- For more information on how to extend your layoutHook and key bindings, see+-- <https://xmonad.org/TUTORIAL.html the tutorial> and "XMonad.Doc.Extending".  -- ** Layout-generic actions -- #Layout-generic actions#@@ -135,7 +136,7 @@  ifFloat :: X () -> X () -> X () ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats-                                       if elem w floats then x1 else x2+                                       if w `elem` floats then x1 else x2  focusNonFloat :: X () focusNonFloat = alt2 G.Refocus helper@@ -143,7 +144,7 @@                      ws <- getWindows                      floats <- getFloats                      let (before,  after) = span (/=w) ws-                     case filter (flip notElem floats) $ after ++ before of+                     case filter (`notElem` floats) $ after ++ before of                        [] -> return ()                        w':_ -> focus w' @@ -154,7 +155,7 @@             -> X () focusHelper f g = withFocused $ \w -> do                  ws <- getWindows-                 let (before, _:after) = span (/=w) ws+                 let (before, drop 1 -> after) = span (/=w) ws                  let toFocus = g $ after ++ before                  floats <- getFloats                  case filter (f . flip elem floats) toFocus of
XMonad/Layout/Groups/Wmii.hs view
@@ -4,6 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Groups.Wmii+-- Description :  A wmii-like layout algorithm. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -31,19 +32,16 @@                                    -- * Useful re-exports                                  , shrinkText                                  , def-                                 , defaultTheme                                  , module XMonad.Layout.Groups.Helpers ) where -import XMonad hiding ((|||))+import XMonad  import qualified XMonad.Layout.Groups as G import XMonad.Layout.Groups.Examples import XMonad.Layout.Groups.Helpers  import XMonad.Layout.Tabbed-import XMonad.Layout.Named import XMonad.Layout.Renamed-import XMonad.Layout.LayoutCombinators import XMonad.Layout.MessageControl import XMonad.Layout.Simplest @@ -68,7 +66,7 @@ -- -- > import XMonad.Layout.Groups.Wmii ----- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii'+-- to the top of your @xmonad.hs@, and adding 'wmii' -- (with a 'Shrinker' and decoration 'Theme' as -- parameters) to your layout hook, for example: --@@ -81,8 +79,8 @@ -- -- and so on. ----- For more information on how to extend your layout hook and key bindings, see--- "XMonad.Doc.Extending".+-- For more information on how to extend your layoutHook and key bindings, see+-- <https://xmonad.org/TUTORIAL.html the tutorial> and "XMonad.Doc.Extending". -- -- Finally, you will probably want to be able to move focus and windows -- between groups in a consistent fashion. For this, you should take a look@@ -91,8 +89,8 @@  -- | A layout inspired by wmii wmii s t = G.group innerLayout zoomRowG-    where column = named "Column" $ Tall 0 (3/100) (1/2)-          tabs = named "Tabs" $ Simplest+    where column = renamed [Replace "Column"] $ Tall 0 (3/100) (1/2)+          tabs = renamed [Replace "Tabs"] Simplest           innerLayout = renamed [CutWordsLeft 3]                         $ addTabs s t                         $ ignore NextLayout@@ -131,4 +129,3 @@ -- | Switch the focused group to the \"column\" layout. groupToVerticalLayout :: X () groupToVerticalLayout = sendMessage $ escape $ JumpToLayout "Column"-
XMonad/Layout/Hidden.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}  ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Hidden+-- Description :  Hide windows from layouts. -- Copyright   :  (c) Peter Jones 2015 -- License     :  BSD3-style (see LICENSE) --@@ -20,11 +21,13 @@ module XMonad.Layout.Hidden        ( -- * Usage          -- $usage-         HiddenMsg (..)+         HiddenWindows+       , HiddenMsg (..)        , hiddenWindows        , hideWindow        , popOldestHiddenWindow        , popNewestHiddenWindow+       , popHiddenWindow        ) where  --------------------------------------------------------------------------------@@ -34,7 +37,7 @@  -------------------------------------------------------------------------------- -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Hidden --@@ -43,9 +46,9 @@ -- > myLayout = hiddenWindows (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key bindings, do something like: --@@ -55,27 +58,29 @@ -- -- For detailed instruction on editing the key bindings see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  ---------------------------------------------------------------------------------data HiddenWindows a = HiddenWindows [Window] deriving (Show, Read)+newtype HiddenWindows a = HiddenWindows [Window] deriving (Show, Read)  -------------------------------------------------------------------------------- -- | Messages for the @HiddenWindows@ layout modifier.-data HiddenMsg = HideWindow Window       -- ^ Hide a window.-               | PopNewestHiddenWindow   -- ^ Restore window (FILO).-               | PopOldestHiddenWindow   -- ^ Restore window (FIFO).-               deriving (Typeable, Eq)+data HiddenMsg = HideWindow Window                -- ^ Hide a window.+               | PopNewestHiddenWindow            -- ^ Restore window (FILO).+               | PopOldestHiddenWindow            -- ^ Restore window (FIFO).+               | PopSpecificHiddenWindow Window   -- ^ Restore specific window.+               deriving (Eq)  instance Message HiddenMsg  -------------------------------------------------------------------------------- instance LayoutModifier HiddenWindows Window where   handleMess h@(HiddenWindows hidden) mess-    | Just (HideWindow win)        <- fromMessage mess = hideWindowMsg h win-    | Just (PopNewestHiddenWindow) <- fromMessage mess = popNewestMsg h-    | Just (PopOldestHiddenWindow) <- fromMessage mess = popOldestMsg h-    | Just ReleaseResources        <- fromMessage mess = doUnhook+    | Just (HideWindow win)              <- fromMessage mess = hideWindowMsg h win+    | Just PopNewestHiddenWindow         <- fromMessage mess = popNewestMsg h+    | Just PopOldestHiddenWindow         <- fromMessage mess = popOldestMsg h+    | Just (PopSpecificHiddenWindow win) <- fromMessage mess = popSpecificMsg win h+    | Just ReleaseResources              <- fromMessage mess = doUnhook     | otherwise                                        = return Nothing     where doUnhook = do mapM_ restoreWindow hidden                         return Nothing@@ -107,10 +112,13 @@ popNewestHiddenWindow :: X () popNewestHiddenWindow = sendMessage PopNewestHiddenWindow +popHiddenWindow :: Window -> X ()+popHiddenWindow = sendMessage . PopSpecificHiddenWindow+ -------------------------------------------------------------------------------- hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a)) hideWindowMsg (HiddenWindows hidden) win = do-  modify (\s -> s { windowset = W.delete' win $ windowset s })+  modifyWindowSet $ W.delete' win   return . Just . HiddenWindows $ hidden ++ [win]  --------------------------------------------------------------------------------@@ -129,6 +137,15 @@   return . Just . HiddenWindows $ rest  --------------------------------------------------------------------------------+popSpecificMsg :: Window -> HiddenWindows a -> X (Maybe (HiddenWindows a))+popSpecificMsg _   (HiddenWindows []) = return Nothing+popSpecificMsg win (HiddenWindows hiddenWins) = if win `elem` hiddenWins+  then do+    restoreWindow win+    return . Just . HiddenWindows $ filter (/= win) hiddenWins+  else+    return . Just . HiddenWindows $ hiddenWins++-------------------------------------------------------------------------------- restoreWindow :: Window -> X ()-restoreWindow win =-  modify (\s -> s { windowset = W.insertUp win $ windowset s })+restoreWindow = windows . W.insertUp
XMonad/Layout/HintedGrid.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.HintedGrid+-- Description :  A layout that puts all windows in a square grid while obeying their size hints. -- Copyright   :  (c) Lukas Mai -- License     :  BSD-style (see LICENSE) --@@ -24,10 +25,10 @@ import Prelude hiding ((.))  import XMonad+import XMonad.Prelude (replicateM, sortBy, sortOn) import XMonad.StackSet -import Control.Monad.State-import Data.List+import Control.Monad.State (runState) import Data.Ord  infixr 9 .@@ -35,7 +36,7 @@ (.) = fmap  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.HintedGrid --@@ -50,6 +51,7 @@ -- > myLayout = GridRatio (4/3) False ||| etc. -- -- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and -- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | Automatic mirroring of hinted layouts doesn't work very well, so this@@ -62,15 +64,15 @@  instance LayoutClass Grid Window where     doLayout (Grid m)        r w = doLayout (GridRatio defaultRatio m) r w-    doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w)+    doLayout (GridRatio d m) r w = (, Nothing) . arrange d m r (integrate w)  replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a) replicateS n f = runState . replicateM n $ do (a,s) <- gets f; put s; return a -doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D]+doColumn :: Dimension -> Dimension -> Dimension -> [D -> D] -> [D] doColumn width height k adjs =     let-        (ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs+        (ind, fs) = unzip . sortOn (snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs         (_, ds) = doC height k fs     in     map snd . sortBy (comparing fst) . zip ind $ ds@@ -96,7 +98,7 @@             hoffset = hsingle `div` 2             width' = width - maxw             ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs-            xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws+            xs = map ((width' +) . (`div` 2) . (maxw -)) ws         in         zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs
XMonad/Layout/HintedTile.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.HintedTile+-- Description :  A gapless tiled layout that obeys window size hints. -- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -23,10 +24,10 @@  import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W-import Control.Monad+import XMonad.Prelude  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.HintedTile --@@ -45,9 +46,9 @@ -- built-in Tall with HintedTile, change @import Xmonad@ to -- @import Xmonad hiding (Tall)@. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data HintedTile a = HintedTile     { nmaster     :: !Int         -- ^ number of windows in the master pane@@ -67,7 +68,7 @@     deriving ( Show, Read, Eq, Ord )  instance LayoutClass HintedTile Window where-    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do+    doLayout HintedTile{ orientation = o, nmaster = nm, frac = f, alignment = al } r w' = do         bhs <- mapM mkAdjust w         let (masters, slaves) = splitAt nm bhs         return (zip w (tiler masters slaves), Nothing)@@ -98,15 +99,15 @@     where     (w, h) = bh (sw, sh) -divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) :-      (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))+divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = Rectangle (align al sx sw w) sy w h :+      divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))  where-    (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs)))+    (w, h) = bh (sw, sh `div` fromIntegral (1 + length bhs)) -divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) :-      (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))+divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = Rectangle sx (align al sy sh h) w h :+      divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)  where-    (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh)+    (w, h) = bh (sw `div` fromIntegral (1 + length bhs), sh)  -- Split the screen into two rectangles, using a rational to specify the ratio split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])
XMonad/Layout/IM.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.IM+-- Description :  Layout modfier for multi-windowed instant messengers like Psi or Tkabber. -- Copyright   :  (c) Roman Cheplyaka, Ivan N. Veselov <veselov@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -29,13 +30,16 @@ ) where  import XMonad-import qualified XMonad.StackSet as S import XMonad.Layout.Grid import XMonad.Layout.LayoutModifier+import XMonad.Prelude import XMonad.Util.WindowProperties+import qualified XMonad.StackSet as S +import Control.Arrow (first)+ -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.IM -- > import Data.Ratio ((%))@@ -52,9 +56,9 @@ -- -- Screenshot: <http://haskell.org/haskellwiki/Image:Xmonad-layout-im.png> ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- $hints --@@ -97,20 +101,15 @@             -> X ([(Window, Rectangle)], Maybe (l Window)) applyIM ratio prop wksp rect = do     let stack = S.stack wksp-    let ws = S.integrate' $ stack+    let ws = S.integrate' stack     let (masterRect, slaveRect) = splitHorizontallyBy ratio rect     master <- findM (hasProperty prop) ws     case master of         Just w -> do             let filteredStack = stack >>= S.filter (w /=)             wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect-            return ((w, masterRect) : fst wrs, snd wrs)+            return (first ((w, masterRect) :) wrs)         Nothing -> runLayout wksp rect---- | Like find, but works with monadic computation instead of pure function.-findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)-findM _ [] = return Nothing-findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }  -- | This is for compatibility with old configs only and will be removed in future versions! data IM a = IM Rational Property deriving (Read, Show)
XMonad/Layout/IfMax.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.IfMax+-- Description :  Decide upon a layout depending on the number of windows. -- Copyright   :  (c) 2013 Ilya Portnov -- License     :  BSD3-style (see LICENSE) --@@ -8,7 +9,7 @@ -- Stability   :  unstable -- Portability :  unportable ----- Provides IfMax layout, which will run one layout if there are maximum N +-- Provides IfMax layout, which will run one layout if there are maximum N -- windows on workspace, and another layout, when number of windows is greater -- than N. --@@ -23,20 +24,19 @@     , ifMax     ) where -import Control.Applicative((<$>))-import Control.Arrow+import Control.Arrow ((&&&)) import qualified Data.List as L import qualified Data.Map  as M-import Data.Maybe  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W  -- $usage--- IfMax layout will run one layout if number of windows on workspace is as +-- IfMax layout will run one layout if number of windows on workspace is as -- maximum N, and else will run another layout. ----- You can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.IfMax --@@ -91,5 +91,4 @@       -> l1 w           -- ^ First layout       -> l2 w           -- ^ Second layout       -> IfMax l1 l2 w-ifMax n l1 l2 = IfMax n l1 l2-+ifMax = IfMax
XMonad/Layout/ImageButtonDecoration.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ImageButtonDecoration+-- Description :  Decoration that includes image buttons, executing actions when clicked on. -- Copyright   :  (c) Jan Vornberger 2009 --                    Alejandro Serrano 2010 -- License     :  BSD3-style (see LICENSE)@@ -28,6 +29,9 @@       -- $usage       imageButtonDeco     , defaultThemeWithImageButtons+    , shrinkText+    , CustomShrink(CustomShrink)+    , Shrinker     , imageTitleBarButtonHandler     , ImageButtonDecoration     ) where@@ -43,7 +47,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.ImageButtonDecoration --@@ -76,7 +80,7 @@ -- it easier to visualize  convertToBool' :: [Int] -> [Bool]-convertToBool' = map (\x -> x == 1)+convertToBool' = map (== 1)  convertToBool :: [[Int]] -> [[Bool]] convertToBool = map convertToBool'@@ -148,19 +152,16 @@ -- See 'defaultThemeWithImageButtons' below. imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool imageTitleBarButtonHandler mainw distFromLeft distFromRight = do-    let action = if (fi distFromLeft >= menuButtonOffset &&-                      fi distFromLeft <= menuButtonOffset + buttonSize)-                        then focus mainw >> windowMenu >> return True-                  else if (fi distFromRight >= closeButtonOffset &&-                           fi distFromRight <= closeButtonOffset + buttonSize)-                              then focus mainw >> kill >> return True-                  else if (fi distFromRight >= maximizeButtonOffset &&-                           fi distFromRight <= maximizeButtonOffset + buttonSize)-                             then focus mainw >> sendMessage (maximizeRestore mainw) >> return True-                  else if (fi distFromRight >= minimizeButtonOffset &&-                           fi distFromRight <= minimizeButtonOffset + buttonSize)-                             then focus mainw >> minimizeWindow mainw >> return True-                  else return False+    let action+          | fi distFromLeft >= menuButtonOffset &&+             fi distFromLeft <= menuButtonOffset + buttonSize = focus mainw >> windowMenu >> return True+          | fi distFromRight >= closeButtonOffset &&+            fi distFromRight <= closeButtonOffset + buttonSize = focus mainw >> kill >> return True+          | fi distFromRight >= maximizeButtonOffset &&+            fi distFromRight <= maximizeButtonOffset + buttonSize = focus mainw >> sendMessage (maximizeRestore mainw) >> return True+          | fi distFromRight >= minimizeButtonOffset &&+            fi distFromRight <= minimizeButtonOffset + buttonSize = focus mainw >> minimizeWindow mainw >> return True+          | otherwise = return False     action  defaultThemeWithImageButtons :: Theme@@ -175,9 +176,9 @@                    -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a imageButtonDeco s c = decoration s c $ NFD True -data ImageButtonDecoration a = NFD Bool deriving (Show, Read)+newtype ImageButtonDecoration a = NFD Bool deriving (Show, Read)  instance Eq a => DecorationStyle ImageButtonDecoration a where     describeDeco _ = "ImageButtonDeco"-    decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR+    decorationCatchClicksHook _ = imageTitleBarButtonHandler     decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()
XMonad/Layout/IndependentScreens.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.IndependentScreens+-- Description :  Simulate independent sets of workspaces on each screen (dwm-like). -- Copyright   :  (c) 2009 Daniel Wagner -- License     :  BSD3 --@@ -17,29 +19,31 @@     -- * Usage     -- $usage     VirtualWorkspace, PhysicalWorkspace,+    VirtualWindowSpace, PhysicalWindowSpace,     workspaces',-    withScreens, onCurrentScreen,+    withScreen, withScreens,+    onCurrentScreen,     marshallPP,     whenCurrentOn,     countScreens,+    workspacesOn, screenOnMonitor,+    workspaceOnScreen, focusWindow', doFocus', focusScreen, focusWorkspace, nthWorkspace, withWspOnScreen,     -- * Converting between virtual and physical workspaces     -- $converting     marshall, unmarshall, unmarshallS, unmarshallW,-    marshallWindowSpace, unmarshallWindowSpace, marshallSort+    marshallWindowSpace, unmarshallWindowSpace, marshallSort, ) where --- for the screen stuff-import Control.Applicative((<*), liftA2)-import Control.Arrow hiding ((|||))-import Control.Monad-import Data.List (nub, genericLength)+import Control.Arrow ((***)) import Graphics.X11.Xinerama import XMonad-import XMonad.StackSet hiding (filter, workspaces)-import XMonad.Hooks.DynamicLog+import XMonad.Hooks.StatusBar.PP+import XMonad.Prelude+import qualified XMonad.StackSet as W+import XMonad.Actions.OnScreen (viewOnScreen)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.IndependentScreens --@@ -54,7 +58,7 @@ -- to specific workspace names.  In the default configuration, only -- the keybindings for changing workspace do this: ----- > keyBindings conf = let m = modMask conf in fromList $+-- > keyBindings conf = let modm = modMask conf in fromList $ -- >     {- lots of other keybindings -} -- >     [((m .|. modm, k), windows $ f i) -- >         | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]@@ -62,7 +66,7 @@ -- -- This should change to ----- > keyBindings conf = let m = modMask conf in fromList $+-- > keyBindings conf = let modm = modMask conf in fromList $ -- >     {- lots of other keybindings -} -- >     [((m .|. modm, k), windows $ onCurrentScreen f i) -- >         | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]@@ -75,11 +79,16 @@ -- screen into a physical workspace name. -- -- A complete example abusing many of the functions below is available in the--- "XMonad.Config.Dmwit" module.+-- <https://xmonad.org/configurations.html XMonad.Config.Dmwit> configuration.  type VirtualWorkspace  = WorkspaceId type PhysicalWorkspace = WorkspaceId +-- | A 'WindowSpace' whose tags are 'PhysicalWorkspace's.+type PhysicalWindowSpace = WindowSpace+-- | A 'WindowSpace' whose tags are 'VirtualWorkspace's.+type VirtualWindowSpace = WindowSpace+ -- $converting -- You shouldn't need to use the functions below very much. They are used -- internally. However, in some cases, they may be useful, and so are exported@@ -99,17 +108,76 @@ unmarshallS = fst . unmarshall unmarshallW = snd . unmarshall +-- | Get a list of all the virtual workspace names. workspaces' :: XConfig l -> [VirtualWorkspace]-workspaces' = nub . map (snd . unmarshall) . workspaces+workspaces' = nub . map unmarshallW . workspaces +-- | Specify workspace names for each screen+withScreen :: ScreenId            -- ^ The screen to make workspaces for+           -> [VirtualWorkspace]  -- ^ The desired virtual workspace names+           -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names+withScreen n = map (marshall n)++-- | Make all workspaces across the monitors bear the same names withScreens :: ScreenId            -- ^ The number of screens to make workspaces for             -> [VirtualWorkspace]  -- ^ The desired virtual workspace names             -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names-withScreens n vws = [marshall sc pws | pws <- vws, sc <- [0..n-1]]+withScreens n vws = concatMap (`withScreen` vws) [0..n-1] -onCurrentScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a)-onCurrentScreen f vws = screen . current >>= f . flip marshall vws+-- | Transform a function over physical workspaces into a function over virtual workspaces.+-- This is useful as it allows you to write code without caring about the current screen, i.e. to say "switch to workspace 3"+-- rather than saying "switch to workspace 3 on monitor 3".+onCurrentScreen :: (PhysicalWorkspace -> WindowSet -> a) -> (VirtualWorkspace -> WindowSet -> a)+onCurrentScreen f vws ws =+  let currentScreenId = W.screen $ W.current ws+   in f (marshall currentScreenId vws) ws +-- | Get the workspace currently active on a given screen+workspaceOnScreen :: ScreenId -> WindowSet -> Maybe PhysicalWorkspace+workspaceOnScreen screenId ws = W.tag . W.workspace <$> screenOnMonitor screenId ws++-- | Generate WindowSet transformation by providing a given function with the workspace active on a given screen.+-- This may for example be used to shift a window to another screen as follows:+--+-- > windows $ withWspOnScreen 1 W.shift+--+withWspOnScreen :: ScreenId                               -- ^ The screen to run on+         -> (PhysicalWorkspace -> WindowSet -> WindowSet) -- ^ The transformation that will be passed the workspace currently active on there+         -> WindowSet -> WindowSet+withWspOnScreen screenId operation ws = case workspaceOnScreen screenId ws of+    Just wsp -> operation wsp ws+    Nothing -> ws++-- | Get the screen that is active on a given monitor.+screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen+screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws)++-- | Focus a window, switching workspace on the correct Xinerama screen if neccessary.+focusWindow' :: Window -> WindowSet -> WindowSet+focusWindow' window ws+  | Just window == W.peek ws = ws+  | otherwise = case W.findTag window ws of+      Just tag -> W.focusWindow window $ focusScreen (unmarshallS tag) ws+      Nothing -> ws++-- | ManageHook to focus a window, switching workspace on the correct Xinerama screen if neccessary.+-- Useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook' when using this module.+doFocus' :: ManageHook+doFocus' = doF . focusWindow' =<< ask++-- | Focus a given screen.+focusScreen :: ScreenId -> WindowSet -> WindowSet+focusScreen screenId = withWspOnScreen screenId W.view++-- | Focus the given workspace on the correct Xinerama screen.+-- An example usage can be found at `XMonad.Hooks.EwmhDesktops.setEwmhSwitchDesktopHook`+focusWorkspace :: WorkspaceId -> WindowSet -> WindowSet+focusWorkspace workspaceId = viewOnScreen (unmarshallS workspaceId) workspaceId++-- | Get the nth virtual workspace+nthWorkspace :: Int -> X (Maybe VirtualWorkspace)+nthWorkspace n = (!? n) . workspaces' <$> asks config+ -- | In case you don't know statically how many screens there will be, you can call this in main before starting xmonad.  For example, part of my config reads -- -- > main = do@@ -121,28 +189,27 @@ -- >     } -- countScreens :: (MonadIO m, Integral i) => m i-countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay+countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay --- | This turns a naive pretty-printer into one that is aware of the--- independent screens. That is, you can write your pretty printer to behave--- the way you want on virtual workspaces; this function will convert that--- pretty-printer into one that first filters out physical workspaces on other--- screens, then converts all the physical workspaces on this screen to their--- virtual names.+-- | This turns a pretty-printer into one that is aware of the independent screens. The+-- converted pretty-printer first filters out physical workspaces on other screens, then+-- converts all the physical workspaces on this screen to their virtual names.+-- Note that 'ppSort' still operates on physical (marshalled) workspace names,+-- otherwise functions from "XMonad.Util.WorkspaceCompare" wouldn't work.+-- If you need to sort on virtual names, see 'marshallSort'. ----- For example, if you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write+-- For example, if you have have two bars on the left and right screens, respectively, and @pp@ is+-- a pretty-printer, you could apply 'marshallPP' when creating a @StatusBarConfig@ from "XMonad.Hooks.StatusBar". ----- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle--- >           in log 0 hLeft >> log 1 hRight+-- A sample config looks like this:+--+-- > mySBL = statusBarProp "xmobar" $ pure (marshallPP (S 0) pp)+-- > mySBR = statusBarProp "xmobar" $ pure (marshallPP (S 1) pp)+-- > main = xmonad $ withEasySB (mySBL <> mySBR) defToggleStrutsKey def+-- marshallPP :: ScreenId -> PP -> PP-marshallPP s pp = pp {-    ppCurrent           = ppCurrent         pp . snd . unmarshall,-    ppVisible           = ppVisible         pp . snd . unmarshall,-    ppHidden            = ppHidden          pp . snd . unmarshall,-    ppHiddenNoWindows   = ppHiddenNoWindows pp . snd . unmarshall,-    ppUrgent            = ppUrgent          pp . snd . unmarshall,-    ppSort              = fmap (marshallSort s) (ppSort pp)-    }+marshallPP s pp = pp { ppRename = ppRename pp . unmarshallW+                     , ppSort = (. workspacesOn s) <$> ppSort pp }  -- | Take a pretty-printer and turn it into one that only runs when the current -- workspace is one associated with the given screen. The way this works is a@@ -167,23 +234,42 @@ whenCurrentOn :: ScreenId -> PP -> PP whenCurrentOn s pp = pp     { ppSort = do-        sort <- ppSort pp-        return $ \xs -> case xs of-            x:_ | unmarshallS (tag x) == s -> sort xs-            _ -> []-    , ppOrder = \i@(wss:_) -> case wss of-        "" -> ["\0"] -- we got passed no workspaces; this is the signal from ppSort that this is a boring case-        _  -> ppOrder pp i-    , ppOutput = \out -> case out of-        "\0" -> return () -- we got passed the signal from ppOrder that this is a boring case-        _ -> ppOutput pp out+        sorter <- ppSort pp+        pure $ \case xs@(x:_) | unmarshallS (W.tag x) == s -> sorter xs+                     _ -> []++    , ppOrder  = \case ("":_) -> ["\0"] -- we got passed no workspaces; this is the signal from ppSort that this is a boring case+                       list   -> ppOrder pp list++    , ppOutput = \case "\0"   -> pure () -- we got passed the signal from ppOrder that this is a boring case+                       output -> ppOutput pp output     } --- | If @vSort@ is a function that sorts 'WindowSpace's with virtual names, then @marshallSort s vSort@ is a function which sorts 'WindowSpace's with physical names in an analogous way -- but keeps only the spaces on screen @s@.-marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace])+-- | Filter workspaces that are on a given screen.+workspacesOn :: ScreenId -> [PhysicalWindowSpace] -> [PhysicalWindowSpace]+workspacesOn s = filter (\ws -> unmarshallS (W.tag ws) == s)++-- | @vSort@ is a function that sorts 'VirtualWindowSpace's with virtual names.+-- @marshallSort s vSort@ is a function which sorts 'PhysicalWindowSpace's with virtual names,+-- but keeps only the 'WindowSpace'\'s on screen @s@.+--+-- NOTE: @vSort@ operating on virtual names comes with some caveats, see+-- <https://github.com/xmonad/xmonad-contrib/issues/420 this issue> for+-- more information. You can use 'marshallSort' like in the following example:+--+-- === __Example__+--+-- > pp' :: ScreenId -> PP -> PP+-- > pp' s pp = (marshallPP s pp) { ppSort = fmap (marshallSort s) (ppSort pp) }+-- >+-- > mySBL = statusBarProp "xmobar" $ pure (pp' (S 0) pp)+-- > mySBR = statusBarProp "xmobar" $ pure (pp' (S 1) pp)+-- > main = xmonad $ withEasySB (mySBL <> mySBR) defToggleStrutsKey def+--+-- In this way, you have a custom virtual names sort on top of 'marshallPP'.+marshallSort :: ScreenId -> ([VirtualWindowSpace] -> [VirtualWindowSpace]) -> ([PhysicalWindowSpace] -> [PhysicalWindowSpace]) marshallSort s vSort = pScreens . vSort . vScreens where-    onScreen ws = unmarshallS (tag ws) == s-    vScreens    = map unmarshallWindowSpace . filter onScreen+    vScreens    = map unmarshallWindowSpace . workspacesOn s     pScreens    = map (marshallWindowSpace s)  -- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'.@@ -191,5 +277,5 @@ -- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'. unmarshallWindowSpace :: WindowSpace -> WindowSpace -marshallWindowSpace s ws = ws { tag = marshall s  (tag ws) }-unmarshallWindowSpace ws = ws { tag = unmarshallW (tag ws) }+marshallWindowSpace s ws = ws { W.tag = marshall s  (W.tag ws) }+unmarshallWindowSpace ws = ws { W.tag = unmarshallW (W.tag ws) }
XMonad/Layout/LayoutBuilder.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable    #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -10,6 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.LayoutBuilder+-- Description :  Send a number of windows to one rectangle and the rest to another. -- -- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, --                    2011 Ilya Portnov <portnov84@rambler.ru>,@@ -57,17 +57,16 @@   LayoutN, ) where ----------------------------------------------------------------------------------import Control.Applicative ((<|>))-import Control.Monad (foldM)-import Data.Maybe+import Data.Maybe (maybeToList) import XMonad+import XMonad.Prelude (foldM, (<|>), isJust, fromMaybe, isNothing, listToMaybe) import qualified XMonad.StackSet as W+import XMonad.Util.Stack (zipperFocusedAtFirstOf) import XMonad.Util.WindowProperties  -------------------------------------------------------------------------------- -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutBuilder --@@ -106,9 +105,9 @@ -- -- These examples require "XMonad.Layout.Tabbed". ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may wish to add the following keybindings: --@@ -117,7 +116,7 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -------------------------------------------------------------------------------- -- $selectWin@@ -225,7 +224,7 @@  -------------------------------------------------------------------------------- -- | Change the number of windows handled by the focused layout.-data IncLayoutN = IncLayoutN Int deriving Typeable+newtype IncLayoutN = IncLayoutN Int instance Message IncLayoutN  --------------------------------------------------------------------------------@@ -259,7 +258,7 @@  -------------------------------------------------------------------------------- instance ( LayoutClass l1 a, LayoutClass l2 a-         , Read a, Show a, Show p, Eq a, Typeable a, Predicate p a+         , Read a, Show a, Show p, Typeable p, Eq a, Typeable a, Predicate p a          ) => LayoutClass (LayoutB l1 l2 p) a where      -- | Update window locations.@@ -370,7 +369,7 @@ -- | Check to see if the given window is currently focused. isFocus :: (Show a) => Maybe a -> X Bool isFocus Nothing = return False-isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset+isFocus (Just w) = do ms <- W.stack . W.workspace . W.current <$> gets windowset                       return $ maybe False (\s -> show w == show (W.focus s)) ms  --------------------------------------------------------------------------------@@ -455,11 +454,4 @@  -------------------------------------------------------------------------------- differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)-differentiate' _ [] = Nothing-differentiate' Nothing w = W.differentiate w-differentiate' (Just f) w-    | f `elem` w = Just W.Stack { W.focus = f-                                , W.up    = reverse $ takeWhile (/=f) w-                                , W.down  = tail $ dropWhile (/=f) w-                                }-    | otherwise = W.differentiate w+differentiate' = zipperFocusedAtFirstOf . maybeToList
− XMonad/Layout/LayoutBuilderP.hs 
@@ -1,210 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}--------------------------------------------------------------------------------- |--- Module      :  XMonad.Layout.LayoutBuilderP--- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>--- License     :  BSD3-style (see LICENSE)------ Maintainer  :  Ilya Portnov <portnov84@rambler.ru>--- Stability   :  unstable--- Portability :  unportable------ DEPRECATED.  Use 'XMonad.Layout.LayoutBuilder' instead.-----------------------------------------------------------------------------------module XMonad.Layout.LayoutBuilderP {-# DEPRECATED "Use XMonad.Layout.LayoutBuilder instead" #-} (-  LayoutP (..),-  layoutP, layoutAll,-  B.relBox, B.absBox,-  -- * Overloading ways to select windows-  -- $selectWin-  Predicate (..), Proxy(..),-  ) where--import Control.Monad-import Data.Maybe (isJust)--import XMonad-import qualified XMonad.StackSet as W-import XMonad.Util.WindowProperties--import qualified XMonad.Layout.LayoutBuilder as B---- $selectWin------ 'Predicate' exists because layouts are required to be serializable, and--- "XMonad.Util.WindowProperties" is not sufficient (for example it does not--- allow using regular expressions).------ compare "XMonad.Util.Invisible"---- | Type class for predicates. This enables us to manage not only Windows,--- but any objects, for which instance Predicate is defined.------ Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras-class Predicate p w where-  alwaysTrue :: Proxy w -> p         -- ^ A predicate that is always True.-  checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate---- | Contains no actual data, but is needed to help select the correct instance--- of 'Predicate'-data Proxy a = Proxy---- | Data type for our layout.-data LayoutP p l1 l2 a =-    LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))-    deriving (Show,Read)---- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.---   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.-{-# DEPRECATED layoutP "Use XMonad.Layout.LayoutBuilder.layoutP instead." #-}-layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>-       p-    -> B.SubBox                       -- ^ The box to place the windows in-    -> Maybe B.SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left-    -> l1 a                         -- ^ The layout to use in the specified area-    -> LayoutP p l2 l3 a              -- ^ Where to send the remaining windows-    -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout-layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next)---- | Use the specified layout in the described area for all remaining windows.-{-# DEPRECATED layoutAll "Use XMonad.Layout.LayoutBuilder.layoutAll instead." #-}-layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>-       B.SubBox             -- ^ The box to place the windows in-    -> l1 a               -- ^ The layout to use in the specified area-    -> LayoutP p l1 Full a  -- ^ The resulting layout-layoutAll box sub =-  let a = alwaysTrue (Proxy :: Proxy a)-  in  LayoutP Nothing Nothing a box Nothing sub Nothing--instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>-    LayoutClass (LayoutP p l1 l2) w where--        -- | Update window locations.-        runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect-            = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf-                 let selBox = if isJust nextf'-                                then box-                                else maybe box id mbox--                 (sublist,sub') <- handle sub subs $ calcArea selBox rect--                 (nextlist,next') <- case next of Nothing -> return ([],Nothing)-                                                  Just n -> do (res,l) <- handle n nexts rect-                                                               return (res,Just l)--                 return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' )-              where-                  handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r-                                     l' <- return $ maybe l id ml-                                     return (res,l')--        -- |  Propagate messages.-        handleMessage l m-            | Just (IncMasterN _) <- fromMessage m = sendFocus l m-            | Just (Shrink) <- fromMessage m = sendFocus l m-            | Just (Expand) <- fromMessage m = sendFocus l m-            | otherwise = sendBoth l m--        -- |  Descriptive name for layout.-        description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next-        description (LayoutP _ _ _ _ _ sub Nothing)     = "layoutP "++ description sub---sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)-        => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))-sendSub (LayoutP subf nextf prop box mbox sub next) m =-    do sub' <- handleMessage sub m-       return $ if isJust sub'-                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next-                else Nothing--sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)-         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))-sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m-sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m =-    do sub' <- handleMessage sub m-       next' <- handleMessage next m-       return $ if isJust sub' || isJust next'-                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next')-                else Nothing--sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)-         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))-sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing-sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m =-    do next' <- handleMessage next m-       return $ if isJust next'-                then Just $ LayoutP subf nextf prop box mbox sub next'-                else Nothing--sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)-          => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))-sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf-                                              if foc then sendSub l m-                                                     else sendNext l m--isFocus :: (Show a) => Maybe a -> X Bool-isFocus Nothing = return False-isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset-                      return $ maybe False (\s -> show w == (show $ W.focus s)) ms----- | Split given list of objects (i.e. windows) using predicate.-splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])-splitBy prop ws = foldM step ([], []) ws-  where-    step (good, bad) w = do-      ok <- checkPredicate prop w-      return $ if ok-                then (w:good, bad)-                else (good,   w:bad)--splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)-splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing)-splitStack (Just s) prop subf nextf = do-    let ws = W.integrate s-    (good, other) <- splitBy prop ws-    let subf'  = foc good subf-        nextf' = foc other nextf-    return ( differentiate' subf' good-           , differentiate' nextf' other-           , subf'-           , nextf'-           )-  where-    foc [] _ = Nothing-    foc l f = if W.focus s `elem` l-              then Just $ W.focus s-              else if maybe False (`elem` l) f-                   then f-                   else Just $ head l--calcArea :: B.SubBox -> Rectangle -> Rectangle-calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'-    where-        xpos' = calc False xpos $ rect_width rect-        ypos' = calc False ypos $ rect_height rect-        width' = calc True width $ rect_width rect - xpos'-        height' = calc True height $ rect_height rect - ypos'--        calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $-            case val of B.Rel v -> floor $ v * fromIntegral tot-                        B.Abs v -> if v<0 || (zneg && v==0)-                                 then (fromIntegral tot)+v-                                 else v--differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)-differentiate' _ [] = Nothing-differentiate' Nothing w = W.differentiate w-differentiate' (Just f) w-    | f `elem` w = Just $ W.Stack { W.focus = f-                                  , W.up    = reverse $ takeWhile (/=f) w-                                  , W.down  = tail $ dropWhile (/=f) w-                                  }-    | otherwise = W.differentiate w--instance Predicate Property Window where-  alwaysTrue _ = Const True-  checkPredicate = hasProperty
XMonad/Layout/LayoutCombinators.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Layout.LayoutCombinators+-- Description :  Easily combine multiple layouts into one composite layout. -- Copyright    : (c) David Roundy <droundy@darcs.net> -- License      : BSD --@@ -10,10 +10,7 @@ -- Portability  : portable -- -- The "XMonad.Layout.LayoutCombinators" module provides combinators--- for easily combining multiple layouts into one composite layout, as--- well as a way to jump directly to any particular layout (say, with--- a keybinding) without having to cycle through other layouts to get--- to it.+-- for easily combining multiple layouts into one composite layout. -----------------------------------------------------------------------------  module XMonad.Layout.LayoutCombinators@@ -43,26 +40,20 @@     , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)     , (***/****),(*/****),(**/***),(*/***),(*/**) -      -- * New layout choice combinator and 'JumpToLayout'-      -- $jtl+      -- * Re-exports for backwards compatibility     , (|||)     , JumpToLayout(..)--      -- * Types     , NewSelect     ) where -import Data.Maybe ( isJust, isNothing )--import XMonad hiding ((|||))-import XMonad.StackSet (Workspace (..))+import XMonad import XMonad.Layout.Combo import XMonad.Layout.DragPane  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: ----- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )+-- > import XMonad.Layout.LayoutCombinators -- -- Then edit your @layoutHook@ to use the new layout combinators. For -- example:@@ -70,21 +61,10 @@ -- > myLayout = (Tall 1 (3/100) (1/2) *//* Full)  ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the @layoutHook@ see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"------ To use the 'JumpToLayout' message, hide the normal @|||@ operator instead:------ > import XMonad hiding ( (|||) )--- > import XMonad.Layout.LayoutCombinators------ If you import XMonad.Layout, you will need to hide it from there as well.--- Then bind some keys to a 'JumpToLayout' message:------ >   , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")  -- jump directly to the Full layout+-- For more detailed instructions on editing the @layoutHook@ see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". ----- See below for more detailed documentation.  -- $combine -- Each of the following combinators combines two layouts into a@@ -100,7 +80,7 @@          */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */**  -- $dpv--- These combinators combine two layouts using "XMonad.DragPane" in+-- These combinators combine two layouts using "XMonad.Layout.DragPane" in -- vertical mode.  (*||*),(**||*),(***||*),(****||*), (***||**),(****||***),@@ -120,7 +100,7 @@ (*||**)     = combineTwo (dragPane Vertical 0.1 (1/3))  -- $dph--- These combinators combine two layouts using "XMonad.DragPane" in+-- These combinators combine two layouts using "XMonad.Layout.DragPane" in -- horizontal mode.  (*//*),(**//*),(***//*),(****//*), (***//**),(****//***),@@ -177,114 +157,5 @@ (*/***)    = combineTwo (Mirror $ Tall 1 0.1 (1/4)) (*/**)     = combineTwo (Mirror $ Tall 1 0.1 (1/3)) -infixr 5 |||---- $jtl--- The standard xmonad core exports a layout combinator @|||@ which--- represents layout choice.  This is a reimplementation which also--- provides the capability to support 'JumpToLayout' messages.  To use--- it, be sure to hide the import of @|||@ from the xmonad core; if either of--- these two lines appear in your configuration:------ > import XMonad--- > import XMonad.Layout------ replace them with these instead, respectively:------ > import XMonad hiding ( (|||) )--- > import XMonad.Layout hiding ( (|||) )------ The argument given to a 'JumpToLayout' message should be the--- @description@ of the layout to be selected.  If you use--- "XMonad.Hooks.DynamicLog", this is the name of the layout displayed--- in your status bar.  Alternatively, you can use GHCi to determine--- the proper name to use.  For example:------ > $ ghci--- > GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help--- > Loading package base ... linking ... done.--- > :set prompt "> "    -- don't show loaded module names--- > > :m +XMonad.Core   -- load the xmonad core--- > > :m +XMonad.Layout.Grid  -- load whatever module you want to use--- > > description Grid  -- find out what it's called--- > "Grid"------ As yet another (possibly easier) alternative, you can use the--- "XMonad.Layout.Named" modifier to give custom names to your--- layouts, and use those.------ For the ability to select a layout from a prompt, see--- "Xmonad.Prompt.Layout".---- | A reimplementation of the combinator of the same name from the---   xmonad core, providing layout choice, and the ability to support---   'JumpToLayout' messages.-(|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a-(|||) = NewSelect True--data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show )---- |-data JumpToLayout = JumpToLayout String -- ^ A message to jump to a particular layout-                                        -- , specified by its description string..-                  | NextLayoutNoWrap-                  | Wrap-                    deriving ( Read, Show, Typeable )-instance Message JumpToLayout--instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where-    runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r-                                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')--    runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r-                                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')-    description (NewSelect True l1 _) = description l1-    description (NewSelect False _ l2) = description l2-    handleMessage l@(NewSelect False _ _) m-        | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m-    handleMessage l@(NewSelect amfirst _ _) m-        | Just NextLayoutNoWrap <- fromMessage m =-                  if amfirst then when' isNothing (passOnM m l) $-                                  fmap Just $ swap l >>= passOn (SomeMessage Wrap)-                             else passOnM m l-    handleMessage l m-        | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $-                                             fmap Just $ swap l >>= passOn (SomeMessage Wrap)-    handleMessage l@(NewSelect True _ l2) m-        | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l-    handleMessage l@(NewSelect False l1 _) m-        | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l-    handleMessage l m-        | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $-                                                   do ml' <- passOnM m $ sw l-                                                      case ml' of-                                                        Nothing -> return Nothing-                                                        Just l' -> Just `fmap` swap (sw l')-    handleMessage (NewSelect b l1 l2) m-        | Just ReleaseResources  <- fromMessage m =-        do ml1' <- handleMessage l1 m-           ml2' <- handleMessage l2 m-           return $ if isJust ml1' || isJust ml2'-                    then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2')-                    else Nothing-    handleMessage l m = passOnM m l--swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)-swap l = sw `fmap` passOn (SomeMessage Hide) l--sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a-sw (NewSelect b lt lf) = NewSelect (not b) lt lf--passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>-          SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)-passOn m l = maybe l id `fmap` passOnM m l--passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>-           SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))-passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m-                                      return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'-passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m-                                       return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'--when' :: Monad m => (a -> Bool) -> m a -> m a -> m a-when' f a b = do a1 <- a; if f a1 then b else return a1+type NewSelect = Choose+{-# DEPRECATED NewSelect "Use 'Choose' instead." #-}
XMonad/Layout/LayoutHints.hs view
@@ -1,8 +1,11 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ParallelListComp, PatternGuards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Layout.LayoutHints+-- Description :  Make layouts respect size hints. -- Copyright    : (c) David Roundy <droundy@darcs.net> -- License      : BSD --@@ -22,32 +25,29 @@     , LayoutHints     , LayoutHintsToCenter     , hintsEventHook+    -- * For developers+    , placeRectangle     )  where  import XMonad(LayoutClass(runLayout), mkAdjust, Window,               Dimension, Position, Rectangle(Rectangle), D,               X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,               (<&&>), io, applySizeHints, whenX, isClient, withDisplay,-              getWindowAttributes, getWMNormalHints, WindowAttributes(..))+              getWMNormalHints, WindowAttributes(..))+import XMonad.Prelude import qualified XMonad.StackSet as W  import XMonad.Layout.Decoration(isInStack) import XMonad.Layout.LayoutModifier(ModifiedLayout(..),                                     LayoutModifier(modifyLayout, redoLayout, modifierDescription)) import XMonad.Util.Types(Direction2D(..))-import Control.Applicative((<$>)) import Control.Arrow(Arrow((***), first, second))-import Control.Monad(join)-import Data.Function(on)-import Data.List(sortBy)-import Data.Monoid(All(..))  import Data.Set (Set) import qualified Data.Set as Set-import Data.Maybe(fromJust)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutHints --@@ -66,14 +66,14 @@ -- -- > myLayout = layoutHintsToCenter (Tall 1 (3/100) (1/2)) ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- To make XMonad reflect changes in window hints immediately, add -- 'hintsEventHook' to your 'handleEventHook'. ----- > myHandleEventHook = hintsEventHook <+> ...+-- > myHandleEventHook = hintsEventHook <> ... -- > -- > main = xmonad def { handleEventHook = myHandleEventHook -- >                   , ... }@@ -101,7 +101,7 @@ layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a layoutHintsToCenter = ModifiedLayout LayoutHintsToCenter -data LayoutHints a = LayoutHints (Double, Double)+newtype LayoutHints a = LayoutHints (Double, Double)                      deriving (Read, Show)  instance LayoutModifier LayoutHints Window where@@ -147,18 +147,17 @@     modifyLayout _ ws@(W.Workspace _ _ Nothing) r = runLayout ws r     modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do         (arrs,ol) <- runLayout ws r-        flip (,) ol-            . changeOrder (W.focus st : (filter (/= W.focus st) $ map fst arrs))-            . head . reverse . sortBy (compare `on` (fitting . map snd))-            . map (applyHints st r) . applyOrder r-            <$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs+        (, ol) . changeOrder (W.focus st : filter (/= W.focus st) (map fst arrs))+               . maximumBy (compare `on` (fitting . map snd))+               . map (applyHints st r) . applyOrder r+             <$> mapM (\x -> (x,) <$> mkAdjust (fst x)) arrs  changeOrder :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)] changeOrder w wr = zip w' $ map (fromJust . flip lookup wr) w'     where w' = filter (`elem` map fst wr) w  -- apply hints to first, grow adjacent windows-applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)]+applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),D -> D)] -> [(Window, Rectangle)] applyHints _ _ [] = [] applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) =         let (c',d') = adj (c,d)@@ -166,7 +165,7 @@                     $ if isInStack s w then Rectangle a b c' d' else lrect              ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d')-            growOther' r = growOther ds lrect (freeDirs root lrect) r+            growOther' = growOther ds lrect (freeDirs root lrect)             mapSnd f = map (first $ second f)             next = applyHints s root $ mapSnd growOther' xs         in (w,redr):next@@ -175,7 +174,7 @@ growOther ds lrect fds r     | dirs <- flipDir <$> Set.toList (Set.intersection adj fds)     , not $ any (uncurry opposite) $ cross dirs =-        foldr (flip grow ds) r dirs+        foldr (`grow` ds) r dirs     | otherwise = r     where         adj = adjacent lrect  r@@ -195,7 +194,7 @@ grow D (_ ,py) (Rectangle x y w h) = Rectangle x y w (h+fromIntegral py)  comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction2D-comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (dir,k)) $+comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (dir,) $             any and [[dir `elem` [R,L], allEq [a,c,w,y], [b,d] `surrounds` [x,z]]                     ,[dir `elem` [U,D], allEq [b,d,x,z], [a,c] `surrounds` [w,y]]]     | ((a,b),(c,d)) <- edge $ corners r1@@ -258,16 +257,17 @@  -- | Event hook that refreshes the layout whenever a window changes its hints. hintsEventHook :: Event -> X All-hintsEventHook (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w })+hintsEventHook PropertyEvent{ ev_event_type = t, ev_atom = a, ev_window = w }     | t == propertyNotify && a == wM_NORMAL_HINTS = do-        whenX (isClient w <&&> hintsMismatch w) $ refresh+        whenX (isClient w <&&> hintsMismatch w) refresh         return (All True) hintsEventHook _ = return (All True)  -- | True if the window's current size does not satisfy its size hints. hintsMismatch :: Window -> X Bool-hintsMismatch w = withDisplay $ \d -> io $ do-    wa <- getWindowAttributes d w-    sh <- getWMNormalHints d w-    let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)-    return $ dim /= applySizeHints 0 sh dim+hintsMismatch w = safeGetWindowAttributes w >>= \case+    Nothing -> pure False+    Just wa -> do+        sh <- withDisplay $ \d -> io (getWMNormalHints d w)+        let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)+        return $ dim /= applySizeHints 0 sh dim
XMonad/Layout/LayoutModifier.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Layout.LayoutModifier+-- Description :  A module for writing layout modifiers. -- Copyright    : (c) David Roundy <droundy@darcs.net> -- License      : BSD --@@ -29,7 +30,7 @@     LayoutModifier(..), ModifiedLayout(..)     ) where -import Control.Monad+import XMonad.Prelude  import XMonad import XMonad.StackSet ( Stack, Workspace (..) )@@ -72,7 +73,7 @@ -- -- * "XMonad.Layout.Reflect" ----- * "XMonad.Layout.Named"+-- * "XMonad.Layout.Renamed" -- -- * "XMonad.Layout.WindowNavigation" --@@ -106,7 +107,7 @@                  -> Workspace WorkspaceId (l a) a   -- ^ current workspace                  -> Rectangle                       -- ^ screen rectangle                  -> X ([(a, Rectangle)], Maybe (l a))-    modifyLayout _ w r = runLayout w r+    modifyLayout _ = runLayout      -- | Similar to 'modifyLayout', but this function also allows you     -- update the state of your layout modifier(the second value in the@@ -122,7 +123,7 @@                            -> Workspace WorkspaceId (l a) a                            -> Rectangle                            -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))-    modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r+    modifyLayoutWithUpdate m w r = (, Nothing) <$> modifyLayout m w r      -- | 'handleMess' allows you to spy on messages to the underlying     --   layout, in order to have an effect in the X monad, or alter@@ -156,7 +157,7 @@     --   simply passes on the message to 'handleMess'.     handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))     handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess-                                          return (Left `fmap` mm')+                                          return (Left <$> mm')      -- | 'pureMess' allows you to spy on messages sent to the     --   underlying layout, in order to possibly change the layout@@ -233,7 +234,7 @@     --   should only override this if it is important that the     --   presence of the layout modifier be displayed in text     --   representations of the layout (for example, in the status bar-    --   of a "XMonad.Hooks.DynamicLog" user).+    --   of a "XMonad.Hooks.StatusBar" user).     modifierDescription :: m a -> String     modifierDescription = const "" @@ -244,19 +245,19 @@     --   \"smart space\" in between (the space is not included if the     --   'modifierDescription' is empty).     modifyDescription :: (LayoutClass l a) => m a -> l a -> String-    modifyDescription m l = modifierDescription m <> description l-        where "" <> x = x-              x <> y = x ++ " " ++ y+    modifyDescription m l = modifierDescription m `add` description l+        where "" `add` x = x+              x `add` y = x ++ " " ++ y  -- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the --   semantics of a 'LayoutModifier' applied to an underlying layout.-instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where+instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where     runLayout (Workspace i (ModifiedLayout m l) ms) r =         do ((ws, ml'),mm')  <- modifyLayoutWithUpdate m (Workspace i l ms) r-           (ws', mm'') <- redoLayout (maybe m id mm') r ms ws+           (ws', mm'') <- redoLayout (fromMaybe m mm') r ms ws            let ml'' = case mm'' `mplus` mm' of-                        Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'-                        Nothing -> ModifiedLayout m `fmap` ml'+                        Just m' -> Just $ ModifiedLayout m' $ fromMaybe l ml'+                        Nothing -> ModifiedLayout m <$> ml'            return (ws', ml'')      handleMessage (ModifiedLayout m l) mess =@@ -265,16 +266,11 @@                   Just (Right mess') -> handleMessage l mess'                   _ -> handleMessage l mess            return $ case mm' of-                    Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'-                    _ -> (ModifiedLayout m) `fmap` ml'+                    Just (Left m') -> Just $ ModifiedLayout m' $ fromMaybe l ml'+                    _ -> ModifiedLayout m <$> ml'     description (ModifiedLayout m l) = modifyDescription m l  -- | A 'ModifiedLayout' is simply a container for a layout modifier --   combined with an underlying layout.  It is, of course, itself a --   layout (i.e. an instance of 'LayoutClass'). data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )---- N.B. I think there is a Haddock bug here; the Haddock output for--- the above does not parenthesize (m a) and (l a), which is obviously--- incorrect.-
XMonad/Layout/LayoutScreens.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ViewPatterns #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.LayoutScreens+-- Description :  A layout to divide a single screen into multiple screens. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -21,6 +23,7 @@                                    ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W  -- $usage@@ -33,7 +36,7 @@ -- email window at all times, a crude mimic of sticky windows). -- -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@ file:+-- @xmonad.hs@ file: -- -- > import XMonad.Layout.LayoutScreens -- > import XMonad.Layout.TwoPane@@ -54,17 +57,19 @@ -- >   , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Modify all screens. layoutScreens :: LayoutClass l Int => Int -> l Int -> X () layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."-layoutScreens nscr l =-    do rtrect <- asks theRoot >>= getWindowRectangle+layoutScreens nscr l = asks theRoot >>= \w -> withDisplay $ \d ->+  withWindowAttributes d w $ \attrs ->+    do let rtrect = windowRectangle attrs        (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect-       windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->-           let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs-               s:ss = map snd wss+       windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->+           let x = W.workspace v+               (xs, ys) = splitAt (nscr - 1) $ map W.workspace vs ++ hs+               (notEmpty -> s :| ss) = map snd wss            in  ws { W.current = W.Screen x 0 (SD s)                   , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss                   , W.hidden  = ys }@@ -75,21 +80,20 @@ layoutSplitScreen nscr l =     do rect <- gets $ screenRect . W.screenDetail . W.current . windowset        (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect-       windows $ \ws@(W.StackSet { W.current = c, W.visible = vs, W.hidden = hs }) ->-           let (x:xs, ys) = splitAt nscr $ W.workspace c : hs-               s:ss = map snd wss+       windows $ \ws@W.StackSet{ W.current = c, W.visible = vs, W.hidden = hs } ->+           let x = W.workspace c+               (xs, ys) = splitAt (nscr - 1) hs+               (notEmpty -> s :| ss) = map snd wss            in  ws { W.current = W.Screen x (W.screen c) (SD s)-                  , W.visible = (zipWith3 W.Screen xs [(W.screen c+1) ..] $ map SD ss) +++                  , W.visible = zipWith3 W.Screen xs [(W.screen c+1) ..] (map SD ss) ++                                 map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs                   , W.hidden  = ys } -getWindowRectangle :: Window -> X Rectangle-getWindowRectangle w = withDisplay $ \d ->-    do a <- io $ getWindowAttributes d w-       return $ Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)-                          (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)+windowRectangle :: WindowAttributes -> Rectangle+windowRectangle a = Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)+                              (fromIntegral $ wa_width a) (fromIntegral $ wa_height a) -data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)+newtype FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)  instance LayoutClass FixedLayout a where     doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing)
XMonad/Layout/LimitWindows.hs view
@@ -1,7 +1,11 @@-{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+#ifdef TESTING+{-# OPTIONS_GHC -Wno-duplicate-exports #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.LimitWindows+-- Description :  A layout modifier that limits the number of windows that can be shown. -- Copyright   :  (c) 2009 Adam Vogt --                (c) 2009 Max Rabkin -- wrote limitSelect -- License     :  BSD-style (see xmonad/LICENSE)@@ -34,15 +38,13 @@     LimitWindows, Selection,     ) where -import XMonad.Layout.LayoutModifier import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Prelude (fromJust, guard, (<=<)) import qualified XMonad.StackSet as W-import Control.Monad((<=<),guard)-import Control.Applicative((<$>))-import Data.Maybe(fromJust)  -- $usage--- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:+-- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Layout.LimitWindows --@@ -54,7 +56,7 @@ -- actions. -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip -- the hidden windows.@@ -73,7 +75,7 @@ limitWindows n = ModifiedLayout (LimitWindows FirstN n)  -- | Only display @n@ windows around the focused window. This makes sense with--- layouts that arrange windows linearily, like 'XMonad.Layout.Layout.Accordion'.+-- layouts that arrange windows linearily, like "XMonad.Layout.Accordion". limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a limitSlice n = ModifiedLayout (LimitWindows Slice n) @@ -87,7 +89,7 @@  data SliceStyle = FirstN | Slice deriving (Read,Show) -data LimitChange = LimitChange { unLC :: (Int -> Int) } deriving (Typeable)+newtype LimitChange = LimitChange { unLC :: Int -> Int }  instance Message LimitChange @@ -97,8 +99,8 @@       where pos x   = guard (x>=1)     >> return x             app f x = guard (f x /= x) >>  return (f x) -     modifyLayout (LimitWindows style n) ws r =-        runLayout ws { W.stack = f n <$> W.stack ws } r+     modifyLayout (LimitWindows style n) ws =+        runLayout ws { W.stack = f n <$> W.stack ws }       where f = case style of                     FirstN -> firstN                     Slice -> slice@@ -121,8 +123,8 @@     deriving (Read, Show, Eq)  instance LayoutModifier Selection a where-    modifyLayout s w r =-        runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r+    modifyLayout s w =+        runLayout (w { W.stack = updateAndSelect s <$> W.stack w })      pureModifier sel _ stk wins = (wins, update sel <$> stk) @@ -141,7 +143,7 @@                     (take (nRest s) . drop (start s - lups - 1) $ downs) }     | otherwise         = stk { W.up=reverse (take (nMaster s) ups ++ drop (start s) ups),-                W.down=take ((nRest s) - (lups - start s) - 1) downs }+                W.down=take (nRest s - (lups - start s) - 1) downs }     where         downs = W.down stk         ups = reverse $ W.up stk@@ -150,11 +152,11 @@ updateStart :: Selection l -> W.Stack a -> Int updateStart s stk     | lups < nMaster s  -- the focussed window is in the master pane-        = start s `min` (lups + ldown - (nRest s) + 1) `max` nMaster s+        = start s `min` (lups + ldown - nRest s + 1) `max` nMaster s     | otherwise         = start s `min` lups-                  `max` (lups - (nRest s) + 1)-                  `min` (lups + ldown - (nRest s) + 1)+                  `max` (lups - nRest s + 1)+                  `min` (lups + ldown - nRest s + 1)                   `max` nMaster s     where         lups = length $ W.up stk
XMonad/Layout/MagicFocus.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Layout.MagicFocus+-- Description :  Automagically put the focused window in the master area. -- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com> -- License      : BSD --@@ -29,11 +30,11 @@ import XMonad.Layout.LayoutModifier  import XMonad.Actions.UpdatePointer (updatePointer)-import Data.Monoid(All(..))+import XMonad.Prelude(All(..)) import qualified Data.Map as M  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MagicFocus --@@ -44,9 +45,9 @@ -- > main = xmonad def { layoutHook = myLayout, -- >                     handleEventHook = promoteWarp } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | Create a new layout which automagically puts the focused window --   in the master area.@@ -56,14 +57,11 @@ data MagicFocus a = MagicFocus deriving (Show, Read)  instance LayoutModifier MagicFocus Window where-  modifyLayout MagicFocus (W.Workspace i l s) r =-    withWindowSet $ \wset ->-      runLayout (W.Workspace i l (s >>= \st -> Just $ swap st (W.peek wset))) r+  modifyLayout MagicFocus (W.Workspace i l s) =+    runLayout (W.Workspace i l (s >>= Just . shift)) -swap :: (Eq a) => W.Stack a -> Maybe a -> W.Stack a-swap (W.Stack f u d) focused-    | Just f == focused = W.Stack f [] (reverse u ++ d)-    | otherwise         = W.Stack f u d+shift :: (Eq a) => W.Stack a -> W.Stack a+shift (W.Stack f u d) = W.Stack f [] (reverse u ++ d)  -- | An eventHook that overrides the normal focusFollowsMouse. When the mouse -- it moved to another window, that window is replaced as the master, and the@@ -80,7 +78,7 @@ -- | promoteWarp' allows you to specify an arbitrary pair of arguments to -- pass to 'updatePointer' when the mouse enters another window. promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All-promoteWarp' refPos ratio e@(CrossingEvent {ev_window = w, ev_event_type = t})+promoteWarp' refPos ratio e@CrossingEvent{ev_window = w, ev_event_type = t}     | t == enterNotify && ev_mode   e == notifyNormal = do         ws <- gets windowset         let foc = W.peek ws@@ -98,11 +96,11 @@ -- focusFollowsMouse only for given workspaces or layouts. -- Beware that your focusFollowsMouse setting is ignored if you use this event hook. followOnlyIf :: X Bool -> Event -> X All-followOnlyIf cond e@(CrossingEvent {ev_window = w, ev_event_type = t})+followOnlyIf cond e@CrossingEvent{ev_window = w, ev_event_type = t}     | t == enterNotify && ev_mode e == notifyNormal     = whenX cond (focus w) >> return (All False) followOnlyIf _ _ = return $ All True  -- | Disables focusFollow on the given workspaces: disableFollowOnWS :: [WorkspaceId] -> X Bool-disableFollowOnWS wses = (`notElem` wses) `fmap` gets (W.currentTag . windowset)+disableFollowOnWS wses = (`notElem` wses) <$> gets (W.currentTag . windowset)
XMonad/Layout/Magnifier.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE PatternGuards              #-}+{-# LANGUAGE TypeSynonymInstances       #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Magnifier+-- Description :  Increase the size of the window that has focus. -- Copyright   :  (c) Peter De Wachter and Andrea Rossato 2007 -- License     :  BSD-style (see xmonad/LICENSE) --@@ -9,10 +12,10 @@ -- Stability   :  unstable -- Portability :  unportable ----- Screenshot  :  <http://caladan.rave.org/magnifier.png>+-- This is a layout modifier that will make a layout change the size of+-- the window that has focus. ----- This is a layout modifier that will make a layout increase the size--- of the window that has focus.+-- [Example screenshot using @magnifiercz' 1.3@ with one of the two stack windows focused.](https://user-images.githubusercontent.com/50166980/108524842-c5f69380-72cf-11eb-9fd6-b0bf67b13ed6.png) -- ----------------------------------------------------------------------------- @@ -20,46 +23,70 @@ module XMonad.Layout.Magnifier     ( -- * Usage       -- $usage++      -- * General combinators+      magnify,+      magnifyxy,++      -- * Magnify Everything       magnifier,-      magnifier',       magnifierOff,       magnifiercz,-      magnifiercz',+      magnifierczOff,+      magnifierxy,+      magnifierxyOff,+      maxMagnifierOff,       maximizeVertical,++      -- * Don't Magnify the Master Window+      magnifier',+      magnifiercz',+      magnifierczOff',+      magnifierxy',+      magnifierxyOff',++      -- * Messages and Types       MagnifyMsg (..),+      MagnifyThis(..),       Magnifier,     ) where +import Numeric.Natural (Natural)+ import XMonad-import XMonad.StackSet+import XMonad.Prelude (bool, fi) import XMonad.Layout.LayoutModifier-import XMonad.Util.XUtils+import XMonad.StackSet  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Magnifier ----- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier--- to some layout:+-- Then edit your @layoutHook@ by e.g. adding the 'magnifier' layout+-- modifier to some layout: -- -- > myLayout = magnifier (Tall 1 (3/100) (1/2))  ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- By default magnifier increases the focused window's size by 1.5.--- You can also use:------ > magnifiercz 1.2+-- By default 'magnifier' increases the focused window's size by @1.5@. ----- to use a custom level of magnification.  You can even make the focused--- window smaller for a pop in effect.+-- You can also use @'magnifiercz' 1.2@ or @'magnifierxy' 1 1000@ to use+-- a custom level of magnification. You can even make the focused window+-- smaller for a pop in effect. There's also the possibility of starting+-- out not magnifying anything at all ('magnifierOff'); see below for+-- ways to toggle this on while in use. ----- For more detailed instructions on editing the layoutHook see:+-- The most general combinator available is 'magnify'—all of the other+-- functions in this module are essentially just creative applications+-- of it. ----- "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". ----- Magnifier supports some commands. To use them add something like--- this to your key bindings:+-- Magnifier supports some commands, see 'MagnifyMsg'.  To use them add+-- something like this to your key bindings: -- -- >    , ((modm .|. controlMask              , xK_plus ), sendMessage MagnifyMore) -- >    , ((modm .|. controlMask              , xK_minus), sendMessage MagnifyLess)@@ -79,63 +106,154 @@ -- like @Mag.Toggle@, @Mag.magnifier@, and so on. -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. +-- | Add magnification capabilities to a certain layout.+--+-- For example, to re-create 'magnifiercz' 1.3', you would do+--+-- >>> magnify 1.3 (NoMaster 1) True+--+magnify+    :: Rational     -- ^ Amount to magnify both directions+    -> MagnifyThis  -- ^ What to magnify+    -> Bool         -- ^ Whether magnification should start out on+                    --   (@True@) or off (@False@)+    -> l a          -- ^ Input layout+    -> ModifiedLayout Magnifier l a+magnify cz = magnifyxy cz cz++-- | Like 'magnify', but with the ability to specify different amounts+-- of horizontal and vertical magnification.+--+-- >>> magnifyxy 1.3 1.6 (NoMaster 1) True+magnifyxy+    :: Rational      -- ^ Amount to magnify horizontally+    -> Rational      -- ^ Amount to magnify vertically+    -> MagnifyThis   -- ^ What to magnify+    -> Bool          -- ^ Whether magnification should start out on+                     --   (@True@) or off (@False@)+    -> l a           -- ^ Input layout+    -> ModifiedLayout Magnifier l a+magnifyxy cx cy mt start = ModifiedLayout $+    Mag 1 (fromRational cx, fromRational cy) (bool Off On start) mt+ -- | Increase the size of the window that has focus magnifier :: l a -> ModifiedLayout Magnifier l a-magnifier = ModifiedLayout (Mag 1 (1.5,1.5) On All)+magnifier = magnifiercz 1.5  -- | Change the size of the window that has focus by a custom zoom magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a-magnifiercz cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On All)+magnifiercz cz = magnify cz (AllWins 1) True  -- | Increase the size of the window that has focus, unless if it is one of the -- master windows. magnifier' :: l a -> ModifiedLayout Magnifier l a-magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster)---- | Magnifier that defaults to Off-magnifierOff :: l a -> ModifiedLayout Magnifier l a-magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All)+magnifier' = magnifiercz' 1.5  -- | Increase the size of the window that has focus by a custom zoom, -- unless if it is one of the the master windows. magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a-magnifiercz' cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On NoMaster)+magnifiercz' cz = magnify cz (NoMaster 1) True --- | A magnifier that greatly magnifies just the vertical direction+-- | Increase the size of the window that has focus by a custom zoom in+-- both directions.+magnifierxy :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a+magnifierxy cx cy = magnifyxy cx cy (AllWins 1) True++-- | Like 'magnifierxy', but default to @Off@.+magnifierxyOff :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a+magnifierxyOff cx cy = magnifyxy cx cy (AllWins 1) False++-- | Increase the size of the window that has focus by a custom zoom in+-- both directions, unless it is one of the master windows.+magnifierxy' :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a+magnifierxy' cx cy = magnifyxy cx cy (NoMaster 1) True++-- | Like 'magnifierxy'', but defaults to @Off@.+magnifierxyOff' :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a+magnifierxyOff' cx cy = magnifyxy cx cy (NoMaster 1) False++-- | Magnifier that defaults to Off+magnifierOff :: l a -> ModifiedLayout Magnifier l a+magnifierOff = magnifierczOff 1.5++-- | A magnifier that greatly magnifies the focused window; defaults to+-- @Off@.+maxMagnifierOff :: l a -> ModifiedLayout Magnifier l a+maxMagnifierOff = magnifierczOff 1000++-- | Like 'magnifiercz', but default to @Off@.+magnifierczOff :: Rational -> l a -> ModifiedLayout Magnifier l a+magnifierczOff cz = magnify cz (AllWins 1) False++-- | Like 'magnifiercz'', but default to @Off@.+magnifierczOff' :: Rational -> l a -> ModifiedLayout Magnifier l a+magnifierczOff' cz = magnify cz (NoMaster 1) False++-- | A magnifier that greatly magnifies just the vertical direction;+-- defaults to @Off@. maximizeVertical :: l a -> ModifiedLayout Magnifier l a-maximizeVertical = ModifiedLayout (Mag 1 (1,1000) Off All)+maximizeVertical = ModifiedLayout (Mag 1 (1, 1000) Off (AllWins 1)) -data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )+data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle instance Message MagnifyMsg -data Magnifier a = Mag !Int (Double,Double) Toggle MagnifyMaster deriving (Read, Show)+-- | The type for magnifying a given type; do note that the given type+-- @a@ is a phantom type.+data Magnifier a = Mag+    { masterWins :: !Int+      -- ^ How many windows there are in the master pane.+    , zoomFactor :: !(Double, Double)+      -- ^ Zoom-factor in the @x@ and @y@ direction; the window's width and+      --   height will be multiplied by these amounts when magnifying.+    , toggle :: !Toggle+      -- ^ Whether to magnify windows at all.+    , magWhen :: !MagnifyThis+      -- ^ Conditions when to magnify a given window+    }+    deriving (Read, Show) -data Toggle        = On  | Off      deriving  (Read, Show)-data MagnifyMaster = All | NoMaster deriving  (Read, Show)+-- | Whether magnification is currently enabled.+data Toggle = On | Off deriving (Read, Show) +-- | Which windows to magnify and when to start doing so.  Note that+-- magnifying will start /at/ the cut-off, so @AllWins 3@ will start+-- magnifying when there are at least three windows present in the stack+-- set.+data MagnifyThis+    = AllWins  !Natural  -- ^ Every window+    | NoMaster !Natural  -- ^ Only stack windows+    deriving (Read, Show)+ instance LayoutModifier Magnifier Window where-    redoLayout  (Mag _ z On All     ) r (Just s) wrs = applyMagnifier z r s wrs-    redoLayout  (Mag n z On NoMaster) r (Just s) wrs = unlessMaster n (applyMagnifier z) r s wrs-    redoLayout  _                   _ _        wrs = return (wrs, Nothing)+    redoLayout _   _ Nothing  wrs = pure (wrs, Nothing)+    redoLayout mag r (Just s) wrs = case mag of+        Mag _ z On (AllWins  k) -> magnifyAt k (applyMagnifier z r s wrs)+        Mag n z On (NoMaster k) ->+            magnifyAt k (unlessMaster n (applyMagnifier z) r s wrs)+        _ -> pure (wrs, Nothing)+      where+        magnifyAt cutoff magnifyFun+            | fromIntegral cutoff <= length (integrate s) = magnifyFun+            | otherwise                                   = pure (wrs, Nothing)      handleMess (Mag n z On  t) m-                    | Just MagnifyMore    <- fromMessage m = return . Just $ Mag n             (z `addto`   0.1 ) On  t-                    | Just MagnifyLess    <- fromMessage m = return . Just $ Mag n             (z `addto` (-0.1)) On  t-                    | Just ToggleOff      <- fromMessage m = return . Just $ Mag n             z                  Off t-                    | Just Toggle         <- fromMessage m = return . Just $ Mag n             z                  Off t-                    | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z                  On  t-                    where addto (x,y) i = (x+i,y+i)+        | Just MagnifyMore    <- fromMessage m = return . Just $ Mag n             (z `addto`   0.1 ) On  t+        | Just MagnifyLess    <- fromMessage m = return . Just $ Mag n             (z `addto` (-0.1)) On  t+        | Just ToggleOff      <- fromMessage m = return . Just $ Mag n             z                  Off t+        | Just Toggle         <- fromMessage m = return . Just $ Mag n             z                  Off t+        | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z                  On  t+      where addto (x, y) i = (x + i, y + i)     handleMess (Mag n z Off t) m-                    | Just ToggleOn       <- fromMessage m = return . Just $ Mag n             z                  On  t-                    | Just Toggle         <- fromMessage m = return . Just $ Mag n             z                  On  t-                    | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z                  Off t+        | Just ToggleOn       <- fromMessage m = return . Just $ Mag n             z                  On  t+        | Just Toggle         <- fromMessage m = return . Just $ Mag n             z                  On  t+        | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z                  Off t     handleMess _ _ = return Nothing -    modifierDescription (Mag _ _ On  All     ) = "Magnifier"-    modifierDescription (Mag _ _ On  NoMaster) = "Magnifier NoMaster"-    modifierDescription (Mag _ _ Off _       ) = "Magnifier (off)"+    modifierDescription (Mag _ _ On  AllWins{} ) = "Magnifier"+    modifierDescription (Mag _ _ On  NoMaster{}) = "Magnifier NoMaster"+    modifierDescription (Mag _ _ Off _         ) = "Magnifier (off)"  type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) @@ -146,12 +264,12 @@ applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]                -> X ([(Window, Rectangle)], Maybe a) applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek)-                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)]+                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify' z wr)]                                                 | otherwise         = (w,wr) : ws                               return (reverse $ foldr mag [] wrs, Nothing) -magnify :: (Double, Double) -> Rectangle -> Rectangle-magnify (zoomx,zoomy) (Rectangle x y w h) = Rectangle x' y' w' h'+magnify' :: (Double, Double) -> Rectangle -> Rectangle+magnify' (zoomx,zoomy) (Rectangle x y w h) = Rectangle x' y' w' h'     where x' = x - fromIntegral (w' - w) `div` 2           y' = y - fromIntegral (h' - h) `div` 2           w' = round $ fromIntegral w * zoomx@@ -159,7 +277,7 @@  fit :: Rectangle -> Rectangle -> Rectangle fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'-    where x' = max sx (x - (max 0 (x + fi w - sx - fi sw)))-          y' = max sy (y - (max 0 (y + fi h - sy - fi sh)))+    where x' = max sx (x - max 0 (x + fi w - sx - fi sw))+          y' = max sy (y - max 0 (y + fi h - sy - fi sh))           w' = min sw w           h' = min sh h
XMonad/Layout/Master.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Master+-- Description :  Layout modfier that adds a master window to another layout. -- Copyright   :  (c) Ismael Carnales, Lukas Mai -- License     :  BSD-style (see LICENSE) --@@ -26,10 +27,11 @@ import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier-import Control.Monad +import Control.Arrow (first)+ -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Master --@@ -50,6 +52,7 @@ -- Grid manage the right half. -- -- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Like 'XMonad.Layout.Tall', 'withMaster' supports the@@ -72,7 +75,7 @@     -> Rational -- ^ @frac@, what portion of the screen to use for the master window     -> l a      -- ^ the layout to be modified     -> ModifiedLayout AddMaster l a-mastered delta frac = multimastered 1 delta frac+mastered = multimastered 1  instance LayoutModifier AddMaster Window where     modifyLayout (AddMaster k delta frac) = applyMaster False k delta frac@@ -85,12 +88,12 @@      pureMess _ _ = Nothing -data FixMaster a = FixMaster (AddMaster a) deriving (Show, Read)+newtype FixMaster a = FixMaster (AddMaster a) deriving (Show, Read)  instance LayoutModifier FixMaster Window where     modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f     modifierDescription (FixMaster a) = "Fix" ++ modifierDescription a-    pureMess (FixMaster a) m = liftM FixMaster (pureMess a m)+    pureMess (FixMaster a) m = fmap FixMaster (pureMess a m)  fixMastered :: (LayoutClass l a) =>        Rational -- ^ @delta@, the ratio of the screen to resize by@@ -111,17 +114,17 @@                -> X ([(Window, Rectangle)], Maybe (l Window)) applyMaster f k _ frac wksp rect = do     let st= S.stack wksp-    let ws = S.integrate' $ st+    let ws = S.integrate' st     let n = length ws + fromEnum f-    if n > 1 then do-        if(n<=k) then-             return ((divideCol rect ws), Nothing)+    if n > 1 then+        if n<=k then+             return (divideCol rect ws, Nothing)              else do              let m = take k ws              let (mr, sr) = splitHorizontallyBy frac rect-             let nst = st>>= S.filter (\w -> not (w `elem` m))+             let nst = st>>= S.filter (`notElem` m)              wrs <- runLayout (wksp {S.stack = nst}) sr-             return ((divideCol mr m) ++ (fst wrs), snd wrs)+             return (first (divideCol mr m ++) wrs)         else runLayout wksp rect  -- | Shift rectangle down@@ -135,4 +138,3 @@           oneH = fromIntegral h `div` n           oneRect = Rectangle x y w (fromIntegral oneH)           rects = take n $ iterate (shiftD (fromIntegral oneH)) oneRect-
XMonad/Layout/Maximize.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Maximize+-- Description :  Temporarily yank the focused window out of the layout to mostly fill the screen. -- Copyright   :  (c) 2007 James Webb -- License     :  BSD3-style (see LICENSE) --@@ -27,10 +28,10 @@ import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier-import Data.List ( partition )+import XMonad.Prelude ( partition )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Maximize --@@ -45,9 +46,9 @@ -- > myLayout = maximizeWithPadding 10 (Tall 1 (3/100) (1/2)) ||| Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key-bindings, do something like: --@@ -56,7 +57,7 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data Maximize a = Maximize Dimension (Maybe Window) deriving ( Read, Show ) maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window@@ -67,7 +68,7 @@ maximizeWithPadding :: LayoutClass l Window => Dimension -> l Window -> ModifiedLayout Maximize l Window maximizeWithPadding padding = ModifiedLayout $ Maximize padding Nothing -data MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq )+newtype MaximizeRestore = MaximizeRestore Window deriving ( Eq ) instance Message MaximizeRestore maximizeRestore :: Window -> MaximizeRestore maximizeRestore = MaximizeRestore@@ -91,7 +92,7 @@      pureMess (Maximize padding mw) m = case fromMessage m of         Just (MaximizeRestore w) -> case mw of-            Just w' -> if (w == w')+            Just w' -> if w == w'                         then Just $ Maximize padding Nothing   -- restore window                         else Just $ Maximize padding $ Just w  -- maximize different window             Nothing -> Just $ Maximize padding $ Just w        -- maximize window
XMonad/Layout/MessageControl.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MessageControl+-- Description :  Message escaping and filtering facilities. -- Copyright   :  (c) 2008 Quentin Moser -- License     :  BSD3 --@@ -31,12 +32,10 @@  import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) -import Data.Typeable (Typeable)-import Control.Applicative ((<$>)) import Control.Arrow (second)  -- $usage--- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.MessageEscape --@@ -46,7 +45,6 @@ -- -- > import XMonad.Layout.Master (mastered) -- > import XMonad.Layout.Tabbed (simpleTabbed)--- > import XMonad.Layout.LayoutCombinators ((|||)) -- > -- > myLayout = Tall ||| unEscape (mastered 0.01 0.5 $ Full ||| simpleTabbed) --@@ -63,20 +61,17 @@ -- >                       unEscape $ mastered 0.01 0.5 -- >                         $ Full ||| simpleTabbed) ----- /IMPORTANT NOTE:/ The standard '(|||)' operator from "XMonad.Layout"--- does not behave correctly with 'ignore'. Make sure you use the one--- from "XMonad.Layout.LayoutCombinators".  -- | the Ignore layout modifier. Prevents its inner layout from receiving -- messages of a certain type. -data Ignore m l w = I (l w)+newtype Ignore m l w = I (l w)                     deriving (Show, Read)  instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where     runLayout ws r = second (I <$>) <$> runLayout (unILayout ws) r         where  unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w-               unILayout w@(Workspace { layout = (I l) }) = w { layout = l }+               unILayout w@Workspace{ layout = (I l) } = w { layout = l }     handleMessage l@(I l') sm         = case fromMessageAs sm l of             Just _ -> return Nothing@@ -101,8 +96,6 @@ -- | Data type for an escaped message. Send with 'escape'.  newtype EscapedMessage = Escape SomeMessage-    deriving Typeable- instance Message EscapedMessage  @@ -115,12 +108,12 @@ -- | Applies the UnEscape layout modifier to a layout.  unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w-unEscape l = ModifiedLayout UE l+unEscape = ModifiedLayout UE   -- | Applies the Ignore layout modifier to a layout, blocking -- all messages of the same type as the one passed as its first argument.  ignore :: (Message m, LayoutClass l w)-          => m -> l w -> (Ignore m l w)-ignore _ l = I l+          => m -> l w -> Ignore m l w+ignore _ = I
XMonad/Layout/Minimize.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Minimize+-- Description :  Minimize windows, temporarily removing them from the layout. -- Copyright   :  (c) Jan Vornberger 2009, Alejandro Serrano 2010 -- License     :  BSD3-style (see LICENSE) --@@ -17,6 +18,7 @@ module XMonad.Layout.Minimize (         -- * Usage         -- $usage+        Minimize,         minimize,     ) where @@ -28,7 +30,7 @@ import qualified XMonad.Util.ExtensibleState as XS  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Minimize --@@ -37,9 +39,9 @@ -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- The module is designed to work together with "XMonad.Layout.BoringWindows" so -- that minimized windows will be skipped over when switching the focused window with
XMonad/Layout/Monitor.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Monitor+-- Description :  Layout modfier for displaying some window (monitor) above other windows. -- Copyright   :  (c) Roman Cheplyaka -- License     :  BSD-style (see LICENSE) --@@ -32,14 +33,14 @@     ) where  import XMonad+import XMonad.Prelude (unless) import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties import XMonad.Hooks.ManageHelpers (doHideIgnore) import XMonad.Hooks.FadeInactive (setOpacity)-import Control.Monad  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Monitor --@@ -72,7 +73,7 @@ -- -- Add ManageHook to de-manage monitor windows and apply opacity settings. ----- > manageHook = myManageHook <+> manageMonitor clock+-- > manageHook = myManageHook <> manageMonitor clock -- -- Apply layout modifier. --@@ -115,7 +116,7 @@                     | ToggleMonitorNamed String                     | ShowMonitorNamed String                     | HideMonitorNamed String-    deriving (Read,Show,Eq,Typeable)+    deriving (Read,Show,Eq) instance Message MonitorMessage  withMonitor :: Property -> a -> (Window -> X a) -> X a
XMonad/Layout/Mosaic.hs view
@@ -1,7 +1,12 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Mosaic+-- Description :  Give each window a specified amount of screen space relative to the others. -- Copyright   :  (c) 2009 Adam Vogt, 2007 James Webb -- License     :  BSD-style (see xmonad/LICENSE) --@@ -28,22 +33,15 @@  import Prelude hiding (sum) -import XMonad(Typeable,-              LayoutClass(doLayout, handleMessage, pureMessage, description),+import XMonad(LayoutClass(doLayout, handleMessage, pureMessage, description),               Message, X, fromMessage, withWindowSet, Resize(..),               splitHorizontallyBy, splitVerticallyBy, sendMessage, Rectangle)+import XMonad.Prelude (mplus, on, sortBy, sum) import qualified XMonad.StackSet as W import Control.Arrow(second, first)-import Control.Monad(mplus)-import Data.Foldable(Foldable,foldMap, sum)-import Data.Function(on)-import Data.List(sortBy)-import Data.Monoid(Monoid,mempty, mappend, (<>))-import Data.Semigroup - -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Mosaic --@@ -64,16 +62,15 @@ -- --  > , ((modm, xK_r), sendMessage Reset) ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data Aspect     = Taller     | Wider     | Reset     | SlopeMod ([Rational] -> [Rational])-    deriving (Typeable)  instance Message Aspect @@ -118,7 +115,7 @@         nextIx (ov,ix,mix)                 | mix <= 0 || ov = fromIntegral $ nls `div` 2                 | otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix-        rect = rects !! maybe (nls `div` 2) round (nextIx `fmap` state)+        rect = rects !! maybe (nls `div` 2) (round . nextIx) state         state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state                     `mplus` Just (True,fromIntegral nls / 2,pred nls)         ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt@@ -186,25 +183,15 @@ normalize x = let s = sum x in map (/s) x  data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty--instance Foldable Tree where-   foldMap _f Empty = mempty-   foldMap f (Leaf x) = f x-   foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r+  deriving (Functor, Show, Foldable) -instance Functor Tree where-   fmap f (Leaf x) = Leaf $ f x-   fmap f (Branch l r) = Branch (fmap f l) (fmap f r)-   fmap _ Empty = Empty+instance Semigroup (Tree a) where+    Empty <> x = x+    x <> Empty = x+    x <> y = Branch x y  instance Monoid (Tree a) where     mempty = Empty-    mappend Empty x = x-    mappend x Empty = x-    mappend x y = Branch x y--instance Semigroup (Tree a) where-    (<>) = mappend  makeTree ::  (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree _ [] = Empty
XMonad/Layout/MosaicAlt.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MosaicAlt+-- Description :  An alternative version of "XMonad.Layout.Mosaic". -- Copyright   :  (c) 2007 James Webb -- License     :  BSD-style (see xmonad/LICENSE) --@@ -33,11 +34,11 @@ import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M-import Data.List ( sortBy )+import XMonad.Prelude ( sortBy ) import Data.Ratio  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MosaicAlt -- > import qualified Data.Map as M@@ -47,9 +48,9 @@ -- > myLayout = MosaicAlt M.empty ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key-bindings, do something like: --@@ -62,7 +63,7 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data HandleWindowAlt =     ShrinkWindowAlt Window@@ -70,7 +71,7 @@     | TallWindowAlt Window     | WideWindowAlt Window     | ResetAlt-    deriving ( Typeable, Eq )+    deriving ( Eq ) instance Message HandleWindowAlt shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt@@ -83,7 +84,7 @@  data Param = Param { area, aspect :: Rational } deriving ( Show, Read ) type Params = M.Map Window Param-data MosaicAlt a = MosaicAlt Params deriving ( Show, Read )+newtype MosaicAlt a = MosaicAlt Params deriving ( Show, Read )  instance LayoutClass MosaicAlt Window where     description _ = "MosaicAlt"@@ -91,7 +92,7 @@             return (arrange rect stack params', Just $ MosaicAlt params')         where             params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params-            ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins+            ins wins as = foldl M.union as $ map (`M.singleton` Param 1 1.5) wins      handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of         Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1@@ -129,7 +130,7 @@  -- Split a list of windows in half by area. areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))-areaSplit params wins = gather [] 0 [] 0 wins+areaSplit params = gather [] 0 [] 0     where         gather a aa b ba (r : rs) =             if aa <= ba@@ -161,8 +162,8 @@ aspectBadness rect win params =         (if a < 1 then tall else wide) * sqrt(w * h)     where-        tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a-        wide = if w < 700 then a else (a * w / 700)+        tall = if w < 700 then (1 / a) * (700 / w) else 1 / a+        wide = if w < 700 then a else a * w / 700         a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params)         w = fromIntegral $ rect_width rect         h = fromIntegral $ rect_height rect
XMonad/Layout/MouseResizableTile.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MouseResizableTile+-- Description :  Like "XMonad.Layout.ResizableTile", but use the mouse to adjust the layout. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -19,7 +20,7 @@                                     -- $usage                                     mouseResizableTile,                                     mouseResizableTileMirrored,-                                    MRTMessage (ShrinkSlave, ExpandSlave),+                                    MRTMessage (ShrinkSlave, ExpandSlave, SetMasterFraction, SetLeftSlaveFraction, SetRightSlaveFraction),                                      -- * Parameters                                     -- $mrtParameters@@ -34,12 +35,13 @@                                    ) where  import XMonad hiding (tile, splitVertically, splitHorizontallyBy)+import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Util.XUtils-import Control.Applicative((<$>))+import Graphics.X11 as X  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MouseResizableTile --@@ -51,9 +53,9 @@ -- > main = xmonad def { layoutHook = myLayout } -- ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to add the following key bindings: --@@ -62,7 +64,7 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- $mrtParameters -- The following functions are also labels for updating the @data@ (whose@@ -80,7 +82,6 @@                     | SetRightSlaveFraction Int Rational                     | ShrinkSlave                     | ExpandSlave-                    deriving Typeable instance Message MRTMessage  data DraggerInfo = MasterDragger Position Rational@@ -146,14 +147,14 @@                                             (rightFracs st ++ repeat (slaveFrac st)) sr' num drg             rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects         mapM_ deleteDragger $ draggers st-        (draggerWrs, newDraggers) <- unzip <$> mapM+        (draggerWrs, newDraggers) <- mapAndUnzipM                                         (createDragger sr . adjustForMirror (isMirrored st))                                         preparedDraggers         return (draggerWrs ++ zip wins rects', Just $ st { draggers = newDraggers,                                                               focusPos = length l,                                                               numWindows = length wins })         where-            mirrorAdjust a b = if (isMirrored st)+            mirrorAdjust a b = if isMirrored st                                 then b                                 else a @@ -190,15 +191,24 @@ draggerGeometry (FixedDragger g d) =     return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d) draggerGeometry BordersDragger = do-    w <- asks (borderWidth . config)+    wins <- gets windowset+    w <- case W.peek wins of+          Just win -> getBorderWidth win+          _        -> asks (borderWidth . config)     return (0, 0, fromIntegral w, 2*w) +getBorderWidth :: Window -> X Dimension+getBorderWidth win = do+    d <- asks display+    (_,_,_,_,_,w,_) <- io $ X.getGeometry d win+    return w+ adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect adjustForMirror False dragger = dragger adjustForMirror True (draggerRect, draggerCursor, draggerInfo) =         (mirrorRect draggerRect, draggerCursor', draggerInfo)     where-        draggerCursor' = if (draggerCursor == xC_sb_h_double_arrow)+        draggerCursor' = if draggerCursor == xC_sb_h_double_arrow                             then xC_sb_v_double_arrow                             else xC_sb_h_double_arrow @@ -234,8 +244,8 @@  sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) =-    (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y)-                (within 1 swh wh) (within 1 sht ht))+    Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y)+                (within 1 swh wh) (within 1 sht ht)  within :: (Ord a) => a -> a -> a -> a within low high a = max low $ min high a
XMonad/Layout/MultiColumns.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MultiColumns+-- Description :  A layout that tiles windows in a growing number of columns. -- Copyright   :  (c) Anders Engstrom <ankaan@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -25,10 +26,10 @@ import XMonad import qualified XMonad.StackSet as W -import Control.Monad+import XMonad.Prelude  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MultiColumns --@@ -55,9 +56,9 @@ -- columns, the screen is instead split equally among all columns. Therefore, -- if equal size among all columns are desired, set the size to -0.5. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | Layout constructor. multiCol@@ -95,8 +96,8 @@                       ,fmap incmastern (fromMessage m)]             where resize Shrink = l { multiColSize = max (-0.5) $ s-ds }                   resize Expand = l { multiColSize = min 1 $ s+ds }-                  incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ tail r }-                      where newval =  max 0 $ head r + x+                  incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ drop 1 r }+                      where newval = max 0 $ maybe 0 (x +) (listToMaybe r)                             r = drop a n                   n = multiColNWin l                   ds = multiColDeltaSize l@@ -128,17 +129,14 @@           -- Compute number of windows in last column and add it to the others           col = c ++ [n-sum c]           -- Compute width of columns-          width = if s>0-                  then if ncol==1-                       -- Only one window-                       then [fromIntegral $ rect_width r]-                       -- Give the master it's space and split the rest equally for the other columns-                       else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1))-                  else if fromIntegral ncol * abs s >= 1-                       -- Split equally-                       then replicate ncol $ fromIntegral (rect_width r) `div` ncol-                       -- Let the master cover what is left...-                       else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size+          width+            | s>0 = if ncol==1+                    -- Only one window+                    then [fromIntegral $ rect_width r]+                    -- Give the master it's space and split the rest equally for the other columns+                    else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1))+            | fromIntegral ncol * abs s >= 1 = replicate ncol $ fromIntegral (rect_width r) `div` ncol+            | otherwise = (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size           -- Compute the horizontal position of columns           xpos = accumEx (fromIntegral $ rect_x r) width           -- Exclusive accumulation@@ -147,4 +145,4 @@           -- Create a rectangle for each column           cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width           -- Split the columns into the windows-          rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr+          rlist = concat $ zipWith splitVertically col cr
XMonad/Layout/MultiDishes.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MultiDishes+-- Description :  A layout stacking groups of extra windows underneath the master windows. -- Copyright   :  (c) Jeremy Apthorp, Nathan Fairhurst -- License     :  BSD-style (see LICENSE) --@@ -23,10 +24,10 @@  import XMonad import XMonad.StackSet (integrate)-import Control.Monad (ap)+import XMonad.Prelude (ap)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MultiDishes --@@ -39,7 +40,7 @@ -- the maximum number of dishes allowed within a stack. -- -- > MultiDishes x 1 y--- is equivalent to +-- is equivalent to -- > Dishes x y -- -- The stack with the fewest dishes is always on top, so 4 windows@@ -52,9 +53,9 @@ -- > |_______| -- > |___|___| ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read) instance LayoutClass MultiDishes a where@@ -69,7 +70,7 @@                         else ws  where     (filledDishStackCount, remainder) =-      (n - nmaster) `quotRem` (max 1 dishesPerStack)+      (n - nmaster) `quotRem` max 1 dishesPerStack      (firstDepth, dishStackCount) =       if remainder == 0 then@@ -78,7 +79,7 @@         (remainder, filledDishStackCount + 1)      (masterRect, dishesRect) =-      splitVerticallyBy (1 - (fromIntegral dishStackCount) * h) s+      splitVerticallyBy (1 - fromIntegral dishStackCount * h) s      dishStackRects =       splitVertically dishStackCount dishesRect
XMonad/Layout/MultiToggle.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards #-}+{-# LANGUAGE ExistentialQuantification, Rank2Types, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards, ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MultiToggle+-- Description :  Dynamically apply and unapply transformers to your window layout. -- Copyright   :  (c) Lukas Mai -- License     :  BSD-style (see LICENSE) --@@ -25,6 +26,7 @@     single,     mkToggle,     mkToggle1,+    isToggleActive,      HList,     HCons,@@ -32,12 +34,13 @@ ) where  import XMonad+import XMonad.Prelude hiding (find)  import XMonad.StackSet (Workspace(..))  import Control.Arrow+import Data.IORef import Data.Typeable-import Data.Maybe  -- $usage -- The basic idea is to have a base layout and a set of layout transformers,@@ -86,11 +89,11 @@ -- which is an instance of the 'Transformer' class.  For example, here -- is the definition of @MIRROR@: ----- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)+-- > data MIRROR = MIRROR deriving (Read, Show, Eq) -- > instance Transformer MIRROR Window where -- >     transform _ x k = k (Mirror x) (\(Mirror x') -> x') ----- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable,+-- Note, you need to put @{-\# LANGUAGE -- TypeSynonymInstances, MultiParamTypeClasses \#-}@ at the -- beginning of your file. @@ -113,7 +116,6 @@  -- | Toggle the specified layout transformer. data Toggle a = forall t. (Transformer t a) => Toggle t-    deriving (Typeable)  instance (Typeable a) => Message (Toggle a) @@ -188,11 +190,11 @@ geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool geq a b = Just a == cast b -instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where+instance (Typeable a, Show ts, Typeable ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where     description mt = currLayout mt `unEL` \l -> description l      runLayout (Workspace i mt s) r = case currLayout mt of-        EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $+        EL l det -> (fmap . fmap $ (\x -> mt { currLayout = EL x det })) <$>             runLayout (Workspace i l s) r      handleMessage mt m@@ -200,14 +202,33 @@         , i@(Just _) <- find (transformers mt) t             = case currLayout mt of                 EL l det -> do-                    l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources)+                    l' <- fromMaybe l <$> handleMessage l (SomeMessage ReleaseResources)                     return . Just $                         mt {                             currLayout = (if cur then id else transform' t) (EL (det l') id),                             currIndex = if cur then Nothing else i                         }-                    where cur = (i == currIndex mt)+                    where cur = i == currIndex mt+        | Just (MultiToggleActiveQueryMessage t ref :: MultiToggleActiveQueryMessage a) <- fromMessage m+        , i@(Just _) <- find (transformers mt) t+            = Nothing <$ io (writeIORef ref (Just (i == currIndex mt)))         | otherwise             = case currLayout mt of-                EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $+                EL l det -> fmap (\x -> mt { currLayout = EL x det }) <$>                     handleMessage l m++data MultiToggleActiveQueryMessage a = forall t. (Transformer t a) =>+    MultiToggleActiveQueryMessage t (IORef (Maybe Bool))++instance (Typeable a) => Message (MultiToggleActiveQueryMessage a)++-- | Query the state of a 'Transformer' on a given workspace.+--+-- To query the current workspace, use something like this:+--+-- > withWindowSet (isToggleActive t . W.workspace . W.current)+isToggleActive :: Transformer t Window => t -> WindowSpace -> X (Maybe Bool)+isToggleActive t w = do+    ref <- io $ newIORef Nothing+    sendMessageWithNoRefresh (MultiToggleActiveQueryMessage t ref) w+    io $ readIORef ref
XMonad/Layout/MultiToggle/Instances.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MultiToggle.Instances+-- Description :  Common instances for "XMonad.Layout.MultiToggle". -- Copyright   :  (c) 2008  Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -29,7 +30,7 @@                      | MIRROR        -- ^ Mirror the current layout.                      | NOBORDERS     -- ^ Remove borders.                      | SMARTBORDERS  -- ^ Apply smart borders.-  deriving (Read, Show, Eq, Typeable)+  deriving (Read, Show, Eq)  instance Transformer StdTransformers Window where     transform FULL         x k = k Full (const x)
XMonad/Layout/MultiToggle/TabBarDecoration.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- |@@ -42,6 +42,6 @@ -- > ...  -- | Transformer for "XMonad.Layout.TabBarDecoration".-data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq, Typeable)+data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq) instance Transformer SimpleTabBar Window where     transform _ x k = k (simpleTabBar x) (\(ModifiedLayout _ (ModifiedLayout _ x')) -> x')
XMonad/Layout/Named.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Named+-- Description :  Assign a name to a given layout. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -15,7 +16,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.Named+module XMonad.Layout.Named {-# DEPRECATED "Use XMonad.Layout.Renamed instead" #-}     ( -- * Usage       -- $usage       named,@@ -26,7 +27,7 @@ import XMonad.Layout.Renamed  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Named --@@ -36,16 +37,12 @@ -- > myLayout = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Note that this module has been deprecated and may be removed in a future -- release, please use "XMonad.Layout.Renamed" instead.---- | (Deprecated) Rename a layout.-named :: String -> l a -> ModifiedLayout Rename l a-named s = renamed [Replace s]  -- | (Deprecated) Remove the first word of the name. nameTail :: l a -> ModifiedLayout Rename l a
XMonad/Layout/NoBorders.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances, PatternGuards, DeriveDataTypeable #-}+{-# LANGUAGE PatternGuards #-}+{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- singleton in Data.List since base 4.15  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.NoBorders+-- Description :  Make a given layout display without borders. -- Copyright   :  (c) --    David Roundy <droundy@darcs.net> --                    2018  Yclept Nemo -- License     :  BSD3-style (see LICENSE)@@ -34,20 +36,16 @@                                ) where  import           XMonad+import           XMonad.Prelude hiding (singleton) import           XMonad.Layout.LayoutModifier import qualified XMonad.StackSet                as W import qualified XMonad.Util.Rectangle          as R -import           Data.List-import           Data.Monoid import qualified Data.Map                       as M-import           Data.Function                  (on)-import           Control.Applicative            ((<$>),(<*>),pure)-import           Control.Monad                  (guard)   -- $usage--- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:+-- You can use this module with the following in your xmonad.hs file: -- -- > import XMonad.Layout.NoBorders --@@ -56,9 +54,9 @@ -- -- > layoutHook = ... ||| noBorders Full ||| ... ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- todo, use an InvisibleList. data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show )@@ -125,7 +123,6 @@     | ResetBorder Window         -- ^ Reset the effects of any 'HasBorder' messages on the specified         -- window.-    deriving (Typeable)  instance Message BorderMessage @@ -146,17 +143,15 @@  -- | Only necessary with 'BorderMessage' - remove non-existent windows from the -- 'alwaysHidden' or 'neverHidden' lists.+{-# DEPRECATED borderEventHook "No longer needed." #-} borderEventHook :: Event -> X All-borderEventHook (DestroyWindowEvent { ev_window = w }) = do-    broadcastMessage $ ResetBorder w-    return $ All True borderEventHook _ = return $ All True  instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where     unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch      redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do-        let gh' wset = let lh = (hiddens gh wset lr mst wrs)+        let gh' wset = let lh = hiddens gh wset lr mst wrs                        in  return $ (ah `union` lh) \\ nh         ch' <- withWindowSet gh'         asks (borderWidth . config) >>= setBorders (ch \\ ch')@@ -167,17 +162,20 @@         | Just (HasBorder b w) <- fromMessage m =             let consNewIf l True  = if w `elem` l then Nothing else Just (w:l)                 consNewIf l False = Just l-            in  (ConfigurableBorder gh) <$> consNewIf ah (not b)+            in  ConfigurableBorder gh <$> consNewIf ah (not b)                                         <*> consNewIf nh b                                         <*> pure ch-        | Just (ResetBorder w) <- fromMessage m =+        | Just (ResetBorder w) <- fromMessage m = resetBorder w+        | Just DestroyWindowEvent { ev_window = w } <- fromMessage m = resetBorder w+        | otherwise = Nothing+      where+        resetBorder w =             let delete' e l = if e `elem` l then (True,delete e l) else (False,l)                 (da,ah') = delete' w ah                 (dn,nh') = delete' w nh             in  if da || dn                 then Just cb { alwaysHidden = ah', neverHidden = nh' }                 else Nothing-        | otherwise = Nothing  -- | SetsAmbiguous allows custom actions to generate lists of windows that -- should not have borders drawn through 'ConfigurableBorder'@@ -247,34 +245,44 @@                                 $ W.screenDetail scr                             ] +            -- Find the screen containing the workspace being layouted.+            -- (This is a list only to avoid the need to specialcase when it+            -- can't be found or when several contain @lr@. When that happens,+            -- the result will probably be incorrect.)+            thisScreen = [ scr | scr <- W.screens wset+                               , screenRect (W.screenDetail scr) `R.supersetOf` lr ]+             -- This originally considered all floating windows across all-            -- workspaces. It seems more efficient to have each layout manage-            -- its own floating windows - and equally valid though untested-            -- against a multihead setup. In some cases the previous code would-            -- redundantly add then remove borders from already-borderless-            -- windows.+            -- workspaces. It seems more efficient to have each screen manage+            -- its own floating windows - and necessary to support the+            -- additional OnlyLayoutFloat* variants correctly in multihead+            -- setups. In some cases the previous code would redundantly add+            -- then remove borders from already-borderless windows.             floating = do+                scr <- thisScreen                 let wz :: Integer -> (Window,Rectangle)                        -> (Integer,Window,Rectangle)                     wz i (w,wr) = (i,w,wr)                     -- For the following: in stacking order lowest -> highest.                     ts = reverse . zipWith wz [-1,-2..] $ wrs                     fs = zipWith wz [0..] $ do-                        w       <- reverse . W.index $ wset+                        w       <- reverse . W.integrate' . W.stack . W.workspace $ scr                         Just wr <- [M.lookup w (W.floating wset)]                         return (w,scaleRationalRect sr wr)-                    sr = screenRect . W.screenDetail . W.current $ wset+                    sr = screenRect . W.screenDetail $ scr                 (i1,w1,wr1) <- fs                 guard $ case amb of                     OnlyLayoutFloatBelow ->                         let vu = do-                            gr           <- sr `R.difference` lr-                            (i2,_w2,wr2) <- ts ++ fs-                            guard $ i2 < i1-                            [wr2 `R.intersects` gr]+                                gr           <- sr `R.difference` lr+                                (i2,_w2,wr2) <- ts ++ fs+                                guard $ i2 < i1+                                [wr2 `R.intersects` gr]                         in lr == wr1 && (not . or) vu                     OnlyLayoutFloat ->                         lr == wr1+                    OnlyFloat ->+                        True                     _ ->                         wr1 `R.supersetOf` sr                 return w1@@ -284,6 +292,7 @@               | Screen <- amb = [w]               | OnlyScreenFloat <- amb = []               | OnlyLayoutFloat <- amb = []+              | OnlyFloat <- amb = []               | OnlyLayoutFloatBelow <- amb = []               | OtherIndicated <- amb               , let nonF = map integrate $ W.current wset : W.visible wset@@ -302,9 +311,6 @@         -- ^ This constructor is used to combine the borderless windows         -- provided by the SetsAmbiguous instances from two other 'Ambiguity'         -- data types.-    | OnlyScreenFloat-        -- ^ Only remove borders on floating windows that cover the whole-        -- screen.     | OnlyLayoutFloatBelow         -- ^ Like 'OnlyLayoutFloat', but only removes borders if no window         -- stacked below remains visible. Considers all floating windows on the@@ -315,13 +321,19 @@     | OnlyLayoutFloat         -- ^ Only remove borders on floating windows that exactly cover the         -- parent layout rectangle.+    | OnlyScreenFloat+        -- ^ Only remove borders on floating windows that cover the whole+        -- screen.     | Never-        -- ^ Never remove borders when ambiguous: this is the same as-        -- smartBorders.+        -- ^ Like 'OnlyScreenFloat', and also remove borders of tiled windows+        -- when not ambiguous: this is the same as 'smartBorders'.     | EmptyScreen         -- ^ Focus in an empty screen does not count as ambiguous.     | OtherIndicated         -- ^ No borders on full when all other screens have borders.+    | OnlyFloat+        -- ^ Remove borders on all floating windows; tiling windows of+        -- any kinds are not affected.     | Screen         -- ^ Borders are never drawn on singleton screens.  With this one you         -- really need another way such as a statusbar to detect focus.
XMonad/Layout/NoFrillsDecoration.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.NoFrillsDecoration+-- Description :  Most basic version of decoration for windows. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -30,7 +31,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.NoFrillsDecoration --@@ -46,7 +47,7 @@              -> l a -> ModifiedLayout (Decoration NoFrillsDecoration s) l a noFrillsDeco s c = decoration s c $ NFD True -data NoFrillsDecoration a = NFD Bool deriving (Show, Read)+newtype NoFrillsDecoration a = NFD Bool deriving (Show, Read)  instance Eq a => DecorationStyle NoFrillsDecoration a where     describeDeco _ = "NoFrillsDeco"
XMonad/Layout/OnHost.hs view
@@ -1,8 +1,10 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.OnHost+-- Description :  Use layouts and apply layout modifiers selectively, depending on the host. -- Copyright   :  (c) Brandon S Allbery, Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -26,14 +28,16 @@  import           XMonad import qualified XMonad.StackSet              as W+import           XMonad.Prelude  import           XMonad.Layout.LayoutModifier -import           Data.Maybe                        (fromMaybe)+import           Foreign                           (allocaArray0)+import           Foreign.C import           System.Posix.Env                  (getEnv)  -- $usage--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.OnHost --@@ -46,7 +50,7 @@ -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText--- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a+-- def ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. -- -- In another scenario, suppose you wanted to have layouts A, B, and C@@ -55,11 +59,13 @@ -- -- > layoutHook = A ||| B ||| onHost "foo" D C ----- Note that we rely on '$HOST' being set in the environment, as is true on most--- modern systems; if it's not, you may want to use a wrapper around xmonad or--- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'.--- This is to avoid dragging in the network package as an xmonad dependency.--- If '$HOST' is not defined, it will behave as if the host name never matches.+-- Note that we rely on either @$HOST@ being set in the environment, or+-- <https://linux.die.net/man/2/gethostname gethostname> returning something+-- useful, as is true on most modern systems; if this is not the case for you,+-- you may want to use a wrapper around xmonad or perhaps use+-- 'System.Posix.Env.setEnv' (or 'putEnv') to set @$HOST@ in 'main'. If+-- neither of the two methods work, the module will behave as if the host name+-- never matches. -- -- Also note that '$HOST' is usually a fully qualified domain name, not a short name. -- If you use a short name, this code will try to truncate $HOST to match; this may@@ -70,8 +76,8 @@ --   'onHost', and so on. onHost :: (LayoutClass l1 a, LayoutClass l2 a)        => String -- ^ the name of the host to match-       -> (l1 a) -- ^ layout to use on the matched host-       -> (l2 a) -- ^ layout to use everywhere else+       -> l1 a   -- ^ layout to use on the matched host+       -> l2 a   -- ^ layout to use everywhere else        -> OnHost l1 l2 a onHost host = onHosts [host] @@ -79,10 +85,10 @@ --   another to use on all other hosts. onHosts :: (LayoutClass l1 a, LayoutClass l2 a)         => [String] -- ^ names of hosts to match-        -> (l1 a)   -- ^ layout to use on matched hosts-        -> (l2 a)   -- ^ layout to use everywhere else+        -> l1 a     -- ^ layout to use on matched hosts+        -> l2 a     -- ^ layout to use everywhere else         -> OnHost l1 l2 a-onHosts hosts l1 l2 = OnHost hosts False l1 l2+onHosts hosts = OnHost hosts False  -- | Specify a layout modifier to apply on a particular host; layouts --   on all other hosts will remain unmodified.@@ -115,16 +121,16 @@  instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where     runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do-      h <- io $ getEnv "HOST"+      h <- io $ getEnv "HOST" <|> getHostName       if maybe False (`elemFQDN` hosts) h         then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r                 return (wrs, Just $ mkNewOnHostT p mlt')         else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r                 return (wrs, Just $ mkNewOnHostF p mlt') -    handleMessage (OnHost hosts bool lt lf) m-        | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf)-        | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ OnHost hosts bool lt nf)+    handleMessage (OnHost hosts choice lt lf) m+        | choice    = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts choice nt lf)+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts choice lt)      description (OnHost _ True  l1 _) = description l1     description (OnHost _ _     _ l2) = description l2@@ -136,7 +142,7 @@  mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a mkNewOnHostF (OnHost hosts _ lt lf) mlf' =-  (\lf' -> OnHost hosts False lt lf') $ fromMaybe lf mlf'+  OnHost hosts False lt $ fromMaybe lf mlf'  -- | 'Data.List.elem' except that if one side has a dot and the other doesn't, we truncate --   the one that does at the dot.@@ -153,3 +159,17 @@   | '.' `elem` a                 = takeWhile (/= '.') a ==                    b   |                 '.' `elem` b =                    a == takeWhile (/= '.') b   | otherwise                    =                    a ==                    b++-----------------------------------------------------------------------+-- cbits++foreign import ccall "gethostname" gethostname :: CString -> CSize -> IO CInt++getHostName :: IO (Maybe String)+getHostName = allocaArray0 size $ \cstr -> do+  throwErrnoIfMinus1_ "getHostName" $ gethostname cstr (fromIntegral size)+  peekCString cstr <&> \case+    "" -> Nothing+    s  -> Just s+ where+  size = 256
XMonad/Layout/OneBig.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.OneBig+-- Description :  Place one window at top left corner, and other windows at the top. -- Copyright   :  (c) 2009 Ilya Portnov -- License     :  BSD3-style (see LICENSE) --@@ -54,23 +55,25 @@  -- | Main layout function oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)]-oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)]-                                      ++ (divideBottom bottomRect bottomWs)-                                      ++ (divideRight rightRect rightWs)-      where ws = W.integrate stack-            n = length ws-            ht (Rectangle _ _ _ hh) = hh-            wd (Rectangle _ _ ww _) = ww-            h' = round (fromIntegral (ht rect)*cy)-            w = wd rect-            m = calcBottomWs n w h'-            master = head ws-            other  = tail ws-            bottomWs = take m other-            rightWs = drop m other-            masterRect = cmaster n m cx cy rect-            bottomRect = cbottom cy rect-            rightRect  = cright cx cy rect+oneBigLayout (OneBig cx cy) rect stack =+  let ws = W.integrate stack+      n  = length ws+   in case ws of+    []               -> []+    (master : other) -> [(master,masterRect)]+                     ++ divideBottom bottomRect bottomWs+                     ++ divideRight rightRect rightWs+     where+      ht (Rectangle _ _ _ hh) = hh+      wd (Rectangle _ _ ww _) = ww+      h' = round (fromIntegral (ht rect)*cy)+      w = wd rect+      m = calcBottomWs n w h'+      bottomWs = take m other+      rightWs = drop m other+      masterRect = cmaster n m cx cy rect+      bottomRect = cbottom cy rect+      rightRect  = cright cx cy rect  -- | Calculate how many windows must be placed at bottom calcBottomWs :: Int -> Dimension -> Dimension -> Int@@ -79,16 +82,16 @@                         2 -> 1                         3 -> 2                         4 -> 2-                        _ -> (fromIntegral w)*(n-1) `div` fromIntegral (h'+(fromIntegral w))+                        _ -> fromIntegral w*(n-1) `div` fromIntegral (h'+fromIntegral w)  -- | Calculate rectangle for master window cmaster:: Int -> Int -> Float -> Float -> Rectangle -> Rectangle cmaster n m cx cy (Rectangle x y sw sh) = Rectangle x y w h-    where w = if (n > m+1) then+    where w = if n > m+1 then                 round (fromIntegral sw*cx)               else                 sw-          h = if (n > 1) then+          h = if n > 1 then                 round (fromIntegral sh*cy)               else                 sh@@ -97,13 +100,13 @@ cbottom:: Float -> Rectangle -> Rectangle cbottom cy (Rectangle sx sy sw sh) = Rectangle sx y sw h     where h = round (fromIntegral sh*(1-cy))-          y = round (fromIntegral sh*cy+(fromIntegral sy))+          y = round (fromIntegral sh*cy+fromIntegral sy)  -- | Calculate rectangle for right windows cright:: Float -> Float -> Rectangle -> Rectangle cright cx cy (Rectangle sx sy sw sh) = Rectangle x sy w h     where w = round (fromIntegral sw*(1-cx))-          x = round (fromIntegral sw*cx+(fromIntegral sx))+          x = round (fromIntegral sw*cx+fromIntegral sx)           h = round (fromIntegral sh*cy)  -- | Divide bottom rectangle between windows@@ -116,7 +119,7 @@  -- | Divide right rectangle between windows divideRight :: Rectangle -> [a] -> [(a, Rectangle)]-divideRight (Rectangle x y w h) ws = if (n==0) then [] else zip ws rects+divideRight (Rectangle x y w h) ws = if n==0 then [] else zip ws rects     where n = length ws           oneH = fromIntegral h `div` n           oneRect = Rectangle x y w (fromIntegral oneH)@@ -129,5 +132,3 @@ -- | Shift rectangle bottom shiftB :: Position -> Rectangle -> Rectangle shiftB s (Rectangle x y w h) = Rectangle x (y+s) w h--
XMonad/Layout/PerScreen.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.PerScreen+-- Description :  Configure layouts based on the width of your screen. -- Copyright   :  (c) Edward Z. Yang -- License     :  BSD-style (see LICENSE) --@@ -25,10 +26,10 @@ import XMonad import qualified XMonad.StackSet as W -import Data.Maybe (fromMaybe)+import XMonad.Prelude (fromMaybe)  -- $usage--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.PerScreen --@@ -41,8 +42,8 @@  ifWider :: (LayoutClass l1 a, LayoutClass l2 a)                => Dimension   -- ^ target screen width-               -> (l1 a)      -- ^ layout to use when the screen is wide enough-               -> (l2 a)      -- ^ layout to use otherwise+               -> l1 a        -- ^ layout to use when the screen is wide enough+               -> l2 a        -- ^ layout to use otherwise                -> PerScreen l1 l2 a ifWider w = PerScreen w False @@ -57,7 +58,7 @@ mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) ->                       PerScreen l1 l2 a mkNewPerScreenF (PerScreen w _ lt lf) mlf' =-    (\lf' -> PerScreen w False lt lf') $ fromMaybe lf mlf'+    PerScreen w False lt $ fromMaybe lf mlf'  instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen l1 l2) a where     runLayout (W.Workspace i p@(PerScreen w _ lt lf) ms) r@@ -68,7 +69,7 @@      handleMessage (PerScreen w bool lt lf) m         | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerScreen w bool nt lf)-        | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerScreen w bool lt nf)+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . PerScreen w bool lt)      description (PerScreen _ True  l1 _) = description l1     description (PerScreen _ _     _ l2) = description l2
XMonad/Layout/PerWorkspace.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.PerWorkspace+-- Description :  Use layouts and apply layout modifiers selectively. -- Copyright   :  (c) Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -25,10 +26,10 @@ import XMonad import qualified XMonad.StackSet as W -import Data.Maybe (fromMaybe)+import XMonad.Prelude (fromMaybe)  -- $usage--- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.PerWorkspace --@@ -41,7 +42,7 @@ -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText--- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a+-- def ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. (In fact, @m1@ can be any -- function @(LayoutClass l a, LayoutClass l' a) => l a -> l' a@.) --@@ -56,8 +57,8 @@ --   'onWorkspace', and so on. onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)                => WorkspaceId -- ^ the tag of the workspace to match-               -> (l1 a)      -- ^ layout to use on the matched workspace-               -> (l2 a)      -- ^ layout to use everywhere else+               -> l1 a        -- ^ layout to use on the matched workspace+               -> l2 a        -- ^ layout to use everywhere else                -> PerWorkspace l1 l2 a onWorkspace wsId = onWorkspaces [wsId] @@ -65,8 +66,8 @@ --   another to use on all other workspaces. onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)                 => [WorkspaceId]  -- ^ tags of workspaces to match-                -> (l1 a)         -- ^ layout to use on matched workspaces-                -> (l2 a)         -- ^ layout to use everywhere else+                -> l1 a           -- ^ layout to use on matched workspaces+                -> l2 a           -- ^ layout to use everywhere else                 -> PerWorkspace l1 l2 a onWorkspaces wsIds = modWorkspaces wsIds . const @@ -108,7 +109,7 @@      handleMessage (PerWorkspace wsIds bool lt lf) m         | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerWorkspace wsIds bool nt lf)-        | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerWorkspace wsIds bool lt nf)+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . PerWorkspace wsIds bool lt)      description (PerWorkspace _ True  l1 _) = description l1     description (PerWorkspace _ _     _ l2) = description l2@@ -122,5 +123,4 @@ mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->                       PerWorkspace l1 l2 a mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' =-    (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf'-+    PerWorkspace wsIds False lt $ fromMaybe lf mlf'
XMonad/Layout/PositionStoreFloat.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.PositionStoreFloat+-- Description :  A floating layout; designed with a dual-head setup in mind. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -29,12 +30,10 @@ import XMonad.Util.PositionStore import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger-import Control.Monad(when)-import Data.Maybe(isJust)-import Data.List(nub)+import XMonad.Prelude (fromMaybe, isJust, nub, when)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.PositionStoreFloat -- > import XMonad.Layout.NoFrillsDecoration@@ -54,7 +53,7 @@ positionStoreFloat :: PositionStoreFloat a positionStoreFloat = PSF (Nothing, []) -data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read)+newtype PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read) instance LayoutClass PositionStoreFloat Window where     description _ = "PSF"     doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do@@ -65,13 +64,12 @@                             Just changedRect -> (w, changedRect)             let wrs' = focused : wrs             let paintOrder' = nub (w : paintOrder)-            when (isJust maybeChange) $ do+            when (isJust maybeChange) $                 updatePositionStore focused sr             return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))         where-            pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of-                                    Just rect   -> rect-                                    Nothing     -> (Rectangle 50 50 200 200)  -- should usually not happen+            pSQ posStore w' sr' = fromMaybe (Rectangle 50 50 200 200)       -- should usually not happen+                                            (posStoreQuery posStore w' sr')     pureMessage (PSF (_, paintOrder)) m         | Just (SetGeometry rect) <- fromMessage m =             Just $ PSF (Just rect, paintOrder)@@ -83,10 +81,10 @@  reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order =-    let ordered = concat $ map (pickElem wrs) order-        rest = filter (\(w, _) -> not (w `elem` order)) wrs+    let ordered = concatMap (pickElem wrs) order+        rest = filter (\(w, _) -> w `notElem` order) wrs     in ordered ++ rest     where-        pickElem list e = case (lookup e list) of+        pickElem list e = case lookup e list of                                 Just result -> [(e, result)]                                 Nothing -> []
XMonad/Layout/Reflect.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Reflect+-- Description :  Reflect a layout horizontally or vertically. -- Copyright   :  (c) Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -23,16 +24,15 @@                               ) where -import XMonad.Core+import XMonad.Prelude (fi) import Graphics.X11 (Rectangle(..), Window) import Control.Arrow (second)  import XMonad.Layout.LayoutModifier import XMonad.Layout.MultiToggle-import XMonad.Util.XUtils (fi)  -- $usage--- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.Reflect --@@ -88,7 +88,7 @@   -data Reflect a = Reflect ReflectDir deriving (Show, Read)+newtype Reflect a = Reflect ReflectDir deriving (Show, Read)  instance LayoutModifier Reflect a where @@ -101,8 +101,8 @@  -------- instances for MultiToggle ------------------ -data REFLECTX = REFLECTX deriving (Read, Show, Eq, Typeable)-data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable)+data REFLECTX = REFLECTX deriving (Read, Show, Eq)+data REFLECTY = REFLECTY deriving (Read, Show, Eq)  instance Transformer REFLECTX Window where     transform REFLECTX x k = k (reflectHoriz x) (\(ModifiedLayout _ x') -> x')
XMonad/Layout/Renamed.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Groups+-- Description :  Modify the description of a layout in a flexible way. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -18,6 +19,7 @@ module XMonad.Layout.Renamed ( -- * Usage                                -- $usage                                renamed+                             , named                              , Rename(..) ) where  import XMonad@@ -28,7 +30,7 @@ -- -- > import XMonad.Layout.Renamed ----- to your @~\/.xmonad\/xmonad.hs@.+-- to your @xmonad.hs@. -- -- You can then use 'renamed' to modify the description of your -- layouts. For example:@@ -39,6 +41,10 @@ renamed :: [Rename a] -> l a -> ModifiedLayout Rename l a renamed = ModifiedLayout . Chain +-- | Rename a layout. (Convenience alias for @renamed [Replace s]@.)+named :: String -> l a -> ModifiedLayout Rename l a+named s = renamed [Replace s]+ -- | The available renaming operations data Rename a = CutLeft Int -- ^ Remove a number of characters from the left               | CutRight Int -- ^ Remove a number of characters from the right@@ -46,6 +52,8 @@               | Prepend String -- ^ Add a string on the left               | CutWordsLeft Int -- ^ Remove a number of words from the left               | CutWordsRight Int -- ^ Remove a number of words from the right+              | KeepWordsLeft Int -- ^ Keep a number of words from the left+              | KeepWordsRight Int -- ^ Keep a number of words from the right               | AppendWords String -- ^ Add a string to the right, prepending a space to it                                    -- if necessary               | PrependWords String -- ^ Add a string to the left, appending a space to it if@@ -60,12 +68,15 @@ apply (CutWordsLeft i) s = unwords $ drop i $ words s apply (CutWordsRight i) s = let ws = words s                            in unwords $ take (length ws - i) ws+apply (KeepWordsLeft i) s = unwords $ take i $ words s+apply (KeepWordsRight i) s = let ws = words s+                           in unwords $ drop (length ws - i) ws apply (Replace s) _ = s apply (Append s') s = s ++ s' apply (Prepend s') s = s' ++ s apply (AppendWords s') s = unwords $ words s ++ [s'] apply (PrependWords s') s = unwords $ s' : words s-apply (Chain rs) s = ($s) $ foldr (flip (.)) id $ map apply rs+apply (Chain rs) s = ($ s) $ foldr (flip (.) . apply) id rs  instance LayoutModifier Rename a where     modifyDescription r l = apply r (description l)
+ XMonad/Layout/ResizableThreeColumns.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ResizableThreeColumns+-- Description :  Like "XMonad.Layout.ThreeColumns", but allows resizing.+-- Copyright   :  (c) Sam Tay <sam.chong.tay@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  ?+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout similar to tall but with three columns. With 2560x1600 pixels this+-- layout can be used for a huge main window and up to six reasonable sized+-- resizable stack windows.+-----------------------------------------------------------------------------++module XMonad.Layout.ResizableThreeColumns (+                              -- * Usage+                              -- $usage+                              ResizableThreeCol(..), MirrorResize(..)+                             ) where++import XMonad hiding (splitVertically)+import XMonad.Prelude+import XMonad.Layout.ResizableTile(MirrorResize(..))+import qualified XMonad.StackSet as W++import qualified Data.Map as M+import Data.Ratio++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Layout.ResizableThreeColumns+--+-- Then edit your @layoutHook@ by adding the ResizableThreeCol layout:+--+-- > myLayout = ResizableThreeCol 1 (3/100) (1/2) [] ||| ResizableThreeColMid 1 (3/100) (1/2) [] ||| etc..+-- > main = xmonad def { layoutHook = myLayout }+--+-- The first argument specifies how many windows initially appear in the main+-- window. The second argument argument specifies the amount to resize while+-- resizing and the third argument specifies the initial size of the columns.+-- A positive size designates the fraction of the screen that the main window+-- should occupy, but if the size is negative the absolute value designates the+-- fraction a stack column should occupy. If both stack columns are visible,+-- they always occupy the same amount of space.+--+-- You may also want to add the following key bindings:+--+-- > , ((modm,               xK_a), sendMessage MirrorShrink)+-- > , ((modm,               xK_z), sendMessage MirrorExpand)+--+-- The ResizableThreeColMid variant places the main window between the stack columns.+--+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".+++-- | Arguments are nmaster, delta, fraction+data ResizableThreeCol a+  = ResizableThreeColMid+    { threeColNMaster :: !Int+    , threeColDelta :: !Rational+    , threeColFrac :: !Rational+    , threeColSlaves :: [Rational]+    }+  | ResizableThreeCol+    { threeColNMaster :: !Int+    , threeColDelta :: !Rational+    , threeColFrac :: !Rational+    , threeColSlaves :: [Rational]+    } deriving (Show,Read)++instance LayoutClass ResizableThreeCol a where+  doLayout (ResizableThreeCol n _ f mf) r    = doL False n f mf r+  doLayout (ResizableThreeColMid n _ f mf) r = doL True  n f mf r+  handleMessage l m = do+    ms <- W.stack . W.workspace . W.current <$> gets windowset+    fs <- M.keys . W.floating <$> gets windowset+    return $ do+      s <- ms+      -- make sure current stack isn't floating+      guard (W.focus s `notElem` fs)+      -- remove floating windows from stack+      let s' = s { W.up = W.up s \\ fs, W.down = W.down s \\ fs }+      -- handle messages+      msum [ fmap resize       (fromMessage m)+           , fmap (mresize s') (fromMessage m)+           , fmap incmastern   (fromMessage m)+           ]+    where+      resize Shrink = l { threeColFrac = max (-0.5) $ frac-delta }+      resize Expand = l { threeColFrac = min 1 $ frac+delta }+      mresize s MirrorShrink = mresize' s delta+      mresize s MirrorExpand = mresize' s (negate delta)+      mresize' s delt =+        let up = length $ W.up s+            down = length $ W.down s+            total = up + down + 1+            pos = if up == nmaster - 1           -- upper right+                  || up == total - 1             -- upper left+                  || up `elem` [down, down + 1]  -- lower right+                  then up - 1+                  else up+            mfrac' = modifymfrac (mfrac ++ repeat 1) delt pos+        in l { threeColSlaves = take total mfrac'}+      modifymfrac [] _ _ = []+      modifymfrac (f:fx) d n+        | n == 0    = f+d : fx+        | otherwise = f : modifymfrac fx d (n-1)+      incmastern (IncMasterN x) = l { threeColNMaster = max 0 (nmaster+x) }+      nmaster = threeColNMaster l+      delta = threeColDelta l+      frac = threeColFrac l+      mfrac = threeColSlaves l+  description _ = "ResizableThreeCol"++doL :: Bool -> Int -> Rational -> [Rational] -> Rectangle+    -> W.Stack a -> X ([(a, Rectangle)], Maybe (layout a))+doL middle nmaster f mf r =+  return+  . (, Nothing)+  . ap zip (tile3 middle f (mf ++ repeat 1) r nmaster . length) . W.integrate++-- | tile3.  Compute window positions using 3 panes+tile3 :: Bool -> Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]+tile3 middle f mf r nmaster n+  | n <= nmaster || nmaster == 0 = splitVertically mf n r+  | n <= nmaster+1 = splitVertically mf nmaster s1+                  ++ splitVertically (drop nmaster mf) (n-nmaster) s2+  | otherwise = concat [ splitVertically mf nmaster r1+                       , splitVertically (drop nmaster mf) nstack1 r2+                       , splitVertically (drop (nmaster + nstack1) mf) nstack2 r3+                       ]+  where+    (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r+    (s1, s2)     = splitHorizontallyBy (if f<0 then 1+f else f) r+    nstack       = n - nmaster+    nstack1      = ceiling (nstack % 2)+    nstack2      = nstack - nstack1++splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]+splitVertically [] _ r = [r]+splitVertically _ n r | n < 2 = [r]+splitVertically (f:fx) n (Rectangle sx sy sw sh) =+  let smallh = min sh (floor $ fi (sh `div` fi n) * f)+  in Rectangle sx sy sw smallh :+       splitVertically fx (n-1) (Rectangle sx (sy+fi smallh) sw (sh-smallh))++split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)+split3HorizontallyBy middle f (Rectangle sx sy sw sh) =+  if middle+  then ( Rectangle (sx + fromIntegral r3w) sy r1w sh+       , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh+       , Rectangle sx sy r3w sh )+  else ( Rectangle sx sy r1w sh+       , Rectangle (sx + fromIntegral r1w) sy r2w sh+       , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh )+  where+    r1w = ceiling $ fromIntegral sw * f+    r2w = ceiling $ (sw - r1w) % 2+    r3w = sw - r1w - r2w
XMonad/Layout/ResizableTile.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ResizableTile+-- Description :  More useful tiled layout that allows you to change a width\/height of window. -- Copyright   :  (c) MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -21,13 +22,12 @@                                    ) where  import XMonad hiding (tile, splitVertically, splitHorizontallyBy)+import XMonad.Prelude import qualified XMonad.StackSet as W-import Control.Monad import qualified Data.Map as M-import Data.List ((\\))  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ResizableTile --@@ -36,9 +36,9 @@ -- > myLayout =  ResizableTall 1 (3/100) (1/2) [] ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to add the following key bindings: --@@ -47,9 +47,9 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable+data MirrorResize = MirrorShrink | MirrorExpand instance Message MirrorResize  data ResizableTall a = ResizableTall@@ -68,25 +68,25 @@  instance LayoutClass ResizableTall a where     doLayout (ResizableTall nmaster _ frac mfrac) r =-        return . (\x->(x,Nothing)) .+        return . (, Nothing) .         ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate     handleMessage (ResizableTall nmaster delta frac mfrac) m =-        do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset-           fs <- (M.keys . W.floating) `fmap` gets windowset+        do ms <- W.stack . W.workspace . W.current <$> gets windowset+           fs <- M.keys . W.floating <$> gets windowset            return $ ms >>= unfloat fs >>= handleMesg         where handleMesg s = msum [fmap resize (fromMessage m)-                                  ,fmap (\x -> mresize x s) (fromMessage m)+                                  ,fmap (`mresize` s) (fromMessage m)                                   ,fmap incmastern (fromMessage m)]               unfloat fs s = if W.focus s `elem` fs                                then Nothing-                               else Just (s { W.up = (W.up s) \\ fs-                                            , W.down = (W.down s) \\ fs })+                               else Just (s { W.up = W.up s \\ fs+                                            , W.down = W.down s \\ fs })               resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac               resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac               mresize MirrorShrink s = mresize' s delta-              mresize MirrorExpand s = mresize' s (0-delta)+              mresize MirrorExpand s = mresize' s (negate delta)               mresize' s d = let n = length $ W.up s-                                 total = n + (length $ W.down s) + 1+                                 total = n + length (W.down s) + 1                                  pos = if n == (nmaster-1) || n == (total-1) then n-1 else n                                  mfrac' = modifymfrac (mfrac ++ repeat 1) d pos                              in ResizableTall nmaster delta frac $ take total mfrac'
XMonad/Layout/ResizeScreen.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ResizeScreen+-- Description :  A layout transformer to have a layout respect a given screen geometry. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -10,9 +11,9 @@ -- Portability :  unportable -- -- A layout transformer to have a layout respect a given screen--- geometry. Mostly used with "Decoration" (the Horizontal and the--- Vertical version will react to SetTheme and change their dimension--- accordingly.+-- geometry. Mostly used with "XMonad.Layout.Decoration" (the+-- Horizontal and the Vertical version will react to SetTheme and+-- change their dimension accordingly. -----------------------------------------------------------------------------  module XMonad.Layout.ResizeScreen@@ -30,7 +31,7 @@  -- $usage -- You can use this module by importing it into your--- @~\/.xmonad\/xmonad.hs@ file:+-- @xmonad.hs@ file: -- -- > import XMonad.Layout.ResizeScreen --@@ -38,9 +39,9 @@ -- -- > layoutHook = resizeHorizontal 40 Full ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeHorizontal i = ModifiedLayout (ResizeScreen L i)@@ -64,14 +65,13 @@ data ResizeMode = T | B | L | R deriving (Read, Show)  instance LayoutModifier ResizeScreen a where-    modifyLayout m ws rect@(Rectangle x y w h)+    modifyLayout m ws (Rectangle x y w h)         | ResizeScreen L i <- m = resize $ Rectangle (x + fi i) y (w - fi i) h         | ResizeScreen R i <- m = resize $ Rectangle x          y (w - fi i) h         | ResizeScreen T i <- m = resize $ Rectangle x (y + fi i) w (h - fi i)         | ResizeScreen B i <- m = resize $ Rectangle x  y         w (h - fi i)         | WithNewScreen  r <- m = resize r-        | otherwise             = resize rect-       where resize nr = runLayout ws nr+       where resize = runLayout ws      pureMess (ResizeScreen d _) m         | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t)
XMonad/Layout/Roledex.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Roledex+-- Description :  A completely pointless layout which acts like Microsoft's Flip 3D. -- Copyright   :  (c) tim.thelion@gmail.com -- License     :  BSD --@@ -26,7 +27,7 @@ import Data.Ratio  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Roledex --@@ -35,9 +36,9 @@ -- > myLayout =  Roledex ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- $screenshot -- <<http://www.timthelion.com/rolodex.png>>@@ -49,8 +50,8 @@  roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a)) roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++-                              (zip ups tops) ++-                              (reverse (zip dns bottoms))+                              zip ups tops +++                              reverse (zip dns bottoms)                                ,Nothing)  where ups    = W.up ws        dns    = W.down ws@@ -65,12 +66,12 @@             (Rectangle _ _ _ h) = sc             (Rectangle _ _ _ rh) = rect        mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect-       mrect  mx my (Rectangle x y w h) = Rectangle (x + (fromIntegral mx)) (y + (fromIntegral my)) w h+       mrect  mx my (Rectangle x y w h) = Rectangle (x + fromIntegral mx) (y + fromIntegral my) w h        tops    = map f $ cd c (length dns)-       bottoms = map f $ [0..(length dns)]-       f n = mrect (gw * (fromIntegral n)) (gh * (fromIntegral n)) rect+       bottoms = map f [0..(length dns)]+       f n = mrect (gw * fromIntegral n) (gh * fromIntegral n) rect        cd n m = if n > m-                then (n - 1) : (cd (n-1) m)+                then (n - 1) : cd (n-1) m                 else []  div' :: Integral a => a -> a -> a
XMonad/Layout/ShowWName.hs view
@@ -1,7 +1,11 @@-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE CPP                   #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ShowWName+-- Description :  A layout modifier that will show the workspace name. -- Copyright   :  (c) Andrea Rossato 2007 -- License     :  BSD-style (see xmonad/LICENSE) --@@ -18,7 +22,6 @@       showWName     , showWName'     , def-    , defaultSWNConfig     , SWNConfig(..)     , ShowWName     ) where@@ -32,15 +35,15 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.ShowWName -- > myLayout = layoutHook def -- > main = xmonad def { layoutHook = showWName myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | A layout modifier to show the workspace name when switching showWName :: l a -> ModifiedLayout ShowWName l a@@ -63,18 +66,18 @@  instance Default SWNConfig where   def =+#ifdef XFT+    SWNC { swn_font    = "xft:monospace-20"+#else     SWNC { swn_font    = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+#endif          , swn_bgcolor = "black"          , swn_color   = "white"          , swn_fade    = 1          } -{-# DEPRECATED defaultSWNConfig "Use def (from Data.Default, and re-exported from XMonad.Layout.ShowWName) instead." #-}-defaultSWNConfig :: SWNConfig-defaultSWNConfig = def- instance LayoutModifier ShowWName a where-    redoLayout      sn r _ wrs = doShow sn r wrs+    redoLayout      sn r _ = doShow sn r      handleMess (SWN _ c (Just (i,w))) m         | Just e    <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)@@ -95,7 +98,7 @@   d <- asks display   n <- withWindowSet (return . S.currentTag)   f <- initXMF (swn_font c)-  width <- fmap (\w -> w + w `div` length n) $ textWidthXMF d f n+  width <- (\w -> w + w `div` length n) <$> textWidthXMF d f n   (as,ds) <- textExtentsXMF f n   let hight = as + ds       y     = fi sy + (fi ht - hight + 2) `div` 2
+ XMonad/Layout/SideBorderDecoration.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+--------------------------------------------------------------------+-- |+-- Module      : XMonad.Layout.SideBorderDecoration+-- Description : Configure the border position around windows.+-- Copyright   : (c) 2018  L. S. Leary+--                   2022  Tony Zorman+-- License     : BSD3+-- Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>+--+-- This module allows for having a configurable border position around+-- windows; i.e., it can move the border to any cardinal direction.+--+--------------------------------------------------------------------+module XMonad.Layout.SideBorderDecoration (+  -- * Usage+  -- $usage+  sideBorder,++  -- * Border configuration+  SideBorderConfig (..),+  def,++  -- * Re-exports+  Direction2D (..),++  -- * Lower-level hooks+  sideBorderLayout,+) where++import qualified XMonad.StackSet as W++import XMonad+import XMonad.Layout.Decoration+import XMonad.StackSet (Stack)+import XMonad.Util.Types++{- $usage++To use this module, first import it into your configuration file:++> import XMonad.Layout.SideBorderDecoration++You can now add the 'sideBorder' combinator to your configuration:++> main :: IO ()+> main = xmonad+>      $ …+>      $ sideBorder mySideBorderConfig+>      $ def { … }+>  where+>   mySideBorderConfig :: SideBorderConfig+>   mySideBorderConfig = def+>     { sbSide          = D+>     , sbActiveColor   = "#ff0000"+>     , sbInactiveColor = "#ffaaaa"+>     , sbSize          = 5+>     }++or, alternatively,++> main :: IO ()+> main = xmonad+>      $ …+>      $ sideBorder def{ sbSide = D, sbActiveColor = "#ff000", … }+>      $ def { … }++See 'SideBorderConfig' for the different size and colour options.++The following is a fully-functional, minimal configuration example:++> import XMonad+> import XMonad.Layout.SideBorderDecoration+>+> main :: IO ()+> main = xmonad $ sideBorder def $ def++This would result in the following border being displayed:++<<https://user-images.githubusercontent.com/50166980/184537672-136f85a3-dfe7-42e2-b4c8-356d934d1bff.png>>++-}++-----------------------------------------------------------------------+-- Configuration++-- | Configuring how the border looks like.+data SideBorderConfig = SideBorderConfig+  { sbSide          :: !Direction2D  -- ^ Which side to have the border on.+  , sbActiveColor   :: !String       -- ^ Active border colour.+  , sbInactiveColor :: !String       -- ^ Inactive border colour.+  , sbSize          :: !Dimension+    -- ^ Size of the border.  This will be the height if 'sbSide' is 'U'+    --   or 'D' and the width if it is 'L' or 'R'.+  }++instance Default SideBorderConfig where+  def :: SideBorderConfig+  def = SideBorderConfig+    { sbSide          = D+    , sbActiveColor   = "#ff0000"+    , sbInactiveColor = "#ffaaaa"+    , sbSize          = 5+    }++-----------------------------------------------------------------------+-- User-facing++-- | Move the default XMonad border to any of the four cardinal+-- directions.+--+-- Note that this function should only be applied once to your+-- configuration and should /not/ be combined with 'sideBorderLayout'.+sideBorder :: SideBorderConfig -> XConfig l -> XConfig (SideBorder l)+sideBorder sbc cfg =+  cfg{ layoutHook  = sideBorderLayout sbc (layoutHook cfg)+     , borderWidth = 0+     }++-- | Layout hook to only enable the side border for some layouts.  For+-- example:+--+-- > myLayout = Full ||| sideBorderLayout def tall ||| somethingElse+--+-- Note that, unlike 'sideBorder', this does /not/ disable the normal+-- border in XMonad, you will have to do this yourself.  Remove this+-- function from your layout hook and use 'sideBorder' if you want a+-- side border in every layout (do not use the two functions together).+sideBorderLayout :: Eq a => SideBorderConfig -> l a -> SideBorder l a+sideBorderLayout SideBorderConfig{ sbSide, sbActiveColor, sbInactiveColor, sbSize } =+  decoration BorderShrinker theme (SideBorderDecoration sbSide)+ where+  theme :: Theme+  theme = deco+    { activeColor   = sbActiveColor+    , inactiveColor = sbInactiveColor+    }+   where+    deco | sbSide `elem` [U, D] = def{ decoHeight = sbSize }+         | otherwise            = def{ decoWidth  = sbSize }++-----------------------------------------------------------------------+-- Decoration++newtype SideBorderDecoration a = SideBorderDecoration Direction2D+  deriving (Show, Read)++type SideBorder = ModifiedLayout (Decoration SideBorderDecoration BorderShrinker)++instance Eq a => DecorationStyle SideBorderDecoration a where+  shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle+  shrink dec (Rectangle _ _ dw dh) (Rectangle x y w h) = case dec of+    SideBorderDecoration U -> Rectangle x           (y + fi dh) w        (h - dh)+    SideBorderDecoration R -> Rectangle x           y           (w - dw) h+    SideBorderDecoration D -> Rectangle x           y           w        (h - dh)+    SideBorderDecoration L -> Rectangle (x + fi dw) y           (w - dw) h++  pureDecoration+    :: SideBorderDecoration a+    -> Dimension -> Dimension+    -> Rectangle+    -> Stack a+    -> [(a, Rectangle)]+    -> (a, Rectangle)+    -> Maybe Rectangle+  pureDecoration dec dw dh _ st _ (win, Rectangle x y w h)+    | win `elem` W.integrate st && dw < w && dh < h = Just $ case dec of+      SideBorderDecoration U -> Rectangle x                 y                 w  dh+      SideBorderDecoration R -> Rectangle (x + fi (w - dw)) y                 dw h+      SideBorderDecoration D -> Rectangle x                 (y + fi (h - dh)) w  dh+      SideBorderDecoration L -> Rectangle x                 y                 dw h+    | otherwise = Nothing++-----------------------------------------------------------------------+-- Shrinker++-- | Kill all text.+data BorderShrinker = BorderShrinker++instance Show BorderShrinker where+  show :: BorderShrinker -> String+  show _ = ""++instance Read BorderShrinker where+  readsPrec :: Int -> ReadS BorderShrinker+  readsPrec _ s = [(BorderShrinker, s)]++instance Shrinker BorderShrinker where+  shrinkIt :: BorderShrinker -> String -> [String]+  shrinkIt _ _ = [""]
XMonad/Layout/SimpleDecoration.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.SimpleDecoration+-- Description :  Add simple decorations to the windows of a given layout. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -21,7 +22,6 @@       simpleDeco     , Theme (..)     , def-    , defaultTheme     , SimpleDecoration (..)     , shrinkText, CustomShrink(CustomShrink)     , Shrinker(..)@@ -32,7 +32,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.SimpleDecoration --@@ -42,9 +42,9 @@ -- > myL = simpleDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. --@@ -53,14 +53,14 @@ -- -- and ----- > myL = dwmStyle shrinkText mySDConfig (layoutHook def)+-- > myL = simpleDeco shrinkText mySDConfig (layoutHook def)  -- | Add simple decorations to windows of a layout. simpleDeco :: (Eq a, Shrinker s) => s -> Theme            -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a simpleDeco s c = decoration s c $ Simple True -data SimpleDecoration a = Simple Bool deriving (Show, Read)+newtype SimpleDecoration a = Simple Bool deriving (Show, Read)  instance Eq a => DecorationStyle SimpleDecoration a where     describeDeco _ = "Simple"
XMonad/Layout/SimpleFloat.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.SimpleFloat+-- Description :  A basic floating layout. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -32,7 +33,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.SimpleFloat --@@ -41,9 +42,9 @@ -- > myLayout = simpleFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | A simple floating layout where every window is placed according -- to the window's initial attributes.@@ -60,7 +61,7 @@                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c)) -data SimpleFloat a = SF Dimension deriving (Show, Read)+newtype SimpleFloat a = SF Dimension deriving (Show, Read) instance LayoutClass SimpleFloat Window where     description _ = "Float"     doLayout (SF i) sc (S.Stack w l r) = do@@ -75,6 +76,6 @@   let ny = ry + fi i       x  =  max rx $ fi $ wa_x wa       y  =  max ny $ fi $ wa_y wa-      wh = (fi $ wa_width  wa) + (bw * 2)-      ht = (fi $ wa_height wa) + (bw * 2)+      wh = fi (wa_width  wa) + (bw * 2)+      ht = fi (wa_height wa) + (bw * 2)   return (w, Rectangle x y wh ht)
XMonad/Layout/Simplest.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Simplest+-- Description :  A very simple layout. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -23,7 +26,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.Simplest --@@ -32,10 +35,10 @@ -- > myLayout = Simplest ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data Simplest a = Simplest deriving (Show, Read) instance LayoutClass Simplest a where-    pureLayout Simplest rec (S.Stack w l r) = zip (w : reverse l ++ r) (repeat rec)+    pureLayout Simplest rec (S.Stack w l r) = map (, rec) (w : reverse l ++ r)
XMonad/Layout/SimplestFloat.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.SimplestFloat+-- Description :  Like "XMonad.Layout.SimpleFloat" but without the decoration. -- Copyright   :  (c) 2008 Jussi Mäki -- License     :  BSD-style (see xmonad/LICENSE) --@@ -19,15 +20,15 @@     , SimplestFloat     ) where +import XMonad.Prelude (fi) import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Layout.LayoutModifier-import XMonad.Util.XUtils (fi)  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.SimplestFloat --@@ -36,9 +37,9 @@ -- > myLayout = simplestFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | A simple floating layout where every window is placed according -- to the window's initial attributes.@@ -47,8 +48,8 @@  data SimplestFloat a = SF deriving (Show, Read) instance LayoutClass SimplestFloat Window where-    doLayout SF sc (S.Stack w l r) = fmap (flip (,) Nothing)-                                   $ mapM (getSize sc) (w : reverse l ++ r)+    doLayout SF sc (S.Stack w l r) =  (, Nothing)+                                  <$> mapM (getSize sc) (w : reverse l ++ r)     description _ = "SimplestFloat"  getSize :: Rectangle -> Window -> X (Window,Rectangle)@@ -58,6 +59,6 @@   wa <- io $ getWindowAttributes d w   let x  =  max rx $ fi $ wa_x wa       y  =  max ry $ fi $ wa_y wa-      wh = (fi $ wa_width  wa) + (bw * 2)-      ht = (fi $ wa_height wa) + (bw * 2)+      wh = fi (wa_width  wa) + (bw * 2)+      ht = fi (wa_height wa) + (bw * 2)   return (w, Rectangle x y wh ht)
XMonad/Layout/SortedLayout.hs view
@@ -4,6 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.SortedLayout+-- Description :  A layout modifier that sorts a given layout by a list of properties. -- Copyright   :  (c) 2016 Kurt Dietrich -- License     :  BSD-style (see xmonad/LICENSE) --@@ -24,18 +25,15 @@   , Property(..)   ) where -import           Control.Monad-import           Data.Functor                 ((<$>))-import           Data.List- import           XMonad+import           XMonad.Prelude hiding (Const) import           XMonad.Layout.LayoutModifier import           XMonad.StackSet              as W import           XMonad.Util.WindowProperties  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.SortedLayout --@@ -44,9 +42,9 @@ -- > myLayout = sorted [ClassName "Firefox", ClassName "URxvt"] Grid -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".   -- | Modify a layout using a list of properties to sort its windows.@@ -66,7 +64,7 @@ instance Ord WindowDescriptor where   compare a b = compare (wdSeqn a) (wdSeqn b) -data SortedLayout a = SortedLayout [Property] deriving (Show, Read)+newtype SortedLayout a = SortedLayout [Property] deriving (Show, Read)  instance LayoutModifier SortedLayout Window where     modifyLayout (SortedLayout props) = sortLayout props
XMonad/Layout/Spacing.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Spacing+-- Description :  Add a configurable amount of space around windows. -- Copyright   :  (C) --   Brent Yorgey --                    2018 Yclept Nemo -- License     :  BSD-style (see LICENSE)@@ -19,10 +20,13 @@ module XMonad.Layout.Spacing     ( -- * Usage       -- $usage-      Border (..)-    , Spacing (..)-    , SpacingModifier (..)+      Spacing (..)     , spacingRaw+    , spacing, spacingWithEdge+    , smartSpacing, smartSpacingWithEdge++      -- * Modify Spacing+    , SpacingModifier (..)     , setSmartSpacing     , setScreenSpacing, setScreenSpacingEnabled     , setWindowSpacing, setWindowSpacingEnabled@@ -33,15 +37,10 @@     , incWindowSpacing, incScreenSpacing     , decWindowSpacing, decScreenSpacing     , incScreenWindowSpacing, decScreenWindowSpacing++      -- * Modify Borders+    , Border (..)     , borderMap, borderIncrementBy-      -- * Backwards Compatibility-      -- $backwardsCompatibility-    , SpacingWithEdge-    , SmartSpacing, SmartSpacingWithEdge-    , ModifySpacing (..)-    , spacing, spacingWithEdge-    , smartSpacing, smartSpacingWithEdge-    , setSpacing, incSpacing     ) where  import           XMonad@@ -52,15 +51,49 @@   -- $usage--- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@+-- You can use this module by importing it into your @xmonad.hs@ -- file: -- -- > import XMonad.Layout.Spacing ----- and modifying your layoutHook as follows (for example):+-- and, for example, modifying your @layoutHook@ as follows: ----- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $--- >              layoutHook def+-- > main :: IO ()+-- > main = xmonad $ def+-- >   { layoutHook = spacingWithEdge 10 $ myLayoutHook+-- >   }+-- >+-- > myLayoutHook = Full ||| ...+--+-- The above would add a 10 pixel gap around windows on all sides, as+-- well as add the same amount of spacing around the edges of the+-- screen.  If you only want to add spacing around windows, you can use+-- 'spacing' instead.+--+-- There is also the 'spacingRaw' command, for more fine-grained+-- control.  For example:+--+-- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True+-- >            $ myLayoutHook+--+-- Breaking this down, the above would do the following:+--+--   - @True@: Enable the 'smartBorder' to not apply borders when there+--     is only one window.+--+--   - @(Border 0 10 10 10)@: Add a 'screenBorder' of 10 pixels in every+--     direction but the top.+--+--   - @True@: Enable the 'screenBorder'.+--+--   - @(Border 10 10 10 10)@: Add a 'windowBorder' of 10 pixels in+--     every direction.+--+--   - @True@: Enable the 'windowBorder'.+--+-- __Warning__: If you also use the 'avoidStruts' layout modifier, it+-- must come /before/ any of these modifiers. See the documentation of+-- 'avoidStruts' for details.  -- | Represent the borders of a rectangle. data Border = Border@@ -146,7 +179,7 @@             else (wrs,ml)       where         moveByQuadrant :: Rectangle -> Rectangle -> Border -> Rectangle-        moveByQuadrant rr mr@(Rectangle {rect_x = x, rect_y = y}) (Border bt bb br bl) =+        moveByQuadrant rr mr@Rectangle{rect_x = x, rect_y = y} (Border bt bb br bl) =             let (rcx,rcy) = R.center rr                 (mcx,mcy) = R.center mr                 dx = orderSelect (compare mcx rcx) (bl,0,negate br)@@ -181,9 +214,6 @@         = Just $ s { windowBorder = f wb }         | Just (ModifyWindowBorderEnabled f) <- fromMessage m         = Just $ s { windowBorderEnabled = f wbe }-        | Just (ModifySpacing f) <- fromMessage m-        = Just $ let f' = borderMap (fromIntegral . f . fromIntegral)-                 in  s { screenBorder = f' sb, windowBorder = f' wb }         | otherwise         = Nothing @@ -208,7 +238,6 @@     | ModifyScreenBorderEnabled (Bool -> Bool)     | ModifyWindowBorder (Border -> Border)     | ModifyWindowBorderEnabled (Bool -> Bool)-    deriving (Typeable)  instance Message SpacingModifier @@ -296,8 +325,7 @@     let bl = [t,b,r,l]         o  = maximum bl         o' = max i $ negate o-        [t',b',r',l'] = map (+o') bl-    in  Border t' b' r' l'+    in  Border (t + o') (b + o') (r + o') (l + o')  -- | Interface to 'XMonad.Util.Rectangle.withBorder'. withBorder' :: Border -> Integer -> Rectangle -> Rectangle@@ -328,31 +356,7 @@ ----------------------------------------------------------------------------- -- Backwards Compatibility: ------------------------------------------------------------------------------{-# DEPRECATED SpacingWithEdge, SmartSpacing, SmartSpacingWithEdge "Use Spacing instead." #-}-{-# DEPRECATED ModifySpacing "Use SpacingModifier instead, perhaps with sendMessages." #-}-{-# DEPRECATED spacing, spacingWithEdge, smartSpacing, smartSpacingWithEdge "Use spacingRaw instead." #-}-{-# DEPRECATED setSpacing "Use setScreenWindowSpacing instead." #-}-{-# DEPRECATED incSpacing "Use incScreenWindowSpacing instead." #-} --- $backwardsCompatibility--- The following functions and types exist solely for compatibility with--- pre-0.14 releases.---- | A type synonym for the 'Spacing' 'LayoutModifier'.-type SpacingWithEdge = Spacing---- | A type synonym for the 'Spacing' 'LayoutModifier'.-type SmartSpacing = Spacing---- | A type synonym for the 'Spacing' 'LayoutModifier'.-type SmartSpacingWithEdge = Spacing---- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of--- the screen spacing and window spacing. See 'SpacingModifier'.-data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)--instance Message ModifySpacing- -- | Surround all windows by a certain number of pixels of blank space. See -- 'spacingRaw'. spacing :: Int -> l a -> ModifiedLayout Spacing l a@@ -378,11 +382,3 @@ smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True     where i' = fromIntegral i---- | See 'setScreenWindowSpacing'.-setSpacing :: Int -> X ()-setSpacing = setScreenWindowSpacing . fromIntegral---- | See 'incScreenWindowSpacing'.-incSpacing :: Int -> X ()-incSpacing = incScreenWindowSpacing . fromIntegral
XMonad/Layout/Spiral.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Spiral+-- Description :  A spiral tiling layout. -- Copyright   :  (c) Joe Thornber <joe.thornber@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -30,7 +31,7 @@ import XMonad.StackSet ( integrate )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Spiral --@@ -39,12 +40,12 @@ -- > myLayout =  spiral (6/7) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  fibs :: [Integer]-fibs = 1 : 1 : zipWith (+) fibs (tail fibs)+fibs = 1 : 1 : zipWith (+) fibs (drop 1 fibs)  mkRatios :: [Integer] -> [Rational] mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs)@@ -57,7 +58,7 @@ blend scale ratios = zipWith (+) ratios scaleFactors     where       len = length ratios-      step = (scale - (1 % 1)) / (fromIntegral len)+      step = (scale - (1 % 1)) / fromIntegral len       scaleFactors = map (* step) . reverse . take len $ [0..]  -- | A spiral layout.  The parameter controls the size ratio between@@ -81,7 +82,7 @@ instance LayoutClass SpiralWithDir a where     pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects         where ws = integrate stack-              ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs+              ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ drop 1 fibs               rects = divideRects (zip ratios dirs) sc               dirs  = dropWhile (/= dir) $ case rot of                                            CW  -> cycle [East .. North]@@ -95,7 +96,7 @@ divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle] divideRects [] r = [r] divideRects ((r,d):xs) rect = case divideRect r d rect of-                                (r1, r2) -> r1 : (divideRects xs r2)+                                (r1, r2) -> r1 : divideRects xs r2  -- It's much simpler if we work with all Integers and convert to -- Rectangle at the end.@@ -120,5 +121,5 @@       North -> let (h1, h2) = chop (1 - ratio) h in (Rect x (y + h1) w h2, Rect x y w h1)  chop :: Rational -> Integer -> (Integer, Integer)-chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in+chop rat n = let f = (fromIntegral n * numerator rat) `div` denominator rat in              (f, n - f)
XMonad/Layout/Square.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Square+-- Description :  A layout that splits the screen into a square area and the rest of the screen. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -28,7 +29,7 @@ import XMonad.StackSet ( integrate )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your @xmonad.hs@ file: -- -- >   import XMonad.Layout.Square --@@ -40,13 +41,13 @@ -- >         [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)]  -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data Square a = Square deriving ( Read, Show )  instance LayoutClass Square a where     pureLayout Square r s = arrange (integrate s)-        where arrange ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]+        where arrange ws@(_:_) = map (, rest) (init ws) ++ [(last ws,sq)]               arrange [] = [] -- actually, this is an impossible case               (rest, sq) = splitSquare r
XMonad/Layout/StackTile.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.StackTile+-- Description :  Like "XMonad.Layout.Dishes" but with the ability to resize the master pane. -- Copyright   :  (c) Rickard Gustafsson <acura@allyourbase.se> -- License     :  BSD-style (see LICENSE) --@@ -23,10 +24,10 @@  import XMonad hiding (tile) import qualified XMonad.StackSet as W-import Control.Monad+import XMonad.Prelude  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.StackTile --@@ -35,9 +36,9 @@ -- > myLayout =  StackTile 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read)
XMonad/Layout/StateFull.hs view
@@ -20,22 +20,18 @@ -- behaviour of a child layout that has not been given the focused window. -------------------------------------------------------------------------------- -module XMonad.Layout.StateFull (+module XMonad.Layout.StateFull {-# DEPRECATED "Use X.L.TrackFloating." #-} (   -- * Usage   -- $Usage   pattern StateFull,   StateFull,-  FocusTracking(..),-  focusTracking+  FocusTracking,+  F.focusTracking ) where -import XMonad hiding ((<&&>))-import qualified XMonad.StackSet as W-import XMonad.Util.Stack (findZ)--import Data.Maybe (fromMaybe)-import Control.Applicative ((<|>),(<$>))-import Control.Monad (join)+import XMonad+import XMonad.Layout.LayoutModifier+import qualified XMonad.Layout.FocusTracking as F  -- $Usage --@@ -53,42 +49,14 @@ -- > main = xmonad def -- >  { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) } --- | The @FocusTracking@ data type for which the @LayoutClass@ instance is---   provided.-data FocusTracking l a = FocusTracking (Maybe a) (l a)-  deriving (Show, Read)---- | Transform a layout into one that remembers and uses its last focus.-focusTracking :: l a -> FocusTracking l a-focusTracking = FocusTracking Nothing+-- | The @FocusTracking@ type for which the @LayoutClass@ instance is provided.+type FocusTracking = ModifiedLayout F.FocusTracking  -- | A type synonym to match the @StateFull@ pattern synonym. type StateFull = FocusTracking Full  -- | A pattern synonym for the primary use case of the @FocusTracking@ --   transformer; using @Full@.-pattern StateFull = FocusTracking Nothing Full--instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where--  description (FocusTracking _ child)-    | (chDesc == "Full")  = "StateFull"-    | (' ' `elem` chDesc) = "FocusTracking (" ++ chDesc ++ ")"-    | otherwise           = "FocusTracking " ++ chDesc-    where chDesc = description child--  runLayout (W.Workspace i (FocusTracking mOldFoc childL) mSt) sr = do--    mRealFoc <- gets (W.peek . windowset)-    let mGivenFoc = W.focus <$> mSt-        passedMSt = if mRealFoc == mGivenFoc then mSt-                    else join (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt--    (wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr-    let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL'-                else Just $ FocusTracking mGivenFoc (fromMaybe childL mChildL')--    return (wrs, newFT)+pattern StateFull :: StateFull a+pattern StateFull = ModifiedLayout (F.FocusTracking Nothing) Full -  handleMessage (FocusTracking mf childLayout) m =-    (fmap . fmap) (FocusTracking mf) (handleMessage childLayout m)
XMonad/Layout/Stoppable.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Stoppable+-- Description :  A layout modifier to stop all non-visible processes. -- Copyright   :  (c) Anton Vorontsov <anton@enomsg.org> 2014 -- License     :  BSD-style (as xmonad) --@@ -47,6 +48,7 @@     ) where  import XMonad+import XMonad.Prelude import XMonad.Actions.WithAll import XMonad.Util.WindowProperties import XMonad.Util.RemoteWindows@@ -54,11 +56,9 @@ import XMonad.StackSet hiding (filter) import XMonad.Layout.LayoutModifier import System.Posix.Signals-import Data.Maybe-import Control.Monad  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Layout.Stoppable@@ -75,9 +75,9 @@ -- layoutHook you have to provide manageHook from -- "XMonad.Util.RemoteWindows" module. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  signalWindow :: Signal -> Window -> X () signalWindow s w = do@@ -121,7 +121,7 @@           where run = sigStoppableWorkspacesHook m >> return Nothing     handleMess (Stoppable m d _) msg         | Just Hide <- fromMessage msg =-            (Just . Stoppable m d . Just) `liftM` startTimer d+            Just . Stoppable m d . Just <$> startTimer d         | otherwise = return Nothing  -- | Convert a layout to a stoppable layout using the default mark
XMonad/Layout/SubLayouts.hs view
@@ -1,7 +1,16 @@-{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ParallelListComp #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.SubLayouts+-- Description :  A layout combinator that allows layouts to be nested. -- Copyright   :  (c) 2009 Adam Vogt -- License     :  BSD-style (see xmonad/LICENSE) --@@ -38,8 +47,6 @@     )     where -import XMonad.Layout.Circle () -- so haddock can find the link- import XMonad.Layout.Decoration(Decoration, DefaultShrinker) import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout,                                     redoLayout),@@ -51,19 +58,15 @@ import XMonad.Util.Invisible(Invisible(..)) import XMonad.Util.Types(Direction2D(..)) import XMonad hiding (def)-import Control.Applicative((<$>),(<*))+import XMonad.Prelude import Control.Arrow(Arrow(second, (&&&)))-import Control.Monad(MonadPlus(mplus), foldM, guard, when, join)-import Data.Function(on)-import Data.List(nubBy, (\\), find)-import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe)-import Data.Traversable(sequenceA)  import qualified XMonad as X import qualified XMonad.Layout.BoringWindows as B import qualified XMonad.StackSet as W import qualified Data.Map as M import Data.Map(Map)+import qualified Data.Set as S  -- $screenshots --@@ -110,7 +113,7 @@ --  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.SubLayouts -- > import XMonad.Layout.WindowNavigation@@ -159,10 +162,9 @@ --  could not be used in the keybinding instead? It avoids having to explicitly --  pass the conf. ----- For more detailed instructions, see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"--- "XMonad.Doc.Extending#Adding_key_bindings"+-- For more detailed instructions, see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>+-- and "XMonad.Doc.Extending#Editing_the_layout_hook".  -- | The main layout modifier arguments: --@@ -180,14 +182,14 @@ --  [@outerLayout@] The layout that determines the rectangles given to each --  group. -----  Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed---  with:+--  Ex. The second group is 'Tall', the third is 'XMonad.Layout.CircleEx.circle',+--  all others are tabbed with: -- --  > myLayout = addTabs shrinkText def---  >          $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle)+--  >          $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| circle) --  >          $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a-subLayout nextLayout sl x = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) x+subLayout nextLayout sl = ModifiedLayout (Sublayout (I []) (nextLayout,sl) [])  -- | @subTabbed@ is a use of 'subLayout' with 'addTabs' to show decorations. subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>@@ -199,7 +201,7 @@ -- defaults ones but to be used as a 'submap' for sending messages to the -- sublayout. defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ())-defaultSublMap (XConfig { modMask = modm }) = M.fromList+defaultSublMap XConfig{ modMask = modm } = M.fromList          [((modm, xK_space), toSubl NextLayout),           ((modm, xK_j), onGroup W.focusDown'),           ((modm, xK_k), onGroup W.focusUp'),@@ -214,7 +216,7 @@          ]         where          -- should these go into XMonad.StackSet?-         focusMaster' st = let (f:fs) = W.integrate st+         focusMaster' st = let (notEmpty -> f :| fs) = W.integrate st             in W.Stack f [] fs          swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d @@ -240,6 +242,9 @@ -- This representation probably simplifies the internals of the modifier. type Groups a = Map a (W.Stack a) +-- | Stack of stacks, a simple representation of groups for purposes of focus.+type GroupStack a = W.Stack (W.Stack a)+ -- | GroupMsg take window parameters to determine which group the action should -- be applied to data GroupMsg a@@ -256,22 +261,21 @@     | WithGroup (W.Stack a -> X (W.Stack a)) a     | SubMessage SomeMessage  a                 -- ^ the sublayout with the given window will get the message-    deriving (Typeable)  -- | merge the window that would be focused by the function when applied to the -- W.Stack of all windows, with the current group removed. The given window -- should be focused by a sublayout. Example usage: @withFocused (sendMessage . -- mergeDir W.focusDown')@ mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window-mergeDir f w = WithGroup g w+mergeDir f = WithGroup g  where g cs = do         let onlyOthers = W.filter (`notElem` W.integrate cs)-        flip whenJust (sendMessage . Merge (W.focus cs) . W.focus . f)-            =<< fmap (onlyOthers =<<) currentStack+        (`whenJust` sendMessage . Merge (W.focus cs) . W.focus . f)+            . (onlyOthers =<<)+          =<< currentStack         return cs -data Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts-    deriving (Typeable)+newtype Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts  instance Message Broadcast instance Typeable a => Message (GroupMsg a)@@ -288,7 +292,7 @@ pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o)  mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate-mergeNav f = Apply (\o -> withFocused (f o))+mergeNav f = Apply (withFocused . f)  -- | Apply a function on the stack belonging to the currently focused group. It -- works for rearranging windows and for changing focus.@@ -299,22 +303,22 @@ toSubl :: (Message a) => a -> X () toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m)) -instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where-    modifyLayout (Sublayout { subls = osls }) (W.Workspace i la st) r = do+instance forall l. (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where+    modifyLayout Sublayout{ subls = osls } (W.Workspace i la st) r = do             let gs' = updateGroup st $ toGroups osls                 st' = W.filter (`elem` M.keys gs') =<< st             updateWs gs'-            oldStack <- gets $ W.stack . W.workspace . W.current . windowset+            oldStack <- currentStack             setStack st'             runLayout (W.Workspace i la st') r <* setStack oldStack             -- FIXME: merge back reordering, deletions? -    redoLayout (Sublayout { delayMess = I ms, def = defl, subls = osls }) _r st arrs = do+    redoLayout Sublayout{ delayMess = I ms, def = defl, subls = osls } _r st arrs = do         let gs' = updateGroup st $ toGroups osls         sls <- fromGroups defl st gs' osls -        let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window) -> Bool-                    -> (Maybe (W.Stack Window)) -> X ([(Window, Rectangle)], l Window)+        let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> l Window -> Bool+                    -> Maybe (W.Stack Window) -> X ([(Window, Rectangle)], l Window)             newL rect n ol isNew sst = do                 orgStack <- currentStack                 let handle l (y,_)@@ -342,7 +346,7 @@             return $ Just $ Sublayout (I ((sm,w):ms)) defl sls          | Just (Broadcast sm) <- fromMessage m = do-            ms' <- fmap (zip (repeat sm) . W.integrate') currentStack+            ms' <- fmap (map (sm,) . W.integrate') currentStack             return $ if null ms' then Nothing                 else Just $ Sublayout (I $ ms' ++ ms) defl sls @@ -391,7 +395,7 @@             in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs  -        | otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m+        | otherwise = join <$> traverse catchLayoutMess (fromMessage m)      where gs = toGroups sls            fgs gs' = do                 st <- currentStack@@ -399,13 +403,11 @@             findGroup z = mplus (M.lookup z gs) $ listToMaybe                     $ M.elems $ M.filter ((z `elem`) . W.integrate) gs-           -- catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))-           --  This l must be the same as from the instance head,-           --  -XScopedTypeVariables should bring it into scope, but we are-           --  trying to avoid warnings with ghc-6.8.2 and avoid CPP++           catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))            catchLayoutMess x = do             let m' = x `asTypeOf` (undefined :: LayoutMessages)-            ms' <- zip (repeat $ SomeMessage m') . W.integrate'+            ms' <- map (SomeMessage m',) . W.integrate'                     <$> currentStack             return $ do guard $ not $ null ms'                         Just $ Sublayout (I $ ms' ++ ms) defl sls@@ -415,48 +417,64 @@  -- | update Group to follow changes in the workspace updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a-updateGroup mst gs =-        let flatten = concatMap W.integrate . M.elems-            news = W.integrate' mst \\ flatten gs-            deads = flatten gs \\ W.integrate' mst--            uniNew = M.union (M.fromList $ map (\n -> (n,single n)) news)-            single x = W.Stack x [] []--            -- pass through a list to update/remove keys-            remDead = M.fromList . map (\w -> (W.focus w,w))-                        . mapMaybe (W.filter (`notElem` deads)) . M.elems--            -- update the current tab group's order and focus-            followFocus hs = fromMaybe hs $ do-                f' <- W.focus `fmap` mst-                xs <- find (elem f' . W.integrate) $ M.elems hs-                xs' <- W.filter (`elem` W.integrate xs) =<< mst-                return $ M.insert f' xs' $ M.delete (W.focus xs) hs--        in remDead $ uniNew $ followFocus gs+updateGroup Nothing _ = mempty+updateGroup (Just st) gs = fromGroupStack (toGroupStack gs st) --- | rearrange the windowset to put the groups of tabs next to eachother, so+-- | rearrange the windowset to put the groups of tabs next to each other, so -- that the stack of tabs stays put. updateWs :: Groups Window -> X () updateWs = windowsMaybe . updateWs'  updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet updateWs' gs ws = do-    f <- W.peek ws-    let w = W.index ws-        nes = concatMap W.integrate $ mapMaybe (flip M.lookup gs) w-        ws' = W.focusWindow f $ foldr W.insertUp (foldr W.delete' ws nes) nes-    guard $ W.index ws' /= W.index ws-    return ws'+    w <- W.stack . W.workspace . W.current $ ws+    let w' = flattenGroupStack . toGroupStack gs $ w+    guard $ w /= w'+    pure $ W.modify' (const w') ws +-- | Flatten a stack of stacks.+flattenGroupStack :: GroupStack a -> W.Stack a+flattenGroupStack (W.Stack (W.Stack f lf rf) ls rs) =+    let l = lf ++ concatMap (reverse . W.integrate) ls+        r = rf ++ concatMap W.integrate rs+    in W.Stack f l r++-- | Extract Groups from a stack of stacks.+fromGroupStack :: (Ord a) => GroupStack a -> Groups a+fromGroupStack = M.fromList . map (W.focus &&& id) . W.integrate++-- | Arrange a stack of windows into a stack of stacks, according to (possibly+-- outdated) Groups.+--+-- Assumes that the groups are disjoint and there are no duplicates in the+-- stack; will result in additional duplicates otherwise. This is a reasonable+-- assumption—the rest of xmonad will mishave too—but it isn't checked+-- anywhere and there had been bugs breaking this assumption in the past.+toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a+toGroupStack gs st@(W.Stack f ls rs) =+    W.Stack (fromJust (lu f)) (mapMaybe lu ls) (mapMaybe lu rs)+  where+    wset = S.fromList (W.integrate st)+    dead = W.filter (`S.member` wset) -- drop dead windows or entire groups+    refocus s | f `elem` W.integrate s -- sync focus/order of current group+                                       = W.filter (`elem` W.integrate s) st+              | otherwise = pure s+    gs' = mapGroups (refocus <=< dead) gs+    gset = S.fromList . concatMap W.integrate . M.elems $ gs'+    -- after refocus, f is either the focused window of some group, or not in+    -- gs' at all, so `lu f` is never Nothing+    lu w | w `S.member` gset = w `M.lookup` gs'+         | otherwise = Just (W.Stack w [] []) -- singleton groups for new wins++mapGroups :: (Ord a) => (W.Stack a -> Maybe (W.Stack a)) -> Groups a -> Groups a+mapGroups f = M.fromList . map (W.focus &&& id) . mapMaybe f . M.elems+ -- | focusWindow'. focus an element of a stack, is Nothing if that element is -- absent. See also 'W.focusWindow' focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a) focusWindow' w st = do-    guard $ not $ null $ filter (w==) $ W.integrate st-    if W.focus st == w then Just st-        else focusWindow' w $ W.focusDown' st+    guard $ w `elem` W.integrate st+    return $ until ((w ==) . W.focus) W.focusDown' st  -- update only when Just windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()
XMonad/Layout/TabBarDecoration.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.TabBarDecoration+-- Description :  A layout modifier to add a bar of tabs to your layouts. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -16,12 +17,12 @@     ( -- * Usage       -- $usage       simpleTabBar, tabBar-    , def, defaultTheme, shrinkText+    , def, shrinkText     , TabBarDecoration (..), XPPosition (..)     , module XMonad.Layout.ResizeScreen     ) where -import Data.List+import XMonad.Prelude import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.Decoration@@ -30,7 +31,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.TabBarDecoration --@@ -38,15 +39,15 @@ -- -- > main = xmonad def { layoutHook = simpleTabBar $ layoutHook def} ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 'tabBar' will give you the possibility of setting a custom shrinker -- and a custom theme. ----- The deafult theme can be dynamically change with the xmonad theme--- selector. See "XMonad.Prompt.Theme". For more themse, look at+-- The default theme can be dynamically changed with the xmonad theme+-- selector. See "XMonad.Prompt.Theme". For more themes, look at -- "XMonad.Util.Themes"  -- | Add, on the top of the screen, a simple bar of tabs to a given@@ -61,7 +62,7 @@ tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a tabBar s t p = decoration s t (TabBar p) -data TabBarDecoration a = TabBar XPPosition deriving (Read, Show)+newtype TabBarDecoration a = TabBar XPPosition deriving (Read, Show)  instance Eq a => DecorationStyle TabBarDecoration a where     describeDeco  _ = "TabBar"@@ -75,4 +76,5 @@               ny  = case p of                      Top    -> y                      Bottom -> y + fi ht - fi dht+                     _      -> error "Position must be 'Top' or 'Bottom'"               nx  = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` wrs
XMonad/Layout/Tabbed.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Tabbed+-- Description :  A tabbed layout. -- Copyright   :  (c) 2007 David Roundy, Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --@@ -27,14 +28,13 @@     , simpleTabbedRightAlways, tabbedRightAlways, addTabsRightAlways     , Theme (..)     , def-    , defaultTheme     , TabbedDecoration (..)     , shrinkText, CustomShrink(CustomShrink)     , Shrinker(..)     , TabbarShown, Direction2D(..)     ) where -import Data.List+import XMonad.Prelude  import XMonad import qualified XMonad.StackSet as S@@ -43,7 +43,7 @@ import XMonad.Util.Types (Direction2D(..))  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Tabbed --@@ -67,9 +67,9 @@ -- on the workspace.  To have it always shown, use one of the layouts or -- modifiers ending in @Always@. ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. --@@ -104,13 +104,13 @@ simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def  -- | A side-tabbed layout with the default xmonad Theme.-simpleTabbedLeft, simpleTabbedRight :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) +simpleTabbedLeft, simpleTabbedRight :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)                                         Simplest Window simpleTabbedLeft = tabbedLeft shrinkText def simpleTabbedRight = tabbedRight shrinkText def  -- | A side-tabbed layout with the default xmonad Theme.-simpleTabbedLeftAlways, simpleTabbedRightAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) +simpleTabbedLeftAlways, simpleTabbedRightAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)                                                   Simplest Window simpleTabbedLeftAlways = tabbedLeftAlways shrinkText def simpleTabbedRightAlways = tabbedRightAlways shrinkText def@@ -187,7 +187,7 @@ createTabs                ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> Direction2D -> s                           -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a -createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l+createTabs sh loc tx th = decoration tx th (Tabbed loc sh)  data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq) @@ -209,7 +209,7 @@     decorationEventHook _ _ _ = return ()      pureDecoration (Tabbed lc sh) wt ht _ s wrs (w,r@(Rectangle x y wh hh))-        = if ((sh == Always && numWindows > 0) || numWindows > 1)+        = if (sh == Always && numWindows > 0) || numWindows > 1           then Just $ case lc of                         U -> upperTab                         D -> lowerTab@@ -220,14 +220,16 @@               loc k h i = k + fi ((h * fi i) `div` max 1 (fi $ length ws))               esize k h = fi $ maybe k (\i -> loc k h (i+1) - loc k h i) $ w `elemIndex` ws               wid = esize x wh-              hid = esize y hh               n k h = maybe k (loc k h) $ w `elemIndex` ws               nx = n x wh-              ny = n y hh               upperTab = Rectangle nx  y wid (fi ht)               lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht)-              leftTab = Rectangle x ny (fi wt) hid-              rightTab = Rectangle (x + fi (wh - wt)) ny (fi wt) hid+              fixHeightLoc i = y + fi ht * fi i+              fixHeightTab k = Rectangle k+                (maybe y fixHeightLoc+                 $ w `elemIndex` ws) (fi wt) (fi ht)+              rightTab = fixHeightTab (x + fi (wh - wt))+              leftTab = fixHeightTab x               numWindows = length ws     shrink (Tabbed loc _ ) (Rectangle _ _ dw dh) (Rectangle x y w h)         = case loc of
+ XMonad/Layout/TallMastersCombo.hs view
@@ -0,0 +1,520 @@+-- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards #-}++---------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.TallMastersCombo+-- Description :  A version of @Tall@ with two permanent master windows.+-- Copyright   :  (c) 2019 Ningji Wei+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ningji Wei <tidues@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout combinator that support Shrink, Expand, and IncMasterN just as the+-- 'Tall' layout, and also support operations of two master windows:+-- a main master, which is the original master window;+-- a sub master, the first window of the second pane.+-- This combinator can be nested, and has a good support for using+-- "XMonad.Layout.Tabbed" as a sublayout.+--+-----------------------------------------------------------------------------++module XMonad.Layout.TallMastersCombo (+  -- * Usage+  -- $usage+  tmsCombineTwoDefault,+  tmsCombineTwo,+  TMSCombineTwo (..),+  RowsOrColumns (..),+  (|||),++  -- * Messages+  SwitchOrientation (..),+  SwapSubMaster (..),+  FocusSubMaster (..), FocusedNextLayout (..), ChangeFocus (..),++  -- * Utilities+  ChooseWrapper (..),+  swapWindow,+  focusWindow,+  handleMessages+) where++import XMonad hiding (focus, (|||))+import qualified XMonad.Layout as LL+import XMonad.Layout.Decoration+import XMonad.Layout.Simplest (Simplest (..))+import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe)+import XMonad.StackSet (Stack (..), Workspace (..), integrate')+import qualified XMonad.StackSet as W+import XMonad.Util.Stack (zipperFocusedAtFirstOf)++---------------------------------------------------------------------------------+-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Layout.TallMastersCombo+--+-- and make sure the Choose layout operator (|||) is hidden by adding the followings:+--+-- > import XMonad hiding ((|||))+-- > import XMonad.Layout hiding ((|||))+--+-- then, add something like+--+-- > tmsCombineTwoDefault (Tall 0 (3/100) 0) simpleTabbed+--+-- This will make the 'Tall' layout as the master pane, and 'simpleTabbed' layout as the second pane.+-- You can shrink, expand, and increase more windows to the master pane just like using the+-- 'Tall' layout.+--+-- To swap and/or focus the sub master window (the first window in the second pane), you can add+-- the following key bindings+--+-- >      , ((modm .|. shiftMask, m),         sendMessage $ FocusSubMaster)+-- >      , ((modm .|. shiftMask, xK_Return), sendMessage $ SwapSubMaster)+--+-- In each pane, you can use multiple layouts with the '(|||)' combinator provided by this module,+-- and switch between them with the 'FocusedNextLayout' message. Below is one example+--+-- > layout1 = Simplest ||| Tabbed+-- > layout2 = Full ||| Tabbed ||| (RowsOrColumns True)+-- > myLayout = tmsCombineTwoDefault layout1 layout2+--+-- then add the following key binding,+--+-- >      , ((modm, w), sendMessage $ FocusedNextLayout)+--+-- Now, pressing this key will toggle the multiple layouts in the currently focused pane.+--+-- You can mirror this layout with the default 'Mirror' key binding. But to have a more natural+-- behaviors, you can use the 'SwitchOrientation' message:+--+-- >      , ((modm, xK_space), sendMessage $ SwitchOrientation)+--+-- This will not mirror the tabbed decoration, and will keep sub-layouts that made by TallMastersCombo+-- and RowsOrColumns display in natural orientations.+--+-- To merge layouts more flexibly, you can use 'tmsCombineTwo' instead.+--+-- > tmsCombineTwo False 1 (3/100) (1/3) Simplest simpleTabbed+--+-- This creates a vertical merged layout with 1 window in the master pane, and the master pane shrinks+-- and expands with a step of (3\/100), and occupies (1\/3) of the screen.+--+-- Each sub-layout have a focused window. To rotate between the focused windows across all the+-- sub-layouts, using the following messages:+--+-- >      , ((modm .|. mod1, j), sendMessage $ NextFocus)+-- >      , ((modm .|. mod1, k), sendMessage $ PrevFocus)+--+-- this let you jump to the focused window in the next/previous sub-layout.+--+--+-- Finally, this combinator can be nested. Here is one example,+--+-- @+-- subLayout  = tmsCombineTwo False 1 (3\/100) (1\/2) Simplest simpleTabbed+-- layout1    = simpleTabbed ||| subLayout+-- layout2    = subLayout ||| simpleTabbed ||| (RowsOrColumns True)+-- baseLayout = tmsCombineTwoDefault layout1 layout2+--+-- mylayouts = smartBorders $+--             avoidStruts $+--             mkToggle (FULL ?? EOT) $+--             baseLayout+-- @+--+-- this is a realization of the cool idea from+--+-- <https://www.reddit.com/r/xmonad/comments/3vkrc3/does_this_layout_exist_if_not_can_anyone_suggest/>+--+-- and is more flexible.+--++-- | A simple layout that arranges windows in a row or a column with equal sizes.+-- It can switch between row mode and column mode by listening to the message 'SwitchOrientation'.+newtype RowsOrColumns a = RowsOrColumns { rowMode :: Bool -- ^ arrange windows in rows or columns+                                        } deriving (Show, Read)++instance LayoutClass RowsOrColumns a where+  description (RowsOrColumns rows) =+    if rows then "Rows" else "Columns"++  pureLayout (RowsOrColumns rows) r s = zip ws rs+    where ws = W.integrate s+          len = length ws+          rs = if rows+               then splitVertically len r+               else splitHorizontally len r++  pureMessage RowsOrColumns{} m+    | Just Row <- fromMessage m = Just $ RowsOrColumns True+    | Just Col <- fromMessage m = Just $ RowsOrColumns False+    | otherwise = Nothing+++data TMSCombineTwo l1 l2 a =+  TMSCombineTwo { focusLst :: [a]+                , ws1 :: [a]+                , ws2 :: [a]+                , rowMod :: Bool  -- ^ merge two layouts in a column or a row+                , nMaster :: !Int     -- ^ number of windows in the master pane+                , rationInc :: !Rational -- ^ percent of screen to increment by when resizing panes+                , tallComboRatio :: !Rational -- ^ default proportion of screen occupied by master pane+                , layoutFst :: l1 a  -- ^ layout for the master pane+                , layoutSnd :: l2 a  -- ^ layout for the second pane+                }+        deriving (Show, Read)++-- | Combine two layouts l1 l2 with default behaviors.+tmsCombineTwoDefault :: (LayoutClass l1 Window, LayoutClass l2 Window) =>+                          l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window+tmsCombineTwoDefault = TMSCombineTwo [] [] [] True 1 (3/100) (1/2)++-- | A more flexible way of merging two layouts. User can specify if merge them vertical or horizontal,+-- the number of windows in the first pane (master pane), the shink and expand increment, and the proportion+-- occupied by the master pane.+tmsCombineTwo :: (LayoutClass l1 Window, LayoutClass l2 Window) =>+                  Bool -> Int -> Rational -> Rational -> l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window+tmsCombineTwo = TMSCombineTwo [] [] []++data Orientation = Row | Col deriving (Read, Show)+instance Message Orientation++-- | A message that switches the orientation of TallMasterCombo layout and the RowsOrColumns layout.+-- This is similar to the 'Mirror' message, but 'Mirror' cannot apply to hidden layouts, and when 'Mirror'+-- applies to the 'XMonad.Layout.Tabbed' decoration, it will also mirror the tabs, which may lead to unintended+-- visualizations. The 'SwitchOrientation' message refreshes layouts according to the orientation of the parent layout,+-- and will not affect the 'XMonad.Layout.Tabbed' decoration.+data SwitchOrientation = SwitchOrientation deriving (Read, Show)+instance Message SwitchOrientation++-- | This message swaps the current focused window with the sub master window (first window in the second pane).+data SwapSubMaster = SwapSubMaster deriving (Read, Show)+instance Message SwapSubMaster++-- | This message changes the focus to the sub master window (first window in the second pane).+data FocusSubMaster = FocusSubMaster deriving (Read, Show)+instance Message FocusSubMaster++-- | This message triggers the 'NextLayout' message in the pane that contains the focused window.+data FocusedNextLayout = FocusedNextLayout deriving (Read, Show)+instance Message FocusedNextLayout++-- | This is a message for changing to the previous or next focused window across all the sub-layouts.+data ChangeFocus = NextFocus | PrevFocus deriving (Read, Show)+instance Message ChangeFocus++-- instance (Typeable l1, Typeable l2, LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where+instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where+  description _ = "TallMasters"++  runLayout (Workspace wid (TMSCombineTwo f _ _ vsp nmaster delta frac layout1 layout2) s) r =+      let (s1,s2,frac',slst1,slst2) = splitStack f nmaster frac s+          (r1, r2) = if vsp+                     then splitHorizontallyBy frac' r+                     else splitVerticallyBy frac' r+      in+      do+         (ws , ml ) <- runLayout (Workspace wid layout1 s1) r1+         (ws', ml') <- runLayout (Workspace wid layout2 s2) r2+         let newlayout1 = fromMaybe layout1 ml+             newlayout2 = fromMaybe layout2 ml'+             (f1, _) = getFocused newlayout1 s1+             (f2, _) = getFocused newlayout2 s2+             fnew = f1 ++ f2+         return (ws++ws', Just $ TMSCombineTwo fnew slst1 slst2 vsp nmaster delta frac newlayout1 newlayout2)+++  handleMessage i@(TMSCombineTwo f w1 w2 vsp nmaster delta frac layout1 layout2) m+    -- messages that only traverse one level+    | Just Shrink <- fromMessage m = return . Just $ TMSCombineTwo f w1 w2 vsp nmaster delta (max 0 $ frac-delta) layout1 layout2+    | Just Expand <- fromMessage m = return . Just $ TMSCombineTwo f w1 w2 vsp nmaster delta (min 1 $ frac+delta) layout1 layout2+    | Just (IncMasterN d) <- fromMessage m =+        let w = w1++w2+            nmasterNew = min (max 0 (nmaster+d)) (length w)+            (w1',w2')  = splitAt nmasterNew w+        in return . Just $ TMSCombineTwo f w1' w2' vsp nmasterNew delta frac layout1 layout2+    | Just SwitchOrientation <- fromMessage m =+            let m1 = if vsp then SomeMessage Col else SomeMessage Row+            in+            do mlayout1 <- handleMessage layout1 m1+               mlayout2 <- handleMessage layout2 m1+               return $ mergeSubLayouts  mlayout1 mlayout2 (TMSCombineTwo f w1 w2 (not vsp) nmaster delta frac layout1 layout2) True+    | Just SwapSubMaster <- fromMessage m =+        -- first get the submaster window+        let subMaster = listToMaybe w2+        in case subMaster of+            Just mw -> do windows $ W.modify' $ swapWindow mw+                          return Nothing+            Nothing -> return Nothing+    | Just FocusSubMaster <- fromMessage m =+        -- first get the submaster window+        let subMaster = listToMaybe w2+        in case subMaster of+            Just mw -> do windows $ W.modify' $ focusWindow mw+                          return Nothing+            Nothing -> return Nothing+    | Just NextFocus <- fromMessage m =+        do+          -- All toggle message is passed to the sublayout with focused window+          mst <- gets (W.stack . W.workspace . W.current . windowset)+          let nextw = adjFocus f mst True+          case nextw of Nothing -> return Nothing+                        Just w  -> do windows $ W.modify' $ focusWindow w+                                      return Nothing+    | Just PrevFocus <- fromMessage m =+        do+          -- All toggle message is passed to the sublayout with focused window+          mst <- gets (W.stack . W.workspace . W.current . windowset)+          let prevw = adjFocus f mst False+          case prevw of Nothing -> return Nothing+                        Just w  -> do windows $ W.modify' $ focusWindow w+                                      return Nothing+    -- messages that traverse recursively+    | Just Row <- fromMessage m =+        do mlayout1 <- handleMessage layout1 (SomeMessage Col)+           mlayout2 <- handleMessage layout2 (SomeMessage Col)+           return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 False nmaster delta frac layout1 layout2) True+    | Just Col <- fromMessage m =+        do mlayout1 <- handleMessage layout1 (SomeMessage Row)+           mlayout2 <- handleMessage layout2 (SomeMessage Row)+           return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 True nmaster delta frac layout1 layout2) True+    | Just FocusedNextLayout <- fromMessage m =+       do+       -- All toggle message is passed to the sublayout with focused window+         mst <- gets (W.stack . W.workspace . W.current . windowset)+         let focId = findFocused mst w1 w2+             m1 = if vsp then SomeMessage Row else SomeMessage Col+         if focId == 1+           then do+                 mlay1 <- handleMessages layout1 [SomeMessage NextLayout, m1]+                 let mlay2 = Nothing+                 return $ mergeSubLayouts mlay1 mlay2 i True+           else do+                 let mlay1 = Nothing+                 mlay2 <- handleMessages layout2 [SomeMessage NextLayout, m1]+                 return $ mergeSubLayouts mlay1 mlay2 i True+    | otherwise =+            do+              mlayout1 <- handleMessage layout1 m+              mlayout2 <- handleMessage layout2 m+              return $ mergeSubLayouts mlayout1 mlayout2 i False++-- | Swap a given window with the focused window.+swapWindow :: (Eq a) => a -> Stack a -> Stack a+swapWindow w (Stack foc upLst downLst)+    | (us, d:ds) <- break (== w) downLst = Stack foc (reverse us ++ d : upLst) ds+    | (ds, u:us) <- break (== w)   upLst = Stack foc us (reverse ds ++ u : downLst)+    | otherwise = Stack foc upLst downLst+++-- | Focus a given window.+focusWindow :: (Eq a) => a -> Stack a -> Stack a+focusWindow w s =+  if w `elem` up s+  then focusSubMasterU w s+  else focusSubMasterD w s+  where+      focusSubMasterU win i@(Stack foc (l:ls) rs)+        | foc == win = i+        | l == win = news+        | otherwise = focusSubMasterU win news+        where+            news = Stack l ls (foc : rs)+      focusSubMasterU _ (Stack foc [] rs) =+          Stack foc [] rs+      focusSubMasterD win i@(Stack foc ls (r:rs))+        | foc == win = i+        | r == win = news+        | otherwise = focusSubMasterD win news+        where+            news = Stack r (foc : ls) rs+      focusSubMasterD _ (Stack foc ls []) =+          Stack foc ls []++-- | Merge two Maybe sublayouts.+mergeSubLayouts+  :: Maybe (l1 a)           -- ^ Left  layout+  -> Maybe (l2 a)           -- ^ Right layout+  -> TMSCombineTwo l1 l2 a  -- ^ How to combine the layouts+  -> Bool                   -- ^ Return a 'Just' no matter what+  -> Maybe (TMSCombineTwo l1 l2 a)+mergeSubLayouts ml1 ml2 (TMSCombineTwo f w1 w2 vsp nmaster delta frac l1 l2) alwaysReturn+  | alwaysReturn = Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (fromMaybe l1 ml1) (fromMaybe l2 ml2)+  | isJust ml1 || isJust ml2 = Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (fromMaybe l1 ml1) (fromMaybe l2 ml2)+  | otherwise = Nothing++findFocused :: (Eq a) => Maybe (Stack a) -> [a] -> [a] -> Int+findFocused mst w1 w2 =+        case mst of+          Nothing -> 1+          Just st -> if foc `elem` w1+                     then 1+                     else if foc `elem` w2+                          then 2+                          else 1+                     where foc = W.focus st++-- | Handle a list of messages one by one, then return the last refreshed layout.+handleMessages :: (LayoutClass l a) => l a -> [SomeMessage] -> X (Maybe (l a))+handleMessages l = foldM  handleMaybeMsg (Just l)++handleMaybeMsg :: (LayoutClass l a) => Maybe (l a) -> SomeMessage -> X (Maybe (l a))+handleMaybeMsg ml m = case ml of Just l  -> do+                                              res <- handleMessage l m+                                              return $ elseOr (Just l) res+                                 Nothing -> return Nothing++-- function for splitting given stack for TallMastersCombo Layouts+splitStack :: (Eq a) => [a] -> Int -> Rational -> Maybe (Stack a) -> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a])+splitStack f nmaster frac s =+    let slst = integrate' s+        f' = case s of (Just s') -> focus s':delete (focus s') f+                       Nothing   -> f+        snum = length slst+        (slst1, slst2) = splitAt nmaster slst+        s0 = zipperFocusedAtFirstOf f' slst+        s1' = zipperFocusedAtFirstOf f' slst1+        s2' = zipperFocusedAtFirstOf f' slst2+        (s1,s2,frac') | nmaster == 0    = (Nothing,s0,0)+                      | nmaster >= snum = (s0,Nothing,1)+                      | otherwise       = (s1',s2',frac)+    in (s1,s2,frac',slst1,slst2)++-- find adjacent window of the current focus window+type Next = Bool+adjFocus :: (Eq a) => [a] -> Maybe (Stack a) -> Next -> Maybe a+adjFocus ws ms next =+  case ms of Nothing -> Nothing+             Just s  -> let searchLst = if next+                                        then down s ++ reverse (up s)+                                        else up s ++ reverse (down s)+                        in  find (`elem` ws) searchLst++-- right biased maybe merge+elseOr :: Maybe a -> Maybe a -> Maybe a+elseOr x y = case y of+              Just _  -> y+              Nothing -> x++----------------- All the rest are for changing focus functionality -------------------++-- | A wrapper for Choose, for monitoring the current active layout. This is because+-- the original Choose layout does not export the data constructor.+data LR = L | R deriving (Show, Read, Eq)+data ChooseWrapper l r a = ChooseWrapper LR (l a) (r a) (Choose l r a) deriving (Show, Read)++data NextNoWrap = NextNoWrap deriving (Eq, Show)+instance Message NextNoWrap++handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a))+handle l m = handleMessage l (SomeMessage m)++data End = End | NoEnd++instance (GetFocused l a, GetFocused r a) => LayoutClass (ChooseWrapper l r) a where+  description (ChooseWrapper _ _ _ lr) = description lr++  runLayout (Workspace wid (ChooseWrapper d l r lr) s) rec =+    do+      let (l', r') = case d of L -> (savFocused l s, r)+                               R -> (l, savFocused r s)+      (ws, ml0) <- runLayout (Workspace wid lr s) rec+      let l1 = case ml0 of Just l0 -> Just $ ChooseWrapper d l' r' l0+                           Nothing -> Nothing+      return (ws,l1)++  handleMessage c@(ChooseWrapper d l r lr) m+    | Just NextLayout <- fromMessage m = do+        mlr' <- handleMessage lr m+        mlrf <- handle c NextNoWrap+        fstf <- handle c FirstLayout+        let mlf = elseOr fstf mlrf+            (d',l',r') = case mlf of Just (ChooseWrapper d0 l0 r0 _) -> (d0,l0,r0)+                                     Nothing                     -> (d,l,r)+        case mlr' of Just lrt -> return $ Just $ ChooseWrapper d' l' r' lrt+                     Nothing  -> return Nothing+    | Just NextNoWrap <- fromMessage m = do+        mlr' <- handleMessage lr m+        (d',l',r', end) <-+              case d of+                L -> do+                       ml <- handle l NextNoWrap+                       case ml of+                           Just l0 -> return (L, l0, r, NoEnd)+                           Nothing -> do+                                  mr <- handle r FirstLayout+                                  case mr of+                                    Just r0 -> return (R, l, r0, NoEnd)+                                    Nothing -> return (R, l, r, NoEnd)+                R -> do+                       mr <- handle r NextNoWrap+                       case mr of+                         Just r0 -> return (R, l, r0, NoEnd)+                         Nothing -> return (d, l, r, End)+        case mlr' of Just lrt -> return $ Just $ ChooseWrapper d' l' r' lrt+                     Nothing  ->+                        case end of NoEnd -> return $ Just $ ChooseWrapper d' l' r' lr+                                    End   -> return Nothing+    | Just FirstLayout <- fromMessage m = do+        mlr' <- handleMessage lr m+        (d',l',r') <- do+                        ml <- handle l FirstLayout+                        case ml of+                          Just l0 -> return (L,l0,r)+                          Nothing -> return (L,l,r)+        case mlr' of Just lrt -> return $ Just $ ChooseWrapper d' l' r' lrt+                     Nothing  -> return $ Just $ ChooseWrapper d' l' r' lr+    | otherwise = do+        mlr' <- handleMessage lr m+        case mlr' of Just lrt -> return $ Just $ ChooseWrapper d l r lrt+                     Nothing  -> return Nothing++-- | This is same as the Choose combination operator.+(|||) :: l a -> r a -> ChooseWrapper l r a+(|||) l r = ChooseWrapper L l r (l LL.||| r)++-- a subclass of layout, which contain extra method to return focused window in sub-layouts+class (LayoutClass l a) => GetFocused l a where+  getFocused :: l a -> Maybe (Stack a) -> ([a], String)+  getFocused _ ms =+    case ms of (Just s) -> ([focus s], "Base")+               Nothing  -> ([], "Base")+  savFocused :: l a -> Maybe (Stack a) -> l a+  savFocused l _ = l++instance (GetFocused l Window, GetFocused r Window) => GetFocused (TMSCombineTwo l r) Window where+  getFocused (TMSCombineTwo f _ _ _ nmaster _ frac lay1 lay2) s =+    let (s1,s2,_,_,_) = splitStack f nmaster frac s+        (f1, str1) = getFocused lay1 s1+        (f2, str2) = getFocused lay2 s2+    in  (f1 ++ f2, "TMS: " ++ show f ++ "::" ++ str1 ++ "--" ++ str2)+  savFocused i@(TMSCombineTwo f _ _ _ nmaster _ frac lay1 lay2) s =+    let (s1,s2,_,_,_) = splitStack f nmaster frac s+        (f', _) = getFocused i s+        lay1' = savFocused lay1 s1+        lay2' = savFocused lay2 s2+    in i {focusLst = f', layoutFst=lay1', layoutSnd=lay2'}++instance (GetFocused l a, GetFocused r a) => GetFocused (ChooseWrapper l r) a where+  getFocused (ChooseWrapper d l r _) s =+    case d of L -> getFocused l s+              R -> getFocused r s+  savFocused (ChooseWrapper d l r lr) s =+    let (l', r') =+                  case d of L -> (savFocused l s, r)+                            R -> (l, savFocused r s)+    in ChooseWrapper d l' r' lr++instance (Typeable a) => GetFocused Simplest a+instance (Typeable a) => GetFocused RowsOrColumns a+instance (Typeable a) => GetFocused Full a+instance (Typeable a) => GetFocused Tall a+instance (Typeable l, Typeable a, Typeable m, LayoutModifier m a, LayoutClass l a) => GetFocused (ModifiedLayout m l) a
XMonad/Layout/ThreeColumns.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ThreeColumns+-- Description :  A layout similar to @Tall@, but with three columns. -- Copyright   :  (c) Kai Grossjohann <kai@emptydomain.de> -- License     :  BSD3-style (see LICENSE) --@@ -25,14 +26,13 @@                              ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W  import Data.Ratio -import Control.Monad- -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ThreeColumns --@@ -46,18 +46,18 @@ -- resizing and the third argument specifies the initial size of the columns. -- A positive size designates the fraction of the screen that the main window -- should occupy, but if the size is negative the absolute value designates the--- fraction a slave column should occupy. If both slave columns are visible,+-- fraction a stack column should occupy. If both stack columns are visible, -- they always occupy the same amount of space. ----- The ThreeColMid variant places the main window between the slave columns.------ For more detailed instructions on editing the layoutHook see:+-- The ThreeColMid variant places the main window between the stack columns. ----- "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".   -- $screenshot--- <<http://server.c-otto.de/xmonad/ThreeColumnsMiddle.png>>+-- <<https://user-images.githubusercontent.com/50166980/156938482-ac38fdd7-eb94-4371-801b-e191cdb9a4ba.png>>  -- | Arguments are nmaster, delta, fraction data ThreeCol a = ThreeColMid { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational}@@ -89,9 +89,9 @@     | otherwise = splitVertically nmaster r1 ++ splitVertically nslave1 r2 ++ splitVertically nslave2 r3         where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r               (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r-              nslave = (n - nmaster)+              nslave = n - nmaster               nslave1 = ceiling (nslave % 2)-              nslave2 = (n - nmaster - nslave1)+              nslave2 = n - nmaster - nslave1  split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) split3HorizontallyBy middle f (Rectangle sx sy sw sh) =
XMonad/Layout/ToggleLayouts.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Layout.ToggleLayouts+-- Description :  A module to toggle between two layouts. -- Copyright    : (c) David Roundy <droundy@darcs.net> -- License      : BSD --@@ -20,10 +21,11 @@     ) where  import XMonad+import XMonad.Prelude (fromMaybe) import XMonad.StackSet (Workspace (..))  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ToggleLayouts --@@ -32,9 +34,9 @@ -- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- To toggle between layouts add a key binding like --@@ -46,10 +48,10 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show)-data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show,Typeable)+data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show) instance Message ToggleLayout  toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleLayouts lt lf a@@ -60,7 +62,7 @@                                                                  return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')      runLayout (Workspace i (ToggleLayouts False lt lf) ms) r = do (ws,mlf') <- runLayout (Workspace i lf ms) r-                                                                  return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf')+                                                                  return (ws,fmap (ToggleLayouts False lt) mlf')     description (ToggleLayouts True lt _) = description lt     description (ToggleLayouts False _ lf) = description lf     handleMessage (ToggleLayouts bool lt lf) m@@ -74,23 +76,23 @@                                           (Just lt',Just lf') -> Just $ ToggleLayouts bool lt' lf'     handleMessage (ToggleLayouts True lt lf) m         | Just ToggleLayout <- fromMessage m = do mlt' <- handleMessage lt (SomeMessage Hide)-                                                  let lt' = maybe lt id mlt'+                                                  let lt' = fromMaybe lt mlt'                                                   return $ Just $ ToggleLayouts False lt' lf         | Just (Toggle d) <- fromMessage m,           d == description lt || d == description lf =               do mlt' <- handleMessage lt (SomeMessage Hide)-                 let lt' = maybe lt id mlt'+                 let lt' = fromMaybe lt mlt'                  return $ Just $ ToggleLayouts False lt' lf         | otherwise = do mlt' <- handleMessage lt m                          return $ fmap (\lt' -> ToggleLayouts True lt' lf) mlt'     handleMessage (ToggleLayouts False lt lf) m         | Just ToggleLayout <- fromMessage m = do mlf' <- handleMessage lf (SomeMessage Hide)-                                                  let lf' = maybe lf id mlf'+                                                  let lf' = fromMaybe lf mlf'                                                   return $ Just $ ToggleLayouts True lt lf'         | Just (Toggle d) <- fromMessage m,           d == description lt || d == description lf =               do mlf' <- handleMessage lf (SomeMessage Hide)-                 let lf' = maybe lf id mlf'+                 let lf' = fromMaybe lf mlf'                  return $ Just $ ToggleLayouts True lt lf'         | otherwise = do mlf' <- handleMessage lf m-                         return $ fmap (\lf' -> ToggleLayouts False lt lf') mlf'+                         return $ fmap (ToggleLayouts False lt) mlf'
XMonad/Layout/TrackFloating.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {- |  Module      :  XMonad.Layout.TrackFloating+Description :  Let focused tiles track focused floats Copyright   :  (c) 2010 & 2013 Adam Vogt                2011 Willem Vanlint License     :  BSD-style (see xmonad/LICENSE)@@ -10,13 +11,9 @@ Stability   :  unstable Portability :  unportable -Layout modifier that tracks focus in the tiled layer while the floating layer-is in use. This is particularly helpful for tiled layouts where the focus-determines what is visible.+Provides layout modifier 'UseTransientFor': when a float has focus and is+@WM_TRANSIENT_FOR@ a tile, run the underlying layout as if that tile had focus. -The relevant bugs are Issue 4 and 306:-<http://code.google.com/p/xmonad/issues/detail?id=4>,-<http://code.google.com/p/xmonad/issues/detail?id=306> -} module XMonad.Layout.TrackFloating     (-- * Usage@@ -32,75 +29,37 @@      UseTransientFor,     ) where -import Control.Monad-import Data.Function-import Data.List-import Data.Maybe-import qualified Data.Map as M-import qualified Data.Set as S-+import XMonad.Prelude import XMonad import XMonad.Layout.LayoutModifier+import XMonad.Layout.FocusTracking+import XMonad.Util.Stack (findZ) import qualified XMonad.StackSet as W  import qualified Data.Traversable as T  -data TrackFloating a = TrackFloating-    { _wasFloating :: Bool,-      _tiledFocus :: Maybe Window }-    deriving (Read,Show,Eq)---instance LayoutModifier TrackFloating Window where-    modifyLayoutWithUpdate os@(TrackFloating _wasF mw) ws@(W.Workspace{ W.stack = ms }) r-      = do-        winset <- gets windowset-        let xCur = fmap W.focus xStack-            xStack = W.stack $ W.workspace $ W.current winset-            isF = fmap (\x -> x `M.member` W.floating winset ||-                            (let (\\\) = (S.\\) `on` (S.fromList . W.integrate')-                             in x `S.member` (xStack \\\ ms)))-                        xCur-            newStack-              -- focus is floating, so use the remembered focus point-              | Just isF' <- isF,-                isF',-                Just w <- mw,-                Just s <- ms,-                Just ns <- find ((==) w . W.focus)-                    $ zipWith const (iterate W.focusDown' s) (W.integrate s)-                = Just ns-              | otherwise-                = ms-            newState = case isF of-              Just True -> mw-              Just False | Just f <- xCur -> Just f-              _ -> Nothing-        ran <- runLayout ws{ W.stack = newStack } r-        return (ran,-                let n = TrackFloating (fromMaybe False isF) newState-                in guard (n /= os) >> Just n)-+{-# DEPRECATED TrackFloating "Use X.L.FocusTracking.FocusTracking." #-}+type TrackFloating = FocusTracking   {- | When focus is on the tiled layer, the underlying layout is run with focus on the window named by the WM_TRANSIENT_FOR property on the floating window. -} useTransientFor :: l a -> ModifiedLayout UseTransientFor l a-useTransientFor x = ModifiedLayout UseTransientFor x+useTransientFor = ModifiedLayout UseTransientFor  data UseTransientFor a = UseTransientFor deriving (Read,Show,Eq)  instance LayoutModifier UseTransientFor Window where-    modifyLayout _ ws@(W.Workspace{ W.stack = ms }) r = do-        m <- gets (W.peek . windowset)+    modifyLayout _ ws@W.Workspace{ W.stack = ms } r = do+        m <- gets (W.peek . W.view (W.tag ws) . windowset)         d <- asks display-        parent <- fmap join $ T.traverse (io . getTransientForHint d) m+        parent <- join <$> T.traverse (io . getTransientForHint d) m          s0 <- get         whenJust parent $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) }-        result <- runLayout ws{ W.stack = fromMaybe ms (liftM2 focusWin ms parent) } r+        result <- runLayout ws{ W.stack = (parent >>= \p -> findZ (p==) ms) <|> ms } r          m' <- gets (W.peek . windowset) @@ -112,16 +71,6 @@   -focusWin :: Eq a => W.Stack a -> a -> Maybe (W.Stack a)-focusWin st@(W.Stack f u d) w-        | w `elem` u || w `elem` d = Just . head . filter ((==w) . W.focus)-            $ iterate (if w `elem` u then W.focusUp'-                                        else W.focusDown') st-        | w == f = Just st-        | otherwise = Nothing--- {- $usage  Apply to your layout in a config like:@@ -158,8 +107,9 @@ * the remembered focus hasn't since been killed  -}+{-# DEPRECATED trackFloating "Use X.L.FocusTracking.focusTracking." #-} trackFloating ::  l a -> ModifiedLayout TrackFloating l a-trackFloating layout = ModifiedLayout (TrackFloating False Nothing) layout+trackFloating = focusTracking  {- $layoutModifier It also corrects focus issues for full-like layouts inside other layout
XMonad/Layout/TwoPane.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.TwoPane+-- Description :  A layout that splits the screen horizontally and shows two windows. -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -26,7 +27,7 @@ import XMonad.StackSet ( focus, up, down)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.TwoPane --@@ -35,9 +36,9 @@ -- > myLayout = TwoPane (3/100) (1/2)  ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".  data TwoPane a =     TwoPane Rational Rational@@ -55,8 +56,8 @@      handleMessage (TwoPane delta split) x =         return $ case fromMessage x of-                   Just Shrink -> Just (TwoPane delta (split - delta))-                   Just Expand -> Just (TwoPane delta (split + delta))+                   Just Shrink -> Just (TwoPane delta (max 0 (split - delta)))+                   Just Expand -> Just (TwoPane delta (min 1 (split + delta)))                    _           -> Nothing      description _ = "TwoPane"
+ XMonad/Layout/TwoPanePersistent.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.TwoPanePersistent+-- Description :  "XMonad.Layout.TwoPane" with a persistent stack window.+-- Copyright   :  (c) Chayanon Wichitrnithed+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Chayanon Wichitrnithed <namowi@gatech.edu>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This layout is the same as "XMonad.Layout.TwoPane" except that it keeps track of the slave window+-- that is alongside the master pane. In other words, it prevents the slave pane+-- from changing after the focus goes back to the master pane.++-----------------------------------------------------------------------------+++module XMonad.Layout.TwoPanePersistent+  (+    -- * Usage+    -- $usage+  TwoPanePersistent(..)+  ) where++import XMonad.StackSet (focus, up, down, Stack, Stack(..))+import XMonad hiding (focus)++-- $usage+-- Import the module in @xmonad.hs@:+--+-- > import XMonad.Layout.TwoPanePersistent+--+-- Then add the layout to the @layoutHook@:+--+-- > myLayout = TwoPanePersistent Nothing (3/100) (1/2) ||| Full ||| etc..+-- > main = xmonad def { layoutHook = myLayout }+++data TwoPanePersistent a = TwoPanePersistent+  { slaveWin :: Maybe a  -- ^ slave window; if 'Nothing' or not in the current workspace,+                         -- the window below the master will go into the slave pane+  , dFrac :: Rational -- ^ shrink/expand size+  , mFrac :: Rational -- ^ initial master size+  } deriving (Show, Read)+++instance (Show a, Eq a) => LayoutClass TwoPanePersistent a where+  doLayout l r s =+    case reverse (up s) of+      -- master is focused+      []         -> return $ focusedMaster l s r++      -- slave is focused+      (master:_) -> return $ focusedSlave l s r master+++  pureMessage (TwoPanePersistent w delta split) x =+    case fromMessage x of+      Just Shrink -> Just (TwoPanePersistent w delta (max 0 (split - delta)))+      Just Expand -> Just (TwoPanePersistent w delta (min 1 (split + delta)))+      _ -> Nothing++  description _ = "TwoPanePersistent"+++----------------------------------------------------------------------------------------++focusedMaster :: (Eq a) => TwoPanePersistent a -> Stack a -> Rectangle+              -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) )+focusedMaster (TwoPanePersistent w delta split) s r =+  let (left, right) = splitHorizontallyBy split r in+      case down s of+        -- there exist windows below the master+        (next:_) -> let nextSlave = ( [(focus s, left), (next, right)]+                                    , Just $ TwoPanePersistent (Just next) delta split )+                    in case w of+                      -- if retains state, preserve the layout+                      Just win -> if win `elem` down s && (focus s /= win)+                                  then ( [(focus s, left), (win, right)]+                                       , Just $ TwoPanePersistent w delta split )+                                  else nextSlave+                      -- if no previous state, default to the next slave window+                      Nothing -> nextSlave+++        -- the master is the only window+        []       -> ( [(focus s, r)]+                    , Just $ TwoPanePersistent Nothing delta split )++++focusedSlave :: TwoPanePersistent a -> Stack a -> Rectangle -> a+             -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) )+focusedSlave (TwoPanePersistent _ delta split) s r m =+  ( [(m, left), (focus s, right)]+  , Just $ TwoPanePersistent (Just $ focus s) delta split )+  where (left, right) = splitHorizontallyBy split r
+ XMonad/Layout/VoidBorders.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.VoidBorders+-- Description :  Set borders to 0 for all windows in the workspace.+-- Copyright   :  Wilson Sales <spoonm@spoonm.org>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <spoonm@spoonm.org>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Modifies a layout to set borders to 0 for all windows in the workspace.+--+-- Unlike "XMonad.Layout.NoBorders", the 'voidBorders' modifier will not+-- restore the window border if the windows are moved to a different workspace+-- or the layout is changed. There is, however, a companion 'normalBorders'+-- modifier which explicitly restores the border.+--+-- This modifier's primary use is to eliminate the "border flash" you get+-- while switching workspaces with the "XMonad.Layout.NoBorders" modifier.+--+-----------------------------------------------------------------------------++module XMonad.Layout.VoidBorders ( -- * Usage+                                   -- $usage+                                   voidBorders+                                 , normalBorders+                                 ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.StackSet (integrate)++-- $usage+-- You can use this module with the following in your @xmonad.hs@+-- file:+--+-- > import XMonad.Layout.VoidBorders+--+-- and modify the layouts to call 'voidBorders' on the layouts you want to+-- remove borders from windows, and 'normalBorders' on the layouts you want+-- to keep borders for:+--+-- > layoutHook = ... ||| voidBorders Full ||| normalBorders Tall ...+--+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook".++data VoidBorders a = VoidBorders deriving (Read, Show)++instance LayoutModifier VoidBorders Window where+  modifierDescription = const "VoidBorders"++  redoLayout VoidBorders _ Nothing wrs = return (wrs, Nothing)+  redoLayout VoidBorders _ (Just s) wrs = do+    mapM_ setZeroBorder $ integrate s+    return (wrs, Nothing)++voidBorders :: l Window -> ModifiedLayout VoidBorders l Window+voidBorders = ModifiedLayout VoidBorders++data NormalBorders a = NormalBorders deriving (Read, Show)++instance LayoutModifier NormalBorders Window where+  modifierDescription = const "NormalBorders"++  redoLayout NormalBorders _ Nothing wrs = return (wrs, Nothing)+  redoLayout NormalBorders _ (Just s) wrs = do+    mapM_ resetBorders $ integrate s+    return (wrs, Nothing)++normalBorders :: l Window -> ModifiedLayout NormalBorders l Window+normalBorders = ModifiedLayout NormalBorders++-- | Sets border width to 0 for every window from the specified layout.+setZeroBorder :: Window -> X ()+setZeroBorder w = setBorders w 0++-- | Resets the border to the value read from the current configuration.+resetBorders :: Window -> X ()+resetBorders w = asks (borderWidth . config) >>= setBorders w++setBorders :: Window -> Dimension -> X ()+setBorders w bw = withDisplay $ \d -> io $ setWindowBorderWidth d w bw
XMonad/Layout/WindowArranger.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances    #-}+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.WindowArranger+-- Description :  A layout modifier to move and resize windows with the keyboard. -- Copyright   :  (c) Andrea Rossato 2007 -- License     :  BSD-style (see xmonad/LICENSE) --@@ -26,16 +27,15 @@     ) where  import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier-import XMonad.Util.XUtils (fi) -import Control.Arrow-import Data.List+import Control.Arrow ((***), (>>>), (&&&), first)  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.WindowArranger -- > myLayout = layoutHook def@@ -45,9 +45,9 @@ -- -- > main = xmonad def { layoutHook = windowArrangeAll myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to define some key binding to move or resize -- windows. These are good defaults:@@ -68,7 +68,7 @@ -- >        , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage (DecreaseUp    1)) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | A layout modifier to float the windows in a workspace windowArrange :: l a -> ModifiedLayout WindowArranger l a@@ -93,7 +93,6 @@                        | MoveUp        Int                        | MoveDown      Int                        | SetGeometry   Rectangle-                         deriving ( Typeable ) instance Message WindowArrangerMsg  data ArrangedWindow a = WR   (a, Rectangle)@@ -163,7 +162,7 @@ getWR = memberFromList fst (==)  mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a]-mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w+mkNewAWRs b w wrs = map t . concatMap (`getWR` wrs) $ w     where t = if b then AWR else WR  removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]@@ -178,7 +177,7 @@ replaceWR wrs = foldr r []     where r x xs               | WR wr <- x = case fst wr `elemIndex` map fst wrs of-                               Just i  -> (WR $ wrs !! i):xs+                               Just i  -> WR (wrs !! i):xs                                Nothing -> x:xs               | otherwise  = x:xs
XMonad/Layout/WindowNavigation.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.WindowNavigation+-- Description :  A layout modifier to allow easy navigation of a workspace. -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -19,13 +20,13 @@                                    -- $usage                                    windowNavigation, configurableNavigation,                                    Navigate(..), Direction2D(..),-                                   MoveWindowToWindow(..),+                                   MoveWindowToWindow(..), WNConfig,                                    navigateColor, navigateBrightness,-                                   noNavigateBorders, defaultWNConfig, def,-                                   WNConfig, WindowNavigation,+                                   noNavigateBorders, def,+                                   WindowNavigation,                                   ) where -import Data.List ( nub, sortBy, (\\) )+import XMonad.Prelude ( nub, sortBy, (\\) ) import XMonad hiding (Point) import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier@@ -34,19 +35,19 @@ import XMonad.Util.XUtils  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.WindowNavigation ----- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier+-- Then edit your 'layoutHook' by adding the WindowNavigation layout modifier -- to some layout: ----- > myLayout = windowNavigation (Tall 1 (3/100) (1/2))  ||| Full ||| etc..+-- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the 'layoutHook' see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In keybindings: --@@ -61,17 +62,24 @@ -- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable )+data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show) instance Typeable a => Message (MoveWindowToWindow a)  data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D               | Apply (Window -> X()) Direction2D -- ^ Apply action with destination window-        deriving ( Typeable ) instance Message Navigate +-- | Used with 'configurableNavigation' to specify how to show reachable windows'+-- borders. You cannot create 'WNConfig' values directly; use 'def' or one of the following+-- three functions to create one.+--+-- 'def', and 'windowNavigation', uses the focused border color at 40% brightness, as if+-- you had specified+--+-- > configurableNavigation (navigateBrightness 0.4) data WNConfig =     WNC { brightness    :: Maybe Double -- Indicates a fraction of the focus color.         , upColor       :: String@@ -80,22 +88,22 @@         , rightColor    :: String         } deriving (Show, Read) +-- | Don't use window borders for navigation. noNavigateBorders :: WNConfig noNavigateBorders =     def {brightness = Just 0} +-- | Indicate reachable windows by drawing their borders in the specified color. navigateColor :: String -> WNConfig navigateColor c =     WNC Nothing c c c c +-- | Indicate reachable windows by drawing their borders in the active border color, with+-- the specified brightness. navigateBrightness :: Double -> WNConfig navigateBrightness f = def { brightness = Just $ max 0 $ min 1 f }  instance Default WNConfig where def = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"--{-# DEPRECATED defaultWNConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.WindowNavigation) instead." #-}-defaultWNConfig :: WNConfig-defaultWNConfig = def  data NavigationState a = NS Point [(a,Rectangle)]
XMonad/Layout/WindowSwitcherDecoration.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.WindowSwitcherDecoration+-- Description :  Switch the position of windows by dragging them onto each other. -- Copyright   :  (c) Jan Vornberger 2009 --                    Alejandro Serrano 2010 -- License     :  BSD3-style (see LICENSE)@@ -30,12 +31,12 @@ import XMonad.Layout.ImageButtonDecoration import XMonad.Layout.DraggingVisualizer import qualified XMonad.StackSet as S-import Control.Monad+import XMonad.Prelude import Foreign.C.Types(CInt)  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Layout.WindowSwitcherDecoration -- > import XMonad.Layout.DraggingVisualizer@@ -75,7 +76,7 @@            -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True -data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read)+newtype WindowSwitcherDecoration a = WSD Bool deriving (Show, Read)  instance Eq a => DecorationStyle WindowSwitcherDecoration a where     describeDeco _ = "WindowSwitcherDeco"@@ -83,10 +84,10 @@     decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons                                                                     then titleBarButtonHandler mainw dFL dFR                                                                     else return False-    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+    decorationWhileDraggingHook _ = handleTiledDraggingInProgress     decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw                                                           hasCrossed <- handleScreenCrossing mainw decoWin-                                                          unless hasCrossed $ do sendMessage $ DraggingStopped+                                                          unless hasCrossed $ do sendMessage DraggingStopped                                                                                  performWindowSwitching mainw  -- Note: the image button code is duplicated from the above@@ -96,7 +97,7 @@            -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True -data ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read)+newtype ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read)  instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where     describeDeco _ = "ImageWindowSwitcherDeco"@@ -104,10 +105,10 @@     decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons                                                                     then imageTitleBarButtonHandler mainw dFL dFR                                                                     else return False-    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+    decorationWhileDraggingHook _ = handleTiledDraggingInProgress     decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw                                                           hasCrossed <- handleScreenCrossing mainw decoWin-                                                          unless hasCrossed $ do sendMessage $ DraggingStopped+                                                          unless hasCrossed $ do sendMessage DraggingStopped                                                                                  performWindowSwitching mainw  handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()@@ -126,13 +127,11 @@        ws <- gets windowset        let allWindows = S.index ws        -- do a little double check to be sure-       if (win `elem` allWindows) && (selWin `elem` allWindows)-            then do+       when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do                 let allWindowsSwitched = map (switchEntries win selWin) allWindows-                let (ls, t:rs) = break (win ==) allWindowsSwitched+                let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched                 let newStack = S.Stack t (reverse ls) rs-                windows $ S.modify' $ \_ -> newStack-            else return ()+                windows $ S.modify' $ const newStack     where         switchEntries a b x             | x == a    = b
XMonad/Layout/WorkspaceDir.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.WorkspaceDir+-- Description :  A layout modifier to set the current directory in a workspace. -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -27,10 +28,11 @@                                    workspaceDir,                                    changeDir,                                    WorkspaceDir,+                                   Chdir(Chdir),                                   ) where  import System.Directory ( setCurrentDirectory, getCurrentDirectory )-import Control.Monad ( when )+import XMonad.Prelude ( when )  import XMonad hiding ( focus ) import XMonad.Prompt ( XPConfig )@@ -39,7 +41,7 @@ import XMonad.StackSet ( tag, currentTag )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.WorkspaceDir --@@ -49,23 +51,28 @@ -- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2))  ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:------ "XMonad.Doc.Extending#Editing_the_layout_hook"+-- For more detailed instructions on editing the layoutHook see+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and+-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- WorkspaceDir provides also a prompt. To use it you need to import -- "XMonad.Prompt" and add something like this to your key bindings: -- -- >  , ((modm .|. shiftMask, xK_x     ), changeDir def) --+-- If you prefer a prompt with case-insensitive completion:+--+-- >  , ((modm .|. shiftMask, xK_x     ),+--       changeDir def {complCaseSensitivity = CaseInSensitive})+-- -- For detailed instruction on editing the key binding see: ----- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data Chdir = Chdir String deriving ( Typeable )+newtype Chdir = Chdir String instance Message Chdir -data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show )+newtype WorkspaceDir a = WorkspaceDir String deriving ( Read, Show )  instance LayoutModifier WorkspaceDir Window where     modifyLayout (WorkspaceDir d) w r = do tc <- gets (currentTag.windowset)
XMonad/Layout/ZoomRow.hs view
@@ -1,11 +1,12 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses-  , PatternGuards, DeriveDataTypeable, ExistentialQuantification+  , PatternGuards, ExistentialQuantification   , FlexibleContexts #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.ZoomRow+-- Description :  Row layout with individually resizable elements. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -35,12 +36,11 @@                              ) where  import XMonad+import XMonad.Prelude (fromMaybe, fi) import qualified XMonad.StackSet as W  import XMonad.Util.Stack-import XMonad.Layout.Decoration (fi) -import Data.Maybe (fromMaybe) import Control.Arrow (second)  -- $usage@@ -49,7 +49,7 @@ -- and decreased, and a window can be set to use the whole available -- space whenever it has focus. ----- You can use this module by including  the following in your @~\/.xmonad/xmonad.hs@:+-- You can use this module by including  the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ZoomRow --@@ -69,8 +69,9 @@ -- >   -- (Un)Maximize the focused window -- > , ((modMask             , xK_f    ), sendMessage ToggleZoomFull) ----- For more information on editing your layout hook and key bindings,--- see "XMonad.Doc.Extending".+-- For more information on editing your layoutHook and key bindings,+-- see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>+-- and "XMonad.Doc.Extending".  -- * Creation functions @@ -106,7 +107,7 @@                           -- ^ Function to compare elements for                           -- equality, a real Eq instance might                           -- not be what you want in some cases-                      , zoomRatios :: (Zipper (Elt a))+                      , zoomRatios :: Zipper (Elt a)                           -- ^ Element specs. The zipper is so we                           -- know what the focus is when we handle                           --  a message@@ -163,7 +164,7 @@                  | ZoomFullToggle                  -- ^ Toggle whether the focused window should                  -- occupy all available space when it has focus-  deriving (Typeable, Show)+  deriving (Show)  instance Message ZoomMessage @@ -185,7 +186,7 @@  -- * LayoutClass instance -instance (EQF f a, Show a, Read a, Show (f a), Read (f a))+instance (EQF f a, Show a, Read a, Show (f a), Read (f a), Typeable f)     => LayoutClass (ZoomRow f) a where     description (ZC _ Nothing) = "ZoomRow"     description (ZC _ (Just s)) = "ZoomRow" ++ if full $ W.focus s@@ -237,7 +238,7 @@                         helper (Right a:as) (Right b:bs) = a `sameAs` b && as `helper` bs                         helper (Left a:as) (Left b:bs) = a `sameAs` b && as `helper` bs                         helper _ _ = False-                        E a1 r1 b1 `sameAs` E a2 r2 b2 = (eq f a1 a2) && (r1 == r2) && (b1 == b2)+                        E a1 r1 b1 `sameAs` E a2 r2 b2 = eq f a1 a2 && (r1 == r2) && (b1 == b2)      pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm                                 , Just (E a r True) <- getFocusZ zelts
+ XMonad/Prelude.hs view
@@ -0,0 +1,514 @@+{-# OPTIONS_GHC -Wno-dodgy-imports #-}+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+--------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prelude+-- Description :  Utility functions and re-exports.+-- Copyright   :  (c) 2021  Tony Zorman+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org>+--+-- Utility functions and re-exports for a more ergonomic developing+-- experience.  Users themselves will not find much use here.+--+--------------------------------------------------------------------+module XMonad.Prelude (+    module Exports,+    fi,+    chunksOf,+    (.:),+    (!?),+    NonEmpty((:|)),+    notEmpty,+    safeGetWindowAttributes,+    mkAbsolutePath,+    findM,++    -- * Keys+    keyToString,+    keymaskToString,+    cleanKeyMask,+    regularKeys,+    allSpecialKeys,+    specialKeys,+    multimediaKeys,+    functionKeys,+    WindowScreen,++    -- * Infinite streams+    Stream(..),+    (+~),+    cycleS,+    takeS,+    toList,+    fromList,+) where++import Foreign (alloca, peek)+import XMonad++import Control.Applicative as Exports+import Control.Monad       as Exports+import Data.Bool           as Exports+import Data.Char           as Exports+import Data.Foldable       as Exports hiding (toList)+import Data.Function       as Exports+import Data.Functor        as Exports hiding (unzip)+import Data.List           as Exports hiding ((!?))+import Data.Maybe          as Exports+import Data.Monoid         as Exports+import Data.Traversable    as Exports++import qualified Data.Map.Strict as Map++import Control.Arrow ((&&&), first)+import Control.Exception (SomeException, handle)+import Data.Bifunctor (bimap)+import Data.Bits+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Tuple (swap)+import GHC.Exts (IsList(..))+import GHC.Stack+import System.Directory (getHomeDirectory)+import System.Environment (getEnv)+import qualified XMonad.StackSet as W++-- | Short for 'fromIntegral'.+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++-- | Given a maximum length, splits a list into sublists+--+-- >>> chunksOf 5 (take 30 $ repeat 'a')+-- ["aaaaa","aaaaa","aaaaa","aaaaa","aaaaa","aaaaa"]+chunksOf :: Int -> [a] -> [[a]]+chunksOf _ [] = []+chunksOf i xs = chunk : chunksOf i rest+  where !(chunk, rest) = splitAt i xs++-- | Safe version of '(!!)'.+(!?) :: [a] -> Int -> Maybe a+(!?) xs n | n < 0 = Nothing+          | otherwise = listToMaybe $ drop n xs++-- | Multivariable composition.+--+-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)+(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b+(.:) = (.) . (.)++-- | Like 'find', but takes a monadic function instead; retains the+-- short-circuiting behaviour of the non-monadic version.+--+-- For example,+--+-- > findM (\a -> putStr (show a <> " ") >> pure False) [1..10]+--+-- would print "1 2 3 4 5 6 7 8 9 10" and return @Nothing@, while+--+-- > findM (\a -> putStr (show a <> " ") >> pure True) [1..10]+--+-- would print @"1"@ and return @Just 1@.+findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)+findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)++-- | 'Data.List.NonEmpty.fromList' with a better error message. Useful to+-- silence GHC's Pattern match(es) are non-exhaustive warning in places where+-- the programmer knows it's always non-empty, but it's infeasible to express+-- that in the type system.+notEmpty :: HasCallStack => [a] -> NonEmpty a+notEmpty [] = error "unexpected empty list"+notEmpty (x:xs) = x :| xs++-- | A safe version of 'Graphics.X11.Xlib.Extras.getWindowAttributes'.+safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes)+safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->+  xGetWindowAttributes dpy w p >>= \case+    0 -> pure Nothing+    _ -> Just <$> peek p++-- | (Naïvely) turn a relative path into an absolute one.+--+-- * If the path starts with @\/@, do nothing.+--+-- * If it starts with @~\/@, replace that with the actual home+-- * directory.+--+-- * If it starts with @$@, read the name of an environment+-- * variable and replace it with the contents of that.+--+-- * Otherwise, prepend the home directory and @\/@ to the path.+mkAbsolutePath :: MonadIO m => FilePath -> m FilePath+mkAbsolutePath ps = do+  home <- io getHomeDirectory+  case ps of+    '/'       : _ -> pure ps+    '~' : '/' : _ -> pure (home <> drop 1 ps)+    '$'       : _ -> let (v,ps') = span (`elem` ("_"<>['A'..'Z']<>['a'..'z']<>['0'..'9'])) (drop 1 ps)+                      in io ((\(_ :: SomeException) -> pure "") `handle` getEnv v) Exports.<&> (<> ps')+    _             -> pure (home <> ('/' : ps))+{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}+{-# SPECIALISE mkAbsolutePath :: FilePath -> X  FilePath #-}++-----------------------------------------------------------------------+-- Keys++-- | Convert a modifier mask into a useful string.+keymaskToString :: KeyMask -- ^ Num lock mask+                -> KeyMask -- ^ Modifier mask+                -> String+keymaskToString numLockMask msk =+  concat . reverse . fst . foldr go ([], msk) $ masks+ where+  masks :: [(KeyMask, String)]+  masks = map (\m -> (m, show m))+              [0 .. toEnum (finiteBitSize msk - 1)]+       ++ [ (numLockMask, "num-" )+          , (lockMask,    "lock-")+          , (controlMask, "C-"   )+          , (shiftMask,   "S-"   )+          , (mod5Mask,    "M5-"  )+          , (mod4Mask,    "M4-"  )+          , (mod3Mask,    "M3-"  )+          , (mod2Mask,    "M2-"  )+          , (mod1Mask,    "M1-"  )+          ]++  go :: (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)+  go (m, s) a@(ss, v)+    | v == 0       = a+    | v .&. m == m = (s : ss, v .&. complement m)+    | otherwise    = a++-- | Convert a full key combination; i.e., a 'KeyMask' and 'KeySym'+-- pair, into a string.+keyToString :: (KeyMask, KeySym) -> String+keyToString = uncurry (++) . bimap (keymaskToString 0) ppKeysym+ where+  ppKeysym :: KeySym -> String+  ppKeysym x = case specialMap Map.!? x of+    Just s  -> "<" <> s <> ">"+    Nothing -> case regularMap Map.!? x of+      Nothing -> keysymToString x+      Just s  -> s++  regularMap = Map.fromList (map swap regularKeys)+  specialMap = Map.fromList (map swap allSpecialKeys)++-- | Strip numlock, capslock, mouse buttons and XKB group from a 'KeyMask',+-- leaving only modifier keys like Shift, Control, Super, Hyper in the mask+-- (hence the \"Key\" in \"cleanKeyMask\").+--+-- Core's 'cleanMask' only strips the first two because key events from+-- passive grabs (key bindings) are stripped of mouse buttons and XKB group by+-- the X server already for compatibility reasons. For more info, see:+-- <https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.html#Delivering_a_Key_or_Button_Event_to_a_Client>+cleanKeyMask :: X (KeyMask -> KeyMask)+cleanKeyMask = cleanKeyMask' <$> gets numberlockMask++cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask+cleanKeyMask' numLockMask mask =+    mask .&. complement (numLockMask .|. lockMask) .&. (button1Mask - 1)++-- | A list of "regular" (extended ASCII) keys.+regularKeys :: [(String, KeySym)]+regularKeys = map (first (:[]))+            $ zip ['!'             .. '~'          ] -- ASCII+                  [xK_exclam       .. xK_asciitilde]+           <> zip ['\xa0'          .. '\xff'       ] -- Latin1+                  [xK_nobreakspace .. xK_ydiaeresis]++-- | A list of all special key names and their associated KeySyms.+allSpecialKeys :: [(String, KeySym)]+allSpecialKeys = functionKeys <> specialKeys <> multimediaKeys++-- | A list pairing function key descriptor strings (e.g. @\"\<F2\>\"@)+-- with the associated KeySyms.+functionKeys :: [(String, KeySym)]+functionKeys = [ ('F' : show n, k)+               | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..]+               ]++-- | A list of special key names and their corresponding KeySyms.+specialKeys :: [(String, KeySym)]+specialKeys =+  [ ("Backspace"  , xK_BackSpace)+  , ("Tab"        , xK_Tab)+  , ("Return"     , xK_Return)+  , ("Pause"      , xK_Pause)+  , ("Num_Lock"   , xK_Num_Lock)+  , ("Caps_Lock"  , xK_Caps_Lock)+  , ("Scroll_lock", xK_Scroll_Lock)+  , ("Sys_Req"    , xK_Sys_Req)+  , ("Print"      , xK_Print)+  , ("Escape"     , xK_Escape)+  , ("Esc"        , xK_Escape)+  , ("Delete"     , xK_Delete)+  , ("Home"       , xK_Home)+  , ("Left"       , xK_Left)+  , ("Up"         , xK_Up)+  , ("Right"      , xK_Right)+  , ("Down"       , xK_Down)+  , ("L"          , xK_Left)+  , ("U"          , xK_Up)+  , ("R"          , xK_Right)+  , ("D"          , xK_Down)+  , ("Page_Up"    , xK_Page_Up)+  , ("Page_Down"  , xK_Page_Down)+  , ("End"        , xK_End)+  , ("Insert"     , xK_Insert)+  , ("Break"      , xK_Break)+  , ("Space"      , xK_space)+  , ("Control_L"  , xK_Control_L)+  , ("Control_R"  , xK_Control_R)+  , ("Shift_L"    , xK_Shift_L)+  , ("Shift_R"    , xK_Shift_R)+  , ("Alt_L"      , xK_Alt_L)+  , ("Alt_R"      , xK_Alt_R)+  , ("Meta_L"     , xK_Meta_L)+  , ("Meta_R"     , xK_Meta_R)+  , ("Super_L"    , xK_Super_L)+  , ("Super_R"    , xK_Super_R)+  , ("Hyper_L"    , xK_Hyper_L)+  , ("Hyper_R"    , xK_Hyper_R)+  , ("KP_Space"   , xK_KP_Space)+  , ("KP_Tab"     , xK_KP_Tab)+  , ("KP_Enter"   , xK_KP_Enter)+  , ("KP_F1"      , xK_KP_F1)+  , ("KP_F2"      , xK_KP_F2)+  , ("KP_F3"      , xK_KP_F3)+  , ("KP_F4"      , xK_KP_F4)+  , ("KP_Home"    , xK_KP_Home)+  , ("KP_Left"    , xK_KP_Left)+  , ("KP_Up"      , xK_KP_Up)+  , ("KP_Right"   , xK_KP_Right)+  , ("KP_Down"    , xK_KP_Down)+  , ("KP_Prior"   , xK_KP_Prior)+  , ("KP_Page_Up" , xK_KP_Page_Up)+  , ("KP_Next"    , xK_KP_Next)+  , ("KP_Page_Down", xK_KP_Page_Down)+  , ("KP_End"     , xK_KP_End)+  , ("KP_Begin"   , xK_KP_Begin)+  , ("KP_Insert"  , xK_KP_Insert)+  , ("KP_Delete"  , xK_KP_Delete)+  , ("KP_Equal"   , xK_KP_Equal)+  , ("KP_Multiply", xK_KP_Multiply)+  , ("KP_Add"     , xK_KP_Add)+  , ("KP_Separator", xK_KP_Separator)+  , ("KP_Subtract", xK_KP_Subtract)+  , ("KP_Decimal" , xK_KP_Decimal)+  , ("KP_Divide"  , xK_KP_Divide)+  , ("KP_0"       , xK_KP_0)+  , ("KP_1"       , xK_KP_1)+  , ("KP_2"       , xK_KP_2)+  , ("KP_3"       , xK_KP_3)+  , ("KP_4"       , xK_KP_4)+  , ("KP_5"       , xK_KP_5)+  , ("KP_6"       , xK_KP_6)+  , ("KP_7"       , xK_KP_7)+  , ("KP_8"       , xK_KP_8)+  , ("KP_9"       , xK_KP_9)+  , ("Menu"       , xK_Menu)+  ]++-- | List of multimedia keys. If Xlib does not know about some keysym+-- it's omitted from the list ('stringToKeysym' returns 'noSymbol' in+-- this case).+multimediaKeys :: [(String, KeySym)]+multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $+  [ "XF86ModeLock"+  , "XF86MonBrightnessUp"+  , "XF86MonBrightnessDown"+  , "XF86KbdLightOnOff"+  , "XF86KbdBrightnessUp"+  , "XF86KbdBrightnessDown"+  , "XF86Standby"+  , "XF86AudioLowerVolume"+  , "XF86AudioMute"+  , "XF86AudioRaiseVolume"+  , "XF86AudioPlay"+  , "XF86AudioStop"+  , "XF86AudioPrev"+  , "XF86AudioNext"+  , "XF86HomePage"+  , "XF86Mail"+  , "XF86Start"+  , "XF86Search"+  , "XF86AudioRecord"+  , "XF86Calculator"+  , "XF86Memo"+  , "XF86ToDoList"+  , "XF86Calendar"+  , "XF86PowerDown"+  , "XF86ContrastAdjust"+  , "XF86RockerUp"+  , "XF86RockerDown"+  , "XF86RockerEnter"+  , "XF86Back"+  , "XF86Forward"+  , "XF86Stop"+  , "XF86Refresh"+  , "XF86PowerOff"+  , "XF86WakeUp"+  , "XF86Eject"+  , "XF86ScreenSaver"+  , "XF86WWW"+  , "XF86Sleep"+  , "XF86Favorites"+  , "XF86AudioPause"+  , "XF86AudioMedia"+  , "XF86MyComputer"+  , "XF86VendorHome"+  , "XF86LightBulb"+  , "XF86Shop"+  , "XF86History"+  , "XF86OpenURL"+  , "XF86AddFavorite"+  , "XF86HotLinks"+  , "XF86BrightnessAdjust"+  , "XF86Finance"+  , "XF86Community"+  , "XF86AudioRewind"+  , "XF86BackForward"+  , "XF86Launch0"+  , "XF86Launch1"+  , "XF86Launch2"+  , "XF86Launch3"+  , "XF86Launch4"+  , "XF86Launch5"+  , "XF86Launch6"+  , "XF86Launch7"+  , "XF86Launch8"+  , "XF86Launch9"+  , "XF86LaunchA"+  , "XF86LaunchB"+  , "XF86LaunchC"+  , "XF86LaunchD"+  , "XF86LaunchE"+  , "XF86LaunchF"+  , "XF86ApplicationLeft"+  , "XF86ApplicationRight"+  , "XF86Book"+  , "XF86CD"+  , "XF86Calculater"+  , "XF86Clear"+  , "XF86Close"+  , "XF86Copy"+  , "XF86Cut"+  , "XF86Display"+  , "XF86DOS"+  , "XF86Documents"+  , "XF86Excel"+  , "XF86Explorer"+  , "XF86Game"+  , "XF86Go"+  , "XF86iTouch"+  , "XF86LogOff"+  , "XF86Market"+  , "XF86Meeting"+  , "XF86MenuKB"+  , "XF86MenuPB"+  , "XF86MySites"+  , "XF86New"+  , "XF86News"+  , "XF86OfficeHome"+  , "XF86Open"+  , "XF86Option"+  , "XF86Paste"+  , "XF86Phone"+  , "XF86Q"+  , "XF86Reply"+  , "XF86Reload"+  , "XF86RotateWindows"+  , "XF86RotationPB"+  , "XF86RotationKB"+  , "XF86Save"+  , "XF86ScrollUp"+  , "XF86ScrollDown"+  , "XF86ScrollClick"+  , "XF86Send"+  , "XF86Spell"+  , "XF86SplitScreen"+  , "XF86Support"+  , "XF86TaskPane"+  , "XF86Terminal"+  , "XF86Tools"+  , "XF86Travel"+  , "XF86UserPB"+  , "XF86User1KB"+  , "XF86User2KB"+  , "XF86Video"+  , "XF86WheelButton"+  , "XF86Word"+  , "XF86Xfer"+  , "XF86ZoomIn"+  , "XF86ZoomOut"+  , "XF86Away"+  , "XF86Messenger"+  , "XF86WebCam"+  , "XF86MailForward"+  , "XF86Pictures"+  , "XF86Music"+  , "XF86TouchpadToggle"+  , "XF86AudioMicMute"+  , "XF86_Switch_VT_1"+  , "XF86_Switch_VT_2"+  , "XF86_Switch_VT_3"+  , "XF86_Switch_VT_4"+  , "XF86_Switch_VT_5"+  , "XF86_Switch_VT_6"+  , "XF86_Switch_VT_7"+  , "XF86_Switch_VT_8"+  , "XF86_Switch_VT_9"+  , "XF86_Switch_VT_10"+  , "XF86_Switch_VT_11"+  , "XF86_Switch_VT_12"+  , "XF86_Ungrab"+  , "XF86_ClearGrab"+  , "XF86_Next_VMode"+  , "XF86_Prev_VMode"+  , "XF86Bluetooth"+  , "XF86WLAN"+  ]++-- | The specialized 'W.Screen' derived from 'WindowSet'.+type WindowScreen -- FIXME move to core+    = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail++-- | An infinite stream type+data Stream a = !a :~ Stream a+infixr 5 :~++instance Functor Stream where+  fmap :: (a -> b) -> Stream a -> Stream b+  fmap f = go+   where go (x :~ xs) = f x :~ go xs++instance IsList (Stream a) where+  type (Item (Stream a)) = a++  fromList :: [a] -> Stream a+  fromList (x : xs) = x :~ fromList xs+  fromList []       = errorWithoutStackTrace "XMonad.Prelude.Stream.fromList: Can't create stream out of finite list."++  toList :: Stream a -> [a]+  toList (x :~ xs) = x : toList xs++-- | Absorb a list into an infinite stream.+(+~) :: [a] -> Stream a -> Stream a+xs +~ s = foldr (:~) s xs+infixr 5 +~++-- | Absorb a non-empty list into an infinite stream.+cycleS :: NonEmpty a -> Stream a+cycleS (x :| xs) = s where s = x :~ xs +~ s++-- | @takeS n stream@ returns the first @n@ elements of @stream@; if @n < 0@,+-- this returns the empty list.+takeS :: Int -> Stream a -> [a]+takeS n = take n . toList
XMonad/Prompt.hs view
@@ -1,1256 +1,1847 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ExistentialQuantification #-}--------------------------------------------------------------------------------- |--- Module      :  XMonad.Prompt--- Copyright   :  (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky---                    2015 Sibi Prabakaran--- License     :  BSD3------ Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>--- Stability   :  unstable--- Portability :  unportable------ A module for writing graphical prompts for XMonad-----------------------------------------------------------------------------------module XMonad.Prompt-    ( -- * Usage-      -- $usage-      mkXPrompt-    , mkXPromptWithReturn-    , mkXPromptWithModes-    , def-    , amberXPConfig-    , defaultXPConfig-    , greenXPConfig-    , XPMode-    , XPType (..)-    , XPPosition (..)-    , XPConfig (..)-    , XPrompt (..)-    , XP-    , defaultXPKeymap, defaultXPKeymap'-    , emacsLikeXPKeymap, emacsLikeXPKeymap'-    , quit-    , killBefore, killAfter, startOfLine, endOfLine-    , insertString, pasteString, moveCursor-    , setInput, getInput-    , moveWord, moveWord', killWord, killWord', deleteString-    , moveHistory, setSuccess, setDone-    , Direction1D(..)-    , ComplFunction-    -- * X Utilities-    -- $xutils-    , mkUnmanagedWindow-    , fillDrawable-    -- * Other Utilities-    -- $utils-    , mkComplFunFromList-    , mkComplFunFromList'-    -- * @nextCompletion@ implementations-    , getNextOfLastWord-    , getNextCompletion-    -- * List utilities-    , getLastWord-    , skipLastWord-    , splitInSubListsAt-    , breakAtSpace-    , uniqSort-    , historyCompletion-    , historyCompletionP-    -- * History filters-    , deleteAllDuplicates-    , deleteConsecutive-    , HistoryMatches-    , initMatches-    , historyUpMatching-    , historyDownMatching-    -- * Types-    , XPState-    ) where--import           XMonad                       hiding (cleanMask, config)-import qualified XMonad                       as X (numberlockMask)-import qualified XMonad.StackSet              as W-import           XMonad.Util.Font-import           XMonad.Util.Types-import           XMonad.Util.XSelection       (getSelection)--import           Codec.Binary.UTF8.String     (decodeString,isUTF8Encoded)-import           Control.Applicative          ((<$>))-import           Control.Arrow                (first, (&&&), (***))-import           Control.Concurrent           (threadDelay)-import           Control.Exception.Extensible as E hiding (handle)-import           Control.Monad.State-import           Data.Bits-import           Data.Char                    (isSpace)-import           Data.IORef-import           Data.List-import qualified Data.Map                     as M-import           Data.Maybe                   (fromMaybe)-import           Data.Set                     (fromList, toList)-import           System.IO-import           System.Posix.Files---- $usage--- For usage examples see "XMonad.Prompt.Shell",--- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh"------ TODO:------ * scrolling the completions that don't fit in the window (?)--type XP = StateT XPState IO--data XPState =-    XPS { dpy                :: Display-        , rootw              :: !Window-        , win                :: !Window-        , screen             :: !Rectangle-        , complWin           :: Maybe Window-        , complWinDim        :: Maybe ComplWindowDim-        , complIndex         :: !(Int,Int)-        , showComplWin       :: Bool-        , operationMode      :: XPOperationMode-        , highlightedCompl   :: Maybe String-        , gcon               :: !GC-        , fontS              :: !XMonadFont-        , commandHistory     :: W.Stack String-        , offset             :: !Int-        , config             :: XPConfig-        , successful         :: Bool-        , numlockMask        :: KeyMask-        , done               :: Bool-        }--data XPConfig =-    XPC { font              :: String     -- ^ Font. For TrueType fonts, use something like-                                          -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font-                                          -- Description, i.e. something like-                                          -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@.-        , bgColor           :: String     -- ^ Background color-        , fgColor           :: String     -- ^ Font color-        , fgHLight          :: String     -- ^ Font color of a highlighted completion entry-        , bgHLight          :: String     -- ^ Background color of a highlighted completion entry-        , borderColor       :: String     -- ^ Border color-        , promptBorderWidth :: !Dimension -- ^ Border width-        , position          :: XPPosition -- ^ Position: 'Top', 'Bottom', or 'CenteredAt'-        , alwaysHighlight   :: !Bool      -- ^ Always highlight an item, overriden to True with multiple modes. This implies having *one* column of autocompletions only.-        , height            :: !Dimension -- ^ Window height-        , maxComplRows      :: Maybe Dimension-                                          -- ^ Just x: maximum number of rows to show in completion window-        , historySize       :: !Int       -- ^ The number of history entries to be saved-        , historyFilter     :: [String] -> [String]-                                         -- ^ a filter to determine which-                                         -- history entries to remember-        , promptKeymap      :: M.Map (KeyMask,KeySym) (XP ())-                                         -- ^ Mapping from key combinations to actions-        , completionKey     :: (KeyMask, KeySym)     -- ^ Key that should trigger completion-        , changeModeKey     :: KeySym     -- ^ Key to change mode (when the prompt has multiple modes)-        , defaultText       :: String     -- ^ The text by default in the prompt line-        , autoComplete      :: Maybe Int  -- ^ Just x: if only one completion remains, auto-select it,-                                          --   and delay by x microseconds-        , showCompletionOnTab :: Bool     -- ^ Only show list of completions when Tab was pressed-        , searchPredicate   :: String -> String -> Bool-                                          -- ^ Given the typed string and a possible-                                          --   completion, is the completion valid?-        }--data XPType = forall p . XPrompt p => XPT p-type ComplFunction = String -> IO [String]-type XPMode = XPType-data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType)--instance Show XPType where-    show (XPT p) = showXPrompt p--instance XPrompt XPType where-    showXPrompt                 = show-    nextCompletion      (XPT t) = nextCompletion      t-    commandToComplete   (XPT t) = commandToComplete   t-    completionToCommand (XPT t) = completionToCommand t-    completionFunction  (XPT t) = completionFunction  t-    modeAction          (XPT t) = modeAction          t---- | The class prompt types must be an instance of. In order to--- create a prompt you need to create a data type, without parameters,--- and make it an instance of this class, by implementing a simple--- method, 'showXPrompt', which will be used to print the string to be--- displayed in the command line window.------ This is an example of a XPrompt instance definition:------ >     instance XPrompt Shell where--- >          showXPrompt Shell = "Run: "-class XPrompt t where--    -- | This method is used to print the string to be-    -- displayed in the command line window.-    showXPrompt :: t -> String--    -- | This method is used to generate the next completion to be-    -- printed in the command line when tab is pressed, given the-    -- string presently in the command line and the list of-    -- completion.-    -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True)-    nextCompletion :: t -> String -> [String] -> String-    nextCompletion = getNextOfLastWord--    -- | This method is used to generate the string to be passed to-    -- the completion function.-    commandToComplete :: t -> String -> String-    commandToComplete _ = getLastWord--    -- | This method is used to process each completion in order to-    -- generate the string that will be compared with the command-    -- presently displayed in the command line. If the prompt is using-    -- 'getNextOfLastWord' for implementing 'nextCompletion' (the-    -- default implementation), this method is also used to generate,-    -- from the returned completion, the string that will form the-    -- next command line when tab is pressed.-    completionToCommand :: t -> String -> String-    completionToCommand _ c = c--    -- | When the prompt has multiple modes, this is the function-    -- used to generate the autocompletion list.-    -- The argument passed to this function is given by `commandToComplete`-    -- The default implementation shows an error message.-    completionFunction :: t -> ComplFunction-    completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"]--    -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called-    -- when the user picks an item from the autocompletion list.-    -- The first argument is the prompt (or mode) on which the item was picked-    -- The first string argument is the autocompleted item's text.-    -- The second string argument is the query made by the user (written in the prompt's buffer).-    -- See XMonad/Actions/Launcher.hs for a usage example.-    modeAction :: t -> String -> String -> X ()-    modeAction _ _ _ = return ()--data XPPosition = Top-                | Bottom-                -- | Prompt will be placed in the center horizontally and-                --   in the certain place of screen vertically. If it's in the upper-                --   part of the screen, completion window will be placed below(like-                --   in 'Top') and otherwise above(like in 'Bottom')-                | CenteredAt { xpCenterY :: Rational-                             -- ^ Rational between 0 and 1, giving-                             -- y coordinate of center of the prompt relative to the screen height.-                             , xpWidth  :: Rational-                             -- ^ Rational between 0 and 1, giving-                             -- width of the prompt relatave to the screen width.-                             }-                  deriving (Show,Read)--amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig--instance Default XPConfig where-  def =-    XPC { font              = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"-        , bgColor           = "grey22"-        , fgColor           = "grey80"-        , fgHLight          = "black"-        , bgHLight          = "grey"-        , borderColor       = "white"-        , promptBorderWidth = 1-        , promptKeymap      = defaultXPKeymap-        , completionKey     = (0,xK_Tab)-        , changeModeKey     = xK_grave-        , position          = Bottom-        , height            = 18-        , maxComplRows      = Nothing-        , historySize       = 256-        , historyFilter     = id-        , defaultText       = []-        , autoComplete      = Nothing-        , showCompletionOnTab = False-        , searchPredicate   = isPrefixOf-        , alwaysHighlight   = False-        }-{-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-}-defaultXPConfig = def-greenXPConfig = def { fgColor = "green", bgColor = "black", promptBorderWidth = 0 }-amberXPConfig = def { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" }--initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode-          -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState-initState d rw w s opMode gc fonts h c nm =-    XPS { dpy                = d-        , rootw              = rw-        , win                = w-        , screen             = s-        , complWin           = Nothing-        , complWinDim        = Nothing-        , showComplWin       = not (showCompletionOnTab c)-        , operationMode      = opMode-        , highlightedCompl   = Nothing-        , gcon               = gc-        , fontS              = fonts-        , commandHistory     = W.Stack { W.focus = defaultText c-                                       , W.up    = []-                                       , W.down  = h }-        , complIndex         = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True-        , offset             = length (defaultText c)-        , config             = c-        , successful         = False-        , done               = False-        , numlockMask        = nm-        }---- Returns the current XPType-currentXPMode :: XPState -> XPType-currentXPMode st = case operationMode st of-  XPMultipleModes modes -> W.focus modes-  XPSingleMode _ xptype -> xptype---- When in multiple modes, this function sets the next mode--- in the list of modes as active-setNextMode :: XPState -> XPState-setNextMode st = case operationMode st of-  XPMultipleModes modes -> case W.down modes of-    [] -> st -- there is no next mode, return same state-    (m:ms) -> let-      currentMode = W.focus modes-      in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack-  _ -> st --nothing to do, the prompt's operation has only one mode---- Returns the highlighted item-highlightedItem :: XPState -> [String] -> Maybe String-highlightedItem st' completions = case complWinDim st' of-  Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are-  Just winDim ->-    let-      (_,_,_,_,xx,yy) = winDim-      complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions)-      (col_index,row_index) = (complIndex st')-    in case completions of-      [] -> Nothing-      _ -> Just $ complMatrix !! col_index !! row_index---- this would be much easier with functional references-command :: XPState -> String-command = W.focus . commandHistory--setCommand :: String -> XPState -> XPState-setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }}--setHighlightedCompl :: Maybe String -> XPState -> XPState-setHighlightedCompl hc st = st { highlightedCompl = hc}---- | Sets the input string to the given value.-setInput :: String -> XP ()-setInput = modify . setCommand---- | Returns the current input string. Intented for use in custom keymaps--- where the 'get' or similar can't be used to retrieve it.-getInput :: XP String-getInput = gets command---- | Same as 'mkXPrompt', except that the action function can have---   type @String -> X a@, for any @a@, and the final action returned---   by 'mkXPromptWithReturn' will have type @X (Maybe a)@.  @Nothing@---   is yielded if the user cancels the prompt (by e.g. hitting Esc or---   Ctrl-G).  For an example of use, see the 'XMonad.Prompt.Input'---   module.-mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a)  -> X (Maybe a)-mkXPromptWithReturn t conf compl action = do-  XConf { display = d, theRoot = rw } <- ask-  s    <- gets $ screenRect . W.screenDetail . W.current . windowset-  hist <- io readHistory-  w    <- io $ createWin d rw conf s-  io $ selectInput d w $ exposureMask .|. keyPressMask-  gc <- io $ createGC d w-  io $ setGraphicsExposures d gc False-  fs <- initXMF (font conf)-  numlock <- gets $ X.numberlockMask-  let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist-      om = (XPSingleMode compl (XPT t)) --operation mode-      st = initState d rw w s om gc fs hs conf numlock-  st' <- io $ execStateT runXP st--  releaseXMF fs-  io $ freeGC d gc-  if successful st' then do-    let-      prune = take (historySize conf)--    io $ writeHistory $ M.insertWith-      (\xs ys -> prune . historyFilter conf $ xs ++ ys)-      (showXPrompt t)-      (prune $ historyFilter conf [command st'])-      hist-                                -- we need to apply historyFilter before as well, since-                                -- otherwise the filter would not be applied if-                                -- there is no history-      --When alwaysHighlight is True, autocompletion is handled with indexes.-      --When it is false, it is handled depending on the prompt buffer's value-    let selectedCompletion = case alwaysHighlight (config st') of-          False -> command st'-          True -> fromMaybe (command st') $ highlightedCompl st'-    Just <$> action selectedCompletion-    else return Nothing---- | Creates a prompt given:------ * a prompt type, instance of the 'XPrompt' class.------ * a prompt configuration ('def' can be used as a starting point)------ * a completion function ('mkComplFunFromList' can be used to--- create a completions function given a list of possible completions)------ * an action to be run: the action must take a string and return 'XMonad.X' ()-mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()-mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return ()---- | Creates a prompt with multiple modes given:------ * A non-empty list of modes--- * A prompt configuration------ The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are--- instances of XPrompt. See XMonad.Actions.Launcher for more details------ The argument supplied to the action to execute is always the current highlighted item,--- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.-mkXPromptWithModes :: [XPType] -> XPConfig -> X ()-mkXPromptWithModes modes conf = do-  XConf { display = d, theRoot = rw } <- ask-  s    <- gets $ screenRect . W.screenDetail . W.current . windowset-  hist <- io readHistory-  w    <- io $ createWin d rw conf s-  io $ selectInput d w $ exposureMask .|. keyPressMask-  gc <- io $ createGC d w-  io $ setGraphicsExposures d gc False-  fs <- initXMF (font conf)-  numlock <- gets $ X.numberlockMask-  let-    defaultMode = head modes-    hs = fromMaybe [] $ M.lookup (showXPrompt defaultMode) hist-    modeStack = W.Stack{ W.focus = defaultMode --current mode-                       , W.up = []-                       , W.down = tail modes --other modes-                       }-    st = initState d rw w s (XPMultipleModes modeStack) gc fs hs conf { alwaysHighlight = True} numlock-  st' <- io $ execStateT runXP st--  releaseXMF fs-  io $ freeGC d gc--  if successful st' then do-    let-      prune = take (historySize conf)--      -- insert into history the buffers value-    io $ writeHistory $ M.insertWith-      (\xs ys -> prune . historyFilter conf $ xs ++ ys)-      (showXPrompt defaultMode)-      (prune $ historyFilter conf [command st'])-      hist--    case operationMode st' of-      XPMultipleModes ms -> let-        action = modeAction $ W.focus ms-        in action (command st') $ (fromMaybe "" $ highlightedCompl st')-      _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode-    else-      return ()---runXP :: XP ()-runXP = do-  (d,w) <- gets (dpy &&& win)-  status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime-  when (status == grabSuccess) $ do-          updateWindows-          eventLoop handle-          io $ ungrabKeyboard d currentTime-  io $ destroyWindow d w-  destroyComplWin-  io $ sync d False--type KeyStroke = (KeySym, String)--eventLoop :: (KeyStroke -> Event -> XP ()) -> XP ()-eventLoop action = do-  d <- gets dpy-  (keysym,string,event) <- io $-            allocaXEvent $ \e -> do-              maskEvent d (exposureMask .|. keyPressMask) e-              ev <- getEvent e-              (ks,s) <- if ev_event_type ev == keyPress-                        then lookupString $ asKeyEvent e-                        else return (Nothing, "")-              return (ks,s,ev)-  action (fromMaybe xK_VoidSymbol keysym,string) event-  gets done >>= flip unless (eventLoop handle)---- | Removes numlock and capslock from a keymask.--- Duplicate of cleanMask from core, but in the--- XP monad instead of X.-cleanMask :: KeyMask -> XP KeyMask-cleanMask msk = do-  numlock <- gets numlockMask-  let highMasks = 1 `shiftL` 12 - 1-  return (complement (numlock .|. lockMask) .&. msk .&. highMasks)---- Main event handler-handle :: KeyStroke -> Event -> XP ()-handle ks@(sym,_) e@(KeyEvent {ev_event_type = t, ev_state = m}) = do-  complKey <- gets $ completionKey . config-  chgModeKey <- gets $ changeModeKey . config-  c <- getCompletions-  mCleaned <- cleanMask m-  when (length c > 1) $ modify (\s -> s { showComplWin = True })-  if complKey == (mCleaned,sym)-     then completionHandle c ks e-     else if (sym == chgModeKey) then-           do-             modify setNextMode-             updateWindows-          else when (t == keyPress) $ keyPressHandle mCleaned ks-handle _ (ExposeEvent {ev_window = w}) = do-  st <- get-  when (win st == w) updateWindows-handle _  _ = return ()---- completion event handler-completionHandle ::  [String] -> KeyStroke -> Event -> XP ()-completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = do-  complKey <- gets $ completionKey . config-  alwaysHlight <- gets $ alwaysHighlight . config-  mCleaned <- cleanMask m-  case () of-    () | t == keyPress && (mCleaned,sym) == complKey -> do-           st <- get--           let updateWins  l = redrawWindows l >> eventLoop (completionHandle l)-               updateState l = case alwaysHlight of-                 False                                           -> simpleComplete l st-                 True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st-                      | otherwise                                -> alwaysHighlightNext l st--           case c of-             []  -> updateWindows   >> eventLoop handle-             [x] -> updateState [x] >> getCompletions >>= updateWins-             l   -> updateState l   >> updateWins l-      | t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c)-      | otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally-  where-    -- When alwaysHighlight is off, just complete based on what the-    -- user has typed so far.-    simpleComplete :: [String] -> XPState -> XP ()-    simpleComplete l st = do-      let newCommand = nextCompletion (currentXPMode st) (command st) l-      modify $ \s -> setCommand newCommand $-                     s { offset = length newCommand-                       , highlightedCompl = Just newCommand-                       }--    -- If alwaysHighlight is on, and this is the first use of the-    -- completion key, update the buffer so that it contains the-    -- current completion item.-    alwaysHighlightCurrent :: XPState -> XP ()-    alwaysHighlightCurrent st = do-      let newCommand = fromMaybe (command st) $ highlightedItem st c-      modify $ \s -> setCommand newCommand $-                     setHighlightedCompl (Just newCommand) $-                     s { offset = length newCommand-                       }--    -- If alwaysHighlight is on, and the user wants the next-    -- completion, move to the next completion item and update the-    -- buffer to reflect that.-    ---    --TODO: Scroll or paginate results-    alwaysHighlightNext :: [String] -> XPState -> XP ()-    alwaysHighlightNext l st = do-      let complIndex' = nextComplIndex st (length l)-          highlightedCompl' = highlightedItem st { complIndex = complIndex'} c-          newCommand = fromMaybe (command st) $ highlightedCompl'-      modify $ \s -> setHighlightedCompl highlightedCompl' $-                     setCommand newCommand $-                     s { complIndex = complIndex'-                       , offset = length newCommand-                       }---- some other event: go back to main loop-completionHandle _ k e = handle k e----Receives an state of the prompt, the size of the autocompletion list and returns the column,row---which should be highlighted next-nextComplIndex :: XPState -> Int -> (Int,Int)-nextComplIndex st nitems = case complWinDim st of-  Nothing -> (0,0) --no window dims (just destroyed or not created)-  Just (_,_,_,_,_,yy) -> let-    (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy)-    (currentcol,currentrow) = complIndex st-    in if (currentcol + 1 >= ncols) then --hlight is in the last column-         if (currentrow + 1 < nrows ) then --hlight is still not at the last row-           (currentcol, currentrow + 1)-         else-           (0,0)-       else if(currentrow + 1 < nrows) then --hlight not at the last row-              (currentcol, currentrow + 1)-            else-              (currentcol + 1, 0)--tryAutoComplete :: XP Bool-tryAutoComplete = do-    ac <- gets (autoComplete . config)-    case ac of-        Just d -> do cs <- getCompletions-                     case cs of-                         [c] -> runCompleted c d >> return True-                         _   -> return False-        Nothing    -> return False-  where runCompleted cmd delay = do-            st <- get-            let new_command = nextCompletion (currentXPMode st) (command st) [cmd]-            modify $ setCommand "autocompleting..."-            updateWindows-            io $ threadDelay delay-            modify $ setCommand new_command-            return True---- KeyPresses---- | Default key bindings for prompts.  Click on the \"Source\" link---   to the right to see the complete list.  See also 'defaultXPKeymap''.-defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())-defaultXPKeymap = defaultXPKeymap' isSpace---- | A variant of 'defaultXPKeymap' which lets you specify a custom---   predicate for identifying non-word characters, which affects all---   the word-oriented commands (move\/kill word).  The default is---   'isSpace'.  For example, by default a path like @foo\/bar\/baz@---   would be considered as a single word.  You could use a predicate---   like @(\\c -> isSpace c || c == \'\/\')@ to move through or---   delete components of the path one at a time.-defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())-defaultXPKeymap' p = M.fromList $-  map (first $ (,) controlMask) -- control + <key>-  [ (xK_u, killBefore)-  , (xK_k, killAfter)-  , (xK_a, startOfLine)-  , (xK_e, endOfLine)-  , (xK_y, pasteString)-  , (xK_Right, moveWord' p Next)-  , (xK_Left, moveWord' p Prev)-  , (xK_Delete, killWord' p Next)-  , (xK_BackSpace, killWord' p Prev)-  , (xK_w, killWord' p Prev)-  , (xK_g, quit)-  , (xK_bracketleft, quit)-  ] ++-  map (first $ (,) 0)-  [ (xK_Return, setSuccess True >> setDone True)-  , (xK_KP_Enter, setSuccess True >> setDone True)-  , (xK_BackSpace, deleteString Prev)-  , (xK_Delete, deleteString Next)-  , (xK_Left, moveCursor Prev)-  , (xK_Right, moveCursor Next)-  , (xK_Home, startOfLine)-  , (xK_End, endOfLine)-  , (xK_Down, moveHistory W.focusUp')-  , (xK_Up, moveHistory W.focusDown')-  , (xK_Escape, quit)-  ]---- | A keymap with many emacs-like key bindings.  Click on the---   \"Source\" link to the right to see the complete list.---   See also 'emacsLikeXPKeymap''.-emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())-emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace---- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom---   predicate for identifying non-word characters, which affects all---   the word-oriented commands (move\/kill word).  The default is---   'isSpace'.  For example, by default a path like @foo\/bar\/baz@---   would be considered as a single word.  You could use a predicate---   like @(\\c -> isSpace c || c == \'\/\')@ to move through or---   delete components of the path one at a time.-emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())-emacsLikeXPKeymap' p = M.fromList $-  map (first $ (,) controlMask) -- control + <key>-  [ (xK_z, killBefore) --kill line backwards-  , (xK_k, killAfter) -- kill line fowards-  , (xK_a, startOfLine) --move to the beginning of the line-  , (xK_e, endOfLine) -- move to the end of the line-  , (xK_d, deleteString Next) -- delete a character foward-  , (xK_b, moveCursor Prev) -- move cursor forward-  , (xK_f, moveCursor Next) -- move cursor backward-  , (xK_BackSpace, killWord' p Prev) -- kill the previous word-  , (xK_y, pasteString)-  , (xK_g, quit)-  , (xK_bracketleft, quit)-  ] ++-  map (first $ (,) mod1Mask) -- meta key + <key>-  [ (xK_BackSpace, killWord' p Prev)-  , (xK_f, moveWord' p Next) -- move a word forward-  , (xK_b, moveWord' p Prev) -- move a word backward-  , (xK_d, killWord' p Next) -- kill the next word-  , (xK_n, moveHistory W.focusUp')-  , (xK_p, moveHistory W.focusDown')-  ]-  ++-  map (first $ (,) 0) -- <key>-  [ (xK_Return, setSuccess True >> setDone True)-  , (xK_KP_Enter, setSuccess True >> setDone True)-  , (xK_BackSpace, deleteString Prev)-  , (xK_Delete, deleteString Next)-  , (xK_Left, moveCursor Prev)-  , (xK_Right, moveCursor Next)-  , (xK_Home, startOfLine)-  , (xK_End, endOfLine)-  , (xK_Down, moveHistory W.focusUp')-  , (xK_Up, moveHistory W.focusDown')-  , (xK_Escape, quit)-  ]--keyPressHandle :: KeyMask -> KeyStroke -> XP ()-keyPressHandle m (ks,str) = do-  km <- gets (promptKeymap . config)-  case M.lookup (m,ks) km of-    Just action -> action >> updateWindows-    Nothing -> case str of-                 "" -> eventLoop handle-                 _ -> when (m .&. controlMask == 0) $ do-                                 let str' = if isUTF8Encoded str-                                               then decodeString str-                                               else str-                                 insertString str'-                                 updateWindows-                                 updateHighlightedCompl-                                 completed <- tryAutoComplete-                                 when completed $ setSuccess True >> setDone True--setSuccess :: Bool -> XP ()-setSuccess b = modify $ \s -> s { successful = b }--setDone :: Bool -> XP ()-setDone b = modify $ \s -> s { done = b }---- KeyPress and State---- | Quit.-quit :: XP ()-quit = flushString >> setSuccess False >> setDone True---- | Kill the portion of the command before the cursor-killBefore :: XP ()-killBefore =-  modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset  = 0 }---- | Kill the portion of the command including and after the cursor-killAfter :: XP ()-killAfter =-  modify $ \s -> setCommand (take (offset s) (command s)) s---- | Kill the next\/previous word, using 'isSpace' as the default---   predicate for non-word characters.  See 'killWord''.-killWord :: Direction1D -> XP ()-killWord = killWord' isSpace---- | Kill the next\/previous word, given a predicate to identify---   non-word characters. First delete any consecutive non-word---   characters; then delete consecutive word characters, stopping---   just before the next non-word character.------   For example, by default (using 'killWord') a path like---   @foo\/bar\/baz@ would be deleted in its entirety.  Instead you can---   use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to---   delete the path one component at a time.-killWord' :: (Char -> Bool) -> Direction1D -> XP ()-killWord' p d = do-  o <- gets offset-  c <- gets command-  let (f,ss)        = splitAt o c-      delNextWord   = snd . break p . dropWhile p-      delPrevWord   = reverse . delNextWord . reverse-      (ncom,noff)   =-          case d of-            Next -> (f ++ delNextWord ss, o)-            Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!!-  modify $ \s -> setCommand ncom $ s { offset = noff}---- | Put the cursor at the end of line-endOfLine :: XP ()-endOfLine  =-    modify $ \s -> s { offset = length (command s)}---- | Put the cursor at the start of line-startOfLine :: XP ()-startOfLine  =-    modify $ \s -> s { offset = 0 }---- |  Flush the command string and reset the offset-flushString :: XP ()-flushString = modify $ \s -> setCommand "" $ s { offset = 0}----reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions.---If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again-resetComplIndex :: XPState -> XPState-resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st---- | Insert a character at the cursor position-insertString :: String -> XP ()-insertString str =-  modify $ \s -> let-    cmd = (c (command s) (offset s))-    st = resetComplIndex $ s { offset = o (offset s)}-    in setCommand cmd st-  where o oo = oo + length str-        c oc oo | oo >= length oc = oc ++ str-                | otherwise = f ++ str ++ ss-                where (f,ss) = splitAt oo oc---- | Insert the current X selection string at the cursor position.-pasteString :: XP ()-pasteString = join $ io $ liftM insertString getSelection---- | Remove a character at the cursor position-deleteString :: Direction1D -> XP ()-deleteString d =-  modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)}-  where o oo = if d == Prev then max 0 (oo - 1) else oo-        c oc oo-            | oo >= length oc && d == Prev = take (oo - 1) oc-            | oo <  length oc && d == Prev = take (oo - 1) f ++ ss-            | oo <  length oc && d == Next = f ++ tail ss-            | otherwise = oc-            where (f,ss) = splitAt oo oc---- | move the cursor one position-moveCursor :: Direction1D -> XP ()-moveCursor d =-  modify $ \s -> s { offset = o (offset s) (command s)}-  where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1)---- | Move the cursor one word, using 'isSpace' as the default---   predicate for non-word characters.  See 'moveWord''.-moveWord :: Direction1D -> XP ()-moveWord = moveWord' isSpace---- | Move the cursor one word, given a predicate to identify non-word---   characters. First move past any consecutive non-word characters;---   then move to just before the next non-word character.-moveWord' :: (Char -> Bool) -> Direction1D -> XP ()-moveWord' p d = do-  c <- gets command-  o <- gets offset-  let (f,ss) = splitAt o c-      len = uncurry (+)-          . (length *** (length . fst . break p))-          . break (not . p)-      newoff = case d of-                 Prev -> o - len (reverse f)-                 Next -> o + len ss-  modify $ \s -> s { offset = newoff }--moveHistory :: (W.Stack String -> W.Stack String) -> XP ()-moveHistory f = do-  modify $ \s -> let ch = f $ commandHistory s-                 in s { commandHistory = ch-                      , offset         = length $ W.focus ch-                      , complIndex     = (0,0) }-  updateWindows-  updateHighlightedCompl--updateHighlightedCompl :: XP ()-updateHighlightedCompl = do-  st <- get-  cs <- getCompletions-  alwaysHighlight' <- gets $ alwaysHighlight . config-  when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs}---- X Stuff--updateWindows :: XP ()-updateWindows = do-  d <- gets dpy-  drawWin-  c <- getCompletions-  case c  of-    [] -> destroyComplWin >> return ()-    l  -> redrawComplWin l-  io $ sync d False--redrawWindows :: [String] -> XP ()-redrawWindows c = do-  d <- gets dpy-  drawWin-  case c of-    [] -> return ()-    l  -> redrawComplWin l-  io $ sync d False--createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window-createWin d rw c s = do-  let (x,y) = case position c of-                Top -> (0,0)-                Bottom -> (0, rect_height s - height c)-                CenteredAt py w -> (floor $ (fi $ rect_width s) * ((1 - w) / 2), floor $ py * fi (rect_height s) - (fi (height c) / 2))-      width = case position c of-                CenteredAt _ w -> floor $ fi (rect_width s) * w-                _              -> rect_width s-  w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw-                      (rect_x s + x) (rect_y s + fi y) width (height c)-  mapWindow d w-  return w--drawWin :: XP ()-drawWin = do-  st <- get-  let (c,(d,(w,gc))) = (config &&& dpy &&& win &&& gcon) st-      scr = defaultScreenOfDisplay d-      wh = case position c of-             CenteredAt _ wd -> floor $ wd * fi (widthOfScreen scr)-             _               -> widthOfScreen scr-      ht = height c-      bw = promptBorderWidth c-  Just bgcolor <- io $ initColor d (bgColor c)-  Just border  <- io $ initColor d (borderColor c)-  p <- io $ createPixmap d w wh ht-                         (defaultDepthOfScreen scr)-  io $ fillDrawable d p gc border bgcolor (fi bw) wh ht-  printPrompt p-  io $ copyArea d p w gc 0 0 wh ht 0 0-  io $ freePixmap d p--printPrompt :: Drawable -> XP ()-printPrompt drw = do-  st <- get-  let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st-      (prt,(com,off)) = (show . currentXPMode &&& command &&& offset) st-      str = prt ++ com-      -- break the string in 3 parts: till the cursor, the cursor and the rest-      (f,p,ss) = if off >= length com-                 then (str, " ","") -- add a space: it will be our cursor ;-)-                 else let (a,b) = (splitAt off com)-                      in (prt ++ a, [head b], tail b)-      ht = height c-  fsl <- io $ textWidthXMF (dpy st) fs f-  psl <- io $ textWidthXMF (dpy st) fs p-  (asc,desc) <- io $ textExtentsXMF fs str-  let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc-      x = (asc + desc) `div` 2--  let draw = printStringXMF d drw fs gc-  -- print the first part-  draw (fgColor c) (bgColor c) x y f-  -- reverse the colors and print the "cursor" ;-)-  draw (bgColor c) (fgColor c) (x + fromIntegral fsl) y p-  -- reverse the colors and print the rest of the string-  draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss---- get the current completion function depending on the active mode-getCompletionFunction :: XPState -> ComplFunction-getCompletionFunction st = case operationMode st of-  XPSingleMode compl _ -> compl-  XPMultipleModes modes -> completionFunction $ W.focus modes---- Completions-getCompletions :: XP [String]-getCompletions = do-  s <- get-  io $ getCompletionFunction s (commandToComplete (currentXPMode s) (command s))-       `E.catch` \(SomeException _) -> return []--setComplWin :: Window -> ComplWindowDim -> XP ()-setComplWin w wi =-  modify (\s -> s { complWin = Just w, complWinDim = Just wi })--destroyComplWin :: XP ()-destroyComplWin = do-  d  <- gets dpy-  cw <- gets complWin-  case cw of-    Just w -> do io $ destroyWindow d w-                 modify (\s -> s { complWin = Nothing, complWinDim = Nothing })-    Nothing -> return ()--type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows)-type Rows = [Position]-type Columns = [Position]--createComplWin :: ComplWindowDim -> XP Window-createComplWin wi@(x,y,wh,ht,_,_) = do-  st <- get-  let d = dpy st-      scr = defaultScreenOfDisplay d-  w <- io $ mkUnmanagedWindow d scr (rootw st)-                      x y wh ht-  io $ mapWindow d w-  setComplWin w wi-  return w--getComplWinDim :: [String] -> XP ComplWindowDim-getComplWinDim compl = do-  st <- get-  let (c,(scr,fs)) = (config &&& screen &&& fontS) st-      wh = case position c of-             CenteredAt _ w -> floor $ fi (rect_width scr) * w-             _ -> rect_width scr-      ht = height c-      bw = promptBorderWidth c--  tws <- mapM (textWidthXMF (dpy st) fs) compl-  let max_compl_len =  fromIntegral ((fi ht `div` 2) + maximum tws)-      columns = max 1 $ wh `div` fi max_compl_len-      rem_height =  rect_height scr - ht-      (rows,r) = length compl `divMod` fi columns-      needed_rows = max 1 (rows + if r == 0 then 0 else 1)-      limit_max_number = case maxComplRows c of-                           Nothing -> id-                           Just m -> min m-      actual_max_number_of_rows = limit_max_number $ rem_height `div` ht-      actual_rows = min actual_max_number_of_rows (fi needed_rows)-      actual_height = actual_rows * ht-      (x,y) = case position c of-                Top -> (0,ht - bw)-                Bottom -> (0, (0 + rem_height - actual_height + bw))-                CenteredAt py w-                  | py <= 1/2 -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) + (fi ht)/2) - bw)-                  | otherwise -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) - (fi ht)/2) - actual_height + bw)-  (asc,desc) <- io $ textExtentsXMF fs $ head compl-  let yp = fi $ (ht + fi (asc - desc)) `div` 2-      xp = (asc + desc) `div` 2-      yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..]-      xx = take (fi columns) [xp,(xp + max_compl_len)..]--  return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy)--drawComplWin :: Window -> [String] -> XP ()-drawComplWin w compl = do-  st <- get-  let c   = config st-      d   = dpy st-      scr = defaultScreenOfDisplay d-      bw  = promptBorderWidth c-      gc  = gcon st-  Just bgcolor <- io $ initColor d (bgColor c)-  Just border  <- io $ initColor d (borderColor c)--  (_,_,wh,ht,xx,yy) <- getComplWinDim compl--  p <- io $ createPixmap d w wh ht-                         (defaultDepthOfScreen scr)-  io $ fillDrawable d p gc border bgcolor (fi bw) wh ht-  let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl)--  printComplList d p gc (fgColor c) (bgColor c) xx yy ac-  --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac  ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy)-  io $ copyArea d p w gc 0 0 wh ht 0 0-  io $ freePixmap d p--redrawComplWin ::  [String] -> XP ()-redrawComplWin compl = do-  st <- get-  nwi <- getComplWinDim compl-  let recreate = do destroyComplWin-                    w <- createComplWin nwi-                    drawComplWin w compl-  if compl /= [] && showComplWin st-     then case complWin st of-            Just w -> case complWinDim st of-                        Just wi -> if nwi == wi -- complWinDim did not change-                                   then drawComplWin w compl -- so update-                                   else recreate-                        Nothing -> recreate-            Nothing -> recreate-     else destroyComplWin---- Finds the column and row indexes in which a string appears.--- if the string is not in the matrix, the indexes default to (0,0)-findComplIndex :: String -> [[String]] -> (Int,Int)-findComplIndex x xss = let-  colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss-  rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex-  in (colIndex,rowIndex)--printComplList :: Display -> Drawable -> GC -> String -> String-               -> [Position] -> [Position] -> [[String]] -> XP ()-printComplList d drw gc fc bc xs ys sss =-    zipWithM_ (\x ss ->-        zipWithM_ (\y item -> do-            st <- get-            alwaysHlight <- gets $ alwaysHighlight . config-            let (f,b) = case alwaysHlight of-                  True -> -- default to the first item, the one in (0,0)-                    let-                      (colIndex,rowIndex) = findComplIndex item sss-                    in -- assign some colors-                     if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st)-                     else (fc,bc)-                  False ->-                    -- compare item with buffer's value-                    if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st)-                    then (fgHLight $ config st,bgHLight $ config st)-                    else (fc,bc)-            printStringXMF d drw (fontS st) gc f b x y item)-        ys ss) xs sss---- History--type History = M.Map String [String]--emptyHistory :: History-emptyHistory = M.empty--getHistoryFile :: IO FilePath-getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir--readHistory :: IO History-readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory- where-    readHist = do-        path <- getHistoryFile-        xs <- bracket (openFile path ReadMode) hClose hGetLine-        readIO xs--writeHistory :: History -> IO ()-writeHistory hist = do-  path <- getHistoryFile-  let filtered = M.filter (not . null) hist-  writeFile path (show filtered) `E.catch` \(SomeException e) ->-                          hPutStrLn stderr ("error writing history: "++show e)-  setFileMode path mode-    where mode = ownerReadMode .|. ownerWriteMode---- $xutils---- | Fills a 'Drawable' with a rectangle and a border-fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel-             -> Dimension -> Dimension -> Dimension -> IO ()-fillDrawable d drw gc border bgcolor bw wh ht = do-  -- we start with the border-  setForeground d gc border-  fillRectangle d drw gc 0 0 wh ht-  -- here foreground means the background of the text-  setForeground d gc bgcolor-  fillRectangle d drw gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2))---- | Creates a window with the attribute override_redirect set to True.--- Windows Managers should not touch this kind of windows.-mkUnmanagedWindow :: Display -> Screen -> Window -> Position-                  -> Position -> Dimension -> Dimension -> IO Window-mkUnmanagedWindow d s rw x y w h = do-  let visual = defaultVisualOfScreen s-      attrmask = cWOverrideRedirect-  allocaSetWindowAttributes $-         \attributes -> do-           set_override_redirect attributes True-           createWindow d rw x y w h 0 (defaultDepthOfScreen s)-                        inputOutput visual attrmask attributes---- $utils---- | This function takes a list of possible completions and returns a--- completions function to be used with 'mkXPrompt'-mkComplFunFromList :: [String] -> String -> IO [String]-mkComplFunFromList _ [] = return []-mkComplFunFromList l s =-  return $ filter (\x -> take (length s) x == s) l---- | This function takes a list of possible completions and returns a--- completions function to be used with 'mkXPrompt'. If the string is--- null it will return all completions.-mkComplFunFromList' :: [String] -> String -> IO [String]-mkComplFunFromList' l [] = return l-mkComplFunFromList' l s =-  return $ filter (\x -> take (length s) x == s) l----- | Given the prompt type, the command line and the completion list,--- return the next completion in the list for the last word of the--- command line. This is the default 'nextCompletion' implementation.-getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String-getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni)-    where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of-                 Just i -> if i >= length l - 1 then 0 else i + 1-                 Nothing -> 0---- | An alternative 'nextCompletion' implementation: given a command--- and a completion list, get the next completion in the list matching--- the whole command line.-getNextCompletion :: String -> [String] -> String-getNextCompletion c l = l !! idx-    where idx = case c `elemIndex` l of-                  Just i  -> if i >= length l - 1 then 0 else i + 1-                  Nothing -> 0---- | Given a maximum length, splits a list into sublists-splitInSubListsAt :: Int -> [a] -> [[a]]-splitInSubListsAt _ [] = []-splitInSubListsAt i x = f : splitInSubListsAt i rest-    where (f,rest) = splitAt i x---- | Gets the last word of a string or the whole string if formed by--- only one word-getLastWord :: String -> String-getLastWord = reverse . fst . breakAtSpace . reverse---- | Skips the last word of the string, if the string is composed by--- more then one word. Otherwise returns the string.-skipLastWord :: String -> String-skipLastWord = reverse . snd . breakAtSpace . reverse--breakAtSpace :: String -> (String, String)-breakAtSpace s-    | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2')-    | otherwise = (s1, s2)-      where (s1, s2 ) = break isSpace s-            (s1',s2') = breakAtSpace $ tail s2---- | 'historyCompletion' provides a canned completion function much like---   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work---   from the query history stored in the XMonad cache directory.-historyCompletion :: ComplFunction-historyCompletion = historyCompletionP (const True)---- | Like 'historyCompletion' but only uses history data from Prompts whose--- name satisfies the given predicate.-historyCompletionP :: (String -> Bool) -> ComplFunction-historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory-    where toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []---- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off---   laziness and stability for efficiency.-uniqSort :: Ord a => [a] -> [a]-uniqSort = toList . fromList---- | Functions to be used with the 'historyFilter' setting.--- 'deleteAllDuplicates' will remove all duplicate entries.--- 'deleteConsecutive' will only remove duplicate elements--- immediately next to each other.-deleteAllDuplicates, deleteConsecutive :: [String] -> [String]-deleteAllDuplicates = nub-deleteConsecutive = map head . group--newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String)))---- | Initializes a new HistoryMatches structure to be passed--- to historyUpMatching-initMatches :: (Functor m, MonadIO m) => m HistoryMatches-initMatches = HistoryMatches <$> liftIO (newIORef ([],Nothing))--historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP ()-historyNextMatching hm@(HistoryMatches ref) next = do-  (completed,completions) <- io $ readIORef ref-  input <- getInput-  if input `elem` completed-     then case completions of-            Just cs -> do-                let cmd = W.focus cs-                modify $ setCommand cmd-                modify $ \s -> s { offset = length cmd }-                io $ writeIORef ref (cmd:completed,Just $ next cs)-            Nothing -> return ()-     else do -- the user typed something new, recompute completions-       io . writeIORef ref . ((,) [input]) . filterMatching input =<< gets commandHistory+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE MultiWayIf #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt+-- Copyright   :  (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky+--                    2015 Sibi Prabakaran, 2018 Yclept Nemo+-- License     :  BSD3+--+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for writing graphical prompts for XMonad+--+-----------------------------------------------------------------------------++-----------------------------------------------------------------------------+-- Bugs:+-- if 'alwaysHighlight' is True, and+--  1 type several characters+--  2 tab-complete past several entries+--  3 backspace back to the several characters+--  4 tab-complete once (results in the entry past the one in [2])+--  5 tab-complete against this shorter list of completions+-- then the prompt will freeze (XMonad continues however).+-----------------------------------------------------------------------------++module XMonad.Prompt+    ( -- * Usage+      -- $usage+      mkXPrompt+    , mkXPromptWithReturn+    , mkXPromptWithModes+    , def+    , amberXPConfig+    , greenXPConfig+    , XPMode+    , XPType (..)+    , XPColor (..)+    , XPPosition (..)+    , XPConfig (..)+    , XPrompt (..)+    , XP+    , defaultXPKeymap, defaultXPKeymap'+    , emacsLikeXPKeymap, emacsLikeXPKeymap'+    , vimLikeXPKeymap, vimLikeXPKeymap'+    , quit+    , promptSubmap, promptBuffer, toHeadChar, bufferOne+    , killBefore, killAfter, startOfLine, endOfLine+    , insertString, pasteString, pasteString'+    , clipCursor, moveCursor, moveCursorClip+    , setInput, getInput, getOffset+    , defaultColor, modifyColor, setColor+    , resetColor, setBorderColor+    , modifyPrompter, setPrompter, resetPrompter+    , selectedCompletion, setCurrentCompletions, getCurrentCompletions+    , moveWord, moveWord', killWord, killWord'+    , changeWord, deleteString+    , moveHistory, setSuccess, setDone, setModeDone+    , Direction1D(..)+    , ComplFunction+    , ComplCaseSensitivity(..)+    -- * X Utilities+    -- $xutils+    , mkUnmanagedWindow+    , fillDrawable+    -- * Other Utilities+    -- $utils+    , mkComplFunFromList+    , mkComplFunFromList'+    -- * @nextCompletion@ implementations+    , getNextOfLastWord+    , getNextCompletion+    -- * List utilities+    , getLastWord+    , skipLastWord+    , splitInSubListsAt+    , breakAtSpace+    , uniqSort+    , historyCompletion+    , historyCompletionP+    -- * History filters+    , deleteAllDuplicates+    , deleteConsecutive+    , HistoryMatches+    , initMatches+    , historyUpMatching+    , historyDownMatching+    -- * Types+    , XPState+    ) where++import           XMonad                       hiding (cleanMask, config)+import           XMonad.Prelude               hiding (toList, fromList)+import qualified XMonad.StackSet              as W+import           XMonad.Util.Font+import           XMonad.Util.Types+import           XMonad.Util.XSelection       (getSelection)++import           Codec.Binary.UTF8.String     (decodeString,isUTF8Encoded)+import           Control.Arrow                (first, (&&&), (***))+import           Control.Concurrent           (threadDelay)+import           Control.Exception            as E hiding (handle)+import           Control.Monad.State+import           Data.Bifunctor               (bimap)+import           Data.Bits+import           Data.IORef+import qualified Data.List.NonEmpty           as NE+import qualified Data.Map                     as M+import           Data.Set                     (fromList, toList)+import           System.IO+import           System.IO.Unsafe             (unsafePerformIO)+import           System.Posix.Files+import Data.List.NonEmpty (nonEmpty)++-- $usage+-- For usage examples see "XMonad.Prompt.Shell",+-- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh"+--+-- TODO:+--+-- * scrolling the completions that don't fit in the window (?)++type XP = StateT XPState IO++data XPState =+    XPS { dpy                   :: Display+        , rootw                 :: !Window+        , win                   :: !Window+        , screen                :: !Rectangle+        , winWidth              :: !Dimension -- ^ Width of the prompt window+        , complWinDim           :: Maybe ComplWindowDim+        , complIndex            :: !(Int,Int)+        , complWin              :: IORef (Maybe Window)+        -- ^ This is an 'IORef' to enable removal of the completion+        -- window if an exception occurs, since otherwise the most+        -- recent value of 'complWin' would not be available.+        , showComplWin          :: Bool+        , operationMode         :: XPOperationMode+        , highlightedCompl      :: Maybe String+        , gcon                  :: !GC+        , fontS                 :: !XMonadFont+        , commandHistory        :: W.Stack String+        , offset                :: !Int+        , config                :: XPConfig+        , successful            :: Bool+        , cleanMask             :: KeyMask -> KeyMask+        , done                  :: Bool+        , modeDone              :: Bool+        , color                 :: XPColor+        , prompter              :: String -> String+        , eventBuffer           :: [(KeySym, String, Event)]+        , inputBuffer           :: String+        , currentCompletions    :: Maybe [String]+        }++data XPConfig =+    XPC { font                  :: String       -- ^ Font. For TrueType fonts, use something like+                                                -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font+                                                -- Description, i.e. something like+                                                -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@.+        , bgColor               :: String       -- ^ Background color+        , fgColor               :: String       -- ^ Font color+        , bgHLight              :: String       -- ^ Background color of a highlighted completion entry+        , fgHLight              :: String       -- ^ Font color of a highlighted completion entry+        , borderColor           :: String       -- ^ Border color+        , promptBorderWidth     :: !Dimension   -- ^ Border width+        , position              :: XPPosition   -- ^ Position: 'Top', 'Bottom', or 'CenteredAt'+        , alwaysHighlight       :: !Bool        -- ^ Always highlight an item, overriden to True with multiple modes+        , height                :: !Dimension   -- ^ Window height+        , maxComplRows          :: Maybe Dimension+                                                -- ^ Just x: maximum number of rows to show in completion window+        , maxComplColumns       :: Maybe Dimension+                                                -- ^ Just x: maximum number of columns to show in completion window+        , historySize           :: !Int         -- ^ The number of history entries to be saved+        , historyFilter         :: [String] -> [String]+                                                -- ^ a filter to determine which+                                                -- history entries to remember+        , promptKeymap          :: M.Map (KeyMask,KeySym) (XP ())+                                                -- ^ Mapping from key combinations to actions+        , completionKey         :: (KeyMask, KeySym)     -- ^ Key to trigger forward completion+        , prevCompletionKey     :: (KeyMask, KeySym)     -- ^ Key to trigger backward completion+        , changeModeKey         :: KeySym       -- ^ Key to change mode (when the prompt has multiple modes)+        , defaultText           :: String       -- ^ The text by default in the prompt line+        , autoComplete          :: Maybe Int    -- ^ Just x: if only one completion remains, auto-select it,+                                                --   and delay by x microseconds+        , showCompletionOnTab   :: Bool         -- ^ Only show list of completions when Tab was pressed+        , complCaseSensitivity  :: ComplCaseSensitivity+                                                -- ^ Perform completion in a case-sensitive manner+        , searchPredicate       :: String -> String -> Bool+                                                -- ^ Given the typed string and a possible+                                                --   completion, is the completion valid?+        , defaultPrompter       :: String -> String+                                                -- ^ Modifies the prompt given by 'showXPrompt'+        , sorter                :: String -> [String] -> [String]+                                                -- ^ Used to sort the possible completions by how well they+                                                --   match the search string (see X.P.FuzzyMatch for an+                                                --   example).+        }++data XPType = forall p . XPrompt p => XPT p+type ComplFunction = String -> IO [String]+type XPMode = XPType+data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType)++data ComplCaseSensitivity = CaseSensitive | CaseInSensitive++instance Show XPType where+    show (XPT p) = showXPrompt p++instance XPrompt XPType where+    showXPrompt                 = show+    nextCompletion      (XPT t) = nextCompletion      t+    commandToComplete   (XPT t) = commandToComplete   t+    completionToCommand (XPT t) = completionToCommand t+    completionFunction  (XPT t) = completionFunction  t+    modeAction          (XPT t) = modeAction          t++-- | A class for an abstract prompt. In order for your data type to be a+-- valid prompt you _must_ make it an instance of this class.+--+-- The minimal complete definition is just 'showXPrompt', i.e. the name+-- of the prompt. This string will be displayed in the command line+-- window (before the cursor).+--+-- As an example of a complete 'XPrompt' instance definition, we can+-- look at the 'XMonad.Prompt.Shell.Shell' prompt from+-- "XMonad.Prompt.Shell":+--+-- >     data Shell = Shell+-- >+-- >     instance XPrompt Shell where+-- >          showXPrompt Shell = "Run: "+class XPrompt t where+    {-# MINIMAL showXPrompt #-}++    -- | This method is used to print the string to be+    -- displayed in the command line window.+    showXPrompt :: t -> String++    -- | This method is used to generate the next completion to be+    -- printed in the command line when tab is pressed, given the+    -- string presently in the command line and the list of+    -- completion.+    -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True)+    nextCompletion :: t -> String -> [String] -> String+    nextCompletion = getNextOfLastWord++    -- | This method is used to generate the string to be passed to+    -- the completion function.+    commandToComplete :: t -> String -> String+    commandToComplete _ = getLastWord++    -- | This method is used to process each completion in order to+    -- generate the string that will be compared with the command+    -- presently displayed in the command line. If the prompt is using+    -- 'getNextOfLastWord' for implementing 'nextCompletion' (the+    -- default implementation), this method is also used to generate,+    -- from the returned completion, the string that will form the+    -- next command line when tab is pressed.+    completionToCommand :: t -> String -> String+    completionToCommand _ c = c++    -- | When the prompt has multiple modes, this is the function+    -- used to generate the autocompletion list.+    -- The argument passed to this function is given by `commandToComplete`+    -- The default implementation shows an error message.+    completionFunction :: t -> ComplFunction+    completionFunction t = const $ return ["Completions for " ++ showXPrompt t ++ " could not be loaded"]++    -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called+    -- when the user picks an item from the autocompletion list.+    -- The first argument is the prompt (or mode) on which the item was picked+    -- The first string argument is the autocompleted item's text.+    -- The second string argument is the query made by the user (written in the prompt's buffer).+    -- See XMonad/Actions/Launcher.hs for a usage example.+    modeAction :: t -> String -> String -> X ()+    modeAction _ _ _ = return ()++data XPPosition = Top+                | Bottom+                -- | Prompt will be placed in the center horizontally and+                --   in the certain place of screen vertically. If it's in the upper+                --   part of the screen, completion window will be placed below (like+                --   in 'Top') and otherwise above (like in 'Bottom')+                | CenteredAt { xpCenterY :: Rational+                             -- ^ Rational between 0 and 1, giving+                             -- y coordinate of center of the prompt relative to the screen height.+                             , xpWidth  :: Rational+                             -- ^ Rational between 0 and 1, giving+                             -- width of the prompt relative to the screen width.+                             }+                  deriving (Show,Read)++data XPColor =+    XPColor { bgNormal      :: String   -- ^ Background color+            , fgNormal      :: String   -- ^ Font color+            , bgHighlight   :: String   -- ^ Background color of a highlighted completion entry+            , fgHighlight   :: String   -- ^ Font color of a highlighted completion entry+            , border        :: String   -- ^ Border color+            }++amberXPConfig, greenXPConfig :: XPConfig++instance Default XPColor where+    def =+        XPColor { bgNormal    = "grey22"+                , fgNormal    = "grey80"+                , bgHighlight = "grey"+                , fgHighlight = "black"+                , border      = "white"+                }++instance Default XPConfig where+  def =+#ifdef XFT+    XPC { font                  = "xft:monospace-12"+#else+    XPC { font                  = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"+#endif+        , bgColor               = bgNormal def+        , fgColor               = fgNormal def+        , bgHLight              = bgHighlight def+        , fgHLight              = fgHighlight def+        , borderColor           = border def+        , promptBorderWidth     = 1+        , promptKeymap          = defaultXPKeymap+        , completionKey         = (0, xK_Tab)+        , prevCompletionKey     = (shiftMask, xK_Tab)+        , changeModeKey         = xK_grave+        , position              = Bottom+        , height                = 18+        , maxComplRows          = Nothing+        , maxComplColumns       = Nothing+        , historySize           = 256+        , historyFilter         = id+        , defaultText           = []+        , autoComplete          = Nothing+        , showCompletionOnTab   = False+        , complCaseSensitivity  = CaseSensitive+        , searchPredicate       = isPrefixOf+        , alwaysHighlight       = False+        , defaultPrompter       = id+        , sorter                = const id+        }+greenXPConfig = def { bgColor           = "black"+                    , fgColor           = "green"+                    , promptBorderWidth = 0+                    }+amberXPConfig = def { bgColor   = "black"+                    , fgColor   = "#ca8f2d"+                    , fgHLight  = "#eaaf4c"+                    }++initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode+          -> GC -> XMonadFont -> [String] -> XPConfig -> (KeyMask -> KeyMask)+          -> Dimension -> XPState+initState d rw w s opMode gc fonts h c cm width =+    XPS { dpy                   = d+        , rootw                 = rw+        , win                   = w+        , screen                = s+        , winWidth              = width+        , complWinDim           = Nothing+        , complWin              = unsafePerformIO (newIORef Nothing)+        , showComplWin          = not (showCompletionOnTab c)+        , operationMode         = opMode+        , highlightedCompl      = Nothing+        , gcon                  = gc+        , fontS                 = fonts+        , commandHistory        = W.Stack { W.focus = defaultText c+                                          , W.up    = []+                                          , W.down  = h+                                          }+        , complIndex            = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True+        , offset                = length (defaultText c)+        , config                = c+        , successful            = False+        , done                  = False+        , modeDone              = False+        , cleanMask             = cm+        , prompter              = defaultPrompter c+        , color                 = defaultColor c+        , eventBuffer           = []+        , inputBuffer           = ""+        , currentCompletions    = Nothing+        }++-- Returns the current XPType+currentXPMode :: XPState -> XPType+currentXPMode st = case operationMode st of+  XPMultipleModes modes -> W.focus modes+  XPSingleMode _ xptype -> xptype++-- When in multiple modes, this function sets the next mode+-- in the list of modes as active+setNextMode :: XPState -> XPState+setNextMode st = case operationMode st of+  XPMultipleModes modes -> case W.down modes of+    [] -> st -- there is no next mode, return same state+    (m:ms) -> let+      currentMode = W.focus modes+      in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack+  _ -> st --nothing to do, the prompt's operation has only one mode++-- Returns the highlighted item+highlightedItem :: XPState -> [String] -> Maybe String+highlightedItem st' completions = case complWinDim st' of+  Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are+  Just winDim ->+    let+      ComplWindowDim{ cwCols, cwRows } = winDim+      complMatrix = chunksOf (length cwRows) (take (length cwCols * length cwRows) completions)+      (col_index,row_index) = complIndex st'+    in case completions of+      [] -> Nothing+      _  -> complMatrix !? col_index >>= (!? row_index)++-- | Return the selected completion, i.e. the 'String' we actually act+-- upon after the user confirmed their selection (by pressing @Enter@).+selectedCompletion :: XPState -> String+selectedCompletion st+    -- If 'alwaysHighlight' is used, look at the currently selected item (if any)+  | alwaysHighlight (config st) = fromMaybe (command st) $ highlightedCompl st+    -- Otherwise, look at what the user actually wrote so far+  | otherwise                   = command st++-- this would be much easier with functional references+command :: XPState -> String+command = W.focus . commandHistory++setCommand :: String -> XPState -> XPState+setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }}++-- | Sets the input string to the given value.+setInput :: String -> XP ()+setInput = modify . setCommand++-- | Returns the current input string. Intended for use in custom keymaps+-- where 'get' or similar can't be used to retrieve it.+getInput :: XP String+getInput = gets command++-- | Returns the offset of the current input string. Intended for use in custom+-- keys where 'get' or similar can't be used to retrieve it.+getOffset :: XP Int+getOffset = gets offset++-- | Accessor encapsulating disparate color fields of 'XPConfig' into an+-- 'XPColor' (the configuration provides default values).+defaultColor :: XPConfig -> XPColor+defaultColor c = XPColor { bgNormal     = bgColor c+                         , fgNormal     = fgColor c+                         , bgHighlight  = bgHLight c+                         , fgHighlight  = fgHLight c+                         , border       = borderColor c+                         }++-- | Modify the prompt colors.+modifyColor :: (XPColor -> XPColor) -> XP ()+modifyColor c = modify $ \s -> s { color = c $ color s }++-- | Set the prompt colors.+setColor :: XPColor -> XP ()+setColor = modifyColor . const++-- | Reset the prompt colors to those from 'XPConfig'.+resetColor :: XP ()+resetColor = gets (defaultColor . config) >>= setColor++-- | Set the prompt border color.+setBorderColor :: String -> XPColor -> XPColor+setBorderColor bc xpc = xpc { border = bc }++-- | Modify the prompter, i.e. for chaining prompters.+modifyPrompter :: ((String -> String) -> (String -> String)) -> XP ()+modifyPrompter p = modify $ \s -> s { prompter = p $ prompter s }++-- | Set the prompter.+setPrompter :: (String -> String) -> XP ()+setPrompter = modifyPrompter . const++-- | Reset the prompter to the one from 'XPConfig'.+resetPrompter :: XP ()+resetPrompter = gets (defaultPrompter . config) >>= setPrompter++-- | Set the current completion list, or 'Nothing' to invalidate the current+-- completions.+setCurrentCompletions :: Maybe [String] -> XP ()+setCurrentCompletions cs = modify $ \s -> s { currentCompletions = cs }++-- | Get the current completion list.+getCurrentCompletions :: XP (Maybe [String])+getCurrentCompletions = gets currentCompletions++-- | Same as 'mkXPrompt', except that the action function can have+--   type @String -> X a@, for any @a@, and the final action returned+--   by 'mkXPromptWithReturn' will have type @X (Maybe a)@.  @Nothing@+--   is yielded if the user cancels the prompt (by e.g. hitting Esc or+--   Ctrl-G).  For an example of use, see the 'XMonad.Prompt.Input'+--   module.+mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a)  -> X (Maybe a)+mkXPromptWithReturn t conf compl action = do+  st' <- mkXPromptImplementation (showXPrompt t) conf (XPSingleMode compl (XPT t))+  if successful st'+    then Just <$> action (selectedCompletion st')+    else return Nothing++-- | Creates a prompt given:+--+-- * a prompt type, instance of the 'XPrompt' class.+--+-- * a prompt configuration ('def' can be used as a starting point)+--+-- * a completion function ('mkComplFunFromList' can be used to+-- create a completions function given a list of possible completions)+--+-- * an action to be run: the action must take a string and return 'XMonad.X' ()+mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()+mkXPrompt t conf compl action = void $ mkXPromptWithReturn t conf compl action++-- | Creates a prompt with multiple modes given:+--+-- * A non-empty list of modes+-- * A prompt configuration+--+-- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are+-- instances of XPrompt. See XMonad.Actions.Launcher for more details+--+-- The argument supplied to the action to execute is always the current highlighted item,+-- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.+mkXPromptWithModes :: [XPType] -> XPConfig -> X ()+mkXPromptWithModes [] _ = pure ()+mkXPromptWithModes (defaultMode : modes) conf = do+  let modeStack = W.Stack { W.focus = defaultMode -- Current mode+                          , W.up = []+                          , W.down = modes -- Other modes+                          }+      om = XPMultipleModes modeStack+  st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om+  when (successful st') $+    case operationMode st' of+      XPMultipleModes ms -> let+        action = modeAction $ W.focus ms+        in action (command st') $ fromMaybe "" (highlightedCompl st')+      _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode++-- Internal function used to implement 'mkXPromptWithReturn' and+-- 'mkXPromptWithModes'.+mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState+mkXPromptImplementation historyKey conf om = do+  XConf { display = d, theRoot = rw } <- ask+  s <- gets $ screenRect . W.screenDetail . W.current . windowset+  cleanMask <- cleanKeyMask+  cachedir <- asks (cacheDir . directories)+  hist <- io $ readHistory conf cachedir+  fs <- initXMF (font conf)+  let width = getWinWidth s (position conf)+  st' <- io $+    bracket+      (createPromptWin d rw conf s width)+      (destroyWindow d)+      (\w ->+        bracket+          (createGC d w)+          (freeGC d)+          (\gc -> do+            selectInput d w $ exposureMask .|. keyPressMask+            setGraphicsExposures d gc False+            let hs = fromMaybe [] $ M.lookup historyKey hist+                st = initState d rw w s om gc fs hs conf cleanMask width+            runXP st))+  releaseXMF fs+  when (successful st') $ do+    let prune = take (historySize conf)+    io $ writeHistory conf cachedir $+      M.insertWith+      (\xs ys -> prune . historyFilter conf $ xs ++ ys)+      historyKey+      -- We need to apply historyFilter before as well, since+      -- otherwise the filter would not be applied if there is no+      -- history+      (prune $ historyFilter conf [selectedCompletion st'])+      hist+  return st'+ where+  -- | Based on the ultimate position of the prompt and the screen+  -- dimensions, calculate its width.+  getWinWidth :: Rectangle -> XPPosition -> Dimension+  getWinWidth scr = \case+    CenteredAt{ xpWidth } -> floor $ fi (rect_width scr) * xpWidth+    _                     -> rect_width scr++-- | Inverse of 'Codec.Binary.UTF8.String.utf8Encode', that is, a convenience+-- function that checks to see if the input string is UTF8 encoded before+-- decoding.+utf8Decode :: String -> String+utf8Decode str+    | isUTF8Encoded str = decodeString str+    | otherwise         = str++runXP :: XPState -> IO XPState+runXP st = do+  let d = dpy st+      w = win st+  bracket+    (grabKeyboard d w True grabModeAsync grabModeAsync currentTime)+    (\_ -> ungrabKeyboard d currentTime)+    (\status ->+      execStateT+        (when (status == grabSuccess) $ do+          ah <- gets (alwaysHighlight . config)+          when ah $ do+            compl <- listToMaybe <$> getCompletions+            modify' $ \xpst -> xpst{ highlightedCompl = compl }+          updateWindows+          eventLoop handleMain evDefaultStop)+        st+      `finally` (mapM_ (destroyWindow d) =<< readIORef (complWin st))+      `finally` sync d False)++type KeyStroke = (KeySym, String)++-- | Check whether the given key stroke is a modifier.+isModifier :: KeyStroke -> Bool+isModifier (_, keyString) = null keyString++-- | Main event "loop". Gives priority to events from the state's event buffer.+eventLoop :: (KeyStroke -> Event -> XP ())+          -> XP Bool+          -> XP ()+eventLoop handle stopAction = do+    b <- gets eventBuffer+    (keysym,keystr,event) <- case b of+        []  -> do+                d <- gets dpy+                io $ allocaXEvent $ \e -> do+                    -- Also capture @buttonPressMask@, see Note [Allow ButtonEvents]+                    maskEvent d (exposureMask .|. keyPressMask .|. buttonPressMask) e+                    ev <- getEvent e+                    if ev_event_type ev == keyPress+                        then do (_, s) <- lookupString $ asKeyEvent e+                                ks <- keycodeToKeysym d (ev_keycode ev) 0+                                return (ks, s, ev)+                        else return (noSymbol, "", ev)+        (l : ls) -> do+                modify $ \s -> s { eventBuffer = ls }+                return l+    handle (keysym,keystr) event+    stopAction >>= \stop -> unless stop (eventLoop handle stopAction)++-- | Default event loop stop condition.+evDefaultStop :: XP Bool+evDefaultStop = gets ((||) . modeDone) <*> gets done++-- | Common patterns shared by all event handlers.+handleOther :: KeyStroke -> Event -> XP ()+handleOther _ ExposeEvent{ev_window = w} = do+    -- Expose events can be triggered by switching virtual consoles.+    st <- get+    when (win st == w) updateWindows+handleOther _ ButtonEvent{ev_event_type = t} = do+    -- See Note [Allow ButtonEvents]+    when (t == buttonPress) $ do+        d <- gets dpy+        io $ allowEvents d replayPointer currentTime+handleOther _ _ = return ()++{- Note [Allow ButtonEvents]++Some settings (like @clickJustFocuses = False@) set up the passive+pointer grabs that xmonad makes to intercept clicks to unfocused windows+with @pointer_mode = grabModeSync@ and @keyboard_mode = grabModeSync@.+This means that any click in an unfocused window leads to a+pointer/keyboard grab that freezes both devices until 'allowEvents' is+called. But "XMonad.Prompt" has its own X event loop, so 'allowEvents'+is never called and everything remains frozen indefinitely.++This does not happen when the grabs are made with @grabModeAsync@, as+pointer events processing is not frozen and the grab only lasts as long+as the mouse button is pressed.++Hence, in this situation we call 'allowEvents' in the prompts event loop+whenever a button event is received, releasing the pointer grab. In this+case, 'replayPointer' takes care of the fact that these events are not+merely discarded, but passed to the respective application window.+-}++-- | Prompt event handler for the main loop. Dispatches to input, completion+-- and mode switching handlers.+handleMain :: KeyStroke -> Event -> XP ()+handleMain stroke@(keysym, keystr) = \case+    KeyEvent{ev_event_type = t, ev_state = m} -> do+      (prevCompKey, (compKey, modeKey)) <- gets $+          (prevCompletionKey &&& completionKey &&& changeModeKey) . config+      keymask <- gets cleanMask <*> pure m+      -- haven't subscribed to keyRelease, so just in case+      when (t == keyPress) $ if+          | (keymask, keysym) == compKey ->+               getCurrentCompletions >>= handleCompletionMain Next+          | (keymask, keysym) == prevCompKey ->+               getCurrentCompletions >>= handleCompletionMain Prev+          | otherwise -> do+               keymap <- gets (promptKeymap . config)+               let mbAction = M.lookup (keymask, keysym) keymap+               -- Either run when we can insert a valid character, or the+               -- pressed key has an action associated to it.+               unless (isModifier stroke && isNothing mbAction) $ do+                   setCurrentCompletions Nothing+                   if keysym == modeKey+                      then modify setNextMode >> updateWindows+                      else handleInput keymask mbAction+    event -> handleOther stroke event+  where+    -- Prompt input handler for the main loop.+    handleInput :: KeyMask -> Maybe (XP ()) -> XP ()+    handleInput keymask = \case+        Just action -> action >> updateWindows+        Nothing     -> when (keymask .&. controlMask == 0) $ do+            insertString $ utf8Decode keystr+            updateWindows+            updateHighlightedCompl+            complete <- tryAutoComplete+            when complete acceptSelection++-- There are two options to store the completion list during the main loop:+-- * Use the State monad, with 'Nothing' as the initial state.+-- * Join the output of the event loop handler to the input of the (same)+--   subsequent handler, using 'Nothing' as the initial input.+-- Both approaches are, under the hood, equivalent.+--+-- | Prompt completion handler for the main loop. Given 'Nothing', generate the+-- current completion list. With the current list, trigger a completion.+handleCompletionMain :: Direction1D -> Maybe [String] -> XP ()+handleCompletionMain dir compls = case compls of+   Just cs -> handleCompletion dir cs+   Nothing -> do+       cs <- getCompletions+       when (length cs > 1) $+           modify $ \s -> s { showComplWin = True }+       setCurrentCompletions $ Just cs+       handleCompletion dir cs++handleCompletion :: Direction1D -> [String] -> XP ()+handleCompletion dir cs = do+    alwaysHlight <- gets $ alwaysHighlight . config+    st <- get++    let updateWins    = redrawWindows (pure ())+        updateState l = if alwaysHlight+            then hlComplete (getLastWord $ command st) l st+            else simpleComplete                        l st++    case cs of+      []  -> updateWindows+      [x] -> do updateState [x]+                cs' <- getCompletions+                updateWins cs'+                setCurrentCompletions $ Just cs'+      l   -> updateState l   >> updateWins l+    where+        -- When alwaysHighlight is off, just complete based on what the+        -- user has typed so far.+        simpleComplete :: [String] -> XPState -> XP ()+        simpleComplete l st = do+          let newCommand = nextCompletion (currentXPMode st) (command st) l+          modify $ \s -> setCommand newCommand $+                         s { offset = length newCommand+                           , highlightedCompl = Just newCommand+                           }++        -- If alwaysHighlight is on, and the user wants the next+        -- completion, move to the next completion item and update the+        -- buffer to reflect that.+        --+        --TODO: Scroll or paginate results+        hlComplete :: String -> [String] -> XPState -> XP ()+        hlComplete prevCompl l st+          | -- The current suggestion matches the command and is a+            -- proper suffix of the last suggestion, so replace it.+            isSuffixOfCmd && isProperSuffixOfLast = replaceCompletion prevCompl++          | -- We only have one suggestion, so we need to be a little+            -- bit smart in order to avoid a loop.+            Just (ch :| []) <- nonEmpty cs =+              if command st == hlCompl+              then put st+              else replaceCompletion ch++            -- The current suggestion matches the command, so advance+            -- to the next completion and try again.+          | isSuffixOfCmd =+              hlComplete hlCompl l $ st{ complIndex = complIndex'+                                       , highlightedCompl = nextHlCompl+                                       }++            -- If nothing matches at all, delete the suggestion and+            -- highlight the next one.+          | otherwise = replaceCompletion prevCompl+         where+          hlCompl     :: String       = fromMaybe (command st) $ highlightedItem st l+          complIndex' :: (Int, Int)   = computeComplIndex dir st+          nextHlCompl :: Maybe String = highlightedItem st{ complIndex = complIndex' } cs++          isSuffixOfCmd        :: Bool = hlCompl `isSuffixOf` command st+          isProperSuffixOfLast :: Bool =      hlCompl   `isSuffixOf` prevCompl+                                      && not (prevCompl `isSuffixOf` hlCompl)++          replaceCompletion :: String -> XP () = \str -> do+              put st+              replicateM_ (length $ words str) $ killWord Prev+              insertString' hlCompl+              endOfLine++-- | Initiate a prompt sub-map event loop. Submaps are intended to provide+-- alternate keybindings. Accepts a default action and a mapping from key+-- combinations to actions. If no entry matches, the default action is run.+promptSubmap :: XP ()+             -> M.Map (KeyMask, KeySym) (XP ())+             -> XP ()+promptSubmap defaultAction keymap = do+    md <- gets modeDone+    setModeDone False+    updateWindows+    eventLoop (handleSubmap defaultAction keymap) evDefaultStop+    setModeDone md++handleSubmap :: XP ()+             -> M.Map (KeyMask, KeySym) (XP ())+             -> KeyStroke+             -> Event+             -> XP ()+handleSubmap defaultAction keymap stroke KeyEvent{ev_event_type = t, ev_state = m} = do+    keymask <- gets cleanMask <*> pure m+    when (t == keyPress) $ handleInputSubmap defaultAction keymap keymask stroke+handleSubmap _ _ stroke event = handleOther stroke event++handleInputSubmap :: XP ()+                  -> M.Map (KeyMask, KeySym) (XP ())+                  -> KeyMask+                  -> KeyStroke+                  -> XP ()+handleInputSubmap defaultAction keymap keymask stroke@(keysym, _) =+    case M.lookup (keymask,keysym) keymap of+        Just action -> action >> updateWindows+        Nothing     -> unless (isModifier stroke) $ defaultAction >> updateWindows++-- | Initiate a prompt input buffer event loop. Input is sent to a buffer and+-- bypasses the prompt. The provided function is given the existing buffer and+-- the input keystring. The first field of the result determines whether the+-- input loop continues (if @True@). The second field determines whether the+-- input is appended to the buffer, or dropped (if @False@). If the loop is to+-- stop without keeping input - that is, @(False,False)@ - the event is+-- prepended to the event buffer to be processed by the parent loop. This+-- allows loop to process both fixed and indeterminate inputs.+--+-- Result given @(continue,keep)@:+--+-- * cont and keep+--+--      * grow input buffer+--+-- * stop and keep+--+--      * grow input buffer+--      * stop loop+--+-- * stop and drop+--+--      * buffer event+--      * stop loop+--+-- * cont and drop+--+--      * do nothing+promptBuffer :: (String -> String -> (Bool,Bool)) -> XP String+promptBuffer f = do+    md <- gets modeDone+    setModeDone False+    eventLoop (handleBuffer f) evDefaultStop+    buff <- gets inputBuffer+    modify $ \s -> s { inputBuffer = "" }+    setModeDone md+    return buff++handleBuffer :: (String -> String -> (Bool,Bool))+             -> KeyStroke+             -> Event+             -> XP ()+handleBuffer f stroke event@KeyEvent{ev_event_type = t, ev_state = m} = do+    keymask <- gets cleanMask <*> pure m+    when (t == keyPress) $ handleInputBuffer f keymask stroke event+handleBuffer _ stroke event = handleOther stroke event++handleInputBuffer :: (String -> String -> (Bool,Bool))+                  -> KeyMask+                  -> KeyStroke+                  -> Event+                  -> XP ()+handleInputBuffer f keymask stroke@(keysym, keystr) event =+    unless (isModifier stroke || keymask .&. controlMask /= 0) $ do+        (evB,inB) <- gets (eventBuffer &&& inputBuffer)+        let keystr' = utf8Decode keystr+        let (cont,keep) = f inB keystr'+        when keep $+            modify $ \s -> s { inputBuffer = inB ++ keystr' }+        unless cont $+            setModeDone True+        unless (cont || keep) $+            modify $ \s -> s { eventBuffer = (keysym,keystr,event) : evB }++-- | Predicate instructing 'promptBuffer' to get (and keep) a single non-empty+-- 'KeyEvent'.+bufferOne :: String -> String -> (Bool,Bool)+bufferOne xs x = (null xs && null x,True)++-- | Return the @(column, row)@ of the desired highlight, or @(0, 0)@ if+-- there is no prompt window or a wrap-around occurs.+computeComplIndex :: Direction1D -> XPState -> (Int, Int)+computeComplIndex dir st = case complWinDim st of+  Nothing -> (0, 0)  -- no window dimensions (just destroyed or not created)+  Just ComplWindowDim{ cwCols, cwRows } ->+    if rowm == currentrow + direction+    then (currentcol, rowm)  -- We are not in the last row, so advance the row+    else (colm, rowm)        -- otherwise advance to the respective column+   where+    (currentcol, currentrow) = complIndex st+    (colm, rowm) =+      ( (currentcol + direction) `mod` length cwCols+      , (currentrow + direction) `mod` length cwRows+      )+    direction = case dir of+      Next ->  1+      Prev -> -1++tryAutoComplete :: XP Bool+tryAutoComplete = do+    ac <- gets (autoComplete . config)+    case ac of+        Just d -> do cs <- getCompletions+                     case cs of+                         [c] -> runCompleted c d >> return True+                         _   -> return False+        Nothing    -> return False+  where runCompleted cmd delay = do+            st <- get+            let new_command = nextCompletion (currentXPMode st) (command st) [cmd]+            modify $ setCommand "autocompleting..."+            updateWindows+            io $ threadDelay delay+            modify $ setCommand new_command+            return True++-- KeyPresses++-- | Default key bindings for prompts.  Click on the \"Source\" link+--   to the right to see the complete list.  See also 'defaultXPKeymap''.+defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())+defaultXPKeymap = defaultXPKeymap' isSpace++-- | A variant of 'defaultXPKeymap' which lets you specify a custom+--   predicate for identifying non-word characters, which affects all+--   the word-oriented commands (move\/kill word).  The default is+--   'isSpace'.  For example, by default a path like @foo\/bar\/baz@+--   would be considered as a single word.  You could use a predicate+--   like @(\\c -> isSpace c || c == \'\/\')@ to move through or+--   delete components of the path one at a time.+defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())+defaultXPKeymap' p = M.fromList $+  map (first $ (,) controlMask) -- control + <key>+  [ (xK_u, killBefore)+  , (xK_k, killAfter)+  , (xK_a, startOfLine)+  , (xK_e, endOfLine)+  , (xK_y, pasteString)+  -- Retain the pre-0.14 moveWord' behavior:+  , (xK_Right, moveWord' p Next >> moveCursor Next)+  , (xK_Left, moveCursor Prev >> moveWord' p Prev)+  , (xK_Delete, killWord' p Next)+  , (xK_BackSpace, killWord' p Prev)+  , (xK_w, killWord' p Prev)+  , (xK_g, quit)+  , (xK_bracketleft, quit)+  ] +++  map (first $ (,) 0)+  [ (xK_Return, acceptSelection)+  , (xK_KP_Enter, acceptSelection)+  , (xK_BackSpace, deleteString Prev)+  , (xK_Delete, deleteString Next)+  , (xK_Left, moveCursor Prev)+  , (xK_Right, moveCursor Next)+  , (xK_Home, startOfLine)+  , (xK_End, endOfLine)+  , (xK_Down, moveHistory W.focusUp')+  , (xK_Up, moveHistory W.focusDown')+  , (xK_Escape, quit)+  ]++-- | A keymap with many emacs-like key bindings.  Click on the+--   \"Source\" link to the right to see the complete list.+--   See also 'emacsLikeXPKeymap''.+emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())+emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace++-- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom+--   predicate for identifying non-word characters, which affects all+--   the word-oriented commands (move\/kill word).  The default is+--   'isSpace'.  For example, by default a path like @foo\/bar\/baz@+--   would be considered as a single word.  You could use a predicate+--   like @(\\c -> isSpace c || c == \'\/\')@ to move through or+--   delete components of the path one at a time.+emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())+emacsLikeXPKeymap' p = M.fromList $+  map (first $ (,) controlMask) -- control + <key>+  [ (xK_z, killBefore) --kill line backwards+  , (xK_k, killAfter) -- kill line fowards+  , (xK_a, startOfLine) --move to the beginning of the line+  , (xK_e, endOfLine) -- move to the end of the line+  , (xK_d, deleteString Next) -- delete a character foward+  , (xK_b, moveCursor Prev) -- move cursor forward+  , (xK_f, moveCursor Next) -- move cursor backward+  , (xK_BackSpace, killWord' p Prev) -- kill the previous word+  , (xK_y, pasteString)+  , (xK_g, quit)+  , (xK_bracketleft, quit)+  , (xK_t, transposeChars)+  , (xK_m, acceptSelection)+  ] +++  map (first $ (,) mod1Mask) -- meta key + <key>+  [ (xK_BackSpace, killWord' p Prev)+  -- Retain the pre-0.14 moveWord' behavior:+  , (xK_f, moveWord' p Next >> moveCursor Next) -- move a word forward+  , (xK_b, moveCursor Prev >> moveWord' p Prev) -- move a word backward+  , (xK_d, killWord' p Next) -- kill the next word+  , (xK_n, moveHistory W.focusUp')+  , (xK_p, moveHistory W.focusDown')+  ]+  +++  map (first $ (,) 0) -- <key>+  [ (xK_Return, acceptSelection)+  , (xK_KP_Enter, acceptSelection)+  , (xK_BackSpace, deleteString Prev)+  , (xK_Delete, deleteString Next)+  , (xK_Left, moveCursor Prev)+  , (xK_Right, moveCursor Next)+  , (xK_Home, startOfLine)+  , (xK_End, endOfLine)+  , (xK_Down, moveHistory W.focusUp')+  , (xK_Up, moveHistory W.focusDown')+  , (xK_Escape, quit)+  ]++-- | Vim-ish key bindings. Click on the \"Source\" link to the right to see the+-- complete list. See also 'vimLikeXPKeymap''.+vimLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())+vimLikeXPKeymap = vimLikeXPKeymap' (setBorderColor "grey22") id id isSpace++-- | A variant of 'vimLikeXPKeymap' with customizable aspects:+vimLikeXPKeymap' :: (XPColor -> XPColor)+                    -- ^ Modifies the prompt color when entering normal mode.+                    -- The default is @setBorderColor "grey22"@ - same color as+                    -- the default background color.+                 -> (String -> String)+                    -- ^ Prompter to use in normal mode. The default of 'id'+                    -- balances 'defaultPrompter' but @("[n] " ++)@ is a good+                    -- alternate with 'defaultPrompter' as @("[i] " ++)@.+                 -> (String -> String)+                    -- ^ Filter applied to the X Selection before pasting. The+                    -- default is 'id' but @filter isPrint@ is a good+                    -- alternate.+                 -> (Char -> Bool)+                    -- ^ Predicate identifying non-word characters. The default+                    -- is 'isSpace'. See the documentation of other keymaps for+                    -- alternates.+                 -> M.Map (KeyMask,KeySym) (XP ())+vimLikeXPKeymap' fromColor promptF pasteFilter notWord = M.fromList $+    map (first $ (,) controlMask) -- control + <key>+    [ (xK_m, acceptSelection)+    ] +++    map (first $ (,) 0)+    [ (xK_Return,       acceptSelection)+    , (xK_KP_Enter,     acceptSelection)+    , (xK_BackSpace,    deleteString Prev)+    , (xK_Delete,       deleteString Next)+    , (xK_Left,         moveCursor Prev)+    , (xK_Right,        moveCursor Next)+    , (xK_Home,         startOfLine)+    , (xK_End,          endOfLine)+    , (xK_Down,         moveHistory W.focusUp')+    , (xK_Up,           moveHistory W.focusDown')+    , (xK_Escape,       moveCursor Prev+                            >> modifyColor fromColor+                            >> setPrompter promptF+                            >> promptSubmap (return ()) normalVimXPKeymap+                            >> resetColor+                            >> resetPrompter+      )+    ] where+    normalVimXPKeymap = M.fromList $+        map (first $ (,) 0)+        [ (xK_i,            setModeDone True)+        , (xK_a,            moveCursor Next >> setModeDone True)+        , (xK_s,            deleteString Next >> setModeDone True)+        , (xK_x,            deleteString Next >> clipCursor)+        , (xK_Delete,       deleteString Next >> clipCursor)+        , (xK_p,            moveCursor Next+                                >> pasteString' pasteFilter+                                >> moveCursor Prev+          )+        , (xK_0,            startOfLine)+        , (xK_Escape,       quit)+        , (xK_Down,         moveHistory W.focusUp')+        , (xK_j,            moveHistory W.focusUp')+        , (xK_Up,           moveHistory W.focusDown')+        , (xK_k,            moveHistory W.focusDown')+        , (xK_Right,        moveCursorClip Next)+        , (xK_l,            moveCursorClip Next)+        , (xK_h,            moveCursorClip Prev)+        , (xK_Left,         moveCursorClip Prev)+        , (xK_BackSpace,    moveCursorClip Prev)+        -- Implementation using the original 'moveWord'':+        --, (xK_e,            moveCursor Next >> moveWord' notWord Next >> moveCursor Prev)+        --, (xK_b,            moveWord' notWord Prev)+        --, (xK_w,            moveWord' (not . notWord) Next >> clipCursor)+        , (xK_e,            moveCursorClip Next >> moveWord' notWord Next)+        , (xK_b,            moveCursorClip Prev >> moveWord' notWord Prev)+        , (xK_w,            moveWord' (not . notWord) Next >> moveCursorClip Next)+        , (xK_f,            promptBuffer bufferOne >>= toHeadChar Next)+        , (xK_d,            promptSubmap (setModeDone True) deleteVimXPKeymap)+        , (xK_c,            promptSubmap (setModeDone True) changeVimXPKeymap+                                >> setModeDone True+          )+        , (xK_Return,       acceptSelection)+        , (xK_KP_Enter,     acceptSelection)+        ] +++        map (first $ (,) shiftMask)+        [ (xK_dollar,       endOfLine >> moveCursor Prev)+        , (xK_D,            killAfter >> moveCursor Prev)+        , (xK_C,            killAfter >> setModeDone True)+        , (xK_P,            pasteString' pasteFilter >> moveCursor Prev)+        , (xK_A,            endOfLine >> setModeDone True)+        , (xK_I,            startOfLine >> setModeDone True)+        , (xK_F,            promptBuffer bufferOne >>= toHeadChar Prev)+        ]+    deleteVimXPKeymap = M.fromList $+        map (bimap (0 ,) (>> setModeDone True))+        [ (xK_e,            deleteString Next >> killWord' notWord Next >> clipCursor)+        , (xK_w,            killWord' (not . notWord) Next >> clipCursor)+        , (xK_0,            killBefore)+        , (xK_b,            killWord' notWord Prev)+        , (xK_d,            setInput "")+        ] +++        map (bimap (shiftMask ,) (>> setModeDone True))+        [ (xK_dollar,       killAfter >> moveCursor Prev)+        ]+    changeVimXPKeymap = M.fromList $+        map (bimap (0 ,) (>> setModeDone True))+        [ (xK_e,            deleteString Next >> killWord' notWord Next)+        , (xK_0,            killBefore)+        , (xK_b,            killWord' notWord Prev)+        , (xK_c,            setInput "")+        , (xK_w,            changeWord notWord)+        ] +++        map (bimap (shiftMask, ) (>> setModeDone True))+        [ (xK_dollar,       killAfter)+        ]++-- Useful for exploring off-by-one issues.+--testOffset :: XP ()+--testOffset = do+--    off <- getOffset+--    str <- getInput+--    setInput $ str ++ "|" ++ (show off) ++ ":" ++ (show $ length str)++-- | Set @True@ to save the prompt's entry to history and run it via the+-- provided action.+setSuccess :: Bool -> XP ()+setSuccess b = modify $ \s -> s { successful = b }++-- | Set @True@ to leave all event loops, no matter how nested.+setDone :: Bool -> XP ()+setDone b = modify $ \s -> s { done = b }++-- | Set @True@ to leave the current event loop, i.e. submaps.+setModeDone :: Bool -> XP ()+setModeDone b = modify $ \s -> s { modeDone = b }++-- KeyPress and State++-- | Accept the current selection and exit.+acceptSelection :: StateT XPState IO ()+acceptSelection = setSuccess True >> setDone True++-- | Quit.+quit :: XP ()+quit = flushString >> setSuccess False >> setDone True >> setModeDone True++-- | Kill the portion of the command before the cursor+killBefore :: XP ()+killBefore =+  modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset  = 0 }++-- | Kill the portion of the command including and after the cursor+killAfter :: XP ()+killAfter =+  modify $ \s -> setCommand (take (offset s) (command s)) s++-- | Kill the next\/previous word, using 'isSpace' as the default+--   predicate for non-word characters.  See 'killWord''.+killWord :: Direction1D -> XP ()+killWord = killWord' isSpace++-- | Kill the next\/previous word, given a predicate to identify+--   non-word characters. First delete any consecutive non-word+--   characters; then delete consecutive word characters, stopping+--   just before the next non-word character.+--+--   For example, by default (using 'killWord') a path like+--   @foo\/bar\/baz@ would be deleted in its entirety.  Instead you can+--   use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to+--   delete the path one component at a time.+killWord' :: (Char -> Bool) -> Direction1D -> XP ()+killWord' p d = do+  o <- gets offset+  c <- gets command+  let (f,ss)        = splitAt o c+      delNextWord   = dropWhile (not . p) . dropWhile p+      delPrevWord   = reverse . delNextWord . reverse+      (ncom,noff)   =+          case d of+            Next -> (f ++ delNextWord ss, o)+            Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!!+  modify $ \s -> setCommand ncom $ s { offset = noff}++-- | From Vim's @:help cw@:+--+-- * Special case: When the cursor is in a word, "cw" and "cW" do not include+--   the white space after a word, they only change up to the end of the word.+changeWord :: (Char -> Bool) -> XP ()+changeWord p = join $ f <$> getInput <*> getOffset <*> pure p+    where+        f :: String -> Int -> (Char -> Bool) -> XP ()+        f str off _ | length str <= off ||+                      null str              = return ()+        f str off p'| p' $ str !! off       = killWord' (not . p') Next+                    | otherwise             = killWord' p' Next++-- | Interchange characters around point, moving forward one character+--   if not at the end of the input.+transposeChars :: XP ()+transposeChars = do+  off <- gets offset+  cmd <- gets command+  let (beforeCursor, afterCursor) = splitAt off cmd+      (ncom, noff) = fromMaybe (cmd, off) (go beforeCursor afterCursor off)+  modify $ \s -> setCommand ncom $ s{ offset = noff }+ where+  go :: [a] -> [a] -> Int -> Maybe ([a], Int)+  go (reverse -> (b1 : b2 : bs)) [] offset =  -- end of line+    Just (reverse $ b2 : b1 : bs, offset)+  go (reverse -> (b : bs)) (a : as) offset =  -- middle of line+    Just (reverse (a : bs) ++ b : as, offset + 1)+  go _ _ _ = Nothing++-- | Put the cursor at the end of line+endOfLine :: XP ()+endOfLine  =+    modify $ \s -> s { offset = length (command s)}++-- | Put the cursor at the start of line+startOfLine :: XP ()+startOfLine  =+    modify $ \s -> s { offset = 0 }++-- |  Flush the command string and reset the offset+flushString :: XP ()+flushString = modify $ \s -> setCommand "" $ s { offset = 0}++--reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions.+--If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again+resetComplIndex :: XPState -> XPState+resetComplIndex st = if alwaysHighlight (config st) then st { complIndex = (0,0) } else st++-- | Insert a character at the cursor position+insertString :: String -> XP ()+insertString str = do+  insertString' str+  modify resetComplIndex++insertString' :: String -> XP ()+insertString' str =+  modify $ \s -> let+    cmd = c (command s) (offset s)+    st = s { offset = o (offset s)}+    in setCommand cmd st+  where o oo = oo + length str+        c oc oo | oo >= length oc = oc ++ str+                | otherwise = f ++ str ++ ss+                where (f,ss) = splitAt oo oc++-- | Insert the current X selection string at the cursor position. The X+-- selection is not modified.+pasteString :: XP ()+pasteString = pasteString' id++-- | A variant of 'pasteString' which allows modifying the X selection before+-- pasting.+pasteString' :: (String -> String) -> XP ()+pasteString' f = insertString . f =<< getSelection++-- | Remove a character at the cursor position+deleteString :: Direction1D -> XP ()+deleteString d =+  modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)}+  where o oo = if d == Prev then max 0 (oo - 1) else oo+        c oc oo+            | oo >= length oc && d == Prev = take (oo - 1) oc+            | oo <  length oc && d == Prev = take (oo - 1) f ++ ss+            | oo <  length oc && d == Next = f ++ drop 1 ss+            | otherwise = oc+            where (f,ss) = splitAt oo oc++-- | Ensure the cursor remains over the command by shifting left if necessary.+clipCursor :: XP ()+clipCursor = modify $ \s -> s { offset = o (offset s) (command s)}+    where o oo c = min (max 0 $ length c - 1) oo++-- | Move the cursor one position.+moveCursor :: Direction1D -> XP ()+moveCursor d =+  modify $ \s -> s { offset = o (offset s) (command s)}+  where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1)++-- | Move the cursor one position, but not beyond the command.+moveCursorClip :: Direction1D -> XP ()+moveCursorClip = (>> clipCursor) . moveCursor+--  modify $ \s -> s { offset = o (offset s) (command s)}+--  where o oo c = if d == Prev then max 0 (oo - 1) else min (max 0 $ length c - 1) (oo + 1)++-- | Move the cursor one word, using 'isSpace' as the default+--   predicate for non-word characters.  See 'moveWord''.+moveWord :: Direction1D -> XP ()+moveWord = moveWord' isSpace++-- | Given a direction, move the cursor to just before the next+-- (predicate,not-predicate) character transition. This means a (not-word,word)+-- transition should be followed by a 'moveCursorClip' action. Always considers+-- the character under the current cursor position.  This means a+-- (word,not-word) transition should be preceded by a 'moveCursorClip' action.+-- Calculated as the length of consecutive non-predicate characters starting+-- from the cursor position, plus the length of subsequent consecutive+-- predicate characters, plus when moving backwards the distance of the cursor+-- beyond the input. Reduced by one to avoid jumping off either end of the+-- input, when present.+--+-- Use these identities to retain the pre-0.14 behavior:+--+-- @+--     (oldMoveWord' p Prev) = (moveCursor Prev >> moveWord' p Prev)+-- @+--+-- @+--     (oldMoveWord' p Next) = (moveWord' p Next >> moveCursor Next)+-- @+moveWord' :: (Char -> Bool) -> Direction1D -> XP ()+moveWord' p d = do+  c <- gets command+  o <- gets offset+  let (f,ss) = splitOn o c+      splitOn n xs = (take (n+1) xs, drop n xs)+      gap = case d of+                Prev -> max 0 $ (o + 1) - length c+                Next -> 0+      len = max 0 . flip (-) 1 . (gap +)+          . uncurry (+)+          . (length *** (length . takeWhile (not . p)))+          . span p+      newoff = case d of+                Prev -> o - len (reverse f)+                Next -> o + len ss+  modify $ \s -> s { offset = newoff }++-- | Set the prompt's input to an entry further up or further down the history+-- stack. Use 'Stack' functions from 'XMonad.StackSet', i.e. 'focusUp'' or+-- 'focusDown''.+moveHistory :: (W.Stack String -> W.Stack String) -> XP ()+moveHistory f = do+  modify $ \s -> let ch = f $ commandHistory s+                 in s { commandHistory = ch+                      , offset         = length $ W.focus ch+                      , complIndex     = (0,0) }+  updateWindows+  updateHighlightedCompl++-- | Move the cursor in the given direction to the first instance of the first+-- character of the given string, assuming the string is not empty. The+-- starting cursor character is not considered, and the cursor is placed over+-- the matching character.+toHeadChar :: Direction1D -> String -> XP ()+toHeadChar _ ""      = pure ()+toHeadChar d (c : _) = do+    cmd <- gets command+    off <- gets offset+    let off' = (if d == Prev then negate . fst else snd)+             . join (***) (maybe 0 (+1) . elemIndex c)+             . (reverse *** drop 1)+             $ splitAt off cmd+    modify $ \st -> st { offset = offset st + off' }++updateHighlightedCompl :: XP ()+updateHighlightedCompl = do+  st <- get+  cs <- getCompletions+  alwaysHighlight' <- gets $ alwaysHighlight . config+  when alwaysHighlight' $ modify $ \s -> s {highlightedCompl = highlightedItem st cs}++------------------------------------------------------------------------+-- X Stuff++-- | The completion windows in its entirety.+data ComplWindowDim = ComplWindowDim+  { cwX         :: !Position    -- ^ Starting x position+  , cwY         :: !Position    -- ^ Starting y position+  , cwWidth     :: !Dimension   -- ^ Width of the entire prompt+  , cwRowHeight :: !Dimension   -- ^ Height of a single row+  , cwCols      :: ![Position]  -- ^ Starting position of all columns+  , cwRows      :: ![Position]  -- ^ Starting positions of all rows+  }+  deriving (Eq)++-- | Create the prompt window.+createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> Dimension -> IO Window+createPromptWin dpy rootw XPC{ position, height } scn width = do+  w <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw+                      (rect_x scn + x) (rect_y scn + y) width height+  setClassHint dpy w (ClassHint "xmonad-prompt" "xmonad")+  mapWindow dpy w+  return w+ where+  (x, y) :: (Position, Position) = fi <$> case position of+    Top             -> (0, 0)+    Bottom          -> (0, rect_height scn - height)+    CenteredAt py w ->+      ( floor $ fi (rect_width scn) * ((1 - w) / 2)+      , floor $ py * fi (rect_height scn) - (fi height / 2)+      )++-- | Update the state of the completion window.+updateComplWin :: Maybe Window -> Maybe ComplWindowDim -> XP ()+updateComplWin win winDim = do+  cwr <- gets complWin+  io $ writeIORef cwr win+  modify' (\s -> s { complWinDim = winDim })++--- | Update all prompt windows.+updateWindows :: XP ()+updateWindows = redrawWindows (void destroyComplWin) =<< getCompletions++-- | Draw the main prompt window and, if necessary, redraw the+-- completion window.+redrawWindows+  :: XP ()     -- ^ What to do if the completions are empty+  -> [String]  -- ^ Given completions+  -> XP ()+redrawWindows emptyAction compls = do+  d <- gets dpy+  drawWin+  maybe emptyAction redrawComplWin (nonEmpty compls)+  io $ sync d False+ where+  -- | Draw the main prompt window.+  drawWin :: XP () = do+    XPS{ color, dpy, win, gcon, winWidth } <- get+    XPC{ height, promptBorderWidth } <- gets config+    let scr = defaultScreenOfDisplay dpy+        ht  = height            -- height of a single row+        bw  = promptBorderWidth+    Just bgcolor <- io $ initColor dpy (bgNormal color)+    Just borderC <- io $ initColor dpy (border color)+    pm <- io $ createPixmap dpy win winWidth ht (defaultDepthOfScreen scr)+    io $ fillDrawable dpy pm gcon borderC bgcolor (fi bw) winWidth ht+    printPrompt pm+    io $ copyArea dpy pm win gcon 0 0 winWidth ht 0 0+    io $ freePixmap dpy pm++-- | Redraw the completion window, if necessary.+redrawComplWin ::  NonEmpty String -> XP ()+redrawComplWin compl = do+  XPS{ showComplWin, complWinDim, complWin } <- get+  nwi <- getComplWinDim compl+  let recreate = do destroyComplWin+                    w <- createComplWin nwi+                    drawComplWin w compl+  if showComplWin+     then io (readIORef complWin) >>= \case+            Just w -> case complWinDim of+                        Just wi -> if nwi == wi -- complWinDim did not change+                                   then drawComplWin w compl -- so update+                                   else recreate+                        Nothing -> recreate+            Nothing -> recreate+     else destroyComplWin+ where+  createComplWin :: ComplWindowDim -> XP Window+  createComplWin wi@ComplWindowDim{ cwX, cwY, cwWidth, cwRowHeight } = do+    XPS{ dpy, rootw } <- get+    let scr = defaultScreenOfDisplay dpy+    w <- io $ mkUnmanagedWindow dpy scr rootw cwX cwY cwWidth cwRowHeight+    io $ mapWindow dpy w+    updateComplWin (Just w) (Just wi)+    return w++-- | Print the main part of the prompt: the prompter, as well as the+-- command line (including the current input) and the cursor.+printPrompt :: Drawable -> XP ()+printPrompt drw = do+  st@XPS{ prompter, color, gcon, config, dpy, fontS, offset } <- get+  let -- (prompt-specific text before the command, the entered command)+      (prt, com) = (prompter . show . currentXPMode &&& command) st+      str = prt ++ com+      -- break the string in 3 parts: till the cursor, the cursor and the rest+      (preCursor, cursor, postCursor) = if offset >= length com+                 then (str, " ","") -- add a space: it will be our cursor ;-)+                 else let (a, b) = splitAt offset com+                      in (prt ++ a, take 1 b, drop 1 b)++  -- vertical and horizontal text alignment+  (asc, desc) <- io $ textExtentsXMF fontS str  -- font ascent and descent+  let y = fi ((height config - fi (asc + desc)) `div` 2) + asc+      x = (asc + desc) `div` 2++  pcFont <- io $ textWidthXMF dpy fontS preCursor+  cFont  <- io $ textWidthXMF dpy fontS cursor+  let draw = printStringXMF dpy drw fontS gcon+  -- print the first part+  draw (fgNormal color) (bgNormal color) x y preCursor+  -- reverse the colors and print the "cursor" ;-)+  draw (bgNormal color) (fgNormal color) (x + fi pcFont) y cursor+  -- flip back to the original colors and print the rest of the string+  draw (fgNormal color) (bgNormal color) (x + fi (pcFont + cFont)) y postCursor++-- | Get all available completions for the current input.+getCompletions :: XP [String]+getCompletions = do+  st@XPS{ config } <- get+  let cmd   = commandToComplete (currentXPMode st) (command st)+      compl = getCompletionFunction st+      srt   = sorter config+  io $ (srt cmd <$> compl cmd) `E.catch` \(SomeException _) -> return []+ where+  -- | Get the current completion function depending on the active mode.+  getCompletionFunction :: XPState -> ComplFunction+  getCompletionFunction st = case operationMode st of+    XPSingleMode compl _ -> compl+    XPMultipleModes modes -> completionFunction $ W.focus modes++-- | Destroy the currently drawn completion window, if there is one.+destroyComplWin :: XP ()+destroyComplWin = do+  XPS{ dpy, complWin } <- get+  io (readIORef complWin) >>= \case+    Just w -> do io $ destroyWindow dpy w+                 updateComplWin Nothing Nothing+    Nothing -> return ()++-- | Given the completions that we would like to show, calculate the+-- required dimensions for the completion windows.+getComplWinDim :: NonEmpty String -> XP ComplWindowDim+getComplWinDim compl = do+  XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get+  let -- Height of a single completion row+      ht = height cfg+      bw = promptBorderWidth cfg++  tws <- mapM (textWidthXMF dpy fs) compl+  let -- Length of widest completion we will print+      maxComplLen = (fi ht `div` 2) + maximum tws+      -- Height of the screen rectangle _without_ the prompt window+      remHeight   = rect_height scr - ht++      maxColumns  = maybe id min (maxComplColumns cfg)+      columns     = max 1 . maxColumns $ winWidth `div` fi maxComplLen+      columnWidth = winWidth `div` columns++      (fullRows, lastRow) = length compl `divMod` fi columns+      allRows   = max 1 (fullRows + if lastRow == 0 then 0 else 1)+      -- Maximum number of rows allowed by the config and the screen dimensions+      maxRows   = maybe id min (maxComplRows cfg) (remHeight `div` ht)+      -- Actual number of rows to be drawn+      rows      = min maxRows (fi allRows)+      rowHeight = rows * ht++      -- Starting x and y position of the completion windows.+      (x, y) = bimap (rect_x scr +) ((rect_y scr +) . fi) $ case position cfg of+        Top    -> (0, ht - bw)+        Bottom -> (0, remHeight - rowHeight + bw)+        CenteredAt py w+          | py <= 1/2 ->+              ( floor $ fi (rect_width scr) * ((1 - w) / 2)+              , floor (py * fi (rect_height scr) + (fi ht / 2)) - bw+              )+          | otherwise ->+              ( floor $ fi (rect_width scr) * ((1 - w) / 2)+              , floor (py * fi (rect_height scr) - (fi ht / 2)) - rowHeight + bw+              )++  -- Get font ascent and descent.  Coherence condition: we will print+  -- everything using the same font.+  (asc, desc) <- io $ textExtentsXMF fs $ NE.head compl+  let yp    = fi $ (ht + fi (asc - desc)) `div` 2 -- y position of the first row+      yRows = take (fi rows) [yp, yp + fi ht ..]  -- y positions of all rows++      xp    = (asc + desc) `div` 2                           -- x position of the first column+      xCols = take (fi columns) [xp, xp + fi columnWidth ..] -- x positions of all columns++  pure $ ComplWindowDim x y winWidth rowHeight xCols yRows++-- | Draw the completion window.+drawComplWin :: Window -> NonEmpty String -> XP ()+drawComplWin w entries = do+  XPS{ config, color, dpy, gcon } <- get+  let scr = defaultScreenOfDisplay dpy+      bw  = promptBorderWidth config+  Just bgcolor <- io $ initColor dpy (bgNormal color)+  Just borderC <- io $ initColor dpy (border color)+  cwd@ComplWindowDim{ cwWidth, cwRowHeight } <- getComplWinDim entries++  p <- io $ createPixmap dpy w cwWidth cwRowHeight (defaultDepthOfScreen scr)+  io $ fillDrawable dpy p gcon borderC bgcolor (fi bw) cwWidth cwRowHeight+  printComplEntries dpy p gcon (fgNormal color) (bgNormal color) entries cwd+  --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac  ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy)+  io $ copyArea dpy p w gcon 0 0 cwWidth cwRowHeight 0 0+  io $ freePixmap dpy p++-- | Print all of the completion entries.+printComplEntries+  :: Display+  -> Drawable+  -> GC+  -> String         -- ^ Default foreground color+  -> String         -- ^ Default background color+  -> NonEmpty String -- ^ Entries to be printed...+  -> ComplWindowDim -- ^ ...into a window of this size+  -> XP ()+printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do+  st@XPS{ color, complIndex, config = XPC{ alwaysHighlight } } <- get+  let printItemAt :: Position -> Position -> String -> XP ()+      printItemAt x y item =+        printStringXMF dpy drw (fontS st) gc fgCol bgCol x y item+       where+        (fgCol, bgCol)+          | -- default to the first item, the one in (0, 0)+            alwaysHighlight, complIndex == findComplIndex item+          = (fgHighlight color, bgHighlight color)+          | -- compare item with buffer's value+            completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st)+          = (fgHighlight color, bgHighlight color)+          | -- if nothing matches, use default colors+            otherwise = (fc, bc)+  zipWithM_ (\x -> zipWithM_ (printItemAt x) cwRows) cwCols complMat+ where+  -- | Create the completion matrix to be printed.+  complMat :: [[String]]+    = chunksOf (length cwRows) (take (length cwCols * length cwRows) (NE.toList entries))++  -- | Find the column and row indexes in which a string appears.+  -- If the string is not in the matrix, the indices default to @(0, 0)@.+  findComplIndex :: String -> (Int, Int)+  findComplIndex item = (colIndex, rowIndex)+   where+    colIndex = fromMaybe 0 $ findIndex (\cols -> item `elem` cols) complMat+    rowIndex = fromMaybe 0 $ elemIndex item =<< complMat !? colIndex++-- History++type History = M.Map String [String]++emptyHistory :: History+emptyHistory = M.empty++getHistoryFile :: FilePath -> FilePath+getHistoryFile cachedir = cachedir ++ "/prompt-history"++readHistory :: XPConfig -> FilePath -> IO History+readHistory (XPC { historySize = 0 }) _ = return emptyHistory+readHistory _ cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory+ where+    readHist = do+        let path = getHistoryFile cachedir+        xs <- withFile path ReadMode hGetLine+        readIO xs++writeHistory :: XPConfig -> FilePath -> History -> IO ()+writeHistory (XPC { historySize = 0 }) _ _ = return ()+writeHistory _ cachedir hist = do+  let path = getHistoryFile cachedir+      filtered = M.filter (not . null) hist+  writeFile path (show filtered) `E.catch` \(SomeException e) ->+                          hPutStrLn stderr ("error writing history: "++show e)+  setFileMode path mode+    where mode = ownerReadMode .|. ownerWriteMode++-- $xutils++-- | Fills a 'Drawable' with a rectangle and a border+fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel+             -> Dimension -> Dimension -> Dimension -> IO ()+fillDrawable d drw gc borderC bgcolor bw wh ht = do+  -- we start with the border+  setForeground d gc borderC+  fillRectangle d drw gc 0 0 wh ht+  -- here foreground means the background of the text+  setForeground d gc bgcolor+  fillRectangle d drw gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2))++-- | Creates a window with the attribute override_redirect set to True.+-- Windows Managers should not touch this kind of windows.+mkUnmanagedWindow :: Display -> Screen -> Window -> Position+                  -> Position -> Dimension -> Dimension -> IO Window+mkUnmanagedWindow d s rw x y w h = do+  let visual = defaultVisualOfScreen s+      attrmask = cWOverrideRedirect+  allocaSetWindowAttributes $+         \attributes -> do+           set_override_redirect attributes True+           createWindow d rw x y w h 0 (defaultDepthOfScreen s)+                        inputOutput visual attrmask attributes++-- $utils++-- | This function takes a list of possible completions and returns a+-- completions function to be used with 'mkXPrompt'+mkComplFunFromList :: XPConfig -> [String] -> String -> IO [String]+mkComplFunFromList _ _ [] = return []+mkComplFunFromList c l s =+  pure $ filter (searchPredicate c s) l++-- | This function takes a list of possible completions and returns a+-- completions function to be used with 'mkXPrompt'. If the string is+-- null it will return all completions.+mkComplFunFromList' :: XPConfig -> [String] -> String -> IO [String]+mkComplFunFromList' _ l [] = return l+mkComplFunFromList' c l s =+  pure $ filter (searchPredicate c s) l++-- | Given the prompt type, the command line and the completion list,+-- return the next completion in the list for the last word of the+-- command line. This is the default 'nextCompletion' implementation.+getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String+getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni)+    where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of+                 Just i -> if i >= length l - 1 then 0 else i + 1+                 Nothing -> 0++-- | An alternative 'nextCompletion' implementation: given a command+-- and a completion list, get the next completion in the list matching+-- the whole command line.+getNextCompletion :: String -> [String] -> String+getNextCompletion c l = l !! idx+    where idx = case c `elemIndex` l of+                  Just i  -> if i >= length l - 1 then 0 else i + 1+                  Nothing -> 0++-- | Given a maximum length, splits a list into sublists+splitInSubListsAt :: Int -> [a] -> [[a]]+splitInSubListsAt = chunksOf+{-# DEPRECATED splitInSubListsAt "Use XMonad.Prelude.chunksOf instead." #-}++-- | Gets the last word of a string or the whole string if formed by+-- only one word+getLastWord :: String -> String+getLastWord = reverse . fst . breakAtSpace . reverse++-- | Skips the last word of the string, if the string is composed by+-- more then one word. Otherwise returns the string.+skipLastWord :: String -> String+skipLastWord = reverse . snd . breakAtSpace . reverse++breakAtSpace :: String -> (String, String)+breakAtSpace s+    | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2')+    | otherwise = (s1, s2)+      where (s1, s2 ) = break isSpace s+            (s1',s2') = breakAtSpace $ drop 1 s2++-- | 'historyCompletion' provides a canned completion function much like+--   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work+--   from the query history stored in the XMonad cache directory.+historyCompletion :: XPConfig -> X ComplFunction+historyCompletion conf = historyCompletionP conf (const True)++-- | Like 'historyCompletion' but only uses history data from Prompts whose+-- name satisfies the given predicate.+historyCompletionP :: XPConfig -> (String -> Bool) -> X ComplFunction+historyCompletionP conf p = do+    cd <- asks (cacheDir . directories)+    pure $ \x ->+        let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []+         in toComplList . M.filterWithKey (const . p) <$> readHistory conf cd++-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off+--   laziness and stability for efficiency.+uniqSort :: Ord a => [a] -> [a]+uniqSort = toList . fromList++-- | Functions to be used with the 'historyFilter' setting.+-- 'deleteAllDuplicates' will remove all duplicate entries.+-- 'deleteConsecutive' will only remove duplicate elements+-- immediately next to each other.+deleteAllDuplicates, deleteConsecutive :: [String] -> [String]+deleteAllDuplicates = nub+deleteConsecutive = map (NE.head . notEmpty) . group+-- The elements of group will always have at least one element.++newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String)))++-- | Initializes a new HistoryMatches structure to be passed+-- to historyUpMatching+initMatches :: (Functor m, MonadIO m) => m HistoryMatches+initMatches = HistoryMatches <$> liftIO (newIORef ([],Nothing))++historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP ()+historyNextMatching hm@(HistoryMatches ref) next = do+  (completed,completions) <- io $ readIORef ref+  input <- getInput+  if input `elem` completed+     then case completions of+            Just cs -> do+                let cmd = W.focus cs+                modify $ setCommand cmd+                modify $ \s -> s { offset = length cmd }+                io $ writeIORef ref (cmd:completed,Just $ next cs)+            Nothing -> return ()+     else do -- the user typed something new, recompute completions+       io . writeIORef ref . ([input] ,) . filterMatching input =<< gets commandHistory        historyNextMatching hm next     where filterMatching :: String -> W.Stack String -> Maybe (W.Stack String)           filterMatching prefix = W.filter (prefix `isPrefixOf`) . next
XMonad/Prompt/AppLauncher.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.AppLauncher+-- Description :  A prompt for launch applications that receive command line parameters. -- Copyright   :  (C) 2008 Luis Cabellos -- License     :  BSD3 --@@ -57,7 +58,7 @@  -}  -- A customized prompt-data AppPrompt = AppPrompt String+newtype AppPrompt = AppPrompt String instance XPrompt AppPrompt where     showXPrompt (AppPrompt n) = n ++ " "
XMonad/Prompt/AppendFile.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.AppendFile+-- Description :  A prompt for appending a single line of text to a file. -- Copyright   :  (c) 2007 Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -29,14 +30,14 @@  import XMonad.Core import XMonad.Prompt+import XMonad.Prelude (mkAbsolutePath)  import System.IO-import Control.Exception.Extensible (bracket)  -- $usage -- -- You can use this module by importing it, along with--- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file:+-- "XMonad.Prompt", into your @xmonad.hs@ file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.AppendFile@@ -60,7 +61,7 @@ -- before saving into the file. Previous example with date can be rewritten as: -- -- > ,  ((modm .|. controlMask, xK_n), do--- >            date <- io $ liftM (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime+-- >            date <- io $ fmap (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime -- >            appendFilePrompt' def (date ++) $ "/home/me/NOTES" -- >        ) --@@ -68,9 +69,9 @@ -- the file too. -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data AppendFile = AppendFile FilePath+newtype AppendFile = AppendFile FilePath  instance XPrompt AppendFile where     showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": "@@ -78,7 +79,7 @@ -- | Given an XPrompt configuration and a file path, prompt the user --   for a line of text, and append it to the given file. appendFilePrompt :: XPConfig -> FilePath -> X ()-appendFilePrompt c fn = appendFilePrompt' c id fn+appendFilePrompt c = appendFilePrompt' c id  -- | Given an XPrompt configuration, string transformation function --   and a file path, prompt the user for a line of text, transform it@@ -91,4 +92,4 @@  -- | Append a string to a file. doAppend :: (String -> String) -> FilePath -> String -> X ()-doAppend trans fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn . trans+doAppend trans fn s = mkAbsolutePath fn >>= \f -> (io . withFile f AppendMode . flip hPutStrLn . trans) s
XMonad/Prompt/ConfirmPrompt.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.ConfirmPrompt+-- Description :  A prompt for setting up simple confirmation prompts for keybindings. -- Copyright   :  (C) 2015 Antoine Beaupré -- License     :  BSD3 --@@ -35,12 +36,12 @@ This should be used something like this:  > ...-> , ((modm , xK_l), confirmPrompt defaultXPConfig "exit" $ io (exitWith ExitSuccess))+> , ((modm , xK_l), confirmPrompt def "exit" $ io (exitWith ExitSuccess)) > ... -}  {- | Customized 'XPrompt' prompt that will ask to confirm the given string -}-data EnterPrompt = EnterPrompt String+newtype EnterPrompt = EnterPrompt String instance XPrompt EnterPrompt where     showXPrompt (EnterPrompt n) = "Confirm " ++ n ++ " (esc/ENTER)" @@ -48,4 +49,4 @@      and simply ask to confirm (ENTER) or cancel (ESCAPE). The actual key      handling is done by mkXPrompt.-} confirmPrompt :: XPConfig -> String -> X() -> X()-confirmPrompt config app func = mkXPrompt (EnterPrompt app) config (mkComplFunFromList []) $ const func+confirmPrompt config app func = mkXPrompt (EnterPrompt app) config (mkComplFunFromList config []) $ const func
XMonad/Prompt/DirExec.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.DirExec+-- Description :  A directory file executables prompt for XMonad. -- Copyright   :  (C) 2008 Juraj Hercek -- License     :  BSD3 --@@ -26,16 +27,15 @@  import Control.Exception as E import System.Directory-import Control.Monad-import Data.List import XMonad+import XMonad.Prelude import XMonad.Prompt  econst :: Monad m => a -> IOException -> m a econst = const . return  -- $usage--- 1. In your @~\/.xmonad\/xmonad.hs@:+-- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt.DirExec --@@ -63,9 +63,9 @@ -- terminal -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data DirExec = DirExec String+newtype DirExec = DirExec String  instance XPrompt DirExec where     showXPrompt (DirExec name) = name@@ -100,7 +100,7 @@ getDirectoryExecutables path =     (getDirectoryContents path >>=         filterM (\x -> let x' = path ++ x in-            liftM2 (&&)+            liftA2 (&&)                 (doesFileExist x')-                (liftM executable (getPermissions x'))))+                (fmap executable (getPermissions x'))))     `E.catch` econst []
XMonad/Prompt/Directory.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Directory+-- Description :  A directory prompt for XMonad. -- Copyright   :  (C) 2007 Andrea Rossato, David Roundy -- License     :  BSD3 --@@ -17,37 +18,47 @@                              -- $usage                              directoryPrompt,                              directoryMultipleModes,+                             directoryMultipleModes',                              Dir                               ) where +import XMonad.Prelude ( sort )+ import XMonad import XMonad.Prompt-import XMonad.Util.Run ( runProcessWithInput )+import XMonad.Prompt.Shell ( compgenDirectories )  -- $usage -- For an example usage see "XMonad.Layout.WorkspaceDir" -data Dir = Dir String (String -> X ())+data Dir = Dir String ComplCaseSensitivity (String -> X ())  instance XPrompt Dir where-    showXPrompt (Dir x _) = x-    completionFunction _ = getDirCompl-    modeAction (Dir _ f) buf auto =+    showXPrompt (Dir x _ _) = x+    completionFunction (Dir _ csn _) = getDirCompl csn+    modeAction (Dir _ _ f) buf auto =       let dir = if null auto then buf else auto       in f dir  directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()-directoryPrompt c prom f = mkXPrompt (Dir prom f) c getDirCompl f+directoryPrompt c prom f = mkXPrompt (Dir prom csn f) c (getDirCompl csn) f+    where csn = complCaseSensitivity c  -- | A @XPType@ entry suitable for using with @mkXPromptWithModes@. directoryMultipleModes :: String            -- ^ Prompt.                        -> (String -> X ())  -- ^ Action.                        -> XPType-directoryMultipleModes p f = XPT (Dir p f)+directoryMultipleModes = directoryMultipleModes' CaseSensitive -getDirCompl :: String -> IO [String]-getDirCompl s = (filter notboring . lines) `fmap`-                runProcessWithInput "bash" [] ("compgen -A directory " ++ s ++ "\n")+-- | Like @directoryMultipleModes@ with a parameter for completion case-sensitivity.+directoryMultipleModes' :: ComplCaseSensitivity -- ^ Completion case sensitivity.+                        -> String               -- ^ Prompt.+                        -> (String -> X ())     -- ^ Action.+                        -> XPType+directoryMultipleModes' csn p f = XPT (Dir p csn f)++getDirCompl :: ComplCaseSensitivity -> String -> IO [String]+getDirCompl csn s = sort . filter notboring . lines <$> compgenDirectories csn s  notboring :: String -> Bool notboring ('.':'.':_) = True
XMonad/Prompt/Email.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Email+-- Description :  A prompt for sending quick, one-line emails, via GNU \'mail\'. -- Copyright   :  (c) 2007 Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -23,13 +24,14 @@  import XMonad.Core import XMonad.Util.Run+import XMonad.Prelude (void) import XMonad.Prompt import XMonad.Prompt.Input  -- $usage -- -- You can use this module by importing it, along with--- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file:+-- "XMonad.Prompt", into your @xmonad.hs@ file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Email@@ -48,7 +50,7 @@ -- characters and then hit \'tab\'. -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.   -- | Prompt the user for a recipient, subject, and body, and send an@@ -56,8 +58,7 @@ --   of addresses for autocompletion. emailPrompt :: XPConfig -> [String] -> X () emailPrompt c addrs =-    inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to ->+    inputPromptWithCompl c "To" (mkComplFunFromList c addrs) ?+ \to ->     inputPrompt c "Subject" ?+ \subj ->     inputPrompt c "Body" ?+ \body ->-    runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")-         >> return ()+    void (runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n"))
XMonad/Prompt/FuzzyMatch.hs view
@@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module      : XMonad.Prompt.FuzzyMatch+-- Description : A prompt for fuzzy completion matching in prompts akin to Emacs ido-mode. -- Copyright   : (C) 2015 Norbert Zeh -- License     : GPL --@@ -18,12 +19,11 @@                                 , fuzzySort                                 ) where -import Data.Char-import Data.Function-import Data.List+import XMonad.Prelude+import qualified Data.List.NonEmpty as NE  -- $usage--- +-- -- This module offers two aspects of fuzzy matching of completions offered by -- XMonad.Prompt. --@@ -32,70 +32,68 @@ -- subsequence is a valid completion; matching is case insensitive.  This means -- that the sequence of typed characters can be obtained from the completion by -- deleting an appropriate subset of its characters.  Example: "spr" matches--- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the--- latter: "S.......P.r..........".+-- \"FastSPR\" but also \"SuccinctParallelTrees\" because it's a subsequence of+-- the latter: "S.......P.r..........". -- -- While this type of inclusiveness is helpful most of the time, it sometimes -- also produces surprising matches.  'fuzzySort' helps sorting matches by -- relevance, using a simple heuristic for measuring relevance.  The matches are -- sorted primarily by the length of the substring that contains the query -- characters and secondarily the starting position of the match.  So, if the--- search string is "spr" and the matches are "FastSPR", "FasterSPR", and--- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR",--- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr"--- within a substring of length 3 ("SPR") while the shortest substring of--- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length--- 11.  "FastSPR" is ranked before "FasterSPR" because its match starts at--- position 5 while the match in "FasterSPR" starts at position 7.+-- search string is "spr" and the matches are \"FastSPR\", \"FasterSPR\", and+-- \"SuccinctParallelTrees\", then the order is \"FastSPR\", \"FasterSPR\",+-- \"SuccinctParallelTrees\" because both \"FastSPR\" and \"FasterSPR\" contain+-- "spr" within a substring of length 3 (\"SPR\") while the shortest substring+-- of \"SuccinctParallelTrees\" that matches "spr" is \"SuccinctPar\", which has+-- length 11.  \"FastSPR\" is ranked before \"FasterSPR\" because its match+-- starts at position 5 while the match in \"FasterSPR\" starts at position 7. ----- To use these functions in an XPrompt, for example, for windowPromptGoto:+-- To use these functions in an XPrompt, for example, for windowPrompt: -- -- > import XMonad.Prompt--- > import XMonad.Prompt.Window ( windowPromptGoto )+-- > import XMonad.Prompt.Window ( windowPrompt ) -- > import XMonad.Prompt.FuzzyMatch -- > -- > myXPConfig = def { searchPredicate = fuzzyMatch---                    , sorter          = fuzzySort---                    }--- +-- >                  , sorter          = fuzzySort+-- >                  }+-- -- then add this to your keys definition: ----- > , ((modm .|. shiftMask, xK_g), windowPromptGoto myXPConfig)+-- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows) -- -- For detailed instructions on editing the key bindings, see--- "Xmonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- | Returns True if the first argument is a subsequence of the second argument, -- that is, it can be obtained from the second sequence by deleting elements. fuzzyMatch :: String -> String -> Bool-fuzzyMatch []         _      = True-fuzzyMatch _          []     = False-fuzzyMatch xxs@(x:xs) (y:ys) | toLower x == toLower y = fuzzyMatch xs  ys-                             | otherwise              = fuzzyMatch xxs ys+fuzzyMatch a b = isSubsequenceOf (map toLower a) (map toLower b)  -- | Sort the given set of strings by how well they match.  Match quality is -- measured first by the length of the substring containing the match and second -- by the positions of the matching characters in the string. fuzzySort :: String -> [String] -> [String]-fuzzySort q = map snd . sortBy (compare `on` fst) . map (rankMatch q)+fuzzySort q = map snd . sort . map (rankMatch q)  rankMatch :: String -> String -> ((Int, Int), String)-rankMatch q s = (minimum $ rankMatches q s, s)+rankMatch q s = (if null matches then (maxBound, maxBound) else minimum matches, s)+  where matches = rankMatches q s  rankMatches :: String -> String -> [(Int, Int)] rankMatches [] _ = [(0, 0)]-rankMatches q  s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s+rankMatches (q:qs) s = map (\(l, r) -> (r - l, l)) $ findShortestMatches (q :| qs) s -findShortestMatches :: String -> String -> [(Int, Int)]+findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)] findShortestMatches q s = foldl' extendMatches spans oss-  where (os:oss) = map (findOccurrences s) q-        spans    = [(o, o) | o <- os]+  where (os :| oss) = NE.map (findOccurrences s) q+        spans       = [(o, o) | o <- os]  findOccurrences :: String -> Char -> [Int] findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]  extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)]-extendMatches spans xs = map last $ groupBy ((==) `on` snd) $ extendMatches' spans xs+extendMatches spans = map last . groupBy ((==) `on` snd) . extendMatches' spans  extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' []                    _          = []
XMonad/Prompt/Input.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Input+-- Description :  Prompt the user for input and pass it along to some other action. -- Copyright   :  (c) 2007 Brent Yorgey -- License     :  BSD-style (see LICENSE) --@@ -49,13 +50,13 @@ -- @fireEmployee@ action, like so: -- -- > firingPrompt :: X ()--- > firingPrompt = inputPrompt defaultXPConfig "Fire" ?+ fireEmployee+-- > firingPrompt = inputPrompt def "Fire" ?+ fireEmployee -- -- If @employees@ contains a list of all his employees, he could also -- create an autocompleting version, like this: ----- > firingPrompt' = inputPromptWithCompl defaultXPConfig "Fire"--- >                     (mkComplFunFromList employees) ?+ fireEmployee+-- > firingPrompt' = inputPromptWithCompl def "Fire"+-- >                     (mkComplFunFromList def employees) ?+ fireEmployee -- -- Now all he has to do is add a keybinding to @firingPrompt@ (or -- @firingPrompt'@), such as@@ -69,7 +70,7 @@ -- invoked. -- -- (For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".)+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.) -- -- "XMonad.Prompt.Input" is also intended to ease the process of -- developing other modules which require user input. For an example@@ -77,7 +78,7 @@ -- "XMonad.Prompt.Email", which prompts the user for a recipient, -- subject, and one-line body, and sends a quick email. -data InputPrompt = InputPrompt String+newtype InputPrompt = InputPrompt String  instance XPrompt InputPrompt  where     showXPrompt (InputPrompt s) = s ++ ": "
XMonad/Prompt/Layout.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Layout+-- Description :  A layout-selection prompt. -- Copyright   :  (C) 2007 Andrea Rossato, David Roundy -- License     :  BSD3 --@@ -18,15 +19,14 @@                              layoutPrompt                             ) where -import Data.List ( sort, nub )+import XMonad.Prelude ( sort, nub ) import XMonad hiding ( workspaces ) import XMonad.Prompt import XMonad.Prompt.Workspace ( Wor(..) ) import XMonad.StackSet ( workspaces, layout )-import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Layout@@ -34,7 +34,7 @@ -- >   , ((modm .|. shiftMask, xK_m     ), layoutPrompt def) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- WARNING: This prompt won't display all possible layouts, because the -- code to enable this was rejected from xmonad core.  It only displays@@ -46,4 +46,4 @@  layoutPrompt :: XPConfig -> X () layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset)-                    mkXPrompt (Wor "") c (mkComplFunFromList' $ sort $ nub ls) (sendMessage . JumpToLayout)+                    mkXPrompt (Wor "") c (mkComplFunFromList' c $ sort $ nub ls) (sendMessage . JumpToLayout)
XMonad/Prompt/Man.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Man+-- Description :  A manual page prompt. -- Copyright   :  (c) 2007 Valery V. Vorotyntsev -- License     :  BSD3-style (see LICENSE) --@@ -25,21 +26,20 @@   import XMonad+import XMonad.Prelude import XMonad.Prompt import XMonad.Util.Run import XMonad.Prompt.Shell (split)  import System.Directory-import System.Process+import System.FilePath (dropExtensions, (</>)) import System.IO+import System.Process -import qualified Control.Exception.Extensible as E-import Control.Monad-import Data.List-import Data.Maybe+import qualified Control.Exception as E  -- $usage--- 1. In your @~\/.xmonad\/xmonad.hs@:+-- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Man@@ -49,7 +49,7 @@ -- >     , ((modm, xK_F1), manPrompt def) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data Man = Man @@ -60,7 +60,7 @@ manPrompt :: XPConfig -> X () manPrompt c = do   mans <- io getMans-  mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man "+  mkXPrompt Man c (manCompl c mans) $ runInTerm "" . (++) "man "  getMans :: IO [String] getMans = do@@ -71,25 +71,24 @@     p2 <- getout "manpath 2>/dev/null"     return $ intercalate ":" $ lines $ p1 ++ p2   let sects    = ["man" ++ show n | n <- [1..9 :: Int]]-      dirs     = [d ++ "/" ++ s | d <- split ':' paths, s <- sects]+      dirs     = [d </> s | d <- split ':' paths, s <- sects]   mans <- forM (nub dirs) $ \d -> do             exists <- doesDirectoryExist d             if exists-              then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`-                   getDirectoryContents d+              then map dropExtensions <$> getDirectoryContents d               else return []   return $ uniqSort $ concat mans -manCompl :: [String] -> String -> IO [String]-manCompl mans s | s == "" || last s == ' ' = return []-                | otherwise                = do+manCompl :: XPConfig -> [String] -> String -> IO [String]+manCompl c mans s | s == "" || last s == ' ' = return []+                  | otherwise                = do   -- XXX readline instead of bash's compgen?-  f <- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")-  mkComplFunFromList (f ++ mans) s+  f <- lines <$> getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")+  mkComplFunFromList c (f ++ mans) s  -- | Run a command using shell and return its output. ----- XXX Merge into 'XMonad.Util.Run'?+-- XXX Merge into "XMonad.Util.Run"? -- -- (Ask \"gurus\" whether @evaluate (length ...)@ approach is -- better\/more idiomatic.)@@ -102,15 +101,3 @@   E.evaluate (length output)   hClose perr   return output--stripExt :: String -> String-stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse--stripSuffixes :: Eq a => [[a]] -> [a] -> [a]-stripSuffixes sufs fn =-    head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn]--rstrip :: Eq a => [a] -> [a] -> Maybe [a]-rstrip suf lst-    | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst-    | otherwise            = Nothing
+ XMonad/Prompt/OrgMode.hs view
@@ -0,0 +1,684 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData          #-}+{-# LANGUAGE ViewPatterns        #-}+--------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.OrgMode+-- Description :  A prompt for interacting with org-mode.+-- Copyright   :  (c) 2021  Tony Zorman+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org>+-- Stability   :  experimental+-- Portability :  unknown+--+-- A prompt for interacting with <https:\/\/orgmode.org\/ org-mode>.+-- This can be seen as an org-specific version of+-- "XMonad.Prompt.AppendFile", allowing for more interesting+-- interactions with that particular file type.+--+-- It can be used to quickly save TODOs, NOTEs, and the like with the+-- additional capability to schedule/deadline a task, add a priority,+-- refile to some existing heading, and use the system's clipboard+-- (really: the primary selection) as the contents of the note.+--+-- A blog post highlighting some features of this module can be found+-- <https://tony-zorman.com/posts/orgmode-prompt/2022-08-27-xmonad-and-org-mode.html here>.+--+--------------------------------------------------------------------+module XMonad.Prompt.OrgMode (+    -- * Usage+    -- $usage++    -- * Prompts+    orgPrompt,              -- :: XPConfig -> String -> FilePath -> X ()+    orgPromptRefile,        -- :: XPConfig -> [String] -> String -> FilePath -> X ()+    orgPromptRefileTo,      -- :: XPConfig -> String -> String -> FilePath -> X ()+    orgPromptPrimary,       -- :: XPConfig -> String -> FilePath -> X ()++    -- * Types+    ClipboardSupport (..),+    OrgMode,                -- abstract++#ifdef TESTING+    pInput,+    Note (..),+    Priority (..),+    Date (..),+    Time (..),+    TimeOfDay (..),+    OrgTime (..),+    DayOfWeek (..),+#endif++) where++import XMonad.Prelude++import XMonad (X, io, whenJust)+import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPromptWithReturn, mkComplFunFromList, ComplFunction)+import XMonad.Util.Parser+import XMonad.Util.XSelection (getSelection)+import XMonad.Util.Run++import Control.DeepSeq (deepseq)+import qualified Data.List.NonEmpty as NE (head)+import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian)+#if MIN_VERSION_time(1, 9, 0)+import Data.Time.Format.ISO8601 (iso8601Show)+#else+import Data.Time.Format (defaultTimeLocale, formatTime, iso8601DateFormat)+#endif+import GHC.Natural (Natural)+import System.IO (IOMode (AppendMode, ReadMode), hClose, hGetContents, openFile, withFile)++{- $usage++You can use this module by importing it, along with "XMonad.Prompt", in+your @xmonad.hs@++> import XMonad.Prompt+> import XMonad.Prompt.OrgMode (orgPrompt)++and adding an appropriate keybinding.  For example, using syntax from+"XMonad.Util.EZConfig":++> , ("M-C-o", orgPrompt def "TODO" "/home/me/org/todos.org")++This would create notes of the form @* TODO /my-message/@ in the+specified file.++You can also enter a relative path; in that case the file path will be+prepended with @$HOME@ or an equivalent directory.  I.e. instead of the+above you can write++> , ("M-C-o", orgPrompt def "TODO" "org/todos.org")+>                -- also possible: "~/org/todos.org"++There is also some scheduling and deadline functionality present.  This+may be initiated by entering @+s@ or @+d@—separated by at least one+whitespace character on either side—into the prompt, respectively.+Then, one may enter a date and (optionally) a time of day.  Any of the+following are valid dates, where brackets indicate optionality:++  - tod[ay]+  - tom[orrow]+  - /any weekday/+  - /any date of the form DD [MM] [YYYY]/++In the last case, the missing month and year will be filled out with the+current month and year.++For weekdays, we also disambiguate as early as possible; a simple @w@+will suffice to mean Wednesday, but @s@ will not be enough to say+Sunday.  You can, however, also write the full word without any+troubles.  Weekdays always schedule into the future; e.g., if today is+Monday and you schedule something for Monday, you will actually schedule+it for the /next/ Monday (the one in seven days).++The time is specified in the @HH:MM@ or @HHMM@ format.  The minutes may+be omitted, in which case we assume a full hour is specified.  It is also+possible to enter a time span using the syntax @HH:MM-HH:MM@ or @HH:MM+HH@.+In the former case, minutes may be omitted.++A few examples are probably in order.  Suppose we have bound the key+above, pressed it, and are now confronted with a prompt:++  - @hello +s today@ would create a TODO note with the header @hello@+    and would schedule that for today's date.++  - @hello +s today 12@ schedules the note for today at 12:00.++  - @hello +s today 12:30@ schedules it for today at 12:30.++  - @hello +d today 12:30@ works just like above, but creates a+    deadline.++  - @hello +d today 12:30-14:30@ works like the above, but gives the+    event a duration of two hours.  An alternative way to specify+    this would be @hello +d today 12:30+2@.++  - @hello +s thu@ would schedule the note for next thursday.++  - @hello +s 11@ would schedule it for the 11th of this month and this+    year.++  - @hello +s 11 jan 2013@ would schedule the note for the 11th of+    January 2013.++Note that, due to ambiguity concerns, years below @25@ result in+undefined parsing behaviour.  Otherwise, what should @message +s 11 jan+13@ resolve to—the 11th of january at 13:00 or the 11th of january in+the year 13?++There is basic support for alphabetic org-mode+<https:\/\/orgmode.org\/manual\/Priorities.html priorities>.+Simply append either @#A@, @#B@, or @#C@ (capitalisation is optional) to+the end of the note.  For example, one could write @"hello +s 11 jan+2013 #A"@ or @"hello #C"@.  Note that there has to be at least one+whitespace character between the end of the note and the chosen+priority.++There's also the possibility to take what's currently in the primary+selection and paste that as the content of the created note.  This is+especially useful when you want to quickly save a URL for later and+return to whatever you were doing before.  See the 'orgPromptPrimary'+prompt for that.++Finally, 'orgPromptRefile' and 'orgPromptRefileTo' provide support to+automatically+<https://orgmode.org/manual/Refile-and-Copy.html refile>+the generated item under a heading of choice.  For example, binding++> orgPromptRefile def "TODO" "todos.org"++to a key will first pop up an ordinary prompt that works exactly like+'orgPrompt', and then query the user for an already existing heading+(with completions) as provided by the @~/todos.org@ file.  If that+prompt is cancelled, the heading will appear in the org file as normal+(i.e., at the end of the file); otherwise, it gets refiled under the+selected heading.++-}++{- TODO++  - XMonad.Util.XSelection.getSelection is really, really horrible.  The+    plan would be to rewrite this in a way so it uses xmonad's+    connection to the X server.++  - Add option to explicitly use the system clipboard instead of the+    primary selection.++-}++------------------------------------------------------------------------+-- Prompt++data OrgMode = OrgMode+  { clpSupport :: ClipboardSupport+  , todoHeader :: String    -- ^ Will display like @* todoHeader @+  , orgFile    :: FilePath+  }++mkOrgCfg :: ClipboardSupport -> String -> FilePath -> X OrgMode+mkOrgCfg clp header fp = OrgMode clp header <$> mkAbsolutePath fp++-- | Whether we should use a clipboard and which one to use.+data ClipboardSupport+  = PrimarySelection+  | NoClpSupport++-- | How one should display the clipboard string.+data Clp+  = Header String  -- ^ In the header as a link: @* [[clp][message]]@+  | Body   String  -- ^ In the body as additional text: @* message \n clp@++instance XPrompt OrgMode where+  showXPrompt :: OrgMode -> String+  showXPrompt OrgMode{ todoHeader, orgFile, clpSupport } =+    mconcat ["Add ", todoHeader, clp, " to ", orgFile, ": "]+   where+    clp :: String = case clpSupport of+      NoClpSupport     -> ""+      PrimarySelection -> " + PS"++-- | Prompt for interacting with @org-mode@.+orgPrompt+  :: XPConfig  -- ^ Prompt configuration+  -> String    -- ^ What kind of note to create; will be displayed after+               --   a single @*@+  -> FilePath  -- ^ Path to @.org@ file, e.g. @home\/me\/todos.org@+  -> X ()+orgPrompt xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg NoClpSupport++-- | Like 'orgPrompt', but additionally make use of the primary+-- selection.  If it is a URL, then use an org-style link+-- @[[primary-selection][entered message]]@ as the heading.  Otherwise,+-- use the primary selection as the content of the note.+--+-- The prompt will display a little @+ PS@ in the window+-- after the type of note.+orgPromptPrimary :: XPConfig -> String -> FilePath -> X ()+orgPromptPrimary xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg PrimarySelection++-- | Internal type in order to generate a nice prompt in+-- 'orgPromptRefile' and 'orgPromptRefileTo'.+data RefilePrompt = Refile+instance XPrompt RefilePrompt where+  showXPrompt :: RefilePrompt -> String+  showXPrompt Refile = "Refile note to: "++-- | Like 'orgPrompt' (which see for the other arguments), but offer to+-- refile the entered note afterwards.+--+-- Note that refiling is done by shelling out to Emacs, hence an @emacs@+-- binary must be in @$PATH@.  One may customise this by following the+-- instructions in "XMonad.Util.Run#g:EDSL"; more specifically, by+-- changing the 'XMonad.Util.Run.emacs' field of+-- 'XMonad.Util.Run.ProcessConfig'.+orgPromptRefile :: XPConfig -> String -> FilePath -> X ()+orgPromptRefile xpc str fp = do+  orgCfg <- mkOrgCfg NoClpSupport str fp++  -- NOTE: Ideally we would just use System.IO.readFile' here+  -- (especially because it also reads everything strictly), but this is+  -- only available starting in base 4.15.x.+  fileContents <- io $ do+    handle   <- openFile (orgFile orgCfg) ReadMode+    contents <- hGetContents handle+    contents <$ (contents `deepseq` hClose handle)++  -- Save the entry as soon as possible.+  notCancelled <- mkOrgPrompt xpc orgCfg+  when notCancelled $+    -- If the user didn't cancel, try to parse the org file and offer to+    -- refile the entry if possible.+    whenJust (runParser pOrgFile fileContents) $ \headings ->+      mkXPromptWithReturn Refile xpc (completeHeadings headings) pure >>= \case+        Nothing     -> pure ()+        Just parent -> refile parent (orgFile orgCfg)+ where+  completeHeadings :: [Heading] -> ComplFunction+  completeHeadings = mkComplFunFromList xpc . map headingText++-- | Like 'orgPromptRefile', but with a fixed heading for refiling; no+-- prompt will appear to query for a target.+--+-- Heading names may omit tags, but generally need to be prefixed by the+-- correct todo keywords; e.g.,+--+-- > orgPromptRefileTo def "PROJECT Work" "TODO" "~/todos.org"+--+-- Will refile the created note @"TODO <text>"@ to the @"PROJECT Work"@+-- heading, even with the actual name is @"PROJECT Work+-- :work:other_tags:"@.  Just entering @"Work"@ will not work, as Emacs+-- doesn't recognise @"PROJECT"@ as an Org keyword by default (i.e. when+-- started in batch-mode).+orgPromptRefileTo+  :: XPConfig+  -> String     -- ^ Heading to refile the entry under.+  -> String+  -> FilePath+  -> X ()+orgPromptRefileTo xpc refileHeading str fp = do+  orgCfg       <- mkOrgCfg NoClpSupport str fp+  notCancelled <- mkOrgPrompt xpc orgCfg+  when notCancelled $ refile refileHeading (orgFile orgCfg)++-- | Create the actual prompt.  Returns 'False' when the input was+-- cancelled by the user (by, for example, pressing @Esc@ or @C-g@) and+-- 'True' otherwise.+mkOrgPrompt :: XPConfig -> OrgMode -> X Bool+mkOrgPrompt xpc oc@OrgMode{ todoHeader, orgFile, clpSupport } =+  isJust <$> mkXPromptWithReturn oc xpc (const (pure [])) appendNote+ where+  -- | Parse the user input, create an @org-mode@ note out of that and+  -- try to append it to the given file.+  appendNote :: String -> X ()+  appendNote input = io $ do+    clpStr <- case clpSupport of+      NoClpSupport     -> pure $ Body ""+      PrimarySelection -> do+        sel <- getSelection+        pure $ if   any (`isPrefixOf` sel) ["http://", "https://"]+               then Header sel+               else Body   $ "\n " <> sel++    withFile orgFile AppendMode . flip hPutStrLn+      <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput+        $ input++------------------------------------------------------------------------+-- Refiling++-- | Let Emacs do the refiling, as this seems—and I know how this+-- sounds—more robust than trying to do it ad-hoc in this module.+refile :: String -> FilePath -> X ()+refile (asString -> parent) (asString -> fp) =+  proc $ inEmacs+     >-> asBatch+     >-> eval (progn [ "find-file" <> fp+                     , "end-of-buffer"+                     , "org-refile nil nil"+                         <> list [ parent+                                 , fp+                                 , "nil"+                                 , saveExcursion ["org-find-exact-headline-in-buffer"+                                                    <> parent]+                                 ]+                     , "save-buffer"+                     ])++------------------------------------------------------------------------+-- Time++-- | A 'Time' is a 'Date' with the possibility of having a specified+-- @HH:MM@ time.+data Time = Time+  { date :: Date+  , tod  :: Maybe OrgTime+  }+  deriving (Eq, Show)++-- | The time in HH:MM.+data TimeOfDay = HHMM Int Int+  deriving (Eq)++instance Show TimeOfDay where+  show :: TimeOfDay -> String+  show (HHMM h m) = pad h <> ":" <> pad m+   where+    pad :: Int -> String+    pad n = (if n <= 9 then "0" else "") <> show n++-- | The time—possibly as a span—in HH:MM format.+data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay+  deriving (Eq)++instance Show OrgTime where+  show :: OrgTime -> String+  show (MomentInTime tod)  = show tod+  show (TimeSpan tod tod') = show tod <> "-" <> show tod'++-- | Type for specifying exactly which day one wants.+data Date+  = Today+  | Tomorrow+  | Next DayOfWeek+    -- ^ This will __always__ show the next 'DayOfWeek' (e.g. calling+    -- 'Next Monday' on a Monday will result in getting the menu for the+    -- following Monday)+  | Date (Int, Maybe Int, Maybe Integer)+    -- ^ Manual date entry in the format DD [MM] [YYYY]+  deriving (Eq, Ord, Show)++toOrgFmt :: Maybe OrgTime -> Day -> String+toOrgFmt tod day =+  mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"]+ where+  time   :: String = maybe "" ((' ' :) . show) tod+#if MIN_VERSION_time(1, 9, 0)+  isoDay :: String = iso8601Show day+#else+  isoDay :: String = formatTime defaultTimeLocale (iso8601DateFormat Nothing) day+#endif++-- | Pretty print a 'Date' and an optional time to reflect the actual+-- date.+ppDate :: Time -> IO String+ppDate Time{ date, tod } = do+  curTime <- getCurrentTime+  let curDay      = utctDay curTime+      (y, m, _)   = toGregorian curDay+      diffToDay d = diffBetween d (dayOfWeek curDay)++  pure . toOrgFmt tod $ case date of+    Today              -> curDay+    Tomorrow           -> utctDay $ addDays 1 curTime+    Next wday          -> utctDay $ addDays (diffToDay wday) curTime+    Date (d, mbM, mbY) -> fromGregorian (fromMaybe y mbY) (fromMaybe m mbM) d+ where+  -- | Add a specified number of days to a 'UTCTime'.+  addDays :: NominalDiffTime -> UTCTime -> UTCTime+    = addUTCTime . (* nominalDay)++  -- | Evil enum hackery.+  diffBetween :: DayOfWeek -> DayOfWeek -> NominalDiffTime+  diffBetween d cur  -- we want to jump to @d@+    | d == cur  = 7+    | otherwise = fromIntegral . abs $ (fromEnum d - fromEnum cur) `mod` 7++-- Old GHC versions don't have a @time@ library new enough to have+-- this, so replicate it here for the moment.++dayOfWeek :: Day -> DayOfWeek+dayOfWeek (ModifiedJulianDay d) = toEnum $ fromInteger $ d + 3++data DayOfWeek+  = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday+  deriving (Eq, Ord, Show)++-- | \"Circular\", so for example @[Tuesday ..]@ gives an endless+-- sequence.  Also: 'fromEnum' gives [1 .. 7] for [Monday .. Sunday],+-- and 'toEnum' performs mod 7 to give a cycle of days.+instance Enum DayOfWeek where+  toEnum :: Int -> DayOfWeek+  toEnum i = case mod i 7 of+    0 -> Sunday+    1 -> Monday+    2 -> Tuesday+    3 -> Wednesday+    4 -> Thursday+    5 -> Friday+    _ -> Saturday++  fromEnum :: DayOfWeek -> Int+  fromEnum = \case+    Monday    -> 1+    Tuesday   -> 2+    Wednesday -> 3+    Thursday  -> 4+    Friday    -> 5+    Saturday  -> 6+    Sunday    -> 7++------------------------------------------------------------------------+-- Note++-- | An @org-mode@ style note.+data Note+  = Scheduled String Time Priority+  | Deadline  String Time Priority+  | NormalMsg String      Priority+  deriving (Eq, Show)++-- | An @org-mode@ style priority symbol[1]; e.g., something like+-- @[#A]@.  Note that this uses the standard org conventions: supported+-- priorities are @A@, @B@, and @C@, with @A@ being the highest.+-- Numerical priorities are not supported.+--+-- [1]: https://orgmode.org/manual/Priorities.html+data Priority = A | B | C | NoPriority+  deriving (Eq, Show)++-- | Pretty print a given 'Note'.+ppNote :: Clp -> String -> Note -> IO String+ppNote clp todo = \case+  Scheduled str time prio -> mkLine str "SCHEDULED: " (Just time) prio+  Deadline  str time prio -> mkLine str "DEADLINE: "  (Just time) prio+  NormalMsg str      prio -> mkLine str ""            Nothing     prio+ where+  mkLine :: String -> String -> Maybe Time -> Priority -> IO String+  mkLine str sched time prio = do+    t <- case time of+      Nothing -> pure ""+      Just ti -> (("\n  " <> sched) <>) <$> ppDate ti+    pure $ "* " <> todo <> priority <> case clp of+      Body   c -> mconcat [str, t, c]+      Header c -> mconcat ["[[", c, "][", str,"]]", t]+   where+    priority = case prio of+      NoPriority -> " "+      otherPrio  -> " [#" <> show otherPrio <> "] "++------------------------------------------------------------------------+-- Note parsing++-- | Parse the given string into a 'Note'.+pInput :: String -> Maybe Note+pInput inp = (`runParser` inp) . choice $+  [ Scheduled <$> (getLast "+s" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority+  , Deadline  <$> (getLast "+d" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority+  , do s <- munch1 (pure True)+       let (s', p) = splitAt (length s - 3) s+       pure $ case tryPrio p of+         Just prio -> NormalMsg (dropStripEnd 0 s') prio+         Nothing   -> NormalMsg s                   NoPriority+  ]+ where+  fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time+  fixTime d tod = case (d, tod) of+    (Nothing, Nothing) -> mempty                -- no day and no time+    (Nothing, Just{})  -> pure (Time Today tod) -- no day, but a time+    (Just d', _)       -> pure (Time d'    tod) -- day given++  tryPrio :: String -> Maybe Priority+  tryPrio [' ', '#', x]+    | x `elem` ("Aa" :: String) = Just A+    | x `elem` ("Bb" :: String) = Just B+    | x `elem` ("Cc" :: String) = Just C+  tryPrio _ = Nothing++  -- Trim whitespace at the end of a string after dropping some number+  -- of characters from it.+  dropStripEnd :: Int -> String -> String+  dropStripEnd n = reverse . dropWhile (== ' ') . drop n . reverse++  getLast :: String -> Parser String+  getLast ptn =  dropStripEnd (length ptn) -- drop only the last pattern before stripping+              .  concat+             <$> endBy1 (go "") (pure ptn)+   where+    go :: String -> Parser String+    go consumed = do+      str  <- munch  (/= NE.head (notEmpty ptn))+      word <- munch1 (/= ' ')+      bool go pure (word == ptn) $ consumed <> str <> word++-- | Parse a 'Priority'.+pPriority :: Parser Priority+pPriority = option NoPriority $+  skipSpaces *> choice+    [ "#" *> foldCase "a" $> A+    , "#" *> foldCase "b" $> B+    , "#" *> foldCase "c" $> C+    ]++-- | Try to parse a 'Time'.+pOrgTime :: Parser (Maybe OrgTime)+pOrgTime = option Nothing $+  between skipSpaces (void " " <|> eof) $+    Just <$> choice+      [ TimeSpan <$> (pTimeOfDay <* ("--" <|> "-" <|> "–")) <*> pTimeOfDay+      -- Org is not super smart around times with this syntax, so+      -- we pretend not to be as well.+      , do from@(HHMM h m) <- pTimeOfDay <* "+"+           off <- pHour+           pure $ TimeSpan from (HHMM (h + off) m)+      , MomentInTime <$> pTimeOfDay+      ]+ where+  pTimeOfDay :: Parser TimeOfDay+  pTimeOfDay = choice+    [ HHMM <$> pHour <* ":" <*> pMinute -- HH:MM+    , pHHMM                             -- HHMM+    , HHMM <$> pHour        <*> pure 0  -- HH+    ]++  pHHMM :: Parser TimeOfDay+  pHHMM = do+    let getTwo = count 2 (satisfy isDigit)+    hh <- read <$> getTwo+    guard (hh >= 0 && hh <= 23)+    mm <- read <$> getTwo+    guard (mm >= 0 && mm <= 59)+    pure $ HHMM hh mm++  pHour   :: Parser Int = pNumBetween 0 23+  pMinute :: Parser Int = pNumBetween 0 59++-- | Try to parse a 'Date'.+pDate :: Parser (Maybe Date)+pDate = skipSpaces *> optional (choice+  [ pPrefix "tod" "ay"    Today+  , pPrefix "tom" "orrow" Tomorrow+  , Next <$> pNext+  , Date <$> pDate'+  ])+ where+  pNext :: Parser DayOfWeek = choice+    [ pPrefix "m"  "onday"    Monday   , pPrefix "tu" "esday"  Tuesday+    , pPrefix "w"  "ednesday" Wednesday, pPrefix "th" "ursday" Thursday+    , pPrefix "f"  "riday"    Friday   , pPrefix "sa" "turday" Saturday+    , pPrefix "su" "nday"     Sunday+    ]++  numWithoutColon :: Parser Int+  numWithoutColon = do+    str <- pNumBetween 1 12 -- month+    c <- get+    if c == ':'+    then pfail+    else pure str++  pDate' :: Parser (Int, Maybe Int, Maybe Integer)+  pDate' =+    (,,) <$> (pNumBetween 1 31 <* (void " " <|> eof))  -- day+         <*> optional (skipSpaces *> choice+               [ pPrefix "ja"  "nuary"    1 , pPrefix "f"   "ebruary" 2+               , pPrefix "mar" "ch"       3 , pPrefix "ap"  "ril"     4+               , pPrefix "may" ""         5 , pPrefix "jun" "e"       6+               , pPrefix "jul" "y"        7 , pPrefix "au"  "gust"    8+               , pPrefix "s"   "eptember" 9 , pPrefix "o"   "ctober"  10+               , pPrefix "n"   "ovember"  11, pPrefix "d"   "ecember" 12+               , numWithoutColon+               ])+         <*> optional (skipSpaces *> num >>= \i -> guard (i >= 25) $> i)++  -- Parse a prefix and drop a potential suffix up to the next (space+  -- separated) word.  If successful, return @ret@.+  pPrefix :: String -> String -> a -> Parser a+  pPrefix start (map toLower -> leftover) ret = do+    void (foldCase start)+    l <- map toLower <$> munch (/= ' ')+    guard (l `isPrefixOf` leftover)+    pure ret++-- | Parse a number between @lo@ (inclusive) and @hi@ (inclusive).+pNumBetween :: Int -> Int -> Parser Int+pNumBetween lo hi = do+  n <- num+  n <$ guard (n >= lo && n <= hi)++-- Parse the given string case insensitively.+foldCase :: String -> Parser String+foldCase = traverse (\c -> char (toLower c) <|> char (toUpper c))++------------------------------------------------------------------------+-- File parsing++data Heading = Heading+  { level       :: Natural+    -- ^ Level of the Org heading; i.e., the number of leading stars.+  , headingText :: String+    -- ^ The heading text without its level.+  }++-- | Naïvely parse an Org file.  At this point, only the headings are+-- parsed into a non-nested list (ignoring parent-child relations); no+-- further analysis is done on the individual lines themselves.+pOrgFile :: Parser [Heading]+pOrgFile = many pHeading++pHeading :: Parser Heading+pHeading = skipSpaces *> do+  level       <- genericLength <$> munch1 (== '*') <* " "+  headingText <- pLine+  void $ many (pLine >>= \line -> guard (isNotHeading line) $> line) -- skip body+  pure Heading{..}++pLine :: Parser String+pLine = munch (/= '\n') <* "\n"++isNotHeading :: String -> Bool+isNotHeading str = case break (/= '*') str of+  ("", _)       -> True+  (_ , ' ' : _) -> False+  _             -> True
XMonad/Prompt/Pass.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Pass+-- Description :  A prompt for interacting with @pass(1)@. -- Copyright   :  (c) 2014 Igor Babuschkin, Antoine R. Dumont -- License     :  BSD3-style (see LICENSE) --@@ -8,73 +10,125 @@ -- Stability   :  unstable -- Portability :  unportable ----- This module provides 4 <XMonad.Prompt> to ease password manipulation (generate, read, remove):+-- A thin wrapper around the standard @pass(1)@ UNIX utility. ----- - two to lookup passwords in the password-store; one of which copies to the---   clipboard, and the other uses @xdotool@ to type the password directly.+-- This module provides several prompts to ease password manipulation+-- (generate, read, edit, remove); all of them benefit from the+-- completion system provided by "XMonad.Prompt".  Specifically, we+-- provide ----- - one to generate a password for a given password label that the user inputs.+-- - various functions to lookup passwords in the password-store: ----- - one to delete a stored password for a given password label that the user inputs.+--     + 'passPrompt' copies the password directly to the clipboard. ----- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>.+--     + 'passOTPPrompt' copies a one-time-password to the clipboard+--        (this uses <https://github.com/tadfisher/pass-otp pass-otp>). ----- The password store is setup through an environment variable PASSWORD_STORE_DIR,--- or @$HOME\/.password-store@ if it is unset.+--     + 'passTypePrompt' and 'passOTPTypePrompt' work like the above,+--       respectively, but use @xdotool@ to type out the password. --+-- - 'passGeneratePrompt' generates a password for a given password+--   label that the user inputs.+--+-- - 'passEditPrompt' edits a password for a given password label that+--   the user inputs.+--+-- - 'passRemovePrompt' deletes a stored password for a given password+--   label that the user inputs.+--+-- The password store is setup through an environment variable+-- @$PASSWORD_STORE_DIR@, or @$HOME\/.password-store@ if it is unset.+-- The editor is determined from the environment variable @$EDITOR@.+-- -- Source: ----- - The password store implementation is <http://git.zx2c4.com/password-store the password-store cli>.+-- - The <https://www.passwordstore.org/ password store>+--   implementation is <http://git.zx2c4.com/password-store here>. -- -- - Inspired by <http://babushk.in/posts/combining-xmonad-and-pass.html> -- ----------------------------------------------------------------------------- -module XMonad.Prompt.Pass (-                            -- * Usage-                            -- $usage-                              passPrompt-                            , passGeneratePrompt-                            , passRemovePrompt-                            , passTypePrompt-                            ) where+module XMonad.Prompt.Pass+    ( -- * Usage+      -- $usage -import XMonad.Core-import XMonad.Prompt ( XPrompt-                     , showXPrompt-                     , commandToComplete-                     , nextCompletion-                     , getNextCompletion-                     , XPConfig-                     , mkXPrompt-                     , searchPredicate)+      -- * Retrieving passwords+      passPrompt+    , passPrompt'+    , passTypePrompt++      -- * Editing passwords+    , passEditPrompt+    , passEditPrompt'+    , passRemovePrompt+    , passRemovePrompt'+    , passGeneratePrompt+    , passGeneratePrompt'+    , passGenerateAndCopyPrompt+    , passGenerateAndCopyPrompt'++      -- * One-time-passwords+    , passOTPPrompt+    , passOTPTypePrompt+    ) where+ import System.Directory (getHomeDirectory)-import System.FilePath (takeExtension, dropExtension, combine)+import System.FilePath (dropExtension, (</>)) import System.Posix.Env (getEnv)+import XMonad+import XMonad.Prelude+import XMonad.Prompt+  ( XPConfig,+    XPrompt,+    commandToComplete,+    getNextCompletion,+    mkXPrompt,+    nextCompletion,+    searchPredicate,+    showXPrompt,+  ) import XMonad.Util.Run (runProcessWithInput)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt.Pass ----- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt':+-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt',+-- 'passRemovePrompt', 'passEditPrompt' or 'passTypePrompt': ----- >   , ((modMask , xK_p)                              , passPrompt xpconfig)--- >   , ((modMask .|. controlMask, xK_p)               , passGeneratePrompt xpconfig)--- >   , ((modMask .|. controlMask  .|. shiftMask, xK_p), passRemovePrompt xpconfig)+-- >   , ((modMask , xK_p)                              , passPrompt def)+-- >   , ((modMask .|. controlMask, xK_p)               , passGeneratePrompt def)+-- >   , ((modMask .|. shiftMask, xK_p)                 , passEditPrompt def)+-- >   , ((modMask .|. controlMask  .|. shiftMask, xK_p), passRemovePrompt def) --+-- You can also use the versions that let you specify a custom prompt:+--+-- >   , ((modMask , xK_p)                              , passPrompt' "Ask 'pass' for" def)+--+-- Note that, by default, we do not use fuzzy matching in this module.+-- To enable this feature, import the "XMonad.Prompt.FuzzyMatch" module+-- and add the relevant functions to your prompt configuration:+--+-- > myXPConfig :: XPConfig+-- > myXPConfig = def+-- >   { searchPredicate = fuzzyMatch+-- >   , sorter          = fuzzySort+-- >   }+-- >+-- > , ((modMask , xK_p), passPrompt myXPConfig)+-- -- For detailed instructions on: ----- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".+-- - editing your key bindings, see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -- -- - how to setup the password store, see <http://git.zx2c4.com/password-store/about/>+--   or @man 1 pass@. -- -type Predicate = String -> String -> Bool--getPassCompl :: [String] -> Predicate -> String -> IO [String]-getPassCompl compls p s = return $ filter (p s) compls+---------------------------------------------------------------------------------+-- Prompt  type PromptLabel = String @@ -85,90 +139,175 @@   commandToComplete _ c           = c   nextCompletion      _           = getNextCompletion --- | Default password store folder in $HOME/.password-store+-- | A prompt to retrieve a password from a given entry. ---passwordStoreFolderDefault :: String -> String-passwordStoreFolderDefault home = combine home ".password-store"+passPrompt :: XPConfig -> X ()+passPrompt = passPrompt' "Select password" --- | Compute the password store's location.--- Use the PASSWORD_STORE_DIR environment variable to set the password store.--- If empty, return the password store located in user's home.----passwordStoreFolder :: IO String-passwordStoreFolder =-  getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir-  where computePasswordStoreDir Nothing         = fmap passwordStoreFolderDefault getHomeDirectory-        computePasswordStoreDir (Just storeDir) = return storeDir+-- | The same as 'passPrompt' but with a user-specified prompt.+passPrompt' :: String -> XPConfig -> X ()+passPrompt' s = mkPassPrompt s selectPassword --- | A pass prompt factory+-- | A prompt to retrieve a OTP from a given entry.  Note that you will+-- need to use the <https://github.com/tadfisher/pass-otp pass-otp>+-- extension for this to work. ---mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()-mkPassPrompt promptLabel passwordFunction xpconfig = do-  passwords <- io (passwordStoreFolder >>= getPasswords)-  mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction+passOTPPrompt :: XPConfig -> X ()+passOTPPrompt = mkPassPrompt "Select OTP" selectOTP --- | A prompt to retrieve a password from a given entry.+-- | A prompt to retrieve a OTP from a given entry.  Note that you will+-- need to use the <https://github.com/tadfisher/pass-otp pass-otp>+-- extension for this to work. ---passPrompt :: XPConfig -> X ()-passPrompt = mkPassPrompt "Select password" selectPassword+passOTPTypePrompt :: XPConfig -> X ()+passOTPTypePrompt = mkPassPrompt "Select OTP" selectOTPType  -- | A prompt to generate a password for a given entry. -- This can be used to override an already stored entry. -- (Beware that no confirmation is asked) -- passGeneratePrompt :: XPConfig -> X ()-passGeneratePrompt = mkPassPrompt "Generate password" generatePassword+passGeneratePrompt = passGeneratePrompt' "Generate password" +-- | The same as 'passGeneratePrompt' but with a user-specified prompt.+passGeneratePrompt' :: String -> XPConfig -> X ()+passGeneratePrompt' s = mkPassPrompt s generatePassword++-- | A prompt to generate a password for a given entry and immediately copy it+-- to the clipboard.  This can be used to override an already stored entry.+-- (Beware that no confirmation is asked)+--+passGenerateAndCopyPrompt :: XPConfig -> X ()+passGenerateAndCopyPrompt = passGenerateAndCopyPrompt' "Generate and copy password"++-- | The same as 'passGenerateAndCopyPrompt' but with a user-specified prompt.+passGenerateAndCopyPrompt' :: String -> XPConfig -> X ()+passGenerateAndCopyPrompt' s = mkPassPrompt s generateAndCopyPassword+ -- | A prompt to remove a password for a given entry. -- (Beware that no confirmation is asked) -- passRemovePrompt :: XPConfig -> X ()-passRemovePrompt = mkPassPrompt "Remove password" removePassword+passRemovePrompt = passRemovePrompt' "Remove password" +-- | The same as 'passRemovePrompt' but with a user-specified prompt.+passRemovePrompt' :: String -> XPConfig -> X ()+passRemovePrompt' s = mkPassPrompt s removePassword+ -- | A prompt to type in a password for a given entry. -- This doesn't touch the clipboard. -- passTypePrompt :: XPConfig -> X () passTypePrompt = mkPassPrompt "Type password" typePassword +-- | A prompt to edit a given entry.+-- This doesn't touch the clipboard.+--+passEditPrompt :: XPConfig -> X ()+passEditPrompt = passEditPrompt' "Edit password"++-- | The same as 'passEditPrompt' but with a user-specified prompt.+passEditPrompt' :: String -> XPConfig -> X ()+passEditPrompt' s = mkPassPrompt s editPassword++-- | A pass prompt factory.+--+mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()+mkPassPrompt promptLabel passwordFunction xpconfig = do+  passwords <- io (passwordStoreFolder >>= getPasswords)+  mkXPrompt (Pass promptLabel)+            xpconfig+            (getPassCompl passwords $ searchPredicate xpconfig)+            passwordFunction+ where+  getPassCompl :: [String] -> (String -> String -> Bool) -> String -> IO [String]+  getPassCompl compls p s = return $ filter (p s) compls++  -- Compute the password store's location. Use the @$PASSWORD_STORE_DIR@+  -- environment variable to set the password store. If empty, return the+  -- password store located in user's home.+  passwordStoreFolder :: IO String+  passwordStoreFolder =+    getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir+   where+    -- Default password store folder in @$HOME/.password-store@.+    computePasswordStoreDir :: Maybe String -> IO String+    computePasswordStoreDir = \case+      Nothing       -> getHomeDirectory <&> (</> ".password-store")+      Just storeDir -> return storeDir++  -- Retrieve the list of passwords from the password store @passwordStoreDir@.+  getPasswords :: FilePath -> IO [String]+  getPasswords passwordStoreDir = do+    files <- runProcessWithInput "find" [+      "-L", -- Traverse symlinks+      passwordStoreDir,+      "-type", "f",+      "-name", "*.gpg",+      "-printf", "%P\n"] []+    return . map dropExtension $ lines files++---------------------------------------------------------------------------------+-- Selecting a password+ -- | Select a password. -- selectPassword :: String -> X ()-selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\""+selectPassword = spawn . pass "--clip" +-- | Select a one-time-password and copy it to the clipboard.+--+selectOTP :: String -> X ()+selectOTP = spawn . pass "otp --clip"++-- | Select a one-time-password and type it out.+--+selectOTPType :: String -> X ()+selectOTPType = spawn . typeString . pass "otp"+ -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- generatePassword :: String -> X ()-generatePassword passLabel = spawn $ "pass generate --force \"" ++ escapeQuote passLabel ++ "\" 30"+generatePassword passLabel = spawn $ pass "generate --force" passLabel ++ " 30" +-- | Generate a 30 characters password for a given entry.+-- If the entry already exists, it is updated with a new password.+-- After generating the password, it is copied to the clipboard.+--+generateAndCopyPassword :: String -> X ()+generateAndCopyPassword passLabel = spawn $ pass "generate --force -c" passLabel ++ " 30"+ -- | Remove a password stored for a given entry. -- removePassword :: String -> X ()-removePassword passLabel = spawn $ "pass rm --force \"" ++ escapeQuote passLabel ++ "\""+removePassword = spawn . pass "rm --force" +-- | Edit a password stored for a given entry.+--+editPassword :: String -> X ()+editPassword = spawn . pass "edit"+ -- | Type a password stored for a given entry using xdotool. -- typePassword :: String -> X ()-typePassword passLabel = spawn $ "pass \"" ++ escapeQuote passLabel-  ++ "\"|head -n1|tr -d '\n'|xdotool type --clearmodifiers --file -"--escapeQuote :: String -> String-escapeQuote = concatMap escape-  where escape :: Char -> String-        escape '"' = ['\\', '\"']-        escape x = return x+typePassword = spawn . typeString . pass "" --- | Retrieve the list of passwords from the password store 'passwordStoreDir-getPasswords :: FilePath -> IO [String]-getPasswords passwordStoreDir = do-  files <- runProcessWithInput "find" [-    passwordStoreDir,-    "-type", "f",-    "-name", "*.gpg",-    "-printf", "%P\n"] []-  return . map removeGpgExtension $ lines files+-- | Type the given string with @xdotool@.+--+-- >>> typeString (pass "" "arXiv")+-- "pass  \"arXiv\" | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -"+typeString :: String -> String+typeString cmd = cmd ++ " | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -" -removeGpgExtension :: String -> String-removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file-                        | otherwise                    = file+-- | Generate a pass prompt.+--+-- >>> pass "otp" "\\n'git'\"hub\""+-- "pass otp \"\\\\n'git'\\\"hub\\\"\""+pass :: String -> String -> String+pass cmd label = concat ["pass ", cmd, " \"", concatMap escape label, "\""]+ where+  escape :: Char -> String+  escape '"'  = "\\\""+  escape '\\' = "\\\\"+  escape x    = [x]
XMonad/Prompt/RunOrRaise.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.RunOrRaise+-- Description :  A prompt to run a program, open a file, or raise a running program. -- Copyright   :  (C) 2008 Justin Bogner -- License     :  BSD3 --@@ -21,20 +22,20 @@     ) where  import XMonad hiding (config)+import XMonad.Prelude import XMonad.Prompt import XMonad.Prompt.Shell import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput)  import Control.Exception as E-import Control.Monad (liftM, liftM2)-import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions)+import System.Directory (doesDirectoryExist, doesFileExist, executable, findExecutable, getPermissions)  econst :: Monad m => a -> IOException -> m a econst = const . return  {- $usage-1. In your @~\/.xmonad\/xmonad.hs@:+1. In your @xmonad.hs@:  > import XMonad.Prompt > import XMonad.Prompt.RunOrRaise@@ -44,7 +45,8 @@ >   , ((modm .|. controlMask, xK_x), runOrRaisePrompt def)  For detailed instruction on editing the key binding see-"XMonad.Doc.Extending#Editing_key_bindings". -}+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.+-}  data RunOrRaisePrompt = RRP instance XPrompt RunOrRaisePrompt where@@ -59,15 +61,20 @@             then spawn $ "xdg-open \"" ++ path ++ "\""             else uncurry runOrRaise . getTarget $ path     where-      isNormalFile f = exists f >>= \e -> if e then notExecutable f else return False-      exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f]+      isNormalFile f = do+          notCommand <- isNothing <$> findExecutable f -- not a command (executable in $PATH)+          exists <- or <$> sequence [doesDirExist f, doesFileExist f]+          case (notCommand, exists) of+              (True, True) -> notExecutable f -- not executable as a file in current dir+              _            -> pure False       notExecutable = fmap (not . executable) . getPermissions+      doesDirExist f = ("/" `isSuffixOf` f &&) <$> doesDirectoryExist f       getTarget x = (x,isApp x)  isApp :: String -> Query Bool isApp "firefox"     = className =? "Firefox-bin"     <||> className =? "Firefox" isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird"-isApp x = liftM2 (==) pid $ pidof x+isApp x = liftA2 (==) pid $ pidof x  pidof :: String -> Query Int pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0@@ -75,7 +82,7 @@ pid :: Query Int pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w)     where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $-                       liftM getPID' (getWindowProperty32 d a w)+                       fmap getPID' (getWindowProperty32 d a w)           getPID' (Just (x:_)) = fromIntegral x-          getPID' (Just [])     = -1-          getPID' (Nothing)     = -1+          getPID' (Just [])    = -1+          getPID' Nothing      = -1
XMonad/Prompt/Shell.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns      #-} {- | Module      :  XMonad.Prompt.Shell+Description :  A shell prompt. Copyright   :  (C) 2007 Andrea Rossato License     :  BSD3 @@ -17,28 +20,31 @@     , shellPrompt     -- ** Variations on shellPrompt     -- $spawns-    , prompt     , safePrompt+    , safeDirPrompt     , unsafePrompt+    , prompt      -- * Utility functions+    , compgenDirectories+    , compgenFiles     , getCommands     , getBrowser     , getEditor     , getShellCompl+    , getShellCompl'     , split     ) where  import           Codec.Binary.UTF8.String (encodeString) import           Control.Exception        as E-import           Control.Monad            (forM)-import           Data.Char                (toLower)-import           Data.List                (isPrefixOf, sortBy)+import           Data.Bifunctor           (bimap) import           System.Directory         (getDirectoryContents) import           System.Environment       (getEnv) import           System.Posix.Files       (getFileStatus, isDirectory)  import           XMonad                   hiding (config)+import           XMonad.Prelude import           XMonad.Prompt import           XMonad.Util.Run @@ -46,7 +52,7 @@ econst = const . return  {- $usage-1. In your @~\/.xmonad\/xmonad.hs@:+1. In your @xmonad.hs@:  > import XMonad.Prompt > import XMonad.Prompt.Shell@@ -56,7 +62,8 @@ >   , ((modm .|. controlMask, xK_x), shellPrompt def)  For detailed instruction on editing the key binding see-"XMonad.Doc.Extending#Editing_key_bindings". -}+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.+-}  data Shell = Shell type Predicate = String -> String -> Bool@@ -94,24 +101,93 @@ unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c] $ searchPredicate config) run     where run a = unsafeSpawn $ c ++ " " ++ a +{- | Like 'safePrompt', but optimized for the use-case of a program that+needs a file as an argument.++For example, a prompt for <https://github.com/mwh/dragon dragon> that+always starts searching in your home directory would look like++> safeDirPrompt "dragon" def "~/"++This is especially useful when using something like+'XMonad.Prompt.FuzzyMatch.fuzzyMatch' from "XMonad.Prompt.FuzzyMatch" as+your prompt's @searchPredicate@.+-}+safeDirPrompt+    :: FilePath  -- ^ The command to execute+    -> XPConfig  -- ^ The prompt configuration+    -> String    -- ^ Which string to start @compgen@ with+    -> X ()+safeDirPrompt cmd cfg@XPC{ searchPredicate } compgenStr =+    mkXPrompt Shell cfg mkCompl (safeSpawn cmd . pure)+  where+    mkCompl :: String -> IO [String]+    mkCompl input =+        shellComplImpl+            CaseSensitive+            (filter (searchPredicate ext))+            (commandCompletionFunction [cmd] searchPredicate input)+            (if "/" `isInfixOf` input then dir else compgenStr)+            input+      where+        -- "/path/to/some/file" ⇒ ("file", "/path/to/some/")+        (ext, dir) :: (String, String)+            = bimap reverse reverse . break (== '/') . reverse $ input+ getShellCompl :: [String] -> Predicate -> String -> IO [String]-getShellCompl cmds p s | s == "" || last s == ' ' = return []-                       | otherwise                = do-    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- "-                                                        ++ s ++ "\n")-    files <- case f of-               [x] -> do fs <- getFileStatus (encodeString x)-                         if isDirectory fs then return [x ++ "/"]-                                           else return [x]-               _   -> return f-    return . sortBy typedFirst . uniqSort $ files ++ commandCompletionFunction cmds p s-    where+getShellCompl = getShellCompl' CaseSensitive++getShellCompl' :: ComplCaseSensitivity -> [String] -> Predicate -> String -> IO [String]+getShellCompl' csn cmds p input =+    shellComplImpl csn id (commandCompletionFunction cmds p input) input input++-- | Based in the user input and the given filtering function, create+-- the completion string to show in the prompt.+shellComplImpl+    :: ComplCaseSensitivity    -- ^ Whether the @compgen@ query should be case sensitive+    -> ([String] -> [String])  -- ^ How to filter the files we get back+    -> [String]                -- ^ The available commands to suggest+    -> String                  -- ^ Which string to give to @compgen@+    -> String                  -- ^ The input string+    -> IO [String]+shellComplImpl csn filterFiles cmds cmpgenStr input+    | input == "" || last input == ' ' = pure []+    | otherwise = do+        choices <- filterFiles . lines <$> compgenFiles csn cmpgenStr+        files   <- case choices of+            [x] -> do fs <- getFileStatus (encodeString x)+                      pure $ if isDirectory fs then [x ++ "/"] else [x]+            _   -> pure choices+        pure . sortBy typedFirst . uniqSort $ files ++ cmds+  where+    typedFirst :: String -> String -> Ordering     typedFirst x y-        | x `startsWith` s && not (y `startsWith` s) = LT-        | y `startsWith` s && not (x `startsWith` s) = GT+        | x `startsWith` input && not (y `startsWith` input) = LT+        | y `startsWith` input && not (x `startsWith` input) = GT         | otherwise = x `compare` y-    startsWith str ps = isPrefixOf (map toLower ps) (map toLower str) +    startsWith :: String -> String -> Bool+    startsWith str ps = map toLower ps `isPrefixOf` map toLower str++compgenFiles :: ComplCaseSensitivity -> String -> IO String+compgenFiles csn = compgen csn "file"++compgenDirectories :: ComplCaseSensitivity -> String -> IO String+compgenDirectories csn = compgen csn "directory"++compgen :: ComplCaseSensitivity -> String -> String -> IO String+compgen csn actionOpt s = runProcessWithInput "bash" [] $+    complCaseSensitivityCmd csn ++ " ; " ++ compgenCmd actionOpt s++complCaseSensitivityCmd :: ComplCaseSensitivity -> String+complCaseSensitivityCmd CaseSensitive =+    "bind 'set completion-ignore-case off'"+complCaseSensitivityCmd CaseInSensitive =+    "bind 'set completion-ignore-case on'"++compgenCmd :: String -> String -> String+compgenCmd actionOpt s = "compgen -A " ++ actionOpt ++ " -- " ++ s ++ "\n"+ commandCompletionFunction :: [String] -> Predicate -> String -> [String] commandCompletionFunction cmds p str | '/' `elem` str = []                                      | otherwise      = filter (p str) cmds@@ -121,16 +197,14 @@     p  <- getEnv "PATH" `E.catch` econst []     let ds = filter (/= "") $ split ':' p     es <- forM ds $ \d -> getDirectoryContents d `E.catch` econst []-    return . uniqSort . filter ((/= '.') . head) . concat $ es+    return . uniqSort . filter (not . ("." `isPrefixOf`)) . concat $ es  split :: Eq a => a -> [a] -> [[a]] split _ [] = [] split e l =-    f : split e (rest ls)+    f : split e (drop 1 ls)         where           (f,ls) = span (/=e) l-          rest s | s == []   = []-                 | otherwise = tail s  escape :: String -> String escape []       = ""
XMonad/Prompt/Ssh.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Ssh+-- Description :  An ssh prompt. -- Copyright   :  (C) 2007 Andrea Rossato -- License     :  BSD3 --@@ -20,6 +21,7 @@     ) where  import XMonad+import XMonad.Prelude import XMonad.Util.Run import XMonad.Prompt @@ -27,15 +29,11 @@ import System.Environment import Control.Exception as E -import Control.Monad-import Data.Maybe-import Data.List(elemIndex)- econst :: Monad m => a -> IOException -> m a econst = const . return  -- $usage--- 1. In your @~\/.xmonad\/xmonad.hs@:+-- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Ssh@@ -45,31 +43,31 @@ -- >   , ((modm .|. controlMask, xK_s), sshPrompt def) -- -- Keep in mind, that if you want to use the completion you have to--- disable the "HashKnownHosts" option in your ssh_config+-- disable the \"HashKnownHosts\" option in your ssh_config -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data Ssh = Ssh  instance XPrompt Ssh where     showXPrompt       Ssh = "SSH to: "-    commandToComplete _ c = maybe c (\(_u,h) -> h) (parseHost c)+    commandToComplete _ c = maybe c snd (parseHost c)     nextCompletion _t c l = maybe next (\(u,_h) -> u ++ "@" ++ next) hostPared-                            where +                            where                               hostPared = parseHost c-                              next = getNextCompletion (maybe c (\(_u,h) -> h) hostPared) l+                              next = getNextCompletion (maybe c snd hostPared) l  sshPrompt :: XPConfig -> X () sshPrompt c = do   sc <- io sshComplList-  mkXPrompt Ssh c (mkComplFunFromList sc) ssh+  mkXPrompt Ssh c (mkComplFunFromList c sc) ssh  ssh :: String -> X () ssh = runInTerm "" . ("ssh " ++ )  sshComplList :: IO [String]-sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal+sshComplList = uniqSort <$> liftA2 (++) sshComplListLocal sshComplListGlobal  sshComplListLocal :: IO [String] sshComplListLocal = do@@ -141,4 +139,4 @@ getWithPort  str = str  parseHost :: String -> Maybe (String, String)-parseHost a = elemIndex '@' a  >>= (\c-> Just ( (take c a), (drop (c+1) a) ) )+parseHost a = elemIndex '@' a  >>= (\c-> Just ( take c a, drop (c+1) a ) )
XMonad/Prompt/Theme.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Theme+-- Description :  A prompt for changing the theme of the current workspace. -- Copyright   :  (C) 2007 Andrea Rossato -- License     :  BSD3 --@@ -20,7 +21,7 @@  import Control.Arrow ( (&&&) ) import qualified Data.Map as M-import Data.Maybe ( fromMaybe )+import XMonad.Prelude ( fromMaybe ) import XMonad import XMonad.Prompt import XMonad.Layout.Decoration@@ -28,7 +29,7 @@  -- $usage -- You can use this module with the following in your--- @~\/.xmonad\/xmonad.hs@:+-- @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Theme@@ -38,7 +39,7 @@ -- >   , ((modm .|. controlMask, xK_t), themePrompt def) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  data ThemePrompt = ThemePrompt @@ -48,7 +49,7 @@     nextCompletion      _ = getNextCompletion  themePrompt :: XPConfig -> X ()-themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme+themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' c . map ppThemeInfo $ listOfThemes) changeTheme     where changeTheme t = sendMessage . SetTheme . fromMaybe def $ M.lookup t mapOfThemes  mapOfThemes :: M.Map String Theme
XMonad/Prompt/Unicode.hs view
@@ -1,5 +1,6 @@ {- | Module      :  XMonad.Prompt.Unicode+Description :  A prompt for inputting Unicode characters. Copyright   :  (c) 2016 Joachim Breitner                    2017 Nick Hu License     :  BSD-style (see LICENSE)@@ -14,8 +15,6 @@ respectively. -} -{-# LANGUAGE DeriveDataTypeable #-}- module XMonad.Prompt.Unicode (  -- * Usage  -- $usage@@ -24,20 +23,15 @@  mkUnicodePrompt  ) where +import Codec.Binary.UTF8.String (decodeString) import qualified Data.ByteString.Char8 as BS-import Data.Char-import Data.Maybe-import Data.Ord import Numeric-import System.Environment import System.IO-import System.IO.Unsafe import System.IO.Error-import Control.Arrow-import Data.List import Text.Printf  import XMonad+import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run import XMonad.Prompt@@ -48,8 +42,8 @@   commandToComplete Unicode s = s   nextCompletion Unicode = getNextCompletion -newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, BS.ByteString)] }-  deriving (Typeable, Read, Show)+newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, String)] }+  deriving (Read, Show)  instance ExtensionClass UnicodeData where   initialValue = UnicodeData []@@ -58,7 +52,7 @@ {- $usage  You can use this module by importing it, along with-"XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file:+"XMonad.Prompt", into your @xmonad.hs@ file:  > import XMonad.Prompt > import XMonad.Prompt.Unicode@@ -67,6 +61,11 @@  >  , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def) +A path to a @UnicodeData.txt@ file or equivalent must be provided.  This file+should be available through your package manager; search for @unicode-data@.+If no package is found, one may opt to download this file directly from+[unicode.org](http://www.unicode.org/Public/UNIDATA/UnicodeData.txt).+ More flexibility is given by the @mkUnicodePrompt@ function, which takes a command and a list of arguments to pass as its first two arguments. See @unicodePrompt@ for details.@@ -85,35 +84,45 @@           hPutStrLn stderr "Do you have unicode-data installed?"           return False         Right dat -> do-          XS.put . UnicodeData . sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat+          XS.put . UnicodeData . sortOn (length . snd) $ parseUnicodeData dat           return True     else return True -parseUnicodeData :: BS.ByteString -> [(Char, BS.ByteString)]+parseUnicodeData :: BS.ByteString -> [(Char, String)] parseUnicodeData = mapMaybe parseLine . BS.lines   where parseLine l = do           field1 : field2 : _ <- return $ BS.split ';' l           [(c,"")] <- return . readHex $ BS.unpack field1-          return (chr c, field2)+          desc <- return . decodeString $ BS.unpack field2+          return (chr c, desc) -searchUnicode :: [(Char, BS.ByteString)] -> String -> [(Char, String)]-searchUnicode entries s = map (second BS.unpack) $ filter go entries-  where w = map BS.pack . filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s-        go (c,d) = all (`BS.isInfixOf` d) w+type Predicate = String -> String -> Bool +searchUnicode :: [(Char, String)] -> Predicate -> String -> [(Char, String)]+searchUnicode entries p s = filter go entries+  where w = filter ((> 1) . length) . words $ map toUpper s+        go (_, d) = all (`p` d) w+ mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()-mkUnicodePrompt prog args unicodeDataFilename config =+mkUnicodePrompt prog args unicodeDataFilename xpCfg =   whenX (populateEntries unicodeDataFilename) $ do     entries <- fmap getUnicodeData (XS.get :: X UnicodeData)-    mkXPrompt Unicode config (unicodeCompl entries) paste+    mkXPrompt+      Unicode+      (xpCfg {sorter = sorter xpCfg . map toUpper})+      (unicodeCompl entries $ searchPredicate xpCfg)+      paste   where-    unicodeCompl _ [] = return []-    unicodeCompl entries s = do-      let m = searchUnicode entries s+    unicodeCompl :: [(Char, String)] -> Predicate -> String -> IO [String]+    unicodeCompl _ _ "" = return []+    unicodeCompl entries p s = do+      let m = searchUnicode entries p s       return . map (\(c,d) -> printf "%s %s" [c] d) $ take 20 m     paste [] = return ()-    paste (c:_) = do-      runProcessWithInput prog args [c]+    paste (c:_) = liftIO $ do+      handle <- spawnPipe $ unwords $ prog : args+      hPutChar handle c+      hClose handle       return ()  -- | Prompt the user for a Unicode character to be inserted into the paste buffer of the X server.
XMonad/Prompt/Window.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Window+-- Description :  A prompt for bringing windows to you, and bring you to windows. -- Copyright   :  Devin Mullins <me@twifkak.com> --                Andrea Rossato <andrea.rossato@unibz.it> -- License     :  BSD-style (see LICENSE)@@ -22,16 +23,12 @@     windowPrompt,     windowMultiPrompt,     allWindows,+    allApplications,     wsWindows,     XWindowMap,--    -- * Deprecated-    windowPromptGoto,-    windowPromptBring,-    windowPromptBringCopy,     ) where -import Control.Monad (forM)+import XMonad.Prelude (forM) import qualified Data.Map as M  import qualified XMonad.StackSet as W@@ -47,7 +44,7 @@ -- where you left your XChat. It also offers helpers to build the -- subset of windows which is used for the prompt completion. ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Window@@ -68,16 +65,17 @@ -- keystrokes to the selected client. -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.  -- Describe actions that can applied  on the selected window-data WindowPrompt = Goto | Bring | BringCopy | BringToMaster+data WindowPrompt = Goto | Bring | BringCopy | BringToMaster | WithWindow String (Window ->  X()) instance XPrompt WindowPrompt where     showXPrompt Goto      = "Go to window: "     showXPrompt Bring     = "Bring window: "     showXPrompt BringToMaster                           = "Bring window to master: "     showXPrompt BringCopy = "Bring a copy: "+    showXPrompt (WithWindow xs _) = xs     commandToComplete _ c = c     nextCompletion      _ = getNextCompletion @@ -89,43 +87,40 @@     showXPrompt (WindowModePrompt action _ _) =         showXPrompt action -    completionFunction (WindowModePrompt _ winmap predicate) =-        \s -> return . filter (predicate s) . map fst . M.toList $ winmap+    completionFunction (WindowModePrompt _ winmap predicate) s =+        return . filter (predicate s) . map fst . M.toList $ winmap      modeAction (WindowModePrompt action winmap _) buf auto = do         let name = if null auto then buf else auto             a = case action of-                  Goto          -> gotoAction  winmap-                  Bring         -> bringAction winmap-                  BringCopy     -> bringCopyAction winmap-                  BringToMaster -> bringToMaster winmap+                  Goto           -> gotoAction+                  Bring          -> bringAction+                  BringCopy      -> bringCopyAction+                  BringToMaster  -> bringToMaster+                  WithWindow _ f -> withWindow f         a name       where-        winAction a m    = flip whenJust (windows . a) . flip M.lookup m+        withWindow f     = flip whenJust f . flip M.lookup winmap+        winAction a      = withWindow (windows . a)         gotoAction       = winAction W.focusWindow         bringAction      = winAction bringWindow         bringCopyAction  = winAction bringCopyWindow         bringToMaster    = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s) --- | Deprecated. Use windowPrompt instead.-{-# DEPRECATED windowPromptGoto      "Use windowPrompt instead." #-}-{-# DEPRECATED windowPromptBring     "Use windowPrompt instead." #-}-{-# DEPRECATED windowPromptBringCopy "Use windowPrompt instead." #-}-windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X ()-windowPromptGoto c = windowPrompt c Goto windowMap-windowPromptBring c = windowPrompt c Bring windowMap-windowPromptBringCopy c = windowPrompt c BringCopy windowMap- -- | A helper to get the map of all windows. allWindows :: XWindowMap allWindows = windowMap +-- | A helper to get the map of all applications+allApplications :: XWindowMap+allApplications = windowAppMap+ -- | A helper to get the map of windows of the current workspace. wsWindows :: XWindowMap wsWindows = withWindowSet (return . W.index) >>= winmap     where       winmap = fmap M.fromList . mapM pair-      pair w = do name <- fmap show $ getName w+      pair w = do name <- show <$> getName w                   return (name, w)  -- | A Map where keys are pretty printable window names and values are
XMonad/Prompt/Workspace.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.Workspace+-- Description :  A workspace prompt. -- Copyright   :  (C) 2007 Andrea Rossato, David Roundy -- License     :  BSD3 --@@ -27,7 +28,7 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex )  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Workspace@@ -35,9 +36,9 @@ -- >   , ((modm .|. shiftMask, xK_m     ), workspacePrompt def (windows . W.shift)) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data Wor = Wor String+newtype Wor = Wor String  instance XPrompt Wor where     showXPrompt (Wor x) = x@@ -46,4 +47,4 @@ workspacePrompt c job = do ws <- gets (workspaces . windowset)                            sort <- getSortByIndex                            let ts = map tag $ sort ws-                           mkXPrompt (Wor "") c (mkComplFunFromList' ts) job+                           mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job
XMonad/Prompt/XMonad.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt.XMonad+-- Description :  A prompt for running XMonad commands. -- Copyright   :  (C) 2007 Andrea Rossato -- License     :  BSD3 --@@ -17,16 +18,17 @@                              -- $usage                              xmonadPrompt,                              xmonadPromptC,+                             xmonadPromptCT,                              XMonad,                               ) where  import XMonad import XMonad.Prompt import XMonad.Actions.Commands (defaultCommands)-import Data.Maybe (fromMaybe)+import XMonad.Prelude (fromMaybe)  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.XMonad@@ -36,12 +38,12 @@ -- >   , ((modm .|. controlMask, xK_x), xmonadPrompt def) -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -data XMonad = XMonad+newtype XMonad = XMonad String  instance XPrompt XMonad where-    showXPrompt XMonad = "XMonad: "+    showXPrompt (XMonad str) = str <> ": "  xmonadPrompt :: XPConfig -> X () xmonadPrompt c = do@@ -50,6 +52,10 @@  -- | An xmonad prompt with a custom command list xmonadPromptC :: [(String, X ())] -> XPConfig -> X ()-xmonadPromptC commands c =-    mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) $+xmonadPromptC = xmonadPromptCT "XMonad"++-- | An xmonad prompt with a custom command list and a custom title+xmonadPromptCT :: String -> [(String, X ())] -> XPConfig -> X ()+xmonadPromptCT title' commands c =+    mkXPrompt (XMonad title') c (mkComplFunFromList' c (map fst commands)) $         fromMaybe (return ()) . (`lookup` commands)
+ XMonad/Prompt/Zsh.hs view
@@ -0,0 +1,64 @@+{- |+Module      :  XMonad.Prompt.Zsh+Description :  Zsh-specific version of "XMonad.Prompt.Shell".+Copyright   :  (C) 2020 Zubin Duggal+License     :  BSD3++Maintainer  :  zubin.duggal@gmail.com+Stability   :  unstable+Portability :  unportable++A version of "XMonad.Prompt.Shell" that lets you access the awesome power of Zsh+completions in your xmonad prompt+-}++module XMonad.Prompt.Zsh+    ( -- * Usage+      -- $usage+      Zsh (..)+    , zshPrompt+    -- * Utility functions+    , getZshCompl+    , stripZsh+    ) where++import XMonad+import XMonad.Prompt+import XMonad.Util.Run++{- $usage+1. Grab the @capture.zsh@ script to capture zsh completions from <https://github.com/Valodim/zsh-capture-completion>+2. In your @xmonad.hs@:++> import XMonad.Prompt+> import XMonad.Prompt.Zsh++3. In your keybindings add something like:++>   , ((modm .|. controlMask, xK_x), zshPrompt def "/path/to/capture.zsh")++For detailed instruction on editing the key binding see+<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. -}++data Zsh = Zsh++instance XPrompt Zsh where+    showXPrompt Zsh       = "Run: "+    completionToCommand _ = stripZsh+    commandToComplete _ s = s+    nextCompletion _ s cs = getNextCompletion s (map stripZsh cs)++zshPrompt :: XPConfig -> FilePath -> X ()+zshPrompt c capture = mkXPrompt Zsh c (getZshCompl capture) (\x -> safeSpawn "zsh" ["-c",x])++getZshCompl :: FilePath -> String -> IO [String]+getZshCompl capture s+  | s == ""   = return []+  | otherwise = processCompls <$> runProcessWithInput capture [s] ""+    where processCompls = map (\x -> skipLastWord s ++ filter (/= '\r') x) . lines++-- | Removes the argument description from the zsh completion+stripZsh :: String -> String+stripZsh "" = ""+stripZsh (' ':'-':'-':' ':_) = ""+stripZsh (x:xs) = x : stripZsh xs
+ XMonad/Util/ActionCycle.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.ActionCycle+-- Description :  Provides a way to implement cycling actions.+-- Copyright   :  (c) 2020 Leon Kowarschick+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module provides a way to have "cycling" actions.+-- This means that you can define an @X ()@ action that cycles through a list of actions,+-- advancing every time it is executed.+-- This may for exapmle be useful for toggle-style keybindings.+--+-----------------------------------------------------------------------------++module XMonad.Util.ActionCycle+  ( -- * Usage+    -- $usage+    cycleAction+  , cycleActionWithResult+  )+where+import Prelude hiding ((!!))+import Data.Map.Strict as M+import XMonad+import qualified XMonad.Util.ExtensibleState as XS+import qualified Data.List.NonEmpty as NonEmpty+import Data.List.NonEmpty ((!!), NonEmpty((:|)))+++-- $usage+-- You can use this module to implement cycling key-bindings by importing "XMonad.Util.ActionCycle"+--+-- > import XMonad.Util.ActionCycle+--+-- and then creating a keybinding as follows:+--+-- > ((mod1Mask, xK_t), cycleAction "cycleActions" [ spawn "commmand1", spawn "command2", spawn "command3" ])+--+-- Note that the name given to cycleAction must be a unique action per cycle.+++-- | Generate an @X ()@ action that cycles through a list of actions,+-- advancing every time the action is called.+cycleAction+  :: String -- ^ Unique name for this action. May be any arbitrary, unique string.+  -> [X ()] -- ^ List of actions that will be cycled through.+  -> X ()+cycleAction _ [] = pure ()+cycleAction name (x:xs) = cycleActionWithResult name (x :| xs)++-- | Another version of 'cycleAction' that returns the result of the actions.+-- To allow for this, we must make sure that the list of actions is non-empty.+cycleActionWithResult+  :: String                   -- ^ Unique name for this action. May be any arbitrary, unique string.+  -> NonEmpty.NonEmpty (X a)  -- ^ Non-empty List of actions that will be cycled through.+  -> X a+cycleActionWithResult name actions = do+  cycleState <- XS.gets (getActionCycle name)+  idx <- case cycleState of+    Just x -> do+      XS.modify (nextActionCycle name (NonEmpty.length actions))+      pure x+    Nothing -> do+      XS.modify (setActionCycle name 1)+      pure 0+  actions !! idx+++newtype ActionCycleState = ActionCycleState (M.Map String Int)++instance ExtensionClass ActionCycleState where+  initialValue = ActionCycleState mempty++getActionCycle :: String -> ActionCycleState -> Maybe Int+getActionCycle name (ActionCycleState s) = M.lookup name s++nextActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState+nextActionCycle name maxNum (ActionCycleState s) = ActionCycleState $ M.update (\n -> Just $ (n + 1) `mod` maxNum) name s++setActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState+setActionCycle name n (ActionCycleState s) = ActionCycleState $ M.insert name n s
+ XMonad/Util/ActionQueue.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.ActionQueue+-- Description :  Queue of XMonad actions+-- Copyright   :  (c) 2021 Xiaokui Shu+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  subbyte@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Put XMonad actions in the queue to be executed in either the+-- @logHook@ or another hook of your choice.+-----------------------------------------------------------------------------++module XMonad.Util.ActionQueue ( -- * Usage+                                 -- $usage+                                 ActionQueue+                               , actionQueue+                               , enqueue+                               , exequeue+                               ) where++import XMonad+import qualified XMonad.Util.ExtensibleConf  as XC+import qualified XMonad.Util.ExtensibleState as XS++import Data.Sequence (Seq (..), ViewL (..), viewl, (|>))++-- $usage+--+-- This module provides a queue that, by default, gets executed every+-- time the @logHook@ runs.  To use this module+--+-- 1. Enqueue `X ()` actions at the place you need; e.g.:+--+-- > enqueue myAction+--+-- 2. Add the 'actionQueue' combinator to your configuration:+--+-- > main = xmonad $ actionQueue $ def+-- >     { ... }+--+-- This will execute all of the actions in the queue (if any) every time+-- the @logHook@ runs.  Developers of other extensions using this module+-- should re-export 'actionQueue'.+--+-- Alternatively, you can directly add 'exequeue' to a hook of your choice.+-- This is discouraged when writing user-facing modules, as (accidentally)+-- adding 'exequeue' to two different hooks might lead to undesirable+-- behaviour.  'actionQueue' uses the "XMonad.Util.ExtensibleConf" interface to+-- circumvent this.+--++newtype ActionQueue = ActionQueue (Seq (X ()))++instance ExtensionClass ActionQueue where+    initialValue = ActionQueue mempty++newtype ActionQueueHooked = ActionQueueHooked ()+  deriving newtype (Semigroup)++-- | Every time the @logHook@ runs, execute all actions in the queue.+actionQueue :: XConfig l -> XConfig l+actionQueue = XC.once (\cfg -> cfg{ logHook = logHook cfg <> exequeue })+                      ActionQueueHooked++-- | Enqueue an action.+enqueue :: X () -> X ()+enqueue = XS.modify . go+  where+    go :: X () -> ActionQueue -> ActionQueue+    go a (ActionQueue as) = ActionQueue $ as |> a++-- | Execute every action in the queue.+exequeue :: X ()+exequeue = do+    -- Note that we are executing all actions one by one.  Otherwise, we may+    -- not execute the actions in the right order.  Any of them may call+    -- 'refresh' or 'windows', which triggers the logHook, which may trigger+    -- 'exequeue' again if it is used in the logHook.+    ActionQueue aas <- XS.get+    case viewl aas of+      EmptyL  -> pure ()+      a :< as -> do XS.put (ActionQueue as)+                    a `catchX` pure ()+                    exequeue
+ XMonad/Util/ClickableWorkspaces.hs view
@@ -0,0 +1,83 @@+-------------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.ClickableWorkspaces+-- Description :  Make workspace tags clickable in XMobar (for switching focus).+-- Copyright   :  (c) Geoff deRosenroll <geoffderosenroll@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Geoff deRosenroll <geoffderosenroll@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides @clickablePP@, which when applied to the 'PP' pretty-printer used+-- by "XMonad.Hooks.StatusBar" will make the workspace tags clickable in+-- XMobar (for switching focus).+--+-----------------------------------------------------------------------------++module XMonad.Util.ClickableWorkspaces (+  -- * Usage+  -- $usage+  clickablePP,+  clickableWrap,+  ) where++import XMonad.Prelude ((<&>), (>=>))+import XMonad+import XMonad.Hooks.StatusBar.PP (xmobarAction, PP(..))+import XMonad.Util.WorkspaceCompare (getSortByIndex)+import qualified XMonad.StackSet as W+import Data.List (elemIndex)++-- $usage+-- If you're using the "XMonad.Hooks.StatusBar" interface, apply 'clickablePP'+-- to the 'PP' passed to 'XMonad.Hooks.StatusBar.statusBarProp':+--+-- > mySB <- statusBarProp "xmobar" (clickablePP xmobarPP)+--+-- Or if you're using the old "XMonad.Hooks.DynamicLog" interface:+--+-- > logHook = clickablePP xmobarPP { ... } >>= dynamicLogWithPP+--+-- Requirements:+--+--   * @xdotool@ on system (in path)+--   * "XMonad.Hooks.EwmhDesktops" for @xdotool@ support (see Hackage docs for setup)+--   * use of UnsafeStdinReader\/UnsafeXMonadLog in xmobarrc (rather than StdinReader\/XMonadLog)+--+-- Note that UnsafeStdinReader is potentially dangerous if your workspace+-- names are dynamically generated from untrusted input (like window titles).+-- You may need to add @xmobarRaw@ to 'ppRename' before applying+-- 'clickablePP' in such case.++-- | Wrap string with an xmobar action that uses @xdotool@ to switch to+-- workspace @i@.+clickableWrap :: Int -> String -> String+clickableWrap i = xmobarAction ("xdotool set_desktop " ++ show i) "1"++-- | 'XMonad.Util.WorkspaceCompare.getWsIndex' extended to handle workspaces+-- not in the static 'workspaces' config, such as those created by+-- "XMonad.Action.DynamicWorkspaces".+--+-- Uses 'getSortByIndex', as that's what "XMonad.Hooks.EwmhDesktops" uses to+-- export the information to tools like @xdotool@. (Note that EwmhDesktops can+-- be configured with a custom sort function, and we don't handle that here+-- yet.)+getWsIndex :: X (WorkspaceId -> Maybe Int)+getWsIndex = do+    wSort <- getSortByIndex+    spaces <- gets (map W.tag . wSort . W.workspaces . windowset)+    return $ flip elemIndex spaces++-- | Return a function that wraps workspace names in an xmobar action that+-- switches to that workspace.+--+-- This assumes that 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsEventHook'+-- isn't configured to change the workspace order. We might need to add an+-- additional parameter if anyone needs that.+getClickable :: X (String -> WindowSpace -> String)+getClickable = getWsIndex <&> \idx s w -> maybe id clickableWrap (idx (W.tag w)) s++-- | Apply clickable wrapping to the given PP.+clickablePP :: PP -> X PP+clickablePP pp = getClickable <&> \ren -> pp{ ppRename = ppRename pp >=> ren }
XMonad/Util/Cursor.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Cursor+-- Description :  Set the default mouse cursor. -- Copyright   :  (c) 2009 Collabora Ltd -- License     :  BSD-style (see xmonad/LICENSE) --
XMonad/Util/CustomKeys.hs view
@@ -1,8 +1,9 @@ -------------------------------------------------------------------- -- |--- Module     : XMonad.Util.CustomKeys--- Copyright  : (c) 2007 Valery V. Vorotyntsev--- License    : BSD3-style (see LICENSE)+-- Module      : XMonad.Util.CustomKeys+-- Description : Configure key bindings.+-- Copyright   : (c) 2007 Valery V. Vorotyntsev+-- License     : BSD3-style (see LICENSE) -- -- Customized key bindings. --@@ -17,13 +18,14 @@                               ) where  import XMonad+import XMonad.Prelude ((<&>)) import Control.Monad.Reader  import qualified Data.Map as M  -- $usage ----- In @~\/.xmonad\/xmonad.hs@ add:+-- In @xmonad.hs@ add: -- -- > import XMonad.Util.CustomKeys --@@ -70,8 +72,8 @@ customize conf ds is = asks (keys conf) >>= delete ds >>= insert is  delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b)-delete dels kmap = asks dels >>= return . foldr M.delete kmap+delete dels kmap = asks dels <&> foldr M.delete kmap  insert :: (MonadReader r m, Ord a) =>           (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b)-insert ins kmap = asks ins >>= return . foldr (uncurry M.insert) kmap+insert ins kmap = asks ins <&> foldr (uncurry M.insert) kmap
XMonad/Util/DebugWindow.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.DebugWindow+-- Description :  Dump window information for diagnostic\/debugging purposes. -- Copyright   :  (c) Brandon S Allbery KF8NH, 2014 -- License     :  BSD3-style (see LICENSE) --@@ -8,7 +9,7 @@ -- Stability   :  unstable -- Portability :  not portable ----- Module to dump window information for diagnostic/debugging purposes. See +-- Module to dump window information for diagnostic/debugging purposes. See -- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses. -- -----------------------------------------------------------------------------@@ -18,30 +19,28 @@ import           Prelude  import           XMonad+import           XMonad.Prelude  import           Codec.Binary.UTF8.String        (decodeString)-import           Control.Exception.Extensible                          as E-import           Control.Monad                   (when)-import           Data.List                       (unfoldr-                                                 ,intercalate-                                                 )-import           Foreign+import           Control.Exception                                     as E import           Foreign.C.String import           Numeric                         (showHex) import           System.Exit  -- | Output a window by ID in hex, decimal, its ICCCM resource name and class,---   and its title if available.  Also indicate override_redirect with an---   exclamation mark, and wrap in brackets if it is unmapped or withdrawn.+--   its title if available, and EWMH type and state if available.  Also+--   indicate override_redirect with an exclamation mark, and wrap in brackets+--   if it is unmapped or withdrawn. debugWindow   :: Window -> X String debugWindow 0 =  return "-no window-" debugWindow w =  do+  d <- asks display   let wx = pad 8 '0' $ showHex w ""-  w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)+  w' <- safeGetWindowAttributes w   case w' of     Nothing                                   ->       return $ "(deleted window " ++ wx ++ ")"-    Just (WindowAttributes+    Just WindowAttributes       { wa_x                 = x       , wa_y                 = y       , wa_width             = wid@@ -49,9 +48,8 @@       , wa_border_width      = bw       , wa_map_state         = m       , wa_override_redirect = o-      }) -> do-      c' <- withDisplay $ \d ->-            io (getWindowProperty8 d wM_CLASS w)+      } -> do+      c' <- io (getWindowProperty8 d wM_CLASS w)       let c = case c' of                 Nothing -> ""                 Just c''  -> intercalate "/" $@@ -59,23 +57,21 @@                              \s -> if null s                                      then Nothing                                      else let (w'',s'') = break (== '\NUL') s-                                              s'      = if null s''-                                                          then s''-                                                          else tail s''+                                              s'        = drop 1 s''                                           in Just (w'',s')-      t <- catchX' (wrap `fmap` getEWMHTitle  "VISIBLE" w) $-           catchX' (wrap `fmap` getEWMHTitle  ""        w) $-           catchX' (wrap `fmap` getICCCMTitle           w) $+      t <- catchX' (wrap <$> getEWMHTitle  "VISIBLE" w) $+           catchX' (wrap <$> getEWMHTitle  ""        w) $+           catchX' (wrap <$> getICCCMTitle           w) $            return ""       h' <- getMachine w       let h = if null h' then "" else '@':h'       -- if it has WM_COMMAND use it, else use the appName       -- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some       -- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them.-      p' <- withDisplay $ \d -> safeGetCommand d w-      let p = if null p' then "" else wrap $ intercalate " " p'+      p' <- safeGetCommand d w+      let p = if null p' then "" else wrap $ unwords p'       nWP <- getAtom "_NET_WM_PID"-      pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w+      pid' <- io $ getWindowProperty32 d nWP w       let pid = case pid' of                   Just [pid''] -> '(':show pid'' ++ ")"                   _            -> ""@@ -84,6 +80,11 @@                       () | m == waIsViewable -> ("","")                          | otherwise         -> ("[","]")           o'      = if o then "!" else ""+      wT <- getAtom "_NET_WM_WINDOW_TYPE"+      wt' <- io $ getWindowProperty32 d wT w+      ewmh <- case wt' of+                Just wt'' -> windowType d w (fmap fi wt'')+                _         -> return ""       return $ concat [lb                       ,o'                       ,wx@@ -96,15 +97,15 @@                       ,show x                       ,',':show y                       ,if null c then "" else ' ':c-                      ,if null cmd then "" else ' ':cmd +                      ,if null cmd then "" else ' ':cmd+                      ,ewmh                       ,rb                       ]  getEWMHTitle       :: String -> Window -> X String getEWMHTitle sub w =  do   a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME"-  (Just t) <- withDisplay $ \d -> io $ getWindowProperty32 d a w-  return $ map (toEnum . fromEnum) t+  getDecodedStringProp w a -- should always be UTF8_STRING but rules are made to be broken  getICCCMTitle   :: Window -> X String getICCCMTitle w =  getDecodedStringProp w wM_NAME@@ -112,21 +113,21 @@ getDecodedStringProp     :: Window -> Atom -> X String getDecodedStringProp w a =  do   t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a-  [s] <- catchX' (tryUTF8     t) $+  [s] <- catchX' (tryUTF8     t) $ -- shouldn't happen but some apps do it          catchX' (tryCompound t) $-         io ((:[]) `fmap` peekCString t')+         io ((:[]) <$> peekCString t')   return s  tryUTF8                          :: TextProperty -> X [String] tryUTF8 (TextProperty s enc _ _) =  do   uTF8_STRING <- getAtom "UTF8_STRING"-  when (enc == uTF8_STRING) $ error "String is not UTF8_STRING"-  (map decodeString . splitNul) `fmap` io (peekCString s)+  when (enc /= uTF8_STRING) $ error "String is not UTF8_STRING"+  map decodeString . splitNul <$> io (peekCAString s)  tryCompound                            :: TextProperty -> X [String] tryCompound t@(TextProperty _ enc _ _) =  do   cOMPOUND_TEXT <- getAtom "COMPOUND_TEXT"-  when (enc == cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT"+  when (enc /= cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT"   withDisplay $ \d -> io $ wcTextPropertyToTextList d t  splitNul    :: String -> [String]@@ -143,7 +144,7 @@   c <- ask   (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of     Just x -> throw e `const` (x `asTypeOf` ExitSuccess)-    _ -> runX c st errcase+    _      -> runX c st errcase   put s'   return a @@ -155,14 +156,6 @@                   | otherwise  =        s' : wrap' ss     wrap' ""                   =             "" --- Graphics.X11.Extras.getWindowAttributes is bugggggggy-safeGetWindowAttributes     :: Display -> Window -> IO (Maybe WindowAttributes)-safeGetWindowAttributes d w =  alloca $ \p -> do-  s <- xGetWindowAttributes d w p-  case s of-    0 -> return Nothing-    _ -> Just `fmap` peek p- -- and so is getCommand safeGetCommand     :: Display -> Window -> X [String] safeGetCommand d w =  do@@ -180,3 +173,49 @@  getMachine   :: Window -> X String getMachine w =  catchX' (getAtom "WM_CLIENT_MACHINE" >>= getDecodedStringProp w) (return "")++-- if it's one EWMH atom then we strip prefix and lowercase, otherwise we+-- return the whole thing. we also get the state here, with similar rules+-- (all EWMH = all prefixes removed and lowercased)+windowType        :: Display -> Window -> [Atom] -> X String+windowType d w ts =  do+  tstr <- decodeType ts+  wS <- getAtom "_NET_WM_STATE"+  ss' <- io $ getWindowProperty32 d wS w+  sstr <- case ss' of+            Just ss -> windowState (fmap fi ss)+            _       -> return ""+  return $ " (" ++ tstr ++ sstr ++ ")"+  where+    decodeType     :: [Atom] -> X String+    decodeType []  =  return ""+    decodeType [t] =  simplify "_NET_WM_WINDOW_TYPE_" t+    decodeType tys =  unAtoms tys " (" False++    unAtoms             :: [Atom] -> String -> Bool -> X String+    unAtoms []     t i  =  return $ if i then t else t ++ ")"+    unAtoms (a:as) t i  =  do+                            s' <- io $ getAtomName d a+                            let s = case s' of+                                      Just s'' -> s''+                                      _        -> '<':show a ++ ">"+                            unAtoms as (t ++ (if i then ' ':s else s)) True++    simplify       :: String -> Atom -> X String+    simplify pfx a =  do+                        s' <- io $ getAtomName d a+                        case s' of+                          Nothing -> return $ '<':show a ++ ">"+                          Just s  -> if pfx `isPrefixOf` s then+                                       return $ map toLower (drop (length pfx) s)+                                     else+                                       return s++    -- note that above it says this checks all of them before simplifying.+    -- I'll do that after I'm confident this works as intended.+    windowState     :: [Atom] -> X String+    windowState []  =  return ""+    windowState as' =  go as' ";"+      where+        go []     t = return t+        go (a:as) t = simplify "_NET_WM_STATE_" a >>= \t' -> go as (t ++ ' ':t')
XMonad/Util/Dmenu.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Dmenu+-- Description :  Convenient bindings to dmenu. -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -24,7 +25,6 @@ import qualified XMonad.StackSet as W import qualified Data.Map as M import XMonad.Util.Run-import Control.Monad (liftM)  -- $usage -- You can use this module with the following in your Config.hs file:@@ -43,27 +43,27 @@ dmenuXinerama :: [String] -> X String dmenuXinerama opts = do     curscreen <--      (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int+      fromIntegral . W.screen . W.current <$> gets windowset :: X Int     _ <-       runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)     menuArgs "dmenu" ["-xs", show (curscreen+1)] opts  -- | Run dmenu to select an option from a list. dmenu :: MonadIO m => [String] -> m String-dmenu opts = menu "dmenu" opts+dmenu = menu "dmenu"  -- | like 'dmenu' but also takes the command to run. menu :: MonadIO m => String -> [String] -> m String-menu menuCmd opts = menuArgs menuCmd [] opts+menu menuCmd = menuArgs menuCmd []  -- | Like 'menu' but also takes a list of command line arguments. menuArgs :: MonadIO m => String -> [String] -> [String] -> m String-menuArgs menuCmd args opts = liftM (filter (/='\n')) $+menuArgs menuCmd args opts = filter (/='\n') <$>   runProcessWithInput menuCmd args (unlines opts)  -- | Like 'dmenuMap' but also takes the command to run. menuMap :: MonadIO m => String -> M.Map String a -> m (Maybe a)-menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap+menuMap menuCmd = menuMapArgs menuCmd []  -- | Like 'menuMap' but also takes a list of command line arguments. menuMapArgs :: MonadIO m => String -> [String] -> M.Map String a ->@@ -76,4 +76,4 @@  -- | Run dmenu to select an entry from a map based on the key. dmenuMap :: MonadIO m => M.Map String a -> m (Maybe a)-dmenuMap selectionMap = menuMap "dmenu" selectionMap+dmenuMap = menuMap "dmenu"
+ XMonad/Util/DynamicScratchpads.hs view
@@ -0,0 +1,105 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.DynamicScratchpads+-- Description :  Dynamically declare any window as a scratchpad.+-- Copyright   :  (c) Robin Oberschweiber <mephory@mephory.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Robin Obercshweiber <mephory@mephory.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Dynamically declare any window as a scratchpad.+--+-----------------------------------------------------------------------------++module XMonad.Util.DynamicScratchpads {-# DEPRECATED "Use the dynamic scratchpad facility of XMonad.Util.NamedScratchpad instead." #-} (+  -- * Usage+  -- $usage+  makeDynamicSP,+  spawnDynamicSP+  ) where++import Graphics.X11.Types+import XMonad.Core+import XMonad.Operations+import qualified Data.Map as M+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS+++-- $usage+-- Allows you to dynamically declare windows as scratchpads. You can bind a key+-- to make a window start/stop being a scratchpad, and another key to+-- spawn/hide that scratchpad.+--+-- Like with XMonad.Util.NamedScratchpad, you have to have a workspace called+-- NSP, where hidden scratchpads will be moved to.+--+-- You can declare dynamic scratchpads in your xmonad.hs like so:+--+-- import XMonad.Util.DynamicScratchpads+--+-- , ((modm .|. shiftMask, xK_a), withFocused $ makeDynamicSP "dyn1")+-- , ((modm .|. shiftMask, xK_b), withFocused $ makeDynamicSP "dyn2")+-- , ((modm              , xK_a), spawnDynamicSP "dyn1")+-- , ((modm              , xK_b), spawnDynamicSP "dyn2")++-- | Stores dynamic scratchpads as a map of name to window+newtype SPStorage = SPStorage (M.Map String Window)+    deriving (Read,Show)++instance ExtensionClass SPStorage where+    initialValue = SPStorage M.empty+    extensionType = PersistentExtension++-- | Makes a window a dynamic scratchpad with the given name, or stop a window+-- | from being a dynamic scratchpad, if it already is.+makeDynamicSP :: String -- ^ Scratchpad name+              -> Window -- ^ Window to be made a scratchpad+              -> X ()+makeDynamicSP s w = do+    (SPStorage m) <- XS.get+    case M.lookup s m of+        Nothing -> addDynamicSP s w+        Just ow  -> if w == ow+                    then removeDynamicSP s+                    else showWindow ow >> addDynamicSP s w+{-# DEPRECATED makeDynamicSP "Use XMonad.Util.NamedScratchpad.toggleDynamicNSP instead" #-}++-- | Spawn the specified dynamic scratchpad+spawnDynamicSP :: String -- ^ Scratchpad name+               -> X ()+spawnDynamicSP s = do+    (SPStorage m) <- XS.get+    maybe mempty spawnDynamicSP' (M.lookup s m)+{-# DEPRECATED spawnDynamicSP "Use XMonad.Util.NamedScratchpad.dynamicNSPAction instead" #-}++spawnDynamicSP' :: Window -> X ()+spawnDynamicSP' w = withWindowSet $ \s -> do+    let matchingWindows = filter (== w) ((maybe [] W.integrate . W.stack . W.workspace . W.current) s)+    case matchingWindows of+        [] -> showWindow w+        _  -> hideWindow w++-- | Make a window a dynamic scratchpad+addDynamicSP :: String -> Window -> X ()+addDynamicSP s w = XS.modify $ alterSPStorage (\_ -> Just w) s++-- | Make a window stop being a dynamic scratchpad+removeDynamicSP :: String -> X ()+removeDynamicSP s = XS.modify $ alterSPStorage (const Nothing) s++-- | Moves window to the scratchpad workspace, effectively hiding it+hideWindow :: Window -> X ()+hideWindow = windows . W.shiftWin "NSP"++-- | Move window to current workspace and focus it+showWindow :: Window -> X ()+showWindow w = windows $ \ws ->+    W.focusWindow w . W.shiftWin (W.currentTag ws) w $ ws++alterSPStorage :: (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage+alterSPStorage f k (SPStorage m) = SPStorage $ M.alter f k m++-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:
XMonad/Util/Dzen.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Dzen+-- Description :  Handy wrapper for dzen. -- Copyright   :  (c) glasser@mit.edu -- License     :  BSD --@@ -42,7 +43,7 @@     (>=>),   ) where -import Control.Monad+import XMonad.Prelude import XMonad import XMonad.StackSet import XMonad.Util.Run (runProcessWithInputAndWait, seconds)
XMonad/Util/EZConfig.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.EZConfig+-- Description :  Configure key bindings easily in Emacs style. -- Copyright   :  Devin Mullins <me@twifkak.com> --                Brent Yorgey <byorgey@gmail.com> (key parsing) -- License     :  BSD3-style (see LICENSE)@@ -21,6 +25,7 @@                              -- * Adding or removing keybindings                               additionalKeys, additionalKeysP,+                             remapKeysP,                              removeKeys, removeKeysP,                              additionalMouseBindings, removeMouseBindings, @@ -29,24 +34,31 @@                              mkKeymap, checkKeymap,                              mkNamedKeymap, -                             parseKey -- used by XMonad.Util.Paste+                             -- * Parsers++                             parseKey, -- used by XMonad.Util.Paste+                             parseKeyCombo,+                             parseKeySequence, readKeySequence,+#ifdef TESTING+                             parseModifier,+#endif                             ) where  import XMonad import XMonad.Actions.Submap+import XMonad.Prelude  import XMonad.Util.NamedActions+import XMonad.Util.Parser +import Control.Arrow (first, (&&&))+import qualified Data.List.NonEmpty as NE import qualified Data.Map as M-import Data.List (foldl', sortBy, groupBy, nub) import Data.Ord (comparing)-import Data.Maybe-import Control.Arrow (first, (&&&))--import Text.ParserCombinators.ReadP+import Data.List.NonEmpty (nonEmpty)  -- $usage--- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@:+-- To use this module, first import it into your @xmonad.hs@: -- -- > import XMonad.Util.EZConfig --@@ -82,7 +94,8 @@ -- whichever), or add your own @myModMask = mod1Mask@ line. additionalKeys :: XConfig a -> [((KeyMask, KeySym), X ())] -> XConfig a additionalKeys conf keyList =-    conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) }+    conf { keys = M.union (M.fromList keyList) . keys conf }+infixl 4 `additionalKeys`  -- | Like 'additionalKeys', except using short @String@ key --   descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as@@ -97,15 +110,52 @@ additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l additionalKeysP conf keyList =     conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) }+infixl 4 `additionalKeysP`  -- |+-- Remap keybindings from one binding to another.  More precisely, the+-- input list contains pairs of the form @(TO, FROM)@, and maps the+-- action bound to @FROM@ to the key @TO@.  For example, the following+-- would bind @"M-m"@ to what's bound to @"M-c"@ (which is to close the+-- focused window, in this case):+--+-- > main :: IO ()+-- > main = xmonad $ def `remapKeysP` [("M-m", "M-c")]+--+-- NOTE: Submaps are not transparent, and thus these keys can't be+-- accessed in this way: more explicitly, the @FROM@ string may **not**+-- be a submap.  However, the @TO@ can be a submap without problems.+-- This means that+--+-- > xmonad $ def `remapKeysP` [("M-m", "M-c a")]+--+-- is illegal (and indeed will just disregard the binding altogether),+-- while+--+-- > xmonad $ def `remapKeysP` [("M-c a", "M-m")]+--+-- is totally fine.+remapKeysP :: XConfig l -> [(String, String)] -> XConfig l+remapKeysP conf keyList =+    conf { keys = \cnf -> mkKeymap cnf (keyList' cnf) <> keys conf cnf }+  where+   keyList' :: XConfig Layout -> [(String, X ())]+   keyList' cnf =+     mapMaybe (traverse (\s -> case readKeySequence cnf s of+                                 Just (ks :| []) -> keys conf cnf M.!? ks+                                 _               -> Nothing))+              keyList+infixl 4 `remapKeysP`++-- | -- Remove standard keybindings you're not using. Example use: -- -- > main = xmonad $ def { terminal = "urxvt" } -- >                 `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a removeKeys conf keyList =-    conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ repeat ()) }+    conf { keys = \cnf -> foldr M.delete (keys conf cnf) keyList }+infixl 4 `removeKeys`  -- | Like 'removeKeys', except using short @String@ key descriptors --   like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the@@ -116,18 +166,20 @@  removeKeysP :: XConfig l -> [String] -> XConfig l removeKeysP conf keyList =-    conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) }+    conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (map (, return ()) keyList) }+infixl 4 `removeKeysP`  -- | Like 'additionalKeys', but for mouse bindings. additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a additionalMouseBindings conf mouseBindingsList =-    conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) }+    conf { mouseBindings = M.union (M.fromList mouseBindingsList) . mouseBindings conf }+infixl 4 `additionalMouseBindings`  -- | Like 'removeKeys', but for mouse bindings. removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a removeMouseBindings conf mouseBindingList =-    conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference`-                                   M.fromList (zip mouseBindingList $ repeat ()) }+    conf { mouseBindings = \cnf -> foldr M.delete (mouseBindings conf cnf) mouseBindingList }+infixl 4 `removeMouseBindings`   --------------------------------------------------------------@@ -178,6 +230,8 @@ -- > <Tab> -- > <Return> -- > <Pause>+-- > <Num_Lock>+-- > <Caps_Lock> -- > <Scroll_lock> -- > <Sys_Req> -- > <Print>@@ -194,6 +248,18 @@ -- > <Insert> -- > <Break> -- > <Space>+-- > <Control_L>+-- > <Control_R>+-- > <Shift_L>+-- > <Shift_R>+-- > <Alt_L>+-- > <Alt_R>+-- > <Meta_L>+-- > <Meta_R>+-- > <Super_L>+-- > <Super_R>+-- > <Hyper_L>+-- > <Hyper_R> -- > <F1>-<F24> -- > <KP_Space> -- > <KP_Tab>@@ -352,6 +418,8 @@ -- > <XF86_ClearGrab> -- > <XF86_Next_VMode> -- > <XF86_Prev_VMode>+-- > <XF86Bluetooth>+-- > <XF86WLAN>  mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ()) mkKeymap c = M.fromList . mkSubmaps . readKeymap c@@ -362,47 +430,48 @@ -- | Given a list of pairs of parsed key sequences and actions, --   group them into submaps in the appropriate way. -mkNamedSubmaps :: [([(KeyMask, KeySym)], NamedAction)] -> [((KeyMask, KeySym), NamedAction)]+mkNamedSubmaps :: [(NonEmpty (KeyMask, KeySym), NamedAction)] -> [((KeyMask, KeySym), NamedAction)] mkNamedSubmaps = mkSubmaps' submapName -mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())]+mkSubmaps :: [ (NonEmpty (KeyMask, KeySym), X ()) ] -> [((KeyMask, KeySym), X ())] mkSubmaps = mkSubmaps' $ submap . M.fromList -mkSubmaps' ::  (Ord a) => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)]+mkSubmaps' :: forall a b. (Ord a) => ([(a, b)] -> b) -> [(NonEmpty a, b)] -> [(a, b)] mkSubmaps' subm binds = map combine gathered-  where gathered = groupBy fstKey-                 . sortBy (comparing fst)-                 $ binds-        combine [([k],act)] = (k,act)-        combine ks = (head . fst . head $ ks,-                      subm . mkSubmaps' subm $ map (first tail) ks)-        fstKey = (==) `on` (head . fst)+  where+   gathered :: [[(NonEmpty a, b)]]+   gathered = groupBy fstKey . sortBy (comparing fst) $ binds -on :: (a -> a -> b) -> (c -> a) -> c -> c -> b-op `on` f = \x y -> f x `op` f y+   combine :: [(NonEmpty a, b)] -> (a, b)+   combine [(k :| [], act)] = (k, act)+   combine ks = ( NE.head . fst . NE.head . notEmpty $ ks+                , subm . mkSubmaps' subm $ map (first (notEmpty . NE.drop 1)) ks+                ) +   fstKey :: (NonEmpty a, b) -> (NonEmpty a, b) -> Bool+   fstKey = (==) `on` (NE.head . fst)+ -- | Given a configuration record and a list of (key sequence --   description, action) pairs, parse the key sequences into lists of --   @(KeyMask,KeySym)@ pairs.  Key sequences which fail to parse will --   be ignored.-readKeymap :: XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)]+readKeymap :: XConfig l -> [(String, t)] -> [(NonEmpty (KeyMask, KeySym), t)] readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c))   where maybeKeys (Nothing,_) = Nothing         maybeKeys (Just k, act) = Just (k, act)  -- | Parse a sequence of keys, returning Nothing if there is --   a parse failure (no parse, or ambiguous parse).-readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]-readKeySequence c = listToMaybe . parses-  where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c)+readKeySequence :: XConfig l -> String -> Maybe (NonEmpty (KeyMask, KeySym))+readKeySequence c = nonEmpty <=< runParser (parseKeySequence c <* eof)  -- | Parse a sequence of key combinations separated by spaces, e.g. --   @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2).-parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)]-parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ')+parseKeySequence :: XConfig l -> Parser [(KeyMask, KeySym)]+parseKeySequence c = parseKeyCombo c `sepBy1` many1 (char ' ')  -- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s).-parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym)+parseKeyCombo :: XConfig l -> Parser (KeyMask, KeySym) parseKeyCombo c = do mods <- many (parseModifier c)                      k <- parseKey                      return (foldl' (.|.) 0 mods, k)@@ -410,270 +479,30 @@ -- | Parse a modifier: either M- (user-defined mod-key), --   C- (control), S- (shift), or M#- where # is an integer --   from 1 to 5 (mod1Mask through mod5Mask).-parseModifier :: XConfig l -> ReadP KeyMask-parseModifier c =  (string "M-" >> return (modMask c))-               +++ (string "C-" >> return controlMask)-               +++ (string "S-" >> return shiftMask)-               +++ do _ <- char 'M'-                      n <- satisfy (`elem` ['1'..'5'])-                      _ <- char '-'-                      return $ indexMod (read [n] - 1)+parseModifier :: XConfig l -> Parser KeyMask+parseModifier c = (string "M-" $> modMask c)+               <> (string "C-" $> controlMask)+               <> (string "S-" $> shiftMask)+               <> do _ <- char 'M'+                     n <- satisfy (`elem` ['1'..'5'])+                     _ <- char '-'+                     return $ indexMod (read [n] - 1)     where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] --- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.-parseKey :: ReadP KeySym-parseKey = parseRegular +++ parseSpecial+-- | Parse an unmodified basic key, like @\"x\"@, @\"\<F1\>\"@, etc.+parseKey :: Parser KeySym+parseKey = parseSpecial <> parseRegular  -- | Parse a regular key name (represented by itself).-parseRegular :: ReadP KeySym-parseRegular = choice [ char s >> return k-                      | (s,k) <- zip ['!'             .. '~'          ] -- ASCII-                                     [xK_exclam       .. xK_asciitilde]--                              ++ zip ['\xa0'          .. '\xff'       ] -- Latin1-                                     [xK_nobreakspace .. xK_ydiaeresis]-                      ]+parseRegular :: Parser KeySym+parseRegular = choice [ string s $> k | (s, k) <- regularKeys ]  -- | Parse a special key name (one enclosed in angle brackets).-parseSpecial :: ReadP KeySym-parseSpecial = do _   <- char '<'-                  key <- choice [ string name >> return k-                                | (name,k) <- keyNames-                                ]-                  _   <- char '>'-                  return key---- | A list of all special key names and their associated KeySyms.-keyNames :: [(String, KeySym)]-keyNames = functionKeys ++ specialKeys ++ multimediaKeys---- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@) with---   the associated KeySyms.-functionKeys :: [(String, KeySym)]-functionKeys = [ ('F' : show n, k)-               | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ]---- | A list of special key names and their corresponding KeySyms.-specialKeys :: [(String, KeySym)]-specialKeys = [ ("Backspace"  , xK_BackSpace)-              , ("Tab"        , xK_Tab)-              , ("Return"     , xK_Return)-              , ("Pause"      , xK_Pause)-              , ("Scroll_lock", xK_Scroll_Lock)-              , ("Sys_Req"    , xK_Sys_Req)-              , ("Print"      , xK_Print)-              , ("Escape"     , xK_Escape)-              , ("Esc"        , xK_Escape)-              , ("Delete"     , xK_Delete)-              , ("Home"       , xK_Home)-              , ("Left"       , xK_Left)-              , ("Up"         , xK_Up)-              , ("Right"      , xK_Right)-              , ("Down"       , xK_Down)-              , ("L"          , xK_Left)-              , ("U"          , xK_Up)-              , ("R"          , xK_Right)-              , ("D"          , xK_Down)-              , ("Page_Up"    , xK_Page_Up)-              , ("Page_Down"  , xK_Page_Down)-              , ("End"        , xK_End)-              , ("Insert"     , xK_Insert)-              , ("Break"      , xK_Break)-              , ("Space"      , xK_space)-              , ("KP_Space"   , xK_KP_Space)-              , ("KP_Tab"     , xK_KP_Tab)-              , ("KP_Enter"   , xK_KP_Enter)-              , ("KP_F1"      , xK_KP_F1)-              , ("KP_F2"      , xK_KP_F2)-              , ("KP_F3"      , xK_KP_F3)-              , ("KP_F4"      , xK_KP_F4)-              , ("KP_Home"    , xK_KP_Home)-              , ("KP_Left"    , xK_KP_Left)-              , ("KP_Up"      , xK_KP_Up)-              , ("KP_Right"   , xK_KP_Right)-              , ("KP_Down"    , xK_KP_Down)-              , ("KP_Prior"   , xK_KP_Prior)-              , ("KP_Page_Up" , xK_KP_Page_Up)-              , ("KP_Next"    , xK_KP_Next)-              , ("KP_Page_Down", xK_KP_Page_Down)-              , ("KP_End"     , xK_KP_End)-              , ("KP_Begin"   , xK_KP_Begin)-              , ("KP_Insert"  , xK_KP_Insert)-              , ("KP_Delete"  , xK_KP_Delete)-              , ("KP_Equal"   , xK_KP_Equal)-              , ("KP_Multiply", xK_KP_Multiply)-              , ("KP_Add"     , xK_KP_Add)-              , ("KP_Separator", xK_KP_Separator)-              , ("KP_Subtract", xK_KP_Subtract)-              , ("KP_Decimal" , xK_KP_Decimal)-              , ("KP_Divide"  , xK_KP_Divide)-              , ("KP_0"       , xK_KP_0)-              , ("KP_1"       , xK_KP_1)-              , ("KP_2"       , xK_KP_2)-              , ("KP_3"       , xK_KP_3)-              , ("KP_4"       , xK_KP_4)-              , ("KP_5"       , xK_KP_5)-              , ("KP_6"       , xK_KP_6)-              , ("KP_7"       , xK_KP_7)-              , ("KP_8"       , xK_KP_8)-              , ("KP_9"       , xK_KP_9)-              ]---- | List of multimedia keys. If X server does not know about some--- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case)-multimediaKeys :: [(String, KeySym)]-multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $-                 [ "XF86ModeLock"-                 , "XF86MonBrightnessUp"-                 , "XF86MonBrightnessDown"-                 , "XF86KbdLightOnOff"-                 , "XF86KbdBrightnessUp"-                 , "XF86KbdBrightnessDown"-                 , "XF86Standby"-                 , "XF86AudioLowerVolume"-                 , "XF86AudioMute"-                 , "XF86AudioRaiseVolume"-                 , "XF86AudioPlay"-                 , "XF86AudioStop"-                 , "XF86AudioPrev"-                 , "XF86AudioNext"-                 , "XF86HomePage"-                 , "XF86Mail"-                 , "XF86Start"-                 , "XF86Search"-                 , "XF86AudioRecord"-                 , "XF86Calculator"-                 , "XF86Memo"-                 , "XF86ToDoList"-                 , "XF86Calendar"-                 , "XF86PowerDown"-                 , "XF86ContrastAdjust"-                 , "XF86RockerUp"-                 , "XF86RockerDown"-                 , "XF86RockerEnter"-                 , "XF86Back"-                 , "XF86Forward"-                 , "XF86Stop"-                 , "XF86Refresh"-                 , "XF86PowerOff"-                 , "XF86WakeUp"-                 , "XF86Eject"-                 , "XF86ScreenSaver"-                 , "XF86WWW"-                 , "XF86Sleep"-                 , "XF86Favorites"-                 , "XF86AudioPause"-                 , "XF86AudioMedia"-                 , "XF86MyComputer"-                 , "XF86VendorHome"-                 , "XF86LightBulb"-                 , "XF86Shop"-                 , "XF86History"-                 , "XF86OpenURL"-                 , "XF86AddFavorite"-                 , "XF86HotLinks"-                 , "XF86BrightnessAdjust"-                 , "XF86Finance"-                 , "XF86Community"-                 , "XF86AudioRewind"-                 , "XF86BackForward"-                 , "XF86Launch0"-                 , "XF86Launch1"-                 , "XF86Launch2"-                 , "XF86Launch3"-                 , "XF86Launch4"-                 , "XF86Launch5"-                 , "XF86Launch6"-                 , "XF86Launch7"-                 , "XF86Launch8"-                 , "XF86Launch9"-                 , "XF86LaunchA"-                 , "XF86LaunchB"-                 , "XF86LaunchC"-                 , "XF86LaunchD"-                 , "XF86LaunchE"-                 , "XF86LaunchF"-                 , "XF86ApplicationLeft"-                 , "XF86ApplicationRight"-                 , "XF86Book"-                 , "XF86CD"-                 , "XF86Calculater"-                 , "XF86Clear"-                 , "XF86Close"-                 , "XF86Copy"-                 , "XF86Cut"-                 , "XF86Display"-                 , "XF86DOS"-                 , "XF86Documents"-                 , "XF86Excel"-                 , "XF86Explorer"-                 , "XF86Game"-                 , "XF86Go"-                 , "XF86iTouch"-                 , "XF86LogOff"-                 , "XF86Market"-                 , "XF86Meeting"-                 , "XF86MenuKB"-                 , "XF86MenuPB"-                 , "XF86MySites"-                 , "XF86New"-                 , "XF86News"-                 , "XF86OfficeHome"-                 , "XF86Open"-                 , "XF86Option"-                 , "XF86Paste"-                 , "XF86Phone"-                 , "XF86Q"-                 , "XF86Reply"-                 , "XF86Reload"-                 , "XF86RotateWindows"-                 , "XF86RotationPB"-                 , "XF86RotationKB"-                 , "XF86Save"-                 , "XF86ScrollUp"-                 , "XF86ScrollDown"-                 , "XF86ScrollClick"-                 , "XF86Send"-                 , "XF86Spell"-                 , "XF86SplitScreen"-                 , "XF86Support"-                 , "XF86TaskPane"-                 , "XF86Terminal"-                 , "XF86Tools"-                 , "XF86Travel"-                 , "XF86UserPB"-                 , "XF86User1KB"-                 , "XF86User2KB"-                 , "XF86Video"-                 , "XF86WheelButton"-                 , "XF86Word"-                 , "XF86Xfer"-                 , "XF86ZoomIn"-                 , "XF86ZoomOut"-                 , "XF86Away"-                 , "XF86Messenger"-                 , "XF86WebCam"-                 , "XF86MailForward"-                 , "XF86Pictures"-                 , "XF86Music"-                 , "XF86TouchpadToggle"-                 , "XF86AudioMicMute"-                 , "XF86_Switch_VT_1"-                 , "XF86_Switch_VT_2"-                 , "XF86_Switch_VT_3"-                 , "XF86_Switch_VT_4"-                 , "XF86_Switch_VT_5"-                 , "XF86_Switch_VT_6"-                 , "XF86_Switch_VT_7"-                 , "XF86_Switch_VT_8"-                 , "XF86_Switch_VT_9"-                 , "XF86_Switch_VT_10"-                 , "XF86_Switch_VT_11"-                 , "XF86_Switch_VT_12"-                 , "XF86_Ungrab"-                 , "XF86_ClearGrab"-                 , "XF86_Next_VMode"-                 , "XF86_Prev_VMode" ]+parseSpecial :: Parser KeySym+parseSpecial = do _ <- char '<'+                  choice [ k <$ string name <* char '>'+                         | (name, k) <- allSpecialKeys+                         ]  -- | Given a configuration record and a list of (key sequence --   description, action) pairs, check the key sequence descriptions@@ -709,9 +538,9 @@ checkKeymap :: XConfig l -> [(String, a)] -> X () checkKeymap conf km = warn (doKeymapCheck conf km)   where warn ([],[])   = return ()-        warn (bad,dup) = spawn $ "xmessage 'Warning:\n"+        warn (bad,dup) = xmessage $ "Warning:\n"                             ++ msg "bad" bad ++ "\n"-                            ++ msg "duplicate" dup ++ "'"+                            ++ msg "duplicate" dup         msg _ [] = ""         msg m xs = m ++ " keybindings detected: " ++ showBindings xs         showBindings = unwords . map (("\""++) . (++"\""))@@ -724,7 +553,7 @@ doKeymapCheck conf km = (bad,dups)   where ks = map ((readKeySequence conf &&& id) . fst) km         bad = nub . map snd . filter (isNothing . fst) $ ks-        dups = map (snd . head)+        dups = map (snd . NE.head . notEmpty)              . filter ((>1) . length)              . groupBy ((==) `on` fst)              . sortBy (comparing fst)
+ XMonad/Util/ExclusiveScratchpads.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE LambdaCase #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.ExclusiveScratchpads+-- Description :  Named scratchpads that can be mutually exclusive.+-- Copyright   :  Bruce Forte (2017)+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Bruce Forte+-- Stability   :  unstable+-- Portability :  unportable+--+-- Named scratchpads that can be mutually exclusive.+--+-----------------------------------------------------------------------------++module XMonad.Util.ExclusiveScratchpads+  {-# DEPRECATED "Use the exclusive scratchpad functionality of \"XMonad.Util.NamedScratchpad\" insead." #-}+  (+  -- * Usage+  -- $usage+  mkXScratchpads,+  xScratchpadsManageHook,+  -- * Keyboard related+  scratchpadAction,+  hideAll,+  resetExclusiveSp,+  -- * Mouse related+  setNoexclusive,+  resizeNoexclusive,+  floatMoveNoexclusive,+  -- * Types+  ExclusiveScratchpad(..),+  ExclusiveScratchpads,+  -- * Hooks+  nonFloating,+  defaultFloating,+  customFloating+  ) where++import XMonad.Prelude+import XMonad+import XMonad.Actions.Minimize+import XMonad.Actions.TagWindows (addTag,delTag)+import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)++import qualified XMonad.StackSet as W+import qualified Data.List.NonEmpty as NE++-- $usage+--+-- For this module to work properly, you need to use "XMonad.Layout.BoringWindows" and+-- "XMonad.Layout.Minimize", please refer to the documentation of these modules for more+-- information on how to configure them.+--+-- To use this module, put the following in your @xmonad.hs@:+--+-- > import XMonad.Utils.ExclusiveScratchpads+-- > import XMonad.ManageHook (title,appName)+-- > import qualified XMonad.StackSet as W+--+-- Add exclusive scratchpads, for example:+--+-- > exclusiveSps = mkXScratchpads [ ("htop",   "urxvt -name htop -e htop", title =? "htop")+-- >                               , ("xclock", "xclock", appName =? "xclock")+-- >                               ] $ customFloating $ W.RationalRect (1/4) (1/4) (1/2) (1/2)+--+-- The scratchpads don\'t have to be exclusive, you can create them like this (see 'ExclusiveScratchpad'):+--+-- > regularSps   = [ XSP "term" "urxvt -name scratchpad" (appName =? "scratchpad") defaultFloating [] ]+--+-- Create a list that contains all your scratchpads like this:+--+-- > scratchpads = exclusiveSps ++ regularSps+--+-- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook" or+-- <https://xmonad.org/TUTORIAL.html#final-touches the tutorial>); e.g.,+--+-- > manageHook = myManageHook <> xScratchpadsManageHook scratchpads+--+-- And finally add some keybindings (see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>):+--+-- > , ((modMask, xK_h), scratchpadAction scratchpads "htop")+-- > , ((modMask, xK_c), scratchpadAction scratchpads "xclock")+-- > , ((modMask, xK_t), scratchpadAction scratchpads "term")+-- > , ((modMask, xK_h), hideAll scratchpads)+--+-- Now you can get your scratchpads by pressing the corresponding keys, if you+-- have the @htop@ scratchpad on your current screen and you fetch the @xclock@+-- scratchpad then @htop@ gets hidden.+--+-- If you move a scratchpad it still gets hidden when you fetch a scratchpad of+-- the same family, to change that behaviour and make windows not exclusive+-- anymore when they get resized or moved add these mouse bindings+-- (see "XMonad.Doc.Extending#Editing_mouse_bindings"):+--+-- >     , ((mod4Mask, button1), floatMoveNoexclusive scratchpads)+-- >     , ((mod4Mask, button3), resizeNoexclusive scratchpads)+--+-- To reset a moved scratchpad to the original position that you set with its hook,+-- call @resetExclusiveSp@ when it is in focus. For example if you want to extend+-- Mod-Return to reset the placement when a scratchpad is in focus but keep the+-- default behaviour for tiled windows, set these key bindings:+--+-- > , ((modMask, xK_Return), windows W.swapMaster >> resetExclusiveSp scratchpads)+--+-- __Note:__ This is just an example, in general you can add more than two+-- exclusive scratchpads and multiple families of such.++data ExclusiveScratchpad = XSP { name   :: String       -- ^ Name of the scratchpad+                               , cmd    :: String       -- ^ Command to spawn the scratchpad+                               , query  :: Query Bool   -- ^ Query to match the scratchpad+                               , hook   :: ManageHook   -- ^ Hook to specify the placement policy+                               , exclusive :: [String]  -- ^ Names of exclusive scratchpads+                               }++type ExclusiveScratchpads = [ExclusiveScratchpad]++-- -----------------------------------------------------------------------------------++-- | Create 'ExclusiveScratchpads' from @[(name,cmd,query)]@ with a common @hook@+mkXScratchpads :: [(String,String,Query Bool)]  -- ^ List of @(name,cmd,query)@ of the+                                                --   exclusive scratchpads+               -> ManageHook                    -- ^ The common @hook@ that they use+               -> ExclusiveScratchpads+mkXScratchpads xs h = foldl accumulate [] xs+  where+    accumulate a (n,c,q) = XSP n c q h (filter (n/=) names) : a+    names = map (\(n,_,_) -> n) xs++-- | Create 'ManageHook' from 'ExclusiveScratchpads'+xScratchpadsManageHook :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads from+                                                --   which a 'ManageHook' should be generated+                       -> ManageHook+xScratchpadsManageHook = composeAll . fmap (\sp -> query sp --> hook sp)++-- | Pop up/hide the scratchpad by name and possibly hide its exclusive+scratchpadAction :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads+                 -> String                -- ^ Name of the scratchpad to toggle+                 -> X ()+scratchpadAction xs n =+  let ys = filter ((n==).name) xs in++  case ys of []     -> return ()+             (sp:_) -> let q = query sp in withWindowSet $ \s -> do+                       ws <- filterM (runQuery q) $ W.allWindows s++                       case ws of []    -> do spawn (cmd sp)+                                              hideOthers xs n+                                              windows W.shiftMaster++                                  (w:_) -> do toggleWindow w+                                              whenX (runQuery isExclusive w) (hideOthers xs n)+  where+    toggleWindow w = liftA2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case+      True  -> whenX (onCurrentScreen w) (minimizeWindow w)+      False -> do windows (flip W.shiftWin w =<< W.currentTag)+                  maximizeWindowAndFocus w+                  windows W.shiftMaster++    onCurrentScreen w = withWindowSet (return . elem w . currentWindows)++-- | Hide all 'ExclusiveScratchpads' on the current screen+hideAll :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads+        -> X ()+hideAll xs = mapWithCurrentScreen q minimizeWindow+  where q = joinQueries (map query xs) <&&> isExclusive <&&> isMaximized++-- | If the focused window is a scratchpad, the scratchpad gets reset to the original+-- placement specified with the hook and becomes exclusive again+resetExclusiveSp :: ExclusiveScratchpads -- ^ List of exclusive scratchpads+                 -> X ()+resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do+  let ys = filterM (flip runQuery w . query) xs++  unlessX (null <$> ys) $ do+    mh <- NE.head . notEmpty . map hook <$> ys  -- ys /= [], so `head` is fine+    n  <- NE.head . notEmpty . map name <$> ys  -- same++    (windows . appEndo <=< runQuery mh) w+    hideOthers xs n+    delTag "_XSP_NOEXCLUSIVE" w++  where unlessX = whenX . fmap not++-- -----------------------------------------------------------------------------------++-- | Hide the scratchpad of the same family by name if it's on the focused workspace+hideOthers :: ExclusiveScratchpads -> String -> X ()+hideOthers xs n =+  let ys = concatMap exclusive $ filter ((n==).name) xs+      qs = map query $ filter ((`elem` ys).name) xs+      q  = joinQueries qs <&&> isExclusive <&&> isMaximized in++  mapWithCurrentScreen q minimizeWindow++-- | Conditionally map a function on all windows of the current screen+mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X ()+mapWithCurrentScreen q f = withWindowSet $ \s -> do+  ws <- filterM (runQuery q) $ currentWindows s+  mapM_ f ws++-- | Extract all windows on the current screen from a StackSet+currentWindows :: W.StackSet i l a sid sd -> [a]+currentWindows = W.integrate' . W.stack . W.workspace . W.current++-- | Check if given window is a scratchpad+isScratchpad :: ExclusiveScratchpads -> Window -> X Bool+isScratchpad xs w = withWindowSet $ \s -> do+  let q = joinQueries $ map query xs++  ws <- filterM (runQuery q) $ W.allWindows s+  return $ elem w ws++-- | Build a disjunction from a list of clauses+joinQueries :: [Query Bool] -> Query Bool+joinQueries = foldl (<||>) (liftX $ return False)++-- | Useful queries+isExclusive, isMaximized :: Query Bool+isExclusive = notElem "_XSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS"+isMaximized = not <$> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"++-- -----------------------------------------------------------------------------------++-- | Make a window not exclusive anymore+setNoexclusive :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads+               -> Window                -- ^ Window which should be made not+                                        --   exclusive anymore+               -> X ()+setNoexclusive xs w = whenX (isScratchpad xs w) $ addTag "_XSP_NOEXCLUSIVE" w++-- | Float and drag the window, make it not exclusive anymore+floatMoveNoexclusive :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads+                     -> Window                -- ^ Window which should be moved+                     -> X ()+floatMoveNoexclusive xs w = setNoexclusive xs w+  >> focus w+  >> mouseMoveWindow w+  >> windows W.shiftMaster++-- | Resize window, make it not exclusive anymore+resizeNoexclusive :: ExclusiveScratchpads  -- ^ List of exclusive scratchpads+                  -> Window                -- ^ Window which should be resized+                  -> X ()+resizeNoexclusive xs w = setNoexclusive xs w+  >> focus w+  >> mouseResizeWindow w+  >> windows W.shiftMaster++-- -----------------------------------------------------------------------------------++-- | Manage hook that makes the window non-floating+nonFloating :: ManageHook+nonFloating = idHook++-- | Manage hook that makes the window floating with the default placement+defaultFloating :: ManageHook+defaultFloating = doFloat++-- | Manage hook that makes the window floating with custom placement+customFloating :: W.RationalRect  -- ^ @RationalRect x y w h@ that specifies relative position,+                                  --   height and width (see "XMonad.StackSet#RationalRect")+               -> ManageHook+customFloating = doRectFloat
+ XMonad/Util/ExtensibleConf.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Module      :  XMonad.Util.ExtensibleConf+-- Description :  Extensible and composable configuration for contrib modules.+-- Copyright   :  (c) 2021 Tomáš Janoušek <tomi@nomi.cz>+-- License     :  BSD3+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>+--+-- Extensible and composable configuration for contrib modules.+--+-- This is the configuration counterpart of "XMonad.Util.ExtensibleState". It+-- allows contrib modules to store custom configuration values inside+-- 'XConfig'. This lets them create custom hooks, ensure they hook into xmonad+-- core only once, and possibly more.+--++module XMonad.Util.ExtensibleConf (+    -- * Usage+    -- $usage++    -- * High-level idioms based on Semigroup+    with,+    add,+    once,+    onceM,++    -- * High-level idioms based on Default+    withDef,+    modifyDef,+    modifyDefM,++    -- * Low-level primitivies+    ask,+    lookup,+    alter,+    alterF,+    ) where++import Prelude hiding (lookup)+import XMonad hiding (ask, modify, trace)+import XMonad.Prelude ((<|>), (<&>), fromMaybe)++import Data.Typeable+import qualified Data.Map as M+++-- ---------------------------------------------------------------------+-- $usage+--+-- To utilize this feature in a contrib module, create a data type for the+-- configuration, then use the helper functions provided here to implement+-- a user-friendly composable interface for your contrib module.+--+-- Example:+--+-- > import qualified XMonad.Util.ExtensibleConf as XC+-- >+-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- > newtype MyConf = MyConf{ fromMyConf :: [Int] } deriving Semigroup+-- >+-- > customLogger :: Int -> XConfig l -> XConfig l+-- > customLogger i = XC.once (\c -> c{ logHook = logHook c <> lh }) (MyConf [i])+-- >   where+-- >     lh :: X ()+-- >     lh = XC.with $ io . print . fromMyConf+--+-- The above defines an xmonad configuration combinator that can be applied+-- any number of times like so:+--+-- > main = xmonad $ … . customLogger 1 . ewmh . customLogger 2 . … $ def{…}+--+-- and will always result in just one 'print' invocation in 'logHook'.+++-- ---------------------------------------------------------------------+-- Low-level primitivies++-- | Run-time: Retrieve a configuration value of the requested type.+ask :: (MonadReader XConf m, Typeable a) => m (Maybe a)+ask = asks $ lookup . config++-- | Config-time: Retrieve a configuration value of the requested type.+lookup :: forall a l. Typeable a => XConfig l -> Maybe a+lookup c = fromConfExt =<< typeRep (Proxy @a) `M.lookup` extensibleConf c++-- | Config-time: Alter a configuration value, or absence thereof.+alter :: forall a l. Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l+alter f = mapEC $ M.alter (mapConfExt f) (typeRep (Proxy @a))+  where+    mapEC g c = c{ extensibleConf = g (extensibleConf c) }++-- | Config-time: Functor variant of 'alter', useful if the configuration+-- modifications needs to do some 'IO'.+alterF :: forall a l f. (Typeable a, Functor f)+       => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l)+alterF f = mapEC $ M.alterF (mapConfExtF f) (typeRep (Proxy @a))+  where+    mapEC g c = g (extensibleConf c) <&> \ec -> c{ extensibleConf = ec }+++fromConfExt :: Typeable a => ConfExtension -> Maybe a+fromConfExt (ConfExtension val) = cast val++mapConfExt :: Typeable a+           => (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension+mapConfExt f = fmap ConfExtension . f . (>>= fromConfExt)++mapConfExtF :: (Typeable a, Functor f)+            => (Maybe a -> f (Maybe a)) -> Maybe ConfExtension -> f (Maybe ConfExtension)+mapConfExtF f = fmap (fmap ConfExtension) . f . (>>= fromConfExt)+++-- ---------------------------------------------------------------------+-- High-level idioms based on Semigroup++-- | Run-time: Run a monadic action with the value of the custom+-- configuration, if set.+with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b+with a = ask >>= maybe (pure mempty) a++-- | Config-time: Add (append) a piece of custom configuration to an 'XConfig'+-- using the 'Semigroup' instance of the configuration type.+add :: (Semigroup a, Typeable a)+    => a -- ^ configuration to add+    -> XConfig l -> XConfig l+add x = alter (<> Just x)++-- | Config-time: 'add' a piece of custom configuration, and if it's the first+-- piece of this type, also modify the 'XConfig' using the provided function.+--+-- This can be used to implement a composable interface for modules that must+-- only hook into xmonad core once.+--+-- (The piece of custom configuration is the last argument as it's expected to+-- come from the user.)+once :: forall a l. (Semigroup a, Typeable a)+     => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once+     -> a -- ^ configuration to add+     -> XConfig l -> XConfig l+once f x c = maybe f (const id) (lookup @a c) $ add x c++-- | Config-time: Applicative (monadic) variant of 'once', useful if the+-- 'XConfig' modification needs to do some 'IO' (e.g. create an+-- 'Data.IORef.IORef').+onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a)+      => (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once+      -> a -- ^ configuration to add+      -> XConfig l -> m (XConfig l)+onceM f x c = maybe f (const pure) (lookup @a c) $ add x c+++-- ---------------------------------------------------------------------+-- High-level idioms based on Default++-- | Run-time: Run a monadic action with the value of the custom+-- configuration, or the 'Default' value thereof, if absent.+withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b+withDef a = ask >>= a . fromMaybe def++-- | Config-time: Modify a configuration value in 'XConfig', initializing it+-- to its 'Default' value first if absent. This is an alternative to 'add' for+-- when a 'Semigroup' instance is unavailable or unsuitable.+--+-- Note that this must /not/ be used together with any variant of 'once'!+modifyDef :: forall a l. (Default a, Typeable a)+          => (a -> a) -- ^ modification of configuration+          -> XConfig l -> XConfig l+modifyDef f = alter ((f <$>) . (<|> Just def))++-- | Config-time: Applicative (monadic) variant of 'modifyDef', useful if the+-- configuration value modification needs to do some 'IO' (e.g. create an+-- 'Data.IORef.IORef').+--+-- Note that this must /not/ be used together with any variant of 'once'!+modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a)+           => (a -> m a) -- ^ modification of configuration+           -> XConfig l -> m (XConfig l)+modifyDefM f = alterF (traverse f . (<|> Just def))
XMonad/Util/ExtensibleState.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.ExtensibleState+-- Description :  Module for storing custom mutable state in xmonad. -- Copyright   :  (c) Daniel Schoepe 2009 -- License     :  BSD3-style (see LICENSE) --@@ -18,10 +20,14 @@                               -- $usage                               put                               , modify+                              , modify'+                              , modifyM+                              , modifyM'                               , remove                               , get                               , gets                               , modified+                              , modifiedM                               ) where  import Data.Typeable (typeOf,cast)@@ -29,7 +35,7 @@ import XMonad.Core import XMonad.Util.PureX import qualified Control.Monad.State as State-import Data.Maybe (fromMaybe)+import XMonad.Prelude (fromMaybe)  -- --------------------------------------------------------------------- -- $usage@@ -38,10 +44,9 @@ -- and make it an instance of ExtensionClass. You can then use -- the functions from this module for storing and retrieving your data: ----- > {-# LANGUAGE DeriveDataTypeable #-} -- > import qualified XMonad.Util.ExtensibleState as XS -- >--- > data ListStorage = ListStorage [Integer] deriving Typeable+-- > data ListStorage = ListStorage [Integer] -- > instance ExtensionClass ListStorage where -- >   initialValue = ListStorage [] -- >@@ -59,7 +64,7 @@ -- To make your data persistent between restarts, the data type needs to be -- an instance of Read and Show and the instance declaration has to be changed: ----- > data ListStorage = ListStorage [Integer] deriving (Typeable,Read,Show)+-- > data ListStorage = ListStorage [Integer] deriving (Read,Show) -- > -- > instance ExtensionClass ListStorage where -- >   initialValue = ListStorage []@@ -86,8 +91,21 @@ -- | Apply a function to a stored value of the matching type or the initial value if there -- is none. modify :: (ExtensionClass a, XLike m) => (a -> a) -> m ()-modify f = put . f =<< get+modify = modifyM . (pure .) +-- | Apply an action to a stored value of the matching type or the initial value if there+-- is none.+modifyM :: (ExtensionClass a, XLike m) => (a -> m a) -> m ()+modifyM f = put =<< f =<< get++-- | Like 'modify' but the result value is forced to WHNF before being stored.+modify' :: (ExtensionClass a, XLike m) => (a -> a) -> m ()+modify' = modifyM' . (pure .)++-- | Like 'modifyM' but the result value is forced to WHNF before being stored.+modifyM' :: (ExtensionClass a, XLike m) => (a -> m a) -> m ()+modifyM' f = (put $!) =<< f =<< get+ -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type -- is equal to the new one's)@@ -97,7 +115,7 @@ -- | Try to retrieve a value of the requested type, return an initial value if there is no such value. get :: (ExtensionClass a, XLike m) => m a get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables-  where toValue val = maybe initialValue id $ cast val+  where toValue val = fromMaybe initialValue $ cast val         getState' :: (ExtensionClass a, XLike m) => a -> m a         getState' k = do           v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState@@ -108,7 +126,7 @@                 let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x                 put (val `asTypeOf` k)                 return val-            _ -> return $ initialValue+            _ -> return initialValue         safeRead str = case reads str of                          [(x,"")] -> Just x                          _ -> Nothing@@ -121,8 +139,11 @@ remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)  modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool-modified f = do+modified = modifiedM . (pure .)++modifiedM :: (ExtensionClass a, Eq a, XLike m) => (a -> m a) -> m Bool+modifiedM f = do     v <- get-    case f v of+    f v >>= \case         v' | v' == v   -> return False            | otherwise -> put v' >> return True
XMonad/Util/Font.hs view
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Font+-- Description :  A module for abstracting a font facility over Core fonts and Xft. -- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen -- License     :  BSD-style (see xmonad/LICENSE) --@@ -34,24 +35,22 @@     ) where  import XMonad+import XMonad.Prelude import Foreign-import Control.Applicative import Control.Exception as E-import Data.Maybe-import Data.Bits (shiftR) import Text.Printf (printf)  #ifdef XFT-import Data.List-import Graphics.X11.Xft+import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender+import Graphics.X11.Xft #endif  -- Hide the Core Font/Xft switching here data XMonadFont = Core FontStruct                 | Utf8 FontSet #ifdef XFT-                | Xft  XftFont+                | Xft  (NE.NonEmpty XftFont) #endif  -- $usage@@ -65,16 +64,23 @@           fallBack = blackPixel d (defaultScreen d)  -- | Convert a @Pixel@ into a @String@.+--+-- This function removes any alpha channel from the @Pixel@, because X11+-- mishandles alpha channels and produces black. pixelToString :: (MonadIO m) => Display -> Pixel -> m String pixelToString d p = do     let cm = defaultColormap d (defaultScreen d)-    (Color _ r g b _) <- io (queryColor d cm $ Color p 0 0 0 0)+    (Color _ r g b _) <- io (queryColor d cm $ Color (p .&. 0x00FFFFFF) 0 0 0 0)     return ("#" ++ hex r ++ hex g ++ hex b)   where     -- NOTE: The @Color@ type has 16-bit values for red, green, and     -- blue, even though the actual type in X is only 8 bits wide.  It     -- seems that the upper and lower 8-bit sections of the @Word16@     -- values are the same.  So, we just discard the lower 8 bits.+    --+    -- (Strictly, X11 supports 16-bit values but no visual supported+    -- by XOrg does. It is still correct to discard the lower bits, as+    -- they are not guaranteed to be meaningful in such visuals.)     hex = printf "%02x" . (`shiftR` 8)  econst :: a -> IOException -> a@@ -111,34 +117,47 @@ -- Example: 'xft: Sans-10' initXMF :: String -> X XMonadFont initXMF s =-#ifdef XFT+#ifndef XFT+  Utf8 <$> initUtf8Font s+#else   if xftPrefix `isPrefixOf` s then      do dpy <- asks display-        xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)-        return (Xft xftdraw)-  else-#endif-      fmap Utf8 $ initUtf8Font s-#ifdef XFT-  where xftPrefix = "xft:"+        let fonts = case wordsBy (== ',') (drop (length xftPrefix) s) of+              []       -> fallback :| []  -- NE.singleton only in base 4.15+              (x : xs) -> x :| xs+        fb <- io $ openFont dpy fallback+        fmap Xft . io $ traverse (\f -> E.catch (openFont dpy f) (econst $ pure fb))+                                 fonts+  else Utf8 <$> initUtf8Font s+ where+  xftPrefix = "xft:"+  fallback  = "xft:monospace"+  openFont dpy str = xftFontOpen dpy (defaultScreenOfDisplay dpy) str+  wordsBy p str = case dropWhile p str of+    ""   -> []+    str' -> w : wordsBy p str''+     where (w, str'') = break p str' #endif  releaseXMF :: XMonadFont -> X () #ifdef XFT-releaseXMF (Xft xftfont) = do+releaseXMF (Xft xftfonts) = do   dpy <- asks display-  io $ xftFontClose dpy xftfont+  io $ mapM_ (xftFontClose dpy) xftfonts #endif releaseXMF (Utf8 fs) = releaseUtf8Font fs releaseXMF (Core fs) = releaseCoreFont fs - textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int textWidthXMF _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s #ifdef XFT textWidthXMF dpy (Xft xftdraw) s = liftIO $ do-    gi <- xftTextExtents dpy xftdraw s+#if MIN_VERSION_X11_xft(0, 3, 4)+    gi <- xftTextAccumExtents dpy (toList xftdraw) s+#else+    gi <- xftTextExtents dpy (NE.head xftdraw) s+#endif     return $ xglyphinfo_xOff gi #endif @@ -146,15 +165,21 @@ textExtentsXMF (Utf8 fs) s = do   let (_,rl)  = wcTextExtents fs s       ascent  = fi $ - (rect_y rl)-      descent = fi $ rect_height rl + (fi $ rect_y rl)+      descent = fi $ rect_height rl + fi (rect_y rl)   return (ascent, descent) textExtentsXMF (Core fs) s = do   let (_,a,d,_) = textExtents fs s   return (a,d) #ifdef XFT-textExtentsXMF (Xft xftfont) _ = io $ do-  ascent  <- fi `fmap` xftfont_ascent  xftfont-  descent <- fi `fmap` xftfont_descent xftfont+#if MIN_VERSION_X11_xft(0, 3, 4)+textExtentsXMF (Xft xftfonts) _ = io $ do+  ascent  <- fi <$> xftfont_max_ascent  xftfonts+  descent <- fi <$> xftfont_max_descent xftfonts+#else+textExtentsXMF (Xft xftfonts) _ = io $ do+  ascent  <- fi <$> xftfont_ascent  (NE.head xftfonts)+  descent <- fi <$> xftfont_descent (NE.head xftfonts)+#endif   return (ascent, descent) #endif @@ -190,13 +215,17 @@     setBackground d gc bc'     io $ wcDrawImageString d p fs gc x y s #ifdef XFT-printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do+printStringXMF dpy drw fs@(Xft fonts) gc fc bc x y s = do   let screen   = defaultScreenOfDisplay dpy       colormap = defaultColormapOfScreen screen       visual   = defaultVisualOfScreen screen   bcolor <- stringToPixel dpy bc   (a,d)  <- textExtentsXMF fs s-  gi <- io $ xftTextExtents dpy font s+#if MIN_VERSION_X11_xft(0, 3, 4)+  gi <- io $ xftTextAccumExtents dpy (toList fonts) s+#else+  gi <- io $ xftTextExtents dpy (NE.head fonts) s+#endif   io $ setForeground dpy gc bcolor   io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))                                 (y - fi a)@@ -204,9 +233,9 @@                                 (fi $ a + d)   io $ withXftDraw dpy drw visual colormap $          \draw -> withXftColorName dpy visual colormap fc $-                   \color -> xftDrawString draw color font x y s+#if MIN_VERSION_X11_xft(0, 3, 4)+                   \color -> xftDrawStringFallback draw color (toList fonts) (fi x) (fi y) s+#else+                   \color -> xftDrawString draw color (NE.head fonts) x y s #endif---- | Short-hand for 'fromIntegral'-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral+#endif
+ XMonad/Util/Grab.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE LambdaCase #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Grab+-- Description :  Utilities for grabbing/ungrabbing keys.+-- Copyright   :  (c) 2018  L. S. Leary+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  L. S. Leary+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module should not be directly used by users. Its purpose is to+-- facilitate grabbing and ungrabbing keys.+--------------------------------------------------------------------------------++-- --< Imports & Exports >-- {{{++module XMonad.Util.Grab+  (+ -- * Usage+ -- $Usage+    grabKP+  , ungrabKP+  , grabUngrab+  , grab+  , customRegrabEvHook+  ) where++-- core+import           XMonad++import           Control.Monad                  ( when )+import           Data.Foldable                  ( traverse_ )+-- base+import           Data.Semigroup                 ( All(..) )++-- }}}++-- --< Usage >-- {{{++-- $Usage+--+-- This module should not be directly used by users. Its purpose is to+-- facilitate grabbing and ungrabbing keys.++-- }}}++-- --< Public Utils >-- {{{++-- | A more convenient version of 'grabKey'.+grabKP :: KeyMask -> KeyCode -> X ()+grabKP mdfr kc = do+  XConf { display = dpy, theRoot = rootw } <- ask+  io (grabKey dpy kc mdfr rootw True grabModeAsync grabModeAsync)++-- | A more convenient version of 'ungrabKey'.+ungrabKP :: KeyMask -> KeyCode -> X ()+ungrabKP mdfr kc = do+  XConf { display = dpy, theRoot = rootw } <- ask+  io (ungrabKey dpy kc mdfr rootw)++-- | A convenience function to grab and ungrab keys+grabUngrab+  :: [(KeyMask, KeySym)] -- ^  Keys to grab+  -> [(KeyMask, KeySym)] -- ^ Keys to ungrab+  -> X ()+grabUngrab gr ugr = do+  traverse_ (uncurry ungrabKP) =<< mkGrabs ugr+  traverse_ (uncurry grabKP)   =<< mkGrabs gr++-- | A convenience function to grab keys. This also ungrabs all+-- previously grabbed keys.+grab :: [(KeyMask, KeySym)] -> X ()+grab ks = do+  XConf { display = dpy, theRoot = rootw } <- ask+  io (ungrabKey dpy anyKey anyModifier rootw)+  grabUngrab ks []++-- | An event hook that runs a custom action to regrab the necessary keys.+customRegrabEvHook :: X () -> Event -> X All+customRegrabEvHook regr = \case+  e@MappingNotifyEvent{} -> do+    io (refreshKeyboardMapping e)+    when (ev_request e `elem` [mappingKeyboard, mappingModifier])+      $  cacheNumlockMask+      >> regr+    pure (All False)+  _ -> pure (All True)++-- }}}
+ XMonad/Util/Hacks.hs view
@@ -0,0 +1,216 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Hacks+-- Description :  A collection of small fixes and utilities with possibly hacky implementations.+-- Copyright   :  (c) 2020 Leon Kowarschick+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module is a collection of random fixes, workarounds and other functions+-- that rely on somewhat hacky implementations which may have unwanted side effects+-- and/or are small enough to not warrant a separate module.+--+-- Import this module as qualified like so:+--+-- > import qualified XMonad.Util.Hacks as Hacks+--+-- and then use the functions you want as described in their respective documentation.+--+-----------------------------------------------------------------------------++module XMonad.Util.Hacks (+  -- * Windowed fullscreen+  -- $windowedFullscreenFix+  windowedFullscreenFixEventHook,++  -- * Java Hack+  -- $java+  javaHack,++  -- * Stacking trays (trayer) above panels (xmobar)+  -- $raiseTrayer+  trayerAboveXmobarEventHook,+  trayAbovePanelEventHook,++  -- * Inform xmobar when trays (e.g. trayer) change width+  -- $padTrayer+  trayerPaddingXmobarEventHook,+  trayPaddingXmobarEventHook,+  trayPaddingEventHook,++  -- * Steam flickering fix+  fixSteamFlicker,+  ) where+++import XMonad+import XMonad.Hooks.FloatConfigureReq (fixSteamFlicker)+import XMonad.Hooks.StatusBar (xmonadPropLog')+import XMonad.Prelude (All (All), fi, filterM, when)+import System.Posix.Env (putEnv)+++-- $windowedFullscreenFix+-- Windowed fullscreen describes the behaviour in which XMonad,+-- by default, does not automatically put windows that request being fullscreened+-- into actual fullscreen, but keeps them constrained+-- to their normal window dimensions, still rendering them in fullscreen.+--+-- With chromium based applications like Chrome, Discord and others this+-- can cause issues, where the window does not correctly see the size of the window+-- when displaying the fullscreen content, thus cutting off the window content.+--+-- This function works around that issue by forcing the window to recalculate their+-- dimensions after initiating fullscreen, thus making chrome-based applications+-- behave properly when in windowed fullscreen.+--+-- The following gif shows the behaviour of chrome (left) without this fix+-- compared to firefox, which already behaves as expected by default:+-- <<https://user-images.githubusercontent.com/79924233/115355075-e61dd280-a1ec-11eb-81d3-927ca462945f.gif>>+--+-- Using this function, chrome will now behave as expected as well:+-- <<https://user-images.githubusercontent.com/5300871/99186115-4dbb8780-274e-11eb-9ed2-b7815ba9e597.gif>>+--+-- Usage:+-- add to handleEventHook as follows:+--+-- > handleEventHook = handleEventHook def <> Hacks.windowedFullscreenFixEventHook+--++-- | Fixes fullscreen behaviour of chromium based apps by quickly applying and undoing a resize.+-- This causes chromium to recalculate the fullscreen window+-- dimensions to match the actual "windowed fullscreen" dimensions.+windowedFullscreenFixEventHook :: Event -> X All+windowedFullscreenFixEventHook (ClientMessageEvent _ _ _ dpy win typ (_:dats)) = do+  wmstate <- getAtom "_NET_WM_STATE"+  fullscreen <- getAtom "_NET_WM_STATE_FULLSCREEN"+  when (typ == wmstate && fromIntegral fullscreen `elem` dats) $+    withWindowAttributes dpy win $ \attrs ->+      liftIO $ do+        resizeWindow dpy win (fromIntegral $ wa_width attrs - 1) (fromIntegral $ wa_height attrs)+        resizeWindow dpy win (fromIntegral $ wa_width attrs) (fromIntegral $ wa_height attrs)+  return $ All True+windowedFullscreenFixEventHook _ = return $ All True+++-- $java+-- Some java Applications might not work with xmonad. A common workaround would be to set the environment+-- variable @_JAVA_AWT_WM_NONREPARENTING@ to 1. The function 'javaHack' does exactly that.+-- Example usage:+--+-- > main = xmonad $ Hacks.javaHack (def {...})+--++-- | Fixes Java applications that don't work well with xmonad, by setting @_JAVA_AWT_WM_NONREPARENTING=1@+javaHack :: XConfig l -> XConfig l+javaHack conf = conf+  { startupHook = startupHook conf+                    *> io (putEnv "_JAVA_AWT_WM_NONREPARENTING=1")+  }+++-- $raiseTrayer+-- Placing @trayer@ on top of @xmobar@ is somewhat tricky:+--+-- - they both should be lowered to the bottom of the stacking order to avoid+--   overlapping fullscreen windows+--+-- - the tray needs to be stacked on top of the panel regardless of which+--   happens to start first+--+-- 'trayerAboveXmobarEventHook' (and the more generic+-- 'trayAbovePanelEventHook') is an event hook that ensures the latter:+-- whenever the tray lowers itself to the bottom of the stack, it checks+-- whether there are any panels above it and lowers these again.+--+-- To ensure the former, that is having both @trayer@ and @xmobar@ lower+-- themselves, which is a necessary prerequisite for this event hook to+-- trigger:+--+-- - set @lowerOnStart = True@ and @overrideRedirect = True@ in @~/.xmobarrc@+-- - pass @-l@ to @trayer@+--+-- Usage:+--+-- > handleEventHook = … <> Hacks.trayerAboveXmobarEventHook++-- | Like 'trayAbovePanelEventHook', but specialised for trayer/xmobar.+trayerAboveXmobarEventHook :: Event -> X All+trayerAboveXmobarEventHook = trayAbovePanelEventHook (className =? "trayer") (appName =? "xmobar")++-- | Whenever a tray window lowers itself to the bottom of the stack, look for+-- any panels above it and lower these.+trayAbovePanelEventHook+  :: Query Bool -- ^ tray+  -> Query Bool -- ^ panel+  -> (Event -> X All) -- ^ event hook+trayAbovePanelEventHook trayQ panelQ ConfigureEvent{ev_window = w, ev_above = a} | a == none = do+  whenX (runQuery trayQ w) $ withDisplay $ \dpy -> do+    rootw <- asks theRoot+    (_, _, ws) <- io $ queryTree dpy rootw+    let aboveTrayWs = dropWhile (w /=) ws+    panelWs <- filterM (runQuery panelQ) aboveTrayWs+    mapM_ (io . lowerWindow dpy) panelWs+  mempty+trayAbovePanelEventHook _ _ _ = mempty++-- $padTrayer+-- Communicating tray (e.g., trayer) resize events to xmobar so that+-- padding space may be reserved on xmobar for the tray.+--+-- Basic Usage with trayer:+--+-- First, add the padding hook to your @handleEventHook@ as follows:+--+-- > main = xmonad $ def+-- > { ...+-- > , handleEventHook = handleEventHook def+-- >                  <> Hacks.trayerPaddingXmobarEventHook+-- > }+--+-- Then, assuming the tray is placed on the right, update your+-- @xmobarrc@ as follows:+--+-- > Config { ...+-- >        , commands = [ ...+-- >                     , Run XPropertyLog "_XMONAD_TRAYPAD", ... ]+-- >        , template = " ... %_XMONAD_TRAYPAD%"+-- >        }+--+-- As an example of what happens in this basic usage, consider the+-- case where trayer updates to a width of 53 pixels.+-- The following property will appear on the root window:+--+-- > _XMONAD_TRAYPAD(UTF8_STRING) = "<hspace=53/>"++-- | A simple trayer/xmobar-specific event hook that watches for trayer window+-- resize changes and updates the _XMONAD_TRAYPAD property with xmobar markup+-- that leaves a gap for the trayer.+trayerPaddingXmobarEventHook :: Event -> X All -- ^ event hook+trayerPaddingXmobarEventHook = trayPaddingXmobarEventHook (className =? "trayer") "_XMONAD_TRAYPAD"++-- | A generic version of 'trayerPaddingXmobarEventHook' that+-- allows the user to specify how to identify a tray window and the property+-- to use with 'xmonadPropLog''. This is useful for other trays like+-- stalonetray and also when space for more than one tray-like window needs to+-- be reserved.+trayPaddingXmobarEventHook+  :: Query Bool     -- ^ query to identify the tray window+  -> String         -- ^ 'xmonadPropLog'' property to use+  -> Event -> X All -- ^ resulting event hook+trayPaddingXmobarEventHook trayQ prop = trayPaddingEventHook trayQ hspaceLog+  where hspaceLog width = xmonadPropLog' prop ("<hspace=" ++ show width ++ "/>")++-- | A fully generic tray resize hook that invokes a callback whenever a+-- tray-like window changes width.+trayPaddingEventHook+  :: Query Bool     -- ^ query to identify the tray window+  -> (Int -> X ())  -- ^ action to perform when tray width changes+  -> Event -> X All -- ^ resulting event hook+trayPaddingEventHook trayQ widthChanged ConfigureEvent{ ev_window = w, ev_width = wa } = do+  whenX (runQuery trayQ w) $ widthChanged (fi wa)+  mempty+trayPaddingEventHook _ _ _ = mempty
+ XMonad/Util/History.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE NamedFieldPuns, DeriveTraversable #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.History+-- Description :  Track history in /O(log n)/ time.+-- Copyright   :  (c) 2022 L. S. Leary+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  @LSLeary (on github)+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides 'History', a variation on a LIFO stack with a uniqueness property.+-- In order to achieve the desired asymptotics, the data type is implemented as+-- an ordered Map.+--+-----------------------------------------------------------------------------++module XMonad.Util.History (+  History,+  origin,+  event,+  erase,+  recall,+  ledger,+  transcribe,+  ) where++-- base+import Data.Function (on)+import Text.Read+  ( Read(readPrec, readListPrec), Lexeme(Ident)+  , parens, prec, lexP, step, readListPrecDefault+  )++-- containers+import Data.IntMap (IntMap)+import qualified Data.IntMap.Strict as I+import Data.Map (Map)+import qualified Data.Map.Strict as M+++-- | A history of unique @k@-events with @a@-annotations.+--+--   @History k a@ can be considered a (LIFO) stack of @(k, a)@ values with the+--   property that each @k@ is unique. From this point of view, 'event' pushes+--   and 'ledger' pops/peeks all.+--+--   The naive implementation has /O(n)/ 'event' and 'erase' due to the+--   uniqueness condition, but we can still use it as a denotation:+--+-- > mu :: History k a -> [(k, a)]+--+--   As an opaque data type with strict operations, @History k a@ values are all+--   finite expressions in the core interface: 'origin', 'erase' and 'event'.+--   Hence we define @mu@ by structural induction on these three cases.+--+data History k a = History+  { annals   :: !(IntMap (k, a))+  , recorded :: !(Map k Int)+  } deriving (Functor, Foldable, Traversable)++instance (Eq  k, Eq  a) => Eq  (History k a) where (==)    = (==)    `on` ledger+instance (Ord k, Ord a) => Ord (History k a) where compare = compare `on` ledger++instance (Show k, Show a) => Show (History k a) where+  showsPrec d h+    = showParen (d > app_prec)+    $ showString "transcribe "+    . showsPrec (app_prec+1) (ledger h)+    where app_prec = 10++instance (Read k, Read a, Ord k) => Read (History k a) where+  readPrec = parens . prec app_prec $ do+    Ident "transcribe" <- lexP+    l <- step readPrec+    pure (transcribe l)+    where app_prec = 10+  readListPrec = readListPrecDefault+++-- | /O(1)/. A history of nothing.+--+-- > mu origin := []+--+origin :: History k a+origin = History I.empty M.empty++-- | /O(log n)/. A new event makes history; its predecessor forgotten.+--+-- > mu (event k a h) := (k, a) : mu (erase k h)+--+event :: Ord k => k -> a -> History k a -> History k a+event k a History{annals,recorded} = History+  { annals   = I.insert ik (k, a) . maybe id I.delete mseen $ annals+  , recorded = recorded'+  }+  where+    ik = maybe 0 (\((i, _), _) -> pred i) (I.minViewWithKey annals)+    (mseen, recorded') = M.insertLookupWithKey (\_ x _ -> x) k ik recorded++-- | /O(log n)/. Erase an event from history.+--+-- > mu (erase k h) := filter ((k /=) . fst) (mu h)+--+erase :: Ord k => k -> History k a -> History k a+erase k History{annals,recorded} = History+  { annals   = maybe id I.delete mseen annals+  , recorded = recorded'+  }+  where (mseen, recorded') = M.updateLookupWithKey (\_ _ -> Nothing) k recorded+++-- | /O(log n)/. Recall an event.+recall :: Ord k => k -> History k a -> Maybe a+recall k History{annals,recorded} = do+  ik     <- M.lookup k recorded+  (_, a) <- I.lookup ik annals+  pure a++-- | /O(n)/. Read history, starting with the modern day. @ledger@ is @mu@.+ledger :: History k a -> [(k, a)]+ledger = I.elems . annals++-- | /O(n * log n)/. Transcribe a ledger.+transcribe :: Ord k => [(k, a)] -> History k a+transcribe = foldr (uncurry event) origin
XMonad/Util/Image.hs view
@@ -1,6 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Image+-- Description :  Utilities for manipulating @[[Bool]]@ as images. -- Copyright   :  (c) 2010 Alejandro Serrano -- License     :  BSD-style (see xmonad/LICENSE) --@@ -21,7 +22,8 @@     ) where  import XMonad-import XMonad.Util.Font (stringToPixel,fi)+import XMonad.Prelude+import XMonad.Util.Font (stringToPixel)  -- | Placement of the icon in the title bar data Placement = OffsetLeft Int Int   -- ^ An exact amount of pixels from the upper left corner@@ -37,16 +39,16 @@ -- In the module we suppose that those matrices are represented as [[Bool]], -- so the lengths of the inner lists must be the same. ----- See "Xmonad.Layout.Decoration" for usage examples+-- See "XMonad.Layout.Decoration" for usage examples  -- | Gets the ('width', 'height') of an image imageDims :: [[Bool]] -> (Int, Int)-imageDims img = (length (head img), length img)+imageDims img = (length (fromMaybe [] (listToMaybe img)), length img)  -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing --   the image given its 'Placement' iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position)-iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y)+iconPosition Rectangle{} (OffsetLeft x y) _ = (fi x, fi y) iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon =   let (icon_w, _) = imageDims icon   in (fi w - fi x - fi icon_w, fi y)@@ -72,7 +74,7 @@  -- | Displaces a list of points along a vector 'x', 'y' movePoints :: Position -> Position -> [Point] -> [Point]-movePoints x y points = map (movePoint x y) points+movePoints x y = map (movePoint x y)  -- | Draw an image into a X surface drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String
XMonad/Util/Invisible.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Invisible+-- Description :  A data type to store the layout state. -- Copyright   :  (c) 2007 Andrea Rossato, David Roundy -- License     :  BSD-style (see xmonad/LICENSE) --@@ -22,7 +23,7 @@                             , fromIMaybe                             ) where -import Control.Applicative+import Control.Monad.Fail  -- $usage -- A wrapper data type to store layout state that shouldn't be persisted across@@ -30,10 +31,10 @@ -- Invisible derives trivial definitions for Read and Show, so the wrapped data -- type need not do so. -newtype Invisible m a = I (m a) deriving (Monad, Applicative, Functor)+newtype Invisible m a = I (m a) deriving (Monad, MonadFail, Applicative, Functor) -instance (Functor m, Monad m) => Read (Invisible m a) where-    readsPrec _ s = [(fail "Read Invisible", s)]+instance (Functor m, Monad m, MonadFail m) => Read (Invisible m a) where+    readsPrec _ s = [(Control.Monad.Fail.fail "Read Invisible", s)]  instance Monad m => Show (Invisible m a) where     show _ = ""
XMonad/Util/Loggers.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Loggers+-- Description :  A collection of simple logger functions and formatting utilities. -- Copyright   :  (c) Brent Yorgey, Wirt Wolff -- License     :  BSD-style (see LICENSE) --@@ -9,8 +11,8 @@ -- Portability :  unportable -- -- A collection of simple logger functions and formatting utilities--- which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of--- a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog"+-- which can be used in the 'XMonad.Hooks.StatusBar.PP.ppExtras' field of+-- a pretty-printing status logger format. See "XMonad.Hooks.StatusBar.PP" -- for more information. ----------------------------------------------------------------------------- @@ -31,8 +33,18 @@      -- * XMonad Loggers     -- $xmonad-    , logCurrent, logLayout, logTitle-+    , logCurrent, logLayout+    , logTitle, logTitles, logTitles'+    , logClassname, logClassnames, logClassnames'+    , logConst, logDefault, (.|)+    -- * XMonad: Screen-specific Loggers+    -- $xmonad-screen+    , logCurrentOnScreen, logLayoutOnScreen+    , logTitleOnScreen, logClassnameOnScreen, logWhenActive+    , logTitlesOnScreen, logTitlesOnScreen'+    , logClassnamesOnScreen, logClassnamesOnScreen'+    , TitlesFormat(..)+    , ClassnamesFormat(..)     -- * Formatting Utilities     -- $format     , onLogger@@ -41,66 +53,60 @@     , shortenL     , dzenColorL, xmobarColorL -    , (<$>)-   ) where -import XMonad (liftIO)+import XMonad (Default, gets, liftIO, Window) import XMonad.Core import qualified XMonad.StackSet as W-import XMonad.Hooks.DynamicLog+import XMonad.Hooks.StatusBar.PP+import XMonad.Hooks.UrgencyHook (readUrgents) import XMonad.Util.Font (Align (..))-import XMonad.Util.NamedWindows (getName)+import XMonad.Util.NamedWindows (getName, getNameWMClass) -import Control.Applicative ((<$>)) import Control.Exception as E-import Data.List (isPrefixOf, isSuffixOf)-import Data.Maybe (fromMaybe)-import Data.Traversable (traverse)+import XMonad.Prelude (find, fromMaybe, isPrefixOf, isSuffixOf, WindowScreen)+import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) import System.Directory (getDirectoryContents)-import System.IO-import System.Locale+import System.IO (hGetLine) import System.Process (runInteractiveCommand)-import System.Time  econst :: Monad m => a -> IOException -> m a econst = const . return  -- $usage--- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@:+-- Use this module by importing it into your @xmonad.hs@: -- -- > import XMonad.Util.Loggers -- -- Then, add one or more loggers to the--- 'XMonad.Hooks.DynamicLog.ppExtras' field of your--- 'XMonad.Hooks.DynamicLoc.PP', possibly with extra formatting .+-- 'XMonad.Hooks.StatusBar.PP.ppExtras' field of your+-- "XMonad.Hooks.StatusBar.PP", possibly with extra formatting . -- For example: ----- >   -- display load averages and a pithy quote along with xmonad status.--- >   , logHook = dynamicLogWithPP $ def {--- >                  ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ]--- >                }+-- > myPP = def {+-- >            ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ]+-- >         } -- >   -- gives something like " 3.27 3.52 3.26 Drive defensively.  Buy a tank." -- -- See the formatting section below for another example using -- a @where@ block to define some formatted loggers for a top-level--- @myLogHook@.+-- @myPP@. -- -- Loggers are named either for their function, as in 'battery', -- 'aumixVolume', and 'maildirNew', or are prefixed with \"log\" when -- making use of other functions or by analogy with the pp* functions.--- For example, the logger version of 'XMonad.Hooks.DynamicLog.ppTitle'+-- For example, the logger version of 'XMonad.Hooks.StatusBar.PP.ppTitle' -- is 'logTitle', and 'logFileCount' loggerizes the result of file -- counting code. -- -- Formatting utility names are generally as short as possible and -- carry the suffix \"L\". For example, the logger version of--- 'XMonad.Hooks.DynamicLog.shorten' is 'shortenL'.+-- 'XMonad.Hooks.StatusBar.PP.shorten' is 'shortenL'. -- -- Of course, there is nothing really special about these so-called -- \"loggers\": they are just @X (Maybe String)@ actions.  So you can -- use them anywhere you would use an @X (Maybe String)@, not just--- with DynamicLog.+-- with PP. -- -- Additional loggers welcome! @@ -118,9 +124,9 @@ -- | Get the battery status (percent charge and charging\/discharging --   status). This is an ugly hack and may not work for some people. --   At some point it would be nice to make this more general\/have---   fewer dependencies (assumes @\/usr\/bin\/acpi@ and @sed@ are installed.)+--   fewer dependencies (assumes @acpi@ and @sed@ are installed.) battery :: Logger-battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'"+battery = logCmd "acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'"  -- | Get the current date and time, and format them via the --   given format string.  The format used is the same as that used@@ -129,15 +135,14 @@ --   For more information see something like --   <http://www.cplusplus.com/reference/clibrary/ctime/strftime.html>. date :: String -> Logger-date fmt = io $ do cal <- (getClockTime >>= toCalendarTime)-                   return . Just $ formatCalendarTime defaultTimeLocale fmt cal+date fmt = io $ Just . formatTime defaultTimeLocale fmt <$> getCurrentTime  -- | Get the load average.  This assumes that you have a---   utility called @\/usr\/bin\/uptime@ and that you have @sed@+--   utility called @uptime@ and that you have @sed@ --   installed; these are fairly common on GNU\/Linux systems but it --   would be nice to make this more general. loadAvg :: Logger-loadAvg = logCmd "/usr/bin/uptime | sed 's/.*: //; s/,//g'"+loadAvg = logCmd "uptime | sed 's/.*: //; s/,//g'"  -- | Create a 'Logger' from an arbitrary shell command. logCmd :: String -> Logger@@ -173,10 +178,172 @@ -- example you can loggerize the number of windows on each workspace, or -- titles on other workspaces, or the id of the previously focused workspace.... +-- | Internal function to get a wrapped title string from a window+fetchWindowTitle :: Window -> X String+fetchWindowTitle = fmap show . getName+ -- | Get the title (name) of the focused window. logTitle :: Logger-logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek+logTitle = logWindowInfoFocusedWindow fetchWindowTitle +-- | Get the titles of all windows on the visible workspace of the given+-- screen and format them according to the given functions.+--+-- ==== __Example__+--+-- > myXmobarPP :: X PP+-- > myXmobarPP = pure $ def+-- >   { ppOrder  = [ws, l, _, wins] -> [ws, l, wins]+-- >   , ppExtras = [logTitles formatFocused formatUnfocused]+-- >   }+-- >  where+-- >   formatFocused   = wrap "[" "]" . xmobarColor "#ff79c6" "" . shorten 50 . xmobarStrip+-- >   formatUnfocused = wrap "(" ")" . xmobarColor "#bd93f9" "" . shorten 30 . xmobarStrip+--+logTitlesOnScreen+  :: ScreenId           -- ^ Screen to log the titles on+  -> (String -> String) -- ^ Formatting for the focused   window+  -> (String -> String) -- ^ Formatting for the unfocused window+  -> Logger+logTitlesOnScreen sid formatFoc formatUnfoc =+  logWindowInfoOnScreen fetchWindowTitle sid formatFoc formatUnfoc formatUnfoc++-- | Like 'logTitlesOnScreen' but with support for urgent windows.  To+-- be used with "XMonad.Hooks.UrgencyHook".+logTitlesOnScreen' :: ScreenId -> TitlesFormat -> Logger+logTitlesOnScreen' sid (TitlesFormat formatFoc formatUnfoc formatUrg) =+  logWindowInfoOnScreen fetchWindowTitle sid formatFoc formatUnfoc formatUrg++-- | Like 'logTitlesOnScreen', but directly use the "focused" screen+-- (the one with the currently focused workspace).+logTitles :: (String -> String) -> (String -> String) -> Logger+logTitles formatFoc formatUnfoc =+  logWindowInfoFocusedScreen fetchWindowTitle formatFoc formatUnfoc formatUnfoc++-- | Variant of 'logTitles', but with support for urgent windows.+logTitles' :: TitlesFormat -> Logger+logTitles' (TitlesFormat formatFoc formatUnfoc formatUrg) =+  logWindowInfoFocusedScreen fetchWindowTitle formatFoc formatUnfoc formatUrg++-- | Formatting applied to the titles of certain windows.+data TitlesFormat = TitlesFormat+  { focusedFormat   :: String -> String  -- ^ Focused formatting.+  , unfocusedFormat :: String -> String  -- ^ Unfocused formatting.+  , urgentFormat    :: String -> String  -- ^ Formatting when urgent.+  }++-- | How to format these titles by default when using 'logTitles'' and+-- 'logTitlesOnScreen''.+instance Default TitlesFormat where+  def = TitlesFormat+    { focusedFormat   = xmobarFocusedFormat+    , unfocusedFormat = xmobarWsFormat+    , urgentFormat    = xmobarUrgentFormat+    }++-- | Internal function to get a wrapped classname string from a window+fetchWindowClassname :: Window -> X String+fetchWindowClassname = fmap show . getNameWMClass++-- | Get the classname of the focused window.+logClassname :: Logger+logClassname = logWindowInfoFocusedWindow fetchWindowClassname++-- | Get the classnames of all windows on the visible workspace of the given+-- screen and format them according to the given functions.+logClassnamesOnScreen+  :: ScreenId           -- ^ Screen to log the classnames on+  -> (String -> String) -- ^ Formatting for the focused window+  -> (String -> String) -- ^ Formatting for the unfocused window+  -> Logger+logClassnamesOnScreen sid formatFoc formatUnfoc =+  logWindowInfoOnScreen fetchWindowClassname sid formatFoc formatUnfoc formatUnfoc++-- | Like 'logClassnamesOnScreen' but with support for urgent windows.  To+-- be used with "XMonad.Hooks.UrgencyHook".+logClassnamesOnScreen' :: ScreenId -> ClassnamesFormat -> Logger+logClassnamesOnScreen' sid (ClassnamesFormat formatFoc formatUnfoc formatUrg) =+  logWindowInfoOnScreen fetchWindowClassname sid formatFoc formatUnfoc formatUrg++-- | Like 'logClassnamesOnScreen', but directly use the "focused" screen+-- (the one with the currently focused workspace).+logClassnames :: (String -> String) -> (String -> String) -> Logger+logClassnames formatFoc formatUnfoc =+  logWindowInfoFocusedScreen fetchWindowClassname formatFoc formatUnfoc formatUnfoc++-- | Variant of 'logClassnames', but with support for urgent windows.+logClassnames' :: ClassnamesFormat -> Logger+logClassnames' (ClassnamesFormat formatFoc formatUnfoc formatUrg) =+  logWindowInfoFocusedScreen fetchWindowClassname formatFoc formatUnfoc formatUrg++-- | Formatting applied to the classnames of certain windows.+data ClassnamesFormat = ClassnamesFormat+  { focusedFormatClassname   :: String -> String  -- ^ Focused formatting.+  , unfocusedFormatClassname :: String -> String  -- ^ Unfocused formatting.+  , urgentFormatClassname    :: String -> String  -- ^ Formatting when urgent.+  }++-- | How to format these classnames by default when using 'logClassnames'' and+-- 'logClassnamesOnScreen''.+instance Default ClassnamesFormat where+  def = ClassnamesFormat+    { focusedFormatClassname   = xmobarFocusedFormat+    , unfocusedFormatClassname = xmobarWsFormat+    , urgentFormatClassname    = xmobarUrgentFormat+    }++-- | Internal function to get the specified window information for all windows on+-- the visible workspace of the given screen and format them according to the+-- given functions.+logWindowInfoOnScreen+  :: (Window -> X String)+  -> ScreenId+  -> (String -> String)+  -> (String -> String)+  -> (String -> String)+  -> Logger+logWindowInfoOnScreen getWindowInfo sid formatFoc formatUnfoc formatUrg =+  (`withScreen` sid) $ \screen -> do+    let focWin = fmap W.focus . W.stack . W.workspace $ screen+    urgWins <- readUrgents+    logWindowInfoOnScreenWorker getWindowInfo screen $ \win name ->+      if | Just win == focWin -> formatFoc   name+         | win `elem` urgWins -> formatUrg   name+         | otherwise          -> formatUnfoc name++-- | Internal helper function for 'logWindowInfoOnScreen'.+logWindowInfoOnScreenWorker+  :: (Window -> X String)+  -> WindowScreen+  -> (Window -> String -> String)+  -> Logger+logWindowInfoOnScreenWorker getWindowInfo screen logger = do+  let wins = maybe [] W.integrate . W.stack . W.workspace $ screen+  winNames <- traverse getWindowInfo wins+  pure . Just . unwords $ zipWith logger wins winNames++-- | Internal. Like 'logWindowInfoOnScreen', but directly use the "focused" screen+-- (the one with the currently focused workspace).+logWindowInfoFocusedScreen+  :: (Window -> X String)+  -> (String -> String)+  -> (String -> String)+  -> (String -> String)+  -> Logger+logWindowInfoFocusedScreen getWindowInfo formatFoc formatUnfoc formatUrg = do+  sid <- gets $ W.screen . W.current . windowset+  logWindowInfoOnScreen getWindowInfo sid formatFoc formatUnfoc formatUrg++-- | Internal function to get the specified information for the currently focused window+logWindowInfoFocusedWindow :: (Window -> X String) -> Logger+logWindowInfoFocusedWindow getWindowInfo = withWindowSet $ traverse getWindowInfo . W.peek++-- | Internal formatting helpers+xmobarWsFormat, xmobarFocusedFormat, xmobarUrgentFormat :: String -> String+xmobarWsFormat      = xmobarRaw . shorten 30 . xmobarStrip+xmobarFocusedFormat = wrap "[" "]" . xmobarWsFormat+xmobarUrgentFormat  = wrap "!" "!" . xmobarWsFormat+ -- | Get the name of the current layout. logLayout :: Logger logLayout = withWindowSet $ return . Just . ld@@ -186,17 +353,87 @@ logCurrent :: Logger logCurrent = withWindowSet $ return . Just . W.currentTag +-- | Log the given string, as is.+logConst :: String -> Logger+logConst = return . Just++-- | If the first logger returns @Nothing@, the default logger is used.+-- For example, to display a quote when no windows are on the screen,+-- you can do:+--+-- > logDefault logTitle (logConst "Hey, you, you're finally awake.")+logDefault :: Logger -> Logger -> Logger+logDefault l d = l >>= maybe d logConst++-- | An infix operator for 'logDefault', which can be more convenient to+-- combine multiple loggers.+--+-- > logTitle .| logWhenActive 0 (logConst "*") .| logConst "There's nothing here"+(.|) :: Logger -> Logger -> Logger+(.|) = logDefault++-- $xmonad-screen+-- It is also possible to bind loggers like 'logTitle' to a specific screen. For+-- example, using @logTitleOnScreen 1@ will log the title of the focused window+-- on screen 1, even if screen 1 is not currently active.++-- | Only display the 'Logger' if the screen with the given 'ScreenId' is+-- active.+-- For example, this can be used to create a marker that is only displayed+-- when the primary screen is active.+--+-- > logWhenActive 0 (logConst "*")+logWhenActive :: ScreenId -> Logger -> Logger+logWhenActive n l = do+  c <- withWindowSet $ return . W.screen . W.current+  if n == c then l else return Nothing++-- | Get the title (name) of the focused window, on the given screen.+logTitleOnScreen :: ScreenId -> Logger+logTitleOnScreen = logWindowInfoFocusedWindowOnScreen fetchWindowTitle++-- | Get the classname of the focused window, on the given screen.+logClassnameOnScreen :: ScreenId -> Logger+logClassnameOnScreen = logWindowInfoFocusedWindowOnScreen fetchWindowClassname++-- | Internal function to get the specified information for the focused window,+-- on the given screen.+logWindowInfoFocusedWindowOnScreen :: (Window -> X String) -> ScreenId -> Logger+logWindowInfoFocusedWindowOnScreen getWindowInfo =+  withScreen+    $ traverse getWindowInfo+    . (W.focus <$>)+    . W.stack+    . W.workspace++-- | Get the name of the visible workspace on the given screen.+logCurrentOnScreen :: ScreenId -> Logger+logCurrentOnScreen = withScreen $ logConst . W.tag . W.workspace++-- | Get the name of the current layout on the given screen.+logLayoutOnScreen :: ScreenId -> Logger+logLayoutOnScreen =+  withScreen $ logConst . description . W.layout . W.workspace++-- | A helper function to create screen-specific loggers.+withScreen :: (WindowScreen -> Logger) -> ScreenId -> Logger+withScreen f n = do+  ss <- withWindowSet $ return . W.screens+  case find ((== n) . W.screen) ss of+    Just s  -> f s+    Nothing -> pure Nothing+ -- $format -- Combine logger formatting functions to make your--- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable.--- (For convenience this module exports 'Control.Applicative.<$>' to--- use instead of \'.\' or \'$\' in hard to read formatting lines.+-- 'XMonad.Hooks.StatusBar.PP.ppExtras' more colorful and readable.+-- (For convenience, you can use '<$>' instead of \'.\' or \'$\' in hard to read+-- formatting lines. -- For example: ----- > myLogHook = dynamicLogWithPP def {+-- > myPP = def { -- >     -- skipped -- >     , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"]--- >     , ppOrder = \(ws,l,_,xs) -> [l,ws] ++ xs+-- >     , ppOrder = \(ws:l:_:xs) -> [l,ws] ++ xs -- >     } -- >   where -- >     -- lTitle = fixedWidthL AlignCenter "." 99 . dzenColorL "cornsilk3" "" . padL . shortenL 80 $ logTitle@@ -205,6 +442,9 @@ -- > -- >     lLoad = dzenColorL "#6A5ACD" "" . wrapL loadIcon "   " . padL $ loadAvg -- >     loadIcon = " ^i(/home/me/.dzen/icons/load.xbm)"+--+-- For more information on how to add the pretty-printer to your status bar, please+-- check "XMonad.Hooks.StatusBar". -- -- Note: When applying 'shortenL' or 'fixedWidthL' to logger strings -- containing colors or other formatting commands, apply the formatting
XMonad/Util/Loggers/NamedScratchpad.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Loggers.NamedScratchpad+-- Description :  A collection of Loggers for "XMonad.Util.NamedScratchpad". -- Copyright   :  (c) Brandon S Allbery <allbery.b@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -8,12 +9,10 @@ -- Stability   :  unstable -- Portability :  unportable ----- 'XMonad.Util.Loggers' for 'XMonad.Util.NamedScratchpad'+-- "XMonad.Util.Loggers" for "XMonad.Util.NamedScratchpad" -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable #-}- module XMonad.Util.Loggers.NamedScratchpad (-- * Usage                                             -- $usage                                             nspTrackStartup@@ -28,9 +27,7 @@ import XMonad.Util.Loggers (Logger) import XMonad.Util.NamedScratchpad (NamedScratchpad(..)) import qualified XMonad.Util.ExtensibleState as XS-import Data.Monoid (All(..))-import Data.Char (chr)-import Control.Monad (forM, foldM)+import XMonad.Prelude (All (..), chr, foldM, forM) import qualified Data.IntMap as M import qualified XMonad.StackSet as W (allWindows) @@ -38,7 +35,7 @@ -- This is a set of 'Logger's for 'NamedScratchpad's. -- It provides a 'startupHook' and 'handleEventHook' to keep track of -- 'NamedScratchpad's, and several possible 'Logger's for use in--- 'XMonad.Hooks.DynamicLog' 'ppExtras'.+-- 'XMonad.Hooks.StatusBar.PP.ppExtras'. -- -- You must add 'nspTrackStartup' to your 'startupHook' to initialize -- 'NamedScratchpad' tracking and to detect any currently running@@ -53,16 +50,16 @@ -- (This is difficult to change; "minimizing" by moving it back to 'NSP' -- is even harder.) -- I hide the 'NamedScratchpad's from the taskbar and use this to track--- them instead (see 'XMonad.Util.NoTaskbar').+-- them instead (see "XMonad.Util.NoTaskbar").  -- The extension data for tracking NSP windows-data NSPTrack = NSPTrack [Maybe Window] deriving Typeable+newtype NSPTrack = NSPTrack [Maybe Window] instance ExtensionClass NSPTrack where   initialValue = NSPTrack []  -- | 'startupHook' to initialize scratchpad activation tracking ----- > , startupHook = ... <+> nspTrackStartup scratchpads+-- > , startupHook = ... <> nspTrackStartup scratchpads -- -- If you kickstart the 'logHook', do it /after/ 'nspTrackStartup'! nspTrackStartup :: [NamedScratchpad] -> X ()@@ -86,14 +83,14 @@  -- | 'handleEventHook' to track scratchpad activation/deactivation ----- > , handleEventHook = ... <+> nspTrackHook scratchpads+-- > , handleEventHook = ... <> nspTrackHook scratchpads nspTrackHook :: [NamedScratchpad] -> Event -> X All-nspTrackHook _ (DestroyWindowEvent {ev_window = w}) = do+nspTrackHook _ DestroyWindowEvent{ev_window = w} = do   XS.modify $ \(NSPTrack ws) -> NSPTrack $ map (\sw -> if sw == Just w then Nothing else sw) ws   return (All True)-nspTrackHook ns (ConfigureRequestEvent {ev_window = w}) = do+nspTrackHook ns ConfigureRequestEvent{ev_window = w} = do   NSPTrack ws <- XS.get-  ws' <- forM (zip3 [0..] ws ns) $ \(_,w',NS _ _ q _) -> do+  ws' <- forM (zip3 [0 :: Integer ..] ws ns) $ \(_,w',NS _ _ q _) -> do     p <- runQuery q w     return $ if p then Just w else w'   XS.put $ NSPTrack ws'
XMonad/Util/Minimize.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}-----------------------------------------------------------------------------+----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Minimize+-- Description :  Common utilities for window minimizing\/maximizing. -- Copyright   :  (c) Bogdan Sinitsyn (2016) -- License     :  BSD3-style (see LICENSE) --@@ -28,7 +28,7 @@     { rectMap :: RectMap     , minimizedStack :: [Window]     }-    deriving (Eq, Typeable, Read, Show)+    deriving (Eq, Read, Show)  instance ExtensionClass Minimized where   initialValue = Minimized { rectMap = M.empty
XMonad/Util/NamedActions.hs view
@@ -1,8 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving, TupleSections #-} -------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.NamedActions+-- Description :  A wrapper for keybinding configuration that can list the available keybindings. -- Copyright   :  2009 Adam Vogt <vogt.adam@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -46,14 +47,10 @@   import XMonad.Actions.Submap(submap)+import XMonad.Prelude (groupBy, keyToString) import XMonad-import System.Posix.Process(executeFile)-import Control.Arrow(Arrow((&&&), second, (***)))-import Data.Bits(Bits((.&.), complement))-import Data.List (groupBy)-import System.Exit(ExitCode(ExitSuccess), exitWith)--import Control.Applicative ((<*>))+import Control.Arrow(Arrow((&&&), second))+import System.Exit(exitSuccess)  import qualified Data.Map as M import qualified XMonad.StackSet as W@@ -114,13 +111,14 @@ -- | 'sendMessage' but add a description that is @show message@. Note that not -- all messages have show instances. sendMessage' :: (Message a, Show a) => a -> NamedAction-sendMessage' x = NamedAction $ (XMonad.sendMessage x,show x)+sendMessage' x = NamedAction (XMonad.sendMessage x,show x)  -- | 'spawn' but the description is the string passed spawn' :: String -> NamedAction spawn' x = addName x $ spawn x  class HasName a where+    {-# MINIMAL getAction #-}     showName :: a -> [String]     showName = const [""]     getAction :: a -> X ()@@ -167,22 +165,6 @@      [(d, b)] -> [(d, b1)] -> [(d, NamedAction)] a ^++^ b = map (second NamedAction) a ++ map (second NamedAction) b --- | Or allow another lookup table?-modToString :: KeyMask -> String-modToString mask = concatMap (++"-") $ filter (not . null)-                $ map (uncurry pick)-                [(mod1Mask, "M1")-                ,(mod2Mask, "M2")-                ,(mod3Mask, "M3")-                ,(mod4Mask, "M4")-                ,(mod5Mask, "M5")-                ,(controlMask, "C")-                ,(shiftMask,"Shift")]-    where pick m str = if m .&. complement mask == 0 then str else ""--keyToString :: (KeyMask, KeySym) -> [Char]-keyToString = uncurry (++) . (modToString *** keysymToString)- showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] showKmSimple = concatMap (\(k,e) -> if snd k == 0 then "":showName e else map ((keyToString k ++) . smartSpace) $ showName e) @@ -196,7 +178,7 @@ showKm :: [((KeyMask, KeySym), NamedAction)] -> [String] showKm keybindings = padding $ do     (k,e) <- keybindings-    if snd k == 0 then map ((,) "") $ showName e+    if snd k == 0 then map ("",) $ showName e         else map ((,) (keyToString k) . smartSpace) $ showName e     where padding = let pad n (k,e) = if null k then "\n>> "++e else take n (k++repeat ' ') ++ e                         expand xs n = map (pad n) xs@@ -205,9 +187,7 @@  -- | An action to send to 'addDescrKeys' for showing the keybindings. See also 'showKm' and 'showKmSimple' xMessage :: [((KeyMask, KeySym), NamedAction)] -> NamedAction-xMessage x = addName "Show Keybindings" $ io $ do-    xfork $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing-    return ()+xMessage x = addName "Show Keybindings" $ xmessage $ unlines $ showKm x  -- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding -- to run an action for showing the keybindings.@@ -225,12 +205,12 @@ addDescrKeys' (k,f) ks conf =     let shk l = f $ [(k,f $ ks l)] ^++^ ks l         keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)]-    in conf { keys = keylist }+     in conf { keys = keylist <> keys conf }  -- | A version of the default keys from the default configuration, but with -- 'NamedAction'  instead of @X ()@ defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]-defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) =+defaultKeysDescr conf@XConfig{XMonad.modMask = modm} =     [ subtitle "launching and killing programs"     , ((modm .|. shiftMask, xK_Return), addName "Launch Terminal" $ spawn $ XMonad.terminal conf) -- %! Launch terminal     , ((modm,               xK_p     ), addName "Launch dmenu" $ spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu@@ -268,7 +248,7 @@     , ((modm              , xK_period), sendMessage' (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area      , subtitle "quit, or restart"-    , ((modm .|. shiftMask, xK_q     ), addName "Quit" $ io (exitWith ExitSuccess)) -- %! Quit xmonad+    , ((modm .|. shiftMask, xK_q     ), addName "Quit" $ io exitSuccess) -- %! Quit xmonad     , ((modm              , xK_q     ), addName "Restart" $ spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad     ]
XMonad/Util/NamedScratchpad.hs view
@@ -1,7 +1,10 @@-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE InstanceSigs   #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ViewPatterns   #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.NamedScratchpad+-- Description :  Toggle arbitrary windows to and from the current workspace. -- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -17,31 +20,59 @@   -- * Usage   -- $usage   NamedScratchpad(..),+  scratchpadWorkspaceTag,   nonFloating,   defaultFloating,   customFloating,   NamedScratchpads,   namedScratchpadAction,+  spawnHereNamedScratchpadAction,+  customRunNamedScratchpadAction,   allNamedScratchpadAction,   namedScratchpadManageHook,+  nsHideOnFocusLoss,+  nsSingleScratchpadPerWorkspace,++  -- * Dynamic Scratchpads+  -- $dynamic-scratchpads+  dynamicNSPAction,+  toggleDynamicNSP,++  -- * Exclusive Scratchpads+  -- $exclusive-scratchpads+  addExclusives,+  -- ** Keyboard related+  resetFocusedNSP,+  -- ** Mouse related+  setNoexclusive,+  resizeNoexclusive,+  floatMoveNoexclusive,++  -- * Deprecations   namedScratchpadFilterOutWorkspace,-  namedScratchpadFilterOutWorkspacePP+  namedScratchpadFilterOutWorkspacePP,+   ) where +import Data.Map.Strict (Map, (!?)) import XMonad-import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)-import XMonad.Hooks.DynamicLog (PP, ppSort)--import Control.Monad (filterM)-import Data.Maybe (listToMaybe)+import XMonad.Actions.SpawnOn (spawnHere)+import XMonad.Actions.TagWindows (addTag, delTag)+import XMonad.Hooks.ManageHelpers (doRectFloat)+import XMonad.Hooks.RefocusLast (withRecentsIn)+import XMonad.Hooks.StatusBar.PP (PP, ppSort)+import XMonad.Prelude (appEndo, filterM, findM, foldl', for_, liftA2, unless, void, when, (<=<)) -import qualified XMonad.StackSet as W+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict    as Map +import qualified XMonad.StackSet             as W+import qualified XMonad.Util.ExtensibleState as XS  -- $usage -- Allows to have several floating scratchpads running different applications.--- Bind a key to 'namedScratchpadSpawnAction'.+-- Bind a key to 'namedScratchpadAction'. -- Pressing it will spawn configured application, or bring it to the current -- workspace if it already exists. -- Pressing the key with the application on the current workspace will@@ -82,8 +113,40 @@ -- >  , manageHook = namedScratchpadManageHook scratchpads -- -- For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings"+-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> --+-- For some applications (like displaying your workspaces in a status bar) it+-- is convenient to filter out the @NSP@ workspace when looking at all+-- workspaces. For this, you can use 'XMonad.Hooks.StatusBar.PP.filterOutWsPP',+-- or 'XMonad.Util.WorkspaceCompare.filterOutWs' together with+-- 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort' if your status bar gets+-- the list of workspaces from EWMH.  See the documentation of these functions+-- for examples.+--+-- If you want to explore this module further, scratchpads can come in+-- many forms and flavours:+--+--   + \"Regular\" scratchpads: they can be predefined and+--     summoned/banished with a key press.  These are the scratchpads+--     that you have seen above.+--+--   + [Dynamic scratchpads](#g:dynamic-scratchpads), which allow you to+--     dynamically declare existing windows as scratchpads.  These can+--     be treated as a separate type of scratchpad.+--+--   + [Exclusive](#g:exclusive-scratchpads) scratchpads, which can be+--     seen as a property of already existing scratchpads.  Marking+--     scratchpads as exclusive will not allow them to be shown on the+--     same workspace; the scratchpad being brought up will hide the+--     others.+--+-- See the relevant sections in the documentation for more information.+--+-- Further, there is also a @logHook@ that you can use to hide+-- scratchpads when they lose focus; this is functionality akin to what+-- some dropdown terminals provide.  See the documentation of+-- 'nsHideOnFocusLoss' for an example how to set this up.+--  -- | Single named scratchpad configuration data NamedScratchpad = NS { name   :: String      -- ^ Scratchpad name@@ -92,6 +155,52 @@                           , hook   :: ManageHook  -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@                           } +-- | The NSP state.+data NSPState = NSPState+  { nspExclusives  :: !(Map String NamedScratchpads)+    -- ^ Associates the name of a scratchpad to some list of scratchpads+    -- that should be mutually exclusive to it.+  , nspScratchpads :: !(Map String NamedScratchpad)+    -- ^ Associates a name to an entire scratchpad.+  }++instance ExtensionClass NSPState where+  initialValue :: NSPState+  initialValue = NSPState mempty mempty++-- | Try to:+--+--    (i) Fill the 'nspScratchpads' portion of the 'NSPState' with the+--        given list of scratchpads.  In case that particular map of the+--        state is already non-empty, don't do anything and return that+--        state.+--+--   (ii) Replace possibly dummy scratchpads in @nspExclusives@ with+--        proper values.  For convenience, the user may specify+--        exclusive scratchpads by name in the startup hook.  However,+--        we don't necessarily have all information then to immediately+--        turn these into proper NamedScratchpads.  As such, we thinly+--        wrap the names into an NSP skeleton, to be filled in later.+--        This function, to be executed _before_+--        'someNamedScratchpadAction' is the (latest) point where that+--        happens.+fillNSPState :: NamedScratchpads -> X NSPState+fillNSPState nsps = do+    nsp@(NSPState exs scratches) <- XS.get+    if null scratches+      then let nspState = NSPState (fillOut exs) nspScratches+            in nspState <$ XS.put nspState+      else pure nsp+  where+    -- @fillNSPState@ only runs once, so the complexity here is probably+    -- not a big deal.+    nspScratches :: Map String NamedScratchpad+    nspScratches = Map.fromList $ zip (map name nsps) nsps+    fillOut :: Map String [NamedScratchpad] -> Map String [NamedScratchpad]+    fillOut exs = foldl' (\nspMap n -> Map.map (replaceWith n) nspMap) exs nsps+    replaceWith :: NamedScratchpad -> [NamedScratchpad] -> [NamedScratchpad]+    replaceWith n = map (\x -> if name x == name n then n else x)+ -- | Manage hook that makes the window non-floating nonFloating :: ManageHook nonFloating = idHook@@ -104,63 +213,400 @@ customFloating :: W.RationalRect -> ManageHook customFloating = doRectFloat +-- | @isNSP win nsps@ checks whether the window @win@ is any scratchpad+-- in @nsps@.+isNSP :: Window -> NamedScratchpads -> X Bool+isNSP w = fmap or . traverse ((`runQuery` w) . query)+ -- | Named scratchpads configuration type NamedScratchpads = [NamedScratchpad] --- | Finds named scratchpad configuration by name-findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad-findByName c s = listToMaybe $ filter ((s==) . name) c- -- | Runs application which should appear in specified scratchpad runApplication :: NamedScratchpad -> X () runApplication = spawn . cmd +-- | Runs application which should appear in a specified scratchpad on the workspace it was launched on+runApplicationHere :: NamedScratchpad -> X ()+runApplicationHere = spawnHere . cmd+ -- | Action to pop up specified named scratchpad+--+-- Note [Ignored Arguments]: Most of the time, this function ignores its+-- first argument and uses 'NSPState' instead.  The only time when it+-- does not is when no other window has been opened before in the+-- running xmonad instance.  If this is not your use-case, you can+-- safely call this function with an empty list. namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration                       -> String           -- ^ Scratchpad name                       -> X ()-namedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ head ws)+namedScratchpadAction = customRunNamedScratchpadAction runApplication +-- | Action to pop up specified named scratchpad, initially starting it on the current workspace.+--+-- This function /almost always/ ignores its first argument; see Note+-- [Ignored Arguments] for 'namedScratchpadAction'.+spawnHereNamedScratchpadAction :: NamedScratchpads           -- ^ Named scratchpads configuration+                               -> String                     -- ^ Scratchpad name+                               -> X ()+spawnHereNamedScratchpadAction = customRunNamedScratchpadAction runApplicationHere++-- | Action to pop up specified named scratchpad, given a custom way to initially start the application.+--+-- This function /almost always/ ignores its second argument; see Note+-- [Ignored Arguments] for 'namedScratchpadAction'.+customRunNamedScratchpadAction :: (NamedScratchpad -> X ())  -- ^ Function initially running the application, given the configured @scratchpad@ cmd+                               -> NamedScratchpads           -- ^ Named scratchpads configuration+                               -> String                     -- ^ Scratchpad name+                               -> X ()+customRunNamedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ NE.head ws)++-- | Like 'namedScratchpadAction', but execute the action for all+-- scratchpads that match the query.+--+-- This function /almost always/ ignores its first argument; see Note+-- [Ignored Arguments] for 'namedScratchpadAction'. allNamedScratchpadAction :: NamedScratchpads                          -> String                          -> X ()-allNamedScratchpadAction = someNamedScratchpadAction mapM_+allNamedScratchpadAction = someNamedScratchpadAction mapM_ runApplication -someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())+-- | A @logHook@ to hide scratchpads when they lose focus.  This can be+-- useful for e.g. dropdown terminals.  Note that this also requires you+-- to use the 'XMonad.Hooks.RefocusLast.refocusLastLogHook'.+--+-- ==== __Example__+--+-- > import XMonad.Hooks.RefocusLast (refocusLastLogHook)+-- > import XMonad.Util.NamedScratchpad+-- >+-- > main = xmonad $ def+-- >   { logHook = refocusLastLogHook+-- >            >> nsHideOnFocusLoss myScratchpads+-- >               -- enable hiding for all of @myScratchpads@+-- >   }+nsHideOnFocusLoss :: NamedScratchpads -> X ()+nsHideOnFocusLoss scratches =+    nsHideOnCondition $ \ lastFocus _curFoc _ws hideScratch ->+        whenX (isNSP lastFocus scratches) $+            hideScratch lastFocus++-- | A @logHook@ to have only one active scratchpad on a workspace. This can+-- be useful when working with multiple floating scratchpads which would+-- otherwise be stacked. Note that this also requires you to use the+-- 'XMonad.Hooks.RefocusLast.refocusLastLogHook'.+--+-- ==== __Example__+--+-- > import XMonad.Hooks.RefocusLast (refocusLastLogHook)+-- > import XMonad.Util.NamedScratchpad+-- >+-- > main = xmonad $ def+-- >   { logHook = refocusLastLogHook+-- >            >> nsHideOnNewScratchpad myScratchpads+-- >               -- enable hiding for all of @myScratchpads@+-- >   }+nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X ()+nsSingleScratchpadPerWorkspace scratches =+    nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do+        allScratchesButCurrent <-+            filterM (liftA2 (<&&>) (pure . (/= curFocus)) (`isNSP` scratches))+                    (W.index winSet)+        whenX (isNSP curFocus scratches) $+            for_ allScratchesButCurrent hideScratch++-- | Hide scratchpads according to some condition. See 'nsHideOnFocusLoss' and+-- 'nsSingleScratchpadPerWorkspace' for usage examples.+nsHideOnCondition+    :: (  Window           -- Last focus.+       -> Window           -- Current focus.+       -> WindowSet        -- Current windowset.+       -> (Window -> X ()) -- A function to hide the named scratchpad.+       -> X ())+    -> X ()+nsHideOnCondition cond = withWindowSet $ \winSet -> do+    let cur = W.currentTag winSet+    withRecentsIn cur () $ \lastFocus curFocus -> do+        let hideScratch :: Window -> X ()+            hideScratch win = shiftToNSP (W.workspaces winSet) ($ win)+            isWorthy =+                -- Check for the window being on the current workspace; if there+                -- is no history (i.e., curFocus ≡ lastFocus), don't do anything+                -- because the potential scratchpad is definitely focused.+                lastFocus `elem` W.index winSet && lastFocus /= curFocus+                -- Don't do anything on the NSP workspace, lest the world explodes.+                && cur /= scratchpadWorkspaceTag+        when isWorthy $+            cond lastFocus curFocus winSet hideScratch++-- | Execute some action on a named scratchpad.+--+-- This function /almost always/ ignores its third argument; see Note+-- [Ignored Arguments] for 'namedScratchpadAction'.+someNamedScratchpadAction :: ((Window -> X ()) -> NE.NonEmpty Window -> X ())+                          -> (NamedScratchpad -> X ())                           -> NamedScratchpads                           -> String                           -> X ()-someNamedScratchpadAction f confs n-    | Just conf <- findByName confs n = withWindowSet $ \s -> do-                     filterCurrent <- filterM (runQuery (query conf))-                                        ((maybe [] W.integrate . W.stack . W.workspace . W.current) s)-                     filterAll <- filterM (runQuery (query conf)) (W.allWindows s)-                     case filterCurrent of-                       [] -> do-                         case filterAll of-                           [] -> runApplication conf-                           _  -> f (windows . W.shiftWin (W.currentTag s)) filterAll-                       _ -> do-                         if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))-                             then addHiddenWorkspace scratchpadWorkspaceTag-                             else return ()-                         f (windows . W.shiftWin scratchpadWorkspaceTag) filterAll-    | otherwise = return ()+someNamedScratchpadAction f runApp _ns scratchpadName = do+    NSPState{ nspScratchpads } <- fillNSPState _ns  -- See Note [Filling NSPState]+    case nspScratchpads !? scratchpadName of+        Just conf -> withWindowSet $ \winSet -> do+            let focusedWspWindows = W.index winSet+                allWindows        = W.allWindows winSet+            matchingOnCurrent <- filterM (runQuery (query conf)) focusedWspWindows+            matchingOnAll     <- filterM (runQuery (query conf)) allWindows +            case NE.nonEmpty matchingOnCurrent of+                -- no matching window on the current workspace -> scratchpad not running or in background+                Nothing -> do+                    -- summon the scratchpad+                    case NE.nonEmpty matchingOnAll of+                        Nothing   -> runApp conf+                        Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins+                    -- check for exclusive scratchpads to hide+                    hideUnwanted (name conf) --- tag of the scratchpad workspace+                -- matching window running on current workspace -> window should be shifted to scratchpad workspace+                Just wins -> shiftToNSP (W.workspaces winSet) (`f` wins)+        Nothing -> return ()++{- Note [Filling NSPState]++We have to potentially populate the state with the given scratchpads+here, in case the manageHook didn't run yet and it's still empty.++For backwards compatibility, 3fc830aa09368dca04df24bf7ec4ac817f2de479+introduced an internal state that's filled in the+namedScratchpadManageHook.  A priori, this means that we would need some+kind of MapRequestEvent to happen before processing scratchpads, since+the manageHook doesn't run otherwise, leaving the extensible state empty+until then.  When trying to open a scratchpad right after starting+xmonad—i.e., before having opened a window—we thus have to populate the+NSPState before looking for scratchpads.++Related: https://github.com/xmonad/xmonad-contrib/issues/728+-}++-- | Tag of the scratchpad workspace scratchpadWorkspaceTag :: String scratchpadWorkspaceTag = "NSP"  -- | Manage hook to use with named scratchpads namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration                           -> ManageHook-namedScratchpadManageHook = composeAll . fmap (\c -> query c --> hook c)+namedScratchpadManageHook nsps = do+    ns <- Map.elems . nspScratchpads <$> liftX (fillNSPState nsps)+    composeAll $ fmap (\c -> query c --> hook c) ns +-- | Shift some windows to the scratchpad workspace according to the+-- given function.  The workspace is created if necessary.+shiftToNSP :: [WindowSpace] -> ((Window -> X ()) -> X ()) -> X ()+shiftToNSP ws f = do+    unless (any ((scratchpadWorkspaceTag ==) . W.tag) ws) $+        addHiddenWorkspace scratchpadWorkspaceTag+    f (windows . W.shiftWin scratchpadWorkspaceTag)++------------------------------------------------------------------------+-- Dynamic scratchpad functionality++-- $dynamic-scratchpads+--+-- Dynamic scratchpads allow you to declare existing windows as+-- scratchpads.  You can bind a key to make a window start/stop being a+-- scratchpad, and another key to toggle its visibility.  Because+-- dynamic scratchpads are based on existing windows, they have some+-- caveats in comparison to "normal" scratchpads:+--+--   * @xmonad@ has no way of knowing /how/ windows were spawned and+--     thus one is not able to "start" dynamic scratchpads again after+--     the associated window has been closed.+--+--   * If you already have an active dynamic scratchpad @"dyn1"@ and you+--     call 'toggleDynamicNSP' with another window, that window will+--     henceforth occupy the @"dyn1"@ scratchpad.  If you still need the+--     old window, you might have to travel to your scratchpad workspace+--     ('scratchpadWorkspaceTag') in order to retrieve it.+--+-- As an example, the following snippet contains keybindings for two+-- dynamic scratchpads, called @"dyn1"@ and @"dyn2"@:+--+-- > import XMonad.Util.NamedScratchpads+-- >+-- > , ("M-s-a", withFocused $ toggleDynamicNSP "dyn1")+-- > , ("M-s-b", withFocused $ toggleDynamicNSP "dyn2")+-- > , ("M-a"  , dynamicNSPAction "dyn1")+-- > , ("M-b"  , dynamicNSPAction "dyn2")+--++-- | A 'NamedScratchpad' representing a "dynamic" scratchpad; i.e., a+-- scratchpad based on an already existing window.+mkDynamicNSP :: String -> Window -> NamedScratchpad+mkDynamicNSP s w =+    NS { name  = s+       , cmd   = ""               -- we are never going to spawn a dynamic scratchpad+       , query = (w ==) <$> ask+       , hook  = mempty           -- cmd is never called so this will never run+       }++-- | Make a window a dynamic scratchpad+addDynamicNSP :: String -> Window -> X ()+addDynamicNSP s w = XS.modify $ \(NSPState exs ws) ->+  NSPState exs (Map.insert s (mkDynamicNSP s w) ws)++-- | Make a window stop being a dynamic scratchpad+removeDynamicNSP :: String -> X ()+removeDynamicNSP s = XS.modify $ \(NSPState exs ws) -> NSPState exs (Map.delete s ws)++-- | Toggle the visibility of a dynamic scratchpad.+dynamicNSPAction :: String -> X ()+dynamicNSPAction = customRunNamedScratchpadAction (const $ pure ()) []++-- | Either create a dynamic scratchpad out of the given window, or stop+-- a window from being one if it already is.+toggleDynamicNSP :: String -> Window -> X ()+toggleDynamicNSP s w = do+    NSPState{ nspScratchpads } <- XS.get+    case nspScratchpads !? s of+        Nothing  -> addDynamicNSP s w+        Just nsp -> ifM (runQuery (query nsp) w)+                        (removeDynamicNSP s)+                        (addDynamicNSP s w)++-----------------------------------------------------------------------+-- Exclusive scratchpads++-- $exclusive-scratchpads+--+-- Exclusive scratchpads allow you to hide certain scratchpads in+-- relation to others.  There can be multiple groups of pairwise+-- exclusive scratchpads; whenever one such scratchpad gets called, it+-- will hide all other scratchpads on the focused workspace that are in+-- this group.+--+-- For example, having defined "Calc", "Mail", and "Term" scratchpads,+-- you can use 'addExclusives' to make some of them dislike each other:+--+-- > myExclusives = addExclusives+-- >   [ ["Calc", "Mail"]+-- >   , ["Mail", "Term"]+-- >   ]+--+-- You now have to add @myExclusives@ to you startupHook:+--+-- > main :: IO+-- > main = xmonad . … . $ def+-- >   { …+-- >   , startupHook = myStartupHook >> myExclusives+-- >   }+--+-- This will hide the "Mail" scratchpad whenever the "Calc" scratchpad+-- is brought up, and vice-versa.  Likewise, "Mail" and "Term" behave in+-- this way, but "Calc" and "Term" may peacefully coexist.+--+-- If you move a scratchpad it still gets hidden when you fetch a+-- scratchpad of the same family.  To change that behaviour—and make+-- windows not exclusive anymore when they get resized or moved—add+-- these mouse bindings (see+-- "XMonad.Doc.Extending#Editing_mouse_bindings"):+--+-- >     , ((mod4Mask, button1), floatMoveNoexclusive)+-- >     , ((mod4Mask, button3), resizeNoexclusive)+--+-- To reset a moved scratchpad to the original position that you set+-- with its hook, focus is and then call 'resetFocusedNSP'.  For+-- example, if you want to extend @M-\<Return\>@ to reset the placement+-- when a scratchpad is in focus but keep the default behaviour for+-- tiled windows, set these key bindings:+--+-- > , ((modMask, xK_Return), windows W.swapMaster >> resetFocusedNSP)++-- | Make some scratchpads exclusive.+addExclusives :: [[String]] -> X ()+addExclusives exs = do+    NSPState _ ws <- XS.get+    -- Re-initialise `ws' to nothing, so we can react to changes in case+    -- of a restart.  See 'fillNSPState' for more details on filling.+    XS.put (NSPState (foldl' (go []) mempty exs) mempty)+    unless (null ws) $+        void (fillNSPState (Map.elems ws))+  where+    -- Ignoring that this is specialised to NSPs, it works something like+    -- >>> foldl' (go []) mempty [[1, 2], [3, 4], [1, 3]]+    -- fromList [(1, [3, 2]), (2, [1]), (3, [1, 4]), (4, [3])]+    go _  m []       = m+    go ms m (n : ns) = go (n : ms) (Map.insertWith (<>) n (mkNSP (ms <> ns)) m) ns+    mkNSP = map (\n -> NS n mempty (pure False) mempty)++-- | @setNoexclusive w@ makes the window @w@ lose its exclusivity+-- features.+setNoexclusive :: Window -> X ()+setNoexclusive w = do+    NSPState _ ws <- XS.get+    whenX (isNSP w (Map.elems ws)) $+        addTag "_NSP_NOEXCLUSIVE" w++-- | If the focused window is a scratchpad, the scratchpad gets reset to+-- the original placement specified with the hook and becomes exclusive+-- again.+resetFocusedNSP :: X ()+resetFocusedNSP = do+    NSPState _ (Map.elems -> ws) <- XS.get+    withFocused $ \w -> do+        mbWin <- findM ((`runQuery` w) . query) ws+        whenJust mbWin $ \win -> do+            (windows . appEndo <=< runQuery (hook win)) w+            hideUnwanted (name win)+            delTag "_NSP_NOEXCLUSIVE" w++-- | @hideUnwanted nspWindow@ hides all windows that @nspWindow@ does+-- not like; i.e., windows that are in some kind of exclusivity contract+-- with it.+--+-- A consistency assumption for this is that @nspWindow@ must be the+-- currently focused window.  For this to take effect, @nspWindow@ must+-- not have set the @_NSP_NOEXCLUSIVE@ property, neither must any+-- exclusive window we'd like to hide.+hideUnwanted :: String -> X ()+hideUnwanted nspWindow = withWindowSet $ \winSet -> do+    NSPState{ nspExclusives } <- XS.get+    whenJust (nspExclusives !? nspWindow) $ \unwanted ->+        withFocused $ \w -> whenX (runQuery notIgnored w) $ do+            for_ (W.index winSet) $ \win ->+                whenX (runQuery (isUnwanted unwanted) win) $+                    shiftToNSP (W.workspaces winSet) ($ win)+  where+    notIgnored :: Query Bool+    notIgnored = notElem "_NSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS"++    isUnwanted :: [NamedScratchpad] -> Query Bool+    isUnwanted = (notIgnored <&&>) . foldr (\nsp qs -> qs <||> query nsp) (pure False)++-- | Float and drag the window; make it lose its exclusivity status in+-- the process.+floatMoveNoexclusive :: Window -- ^ Window which should be moved+                     -> X ()+floatMoveNoexclusive = mouseHelper mouseMoveWindow++-- | Resize window and make it lose its exclusivity status in the+-- process.+resizeNoexclusive :: Window -- ^ Window which should be resized+                  -> X ()+resizeNoexclusive = mouseHelper mouseResizeWindow++mouseHelper :: (Window -> X a) -> Window -> X ()+mouseHelper f w = setNoexclusive w+               >> focus w+               >> f w+               >> windows W.shiftMaster++------------------------------------------------------------------------+-- Deprecations+ -- | Transforms a workspace list containing the NSP workspace into one that -- doesn't contain it. Intended for use with logHooks. namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag)+{-# DEPRECATED namedScratchpadFilterOutWorkspace "Use XMonad.Util.WorkspaceCompare.filterOutWs [scratchpadWorkspaceTag] instead" #-}  -- | Transforms a pretty-printer into one not displaying the NSP workspace. --@@ -177,5 +623,4 @@ namedScratchpadFilterOutWorkspacePP pp = pp {   ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp)   }---- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:+{-# DEPRECATED namedScratchpadFilterOutWorkspacePP "Use XMonad.Hooks.StatusBar.PP.filterOutWsPP [scratchpadWorkspaceTag] instead" #-}
XMonad/Util/NamedWindows.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.NamedWindows+-- Description :  Associate the X titles of windows with them. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) --@@ -18,13 +19,13 @@                                    -- $usage                                    NamedWindow,                                    getName,+                                   getNameWMClass,                                    withNamedWindow,                                    unName                                   ) where -import Control.Applicative ( (<$>) )-import Control.Exception.Extensible as E-import Data.Maybe ( fromMaybe, listToMaybe )+import Control.Exception as E+import XMonad.Prelude ( fromMaybe, listToMaybe, (>=>) )  import qualified XMonad.StackSet as W ( peek ) @@ -53,11 +54,25 @@          copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop -    io $ getIt `E.catch` \(SomeException _) ->  ((`NW` w) . resName) `fmap` getClassHint d w+    io $ getIt `E.catch` \(SomeException _) ->  (`NW` w) . resName <$> getClassHint d w +-- | Get 'NamedWindow' using 'wM_CLASS'+getNameWMClass :: Window -> X NamedWindow+getNameWMClass w =+  withDisplay $ \d+    -- TODO, this code is ugly and convoluted -- clean it up+   -> do+    let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy)+        getProp = getTextProperty d w wM_CLASS+        copy prop =+          fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop+    io $+      getIt `E.catch` \(SomeException _) ->+        (`NW` w) . resName <$> getClassHint d w+ unName :: NamedWindow -> Window unName (NW _ w) = w  withNamedWindow :: (NamedWindow -> X ()) -> X () withNamedWindow f = do ws <- gets windowset-                       whenJust (W.peek ws) $ \w -> getName w >>= f+                       whenJust (W.peek ws) (getName >=> f)
XMonad/Util/NoTaskbar.hs view
@@ -1,9 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      : XMonad.Util.NoTaskbar+-- Description : Mark a window to be ignored by EWMH taskbars and pagers.+-- Copyright   : (c) ???+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : ???+--+-- Function and manageHook to mark a window to be ignored by EWMH+-- taskbars and pagers.+--+-----------------------------------------------------------------------------+ module XMonad.Util.NoTaskbar (-- * Usage                               -- $usage                               noTaskbar                              ,markNoTaskbar) where  import XMonad.Core+import XMonad.Prelude (fi) import XMonad.ManageHook import Graphics.X11.Xlib (Window) import Graphics.X11.Xlib.Atom (aTOM)@@ -27,7 +42,3 @@                     ntb <- getAtom "_NET_WM_STATE_SKIP_TASKBAR"                     npg <- getAtom "_NET_WM_STATE_SKIP_PAGER"                     io $ changeProperty32 d w ws aTOM propModePrepend [fi ntb,fi npg]---- sigh-fi :: (Integral i, Num n) => i -> n-fi = fromIntegral
+ XMonad/Util/Parser.hs view
@@ -0,0 +1,357 @@+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+--------------------------------------------------------------------+-- |+-- Module      : XMonad.Util.Parser+-- Description : A parser combinator library for xmonad+-- Copyright   : (c) 2021  Tony Zorman+-- License     : BSD3+-- Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>+-- Stability   : experimental+-- Portability : non-portable+--+-- A small wrapper around the 'ReadP' parser combinator in @base@,+-- providing a more intuitive behaviour.  While it's theoretically nice+-- that 'ReadP' is actually commutative, this makes a lot of parsing+-- operations rather awkward—more often than not, one only wants the+-- argument that's parsed "first".+--+-- Due to the left-biased nature of the chosen semigroup implementation,+-- using functions like 'many' or 'optional' from "Control.Applicative"+-- now yields more consistent behaviour with other parser combinator+-- libraries.+--+--------------------------------------------------------------------+module XMonad.Util.Parser (+  -- * Usage+  -- $usage++  -- * Running+  Parser,+  runParser,++  -- * Primitive Parsers+  pfail,+  eof,+  num,+  char,+  string,+  skipSpaces,+  get,+  look,+  gather,++  -- * Combining Parsers+  satisfy,+  choice,+  count,+  between,+  option,+  optionally,+  skipMany,+  skipMany1,+  many1,+  sepBy,+  sepBy1,+  endBy,+  endBy1,+  munch,+  munch1,+  chainr,+  chainr1,+  chainl,+  chainl1,+  manyTill,+) where++import XMonad.Prelude++import qualified Text.ParserCombinators.ReadP as ReadP++import Data.Coerce (coerce)+import Data.String (IsString (fromString))+import Text.ParserCombinators.ReadP (ReadP, (<++))++{- $usage++NOTE: This module is mostly intended for developing of other modules.+If you are a users, you probably won't find much use here—you have been+warned.++The high-level API tries to stay as close to 'ReadP' as possible.  If+you are familiar with that then no functions here should surprise you.++One notable usability difference when forcing left-biasedness is /when/+one wants to disambiguate a parse.  For normal 'ReadP' usage this+happens after the actual parsing stage by going through the list of+successful parses.  For 'Parser' it does when constructing the relevant+combinators, leading to only one successful parse.  As an example,+consider the 'ReadP'-based parser++> pLangle = ReadP.string "<"+> pLongerSequence = ReadP.char '<' *> ReadP.string "f" <* ReadP.char '>'+> pCombination = pLangle ReadP.+++ pLongerSequence++Parsing the string @"\<f\>"@ will return++>>> ReadP.readP_to_S pCombination "<f>"+[("<","f>"),("f","")]++One would now need to, for example, filter for the second (leftover)+string being empty and take the head of the resulting list (which may+still have more than one element).++With 'Parser', the same situation would look like the following++> pLangle' = string "<"+> pLongerSequence' = char '<' *> string "f" <* char '>'+> pCombination' = pLongerSequence' <> pLangle'++Notice how @pLangle'@ and @pLongerSequence'@ have traded places—since we+are not forcing @pLangle'@ to consume the entire string and @(<>)@ is+left-biased, @pLongerSequence'@ parses a superset of @pLangle'@!+Running @runParser pCombination'@ now yields the expected result:++>>> runParser pCombination' "<f>"+Just "f"++One might also define @pLangle'@ as @string "<" <* eof@, which would+enable a definition of @pCombination' = pLangle' <> pLongerSequence'@.++For example uses, see "XMonad.Util.EZConfig" or "XMonad.Prompt.OrgMode".+-}++-- Parser :: Type -> Type+newtype Parser a = Parser (ReadP a)+  deriving newtype (Functor, Applicative, Monad)++instance Semigroup (Parser a) where+  -- | Local, exclusive, left-biased choice: If left parser locally+  -- produces any result at all, then right parser is not used.+  (<>) :: Parser a -> Parser a -> Parser a+  (<>) = coerce ((<++) @a)+  {-# INLINE (<>) #-}++instance Monoid (Parser a) where+  -- | A parser that always fails.+  mempty :: Parser a+  mempty = Parser empty+  {-# INLINE mempty #-}++instance Alternative Parser where+  empty :: Parser a+  empty = mempty+  {-# INLINE empty #-}++  (<|>) :: Parser a -> Parser a -> Parser a+  (<|>) = (<>)+  {-# INLINE (<|>) #-}++-- | When @-XOverloadedStrings@ is on, treat a string @s@ as the parser+-- @'string' s@, when appropriate.  This allows one to write things like+-- @"a" *> otherParser@ instead of @'string' "a" *> otherParser@.+instance a ~ String => IsString (Parser a) where+  fromString :: String -> Parser a+  fromString = string+  {-# INLINE fromString #-}++-- | Run a parser on a given string.+runParser :: Parser a -> String -> Maybe a+runParser (Parser p) = fmap fst . listToMaybe . ReadP.readP_to_S p+{-# INLINE runParser #-}++-- | Always fails+pfail :: Parser a+pfail = empty+{-# INLINE pfail #-}++-- | Consume and return the next character.  Fails if there is no input+-- left.+get :: Parser Char+get = coerce ReadP.get+{-# INLINE get #-}++-- | Look-ahead: return the part of the input that is left, without+-- consuming it.+look :: Parser String+look = coerce ReadP.look+{-# INLINE look #-}++-- | Transform a parser into one that does the same, but in addition+-- returns the exact characters read.+--+-- >>> runParser (         string "* " $> True) "* hi"+-- Just True+-- >>> runParser (gather $ string "* " $> True) "* hi"+-- Just ("* ",True)+gather :: forall a. Parser a -> Parser (String, a)+gather = coerce (ReadP.gather @a)+{-# INLINE gather #-}++-- | Succeeds if and only if we are at the end of input.+eof :: Parser ()+eof = coerce ReadP.eof+{-# INLINE eof #-}++-- | Parse an integral number.+num :: (Read a, Integral a) => Parser a+num = read <$> munch1 isDigit+{-# INLINE num #-}++-- | Parse and return the specified character.+char :: Char -> Parser Char+char = coerce ReadP.char+{-# INLINE char #-}++-- | Parse and return the specified string.+string :: String -> Parser String+string = coerce ReadP.string+{-# INLINE string #-}++-- | Skip all whitespace.+skipSpaces :: Parser ()+skipSpaces = coerce ReadP.skipSpaces+{-# INLINE skipSpaces #-}++-- | Consume and return the next character if it satisfies the specified+-- predicate.+satisfy :: (Char -> Bool) -> Parser Char+satisfy = coerce ReadP.satisfy+{-# INLINE satisfy #-}++-- | Combine all parsers in the given list in a left-biased way.+choice :: [Parser a] -> Parser a+choice = foldl' (<>) mempty+{-# INLINE choice #-}++-- | @count n p@ parses @n@ occurrences of @p@ in sequence and returns a+-- list of results.+count :: Int -> Parser a -> Parser [a]+count = replicateM+{-# INLINE count #-}++-- | @between open close p@ parses @open@, followed by @p@ and finally+-- @close@.  Only the value of @p@ is returned.+between :: Parser open -> Parser close -> Parser a -> Parser a+between open close p = open *> p <* close+{-# INLINE between #-}++-- | @option def p@ will try to parse @p@ and, if it fails, simply+-- return @def@ without consuming any input.+option :: a -> Parser a -> Parser a+option def p = p <|> pure def+{-# INLINE option #-}++-- | @optionally p@ optionally parses @p@ and always returns @()@.+optionally :: Parser a -> Parser ()+optionally p = void p <|> pure ()+{-# INLINE optionally #-}++-- | Like 'many', but discard the result.+skipMany :: Parser a -> Parser ()+skipMany = void . many+{-# INLINE skipMany #-}++-- | Like 'many1', but discard the result.+skipMany1 :: Parser a -> Parser ()+skipMany1 p = p *> skipMany p+{-# INLINE skipMany1 #-}++-- | Parse the first zero or more characters satisfying the predicate.+-- Always succeeds; returns an empty string if the predicate returns+-- @False@ on the first character of input.+munch :: (Char -> Bool) -> Parser String+munch = coerce ReadP.munch+{-# INLINE munch #-}++-- | Parse the first one or more characters satisfying the predicate.+-- Fails if none, else succeeds exactly once having consumed all the+-- characters.+munch1 :: (Char -> Bool) -> Parser String+munch1 = coerce ReadP.munch1+{-# INLINE munch1 #-}++-- | @endBy p sep@ parses zero or more occurrences of @p@, separated and+-- ended by @sep@.+endBy :: Parser a -> Parser sep -> Parser [a]+endBy p sep = many (p <* sep)+{-# INLINE endBy #-}++-- | @endBy p sep@ parses one or more occurrences of @p@, separated and+-- ended by @sep@.+endBy1 :: Parser a -> Parser sep -> Parser [a]+endBy1 p sep = many1 (p <* sep)+{-# INLINE endBy1 #-}++-- | Parse one or more occurrences of the given parser.+many1 :: Parser a -> Parser [a]+many1 = some+{-# INLINE many1 #-}++-- | @sepBy p sep@ parses zero or more occurrences of @p@, separated by+-- @sep@.  Returns a list of values returned by @p@.+sepBy :: Parser a -> Parser sep -> Parser [a]+sepBy p sep = sepBy1 p sep <> pure []+{-# INLINE sepBy #-}++-- | @sepBy1 p sep@ parses one or more occurrences of @p@, separated by+-- @sep@.  Returns a list of values returned by @p@.+sepBy1 :: Parser a -> Parser sep -> Parser [a]+sepBy1 p sep = liftA2 (:) p (many (sep *> p))+{-# INLINE sepBy1 #-}++-- | @chainr p op x@ parses zero or more occurrences of @p@, separated+-- by @op@.  Returns a value produced by a /right/ associative+-- application of all functions returned by @op@.  If there are no+-- occurrences of @p@, @x@ is returned.+chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a+chainr p op x = option x (chainr1 p op)+{-# INLINE chainr #-}++-- | Like 'chainr', but parses one or more occurrences of @p@.+chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a+chainr1 p op = scan+ where+  scan :: Parser a+  scan = p >>= rest++  rest :: a -> Parser a+  rest x = option x $ do f <- op+                         f x <$> scan+{-# INLINE chainr1 #-}++-- | @chainl p op x@ parses zero or more occurrences of @p@, separated+-- by @op@.  Returns a value produced by a /left/ associative+-- application of all functions returned by @op@.  If there are no+-- occurrences of @p@, @x@ is returned.+chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a+chainl p op x = option x (chainl1 p op)+{-# INLINE chainl #-}++-- | Like 'chainl', but parses one or more occurrences of @p@.+chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a+chainl1 p op = scan+ where+  scan :: Parser a+  scan = p >>= rest++  rest :: a -> Parser a+  rest x = option x $ do f <- op+                         y <- p+                         rest (f x y)+{-# INLINE chainl1 #-}++-- | @manyTill p end@ parses zero or more occurrences of @p@, until+-- @end@ succeeds.  Returns a list of values returned by @p@.+manyTill :: forall a end. Parser a -> Parser end -> Parser [a]+manyTill p end = scan+ where+  scan :: Parser [a]+  scan = end $> [] <|> liftA2 (:) p scan+{-# INLINE manyTill #-}
XMonad/Util/Paste.hs view
@@ -1,5 +1,6 @@ {- | Module      :  XMonad.Util.Paste+Description :  A module for sending key presses to windows. Copyright   :  (C) 2008 Jérémy Bobbio, gwern License     :  BSD3 @@ -27,15 +28,14 @@ import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent) import Control.Monad.Reader (asks) import XMonad.Operations (withFocused)-import Data.Char (isUpper)-import Data.Maybe (listToMaybe)+import XMonad.Prelude (isUpper, fromMaybe) import XMonad.Util.XSelection (getSelection) import XMonad.Util.EZConfig (parseKey)-import Text.ParserCombinators.ReadP (readP_to_S)+import XMonad.Util.Parser (runParser)  {- $usage -Import this module into your xmonad.hs as usual:+Import this module into your @xmonad.hs@ as usual:  > import XMonad.Util.Paste @@ -68,13 +68,14 @@     > pasteChar shiftMask 'F' -   Note that this function makes use of 'stringToKeysym', and so will probably-   have trouble with any 'Char' outside ASCII.+   Note that this function will probably have trouble with any 'Char'+   outside ASCII. -} pasteChar :: KeyMask -> Char -> X ()-pasteChar m c = sendKey m $ maybe (stringToKeysym [c]) fst-                $ listToMaybe $ readP_to_S parseKey [c]+pasteChar m c = sendKey m $ fromMaybe (unicodeToKeysym c)+                $ runParser parseKey [c] +-- | Send a key with a modifier to the currently focused window. sendKey :: KeyMask -> KeySym -> X () sendKey = (withFocused .) . sendKeyWindow @@ -89,3 +90,14 @@                   sendEvent d w True keyPressMask ev                   setEventType ev keyRelease                   sendEvent d w True keyReleaseMask ev++-- | Convert a unicode character to a 'KeySym'. Ideally, this should+-- work for any unicode character, but see here for details:+-- http://www.cl.cam.ac.uk/~mgk25/ucs/keysyms.txt+unicodeToKeysym :: Char -> KeySym+unicodeToKeysym c+  | (ucp >= 32)  && (ucp <= 126) = fromIntegral ucp+  | (ucp >= 160) && (ucp <= 255) = fromIntegral ucp+  | ucp >= 256                   = fromIntegral $ ucp + 0x1000000+  | otherwise                    = 0 -- this is supposed to be an error, but it's not ideal+  where ucp = fromEnum c -- codepoint
XMonad/Util/PositionStore.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.PositionStore+-- Description :  A utility module to store information about position and size of a window. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -34,16 +33,16 @@ -- and windows sizes as well as positions as fractions of the screen size. -- This way windows can be easily relocated and scaled when switching screens. -data PositionStore = PS (M.Map Window PosStoreRectangle)-                            deriving (Read,Show,Typeable)+newtype PositionStore = PS (M.Map Window PosStoreRectangle)+                            deriving (Read,Show) data PosStoreRectangle = PSRectangle Double Double Double Double-                            deriving (Read,Show,Typeable)+                            deriving (Read,Show)  instance ExtensionClass PositionStore where   initialValue = PS M.empty   extensionType = PersistentExtension -getPosStore :: X (PositionStore)+getPosStore :: X PositionStore getPosStore = XS.get  modifyPosStore :: (PositionStore -> PositionStore) -> X ()@@ -73,6 +72,6 @@  posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore posStoreMove posStore w x y oldSr newSr =-    case (posStoreQuery posStore w oldSr) of+    case posStoreQuery posStore w oldSr of         Nothing -> posStore     -- not in store, can't move -> do nothing         Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr
+ XMonad/Util/Process.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module      :  XMonad.Util.Process+-- Description :  Utilities for unix processes.+-- Copyright   :  (c) 2022 Tomáš Janoušek <tomi@nomi.cz>+-- License     :  BSD3+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>+--+-- This module should not be directly used by users, it's just common code for+-- other modules.+--+module XMonad.Util.Process (+    getPPIDOf,+    getPPIDChain,+    ) where++import Control.Exception (SomeException, handle)+import System.Posix.Types (ProcessID)+import qualified Data.ByteString.Char8 as B++import XMonad.Prelude (fi)++-- | Get the parent process id (PPID) of a given process.+getPPIDOf :: ProcessID -> IO (Maybe ProcessID)+getPPIDOf pid =+    handle+        (\(_ :: SomeException) -> pure Nothing)+        (parse <$> B.readFile ("/proc/" <> show pid <> "/stat"))+  where+    -- Parse PPID out of /proc/*/stat, being careful not to trip over+    -- processes with names like ":-) 1 2 3 4 5 6".+    -- Inspired by https://gitlab.com/procps-ng/procps/-/blob/bcce3e440a1e1ee130c7371251a39c031519336a/proc/readproc.c#L561+    parse stat = case B.words $ snd $ B.spanEnd (/= ')') stat of+        _ : (B.readInt -> Just (ppid, ""))  : _ -> Just (fi ppid)+        _ -> Nothing++-- | Get the chain of parent processes of a given pid. Starts with the given+-- pid and continues up until the parent of all.+getPPIDChain :: ProcessID -> IO [ProcessID]+getPPIDChain pid = (pid :) <$> (maybe (pure []) getPPIDChain =<< getPPIDOf pid)
XMonad/Util/PureX.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}+{-# LANGUAGE DerivingVia, GeneralizedNewtypeDeriving, FlexibleContexts #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.PureX+-- Description :  Composable @X@ actions. -- Copyright   :  L. S. Leary 2018 -- License     :  BSD3-style (see LICENSE) --@@ -44,23 +45,22 @@   withWindowSet', withFocii,   modify'', modifyWindowSet',   getStack, putStack, peek,+  focusWindow, focusNth,   view, greedyView, invisiView,-  shift, curScreen, curWorkspace,+  shift, shiftWin, curScreen, curWorkspace,   curTag, curScreenId, ) where  -- xmonad import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W+import qualified XMonad.Actions.FocusNth  -- mtl import Control.Monad.State import Control.Monad.Reader --- base-import Data.Semigroup (Semigroup(..), Any(..))-import Control.Applicative (liftA2)- -- }}}  -- --< Usage >-- {{{@@ -110,13 +110,7 @@ -- | The @PureX@ newtype over @ReaderT XConf (State XState) a@. newtype PureX a = PureX (ReaderT XConf (State XState) a)   deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState)--instance Semigroup a => Semigroup (PureX a) where-  (<>) = liftA2 (<>)--instance Monoid a => Monoid (PureX a) where-  mappend = liftA2 mappend-  mempty  = return mempty+  deriving (Semigroup, Monoid) via Ap PureX a  -- | The @XLike@ typeclass over monads reading @XConf@ values and tracking --   @XState@ state.@@ -136,7 +130,7 @@ -- | Despite appearing less general, @PureX a@ is actually isomorphic to --   @XLike m => m a@. toXLike :: XLike m => PureX a -> m a-toXLike pa = state =<< runPureX pa <$> ask+toXLike pa = state . runPureX pa =<< ask  -- | A generalisation of 'windowBracket'. Handles refreshing for an action that --   __performs no refresh of its own__ but can indicate that it needs one@@ -156,7 +150,7 @@ -- | A version of @windowBracket@ specialised to take an @X ()@ action and --   perform a refresh handling any changes it makes. handlingRefresh :: X () -> X ()-handlingRefresh = windowBracket (\_ -> True)+handlingRefresh = windowBracket (const True)  -- }}} @@ -168,7 +162,7 @@  -- | A @whenX@/@whenM@ that accepts a monoidal return value. whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a-whenM' mb m = when' <$> mb >>= ($ m)+whenM' mb m = ($ m) . when' =<< mb  -- | A 'whenJust' that accepts a monoidal return value. whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b@@ -214,16 +208,14 @@  -- | Set the stack on the current workspace. putStack :: XLike m => Maybe (W.Stack Window) -> m ()-putStack mst = modifyWindowSet' . modify'' $ \_ -> mst+putStack mst = modifyWindowSet' . modify'' $ const mst  -- | Get the focused window if there is one. peek :: XLike m => m (Maybe Window) peek = withWindowSet' (return . W.peek)  -- | Get the current screen.-curScreen-  :: XLike m-  => m (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+curScreen :: XLike m => m WindowScreen curScreen = withWindowSet' (return . W.current)  -- | Get the current workspace.@@ -272,5 +264,30 @@     mfw' <- peek     return (Any $ Just fw /= mfw') --- }}}+-- | A refresh tracking version of @W.shiftWin@.+shiftWin :: XLike m => WorkspaceId -> Window -> m Any+shiftWin tag w = do+  mtag <- gets $ W.findTag w . windowset+  whenJust' mtag $ \wtag ->+    when' (tag /= wtag) $ do+      modifyWindowSet' $ W.shiftWin tag w+      ntag <- gets $ W.findTag w . windowset+      return (Any $ mtag /= ntag) +-- | Internal. Refresh-tracking logic of focus operations.+focusWith :: XLike m => (WindowSet -> WindowSet) -> m Any+focusWith focuser = do+    old <- peek+    modifyWindowSet' focuser+    new <- peek+    return (Any $ old /= new)++-- | A refresh-tracking version of @W.focusWindow@.+focusWindow :: XLike m => Window -> m Any+focusWindow w = focusWith (W.focusWindow w)++-- | A refresh-tracking version of @XMonad.Actions.FocusNth.focusNth@.+focusNth :: XLike m => Int -> m Any+focusNth i = focusWith (W.modify' (XMonad.Actions.FocusNth.focusNth' i))++-- }}}
XMonad/Util/Rectangle.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Rectangle+-- Description :  A module for handling pixel rectangles. -- Copyright   :  (c) 2018 Yclept Nemo -- License     :  BSD-style (see LICENSE) --@@ -29,6 +30,7 @@     ) where  import           XMonad+import           XMonad.Prelude (fi) import qualified XMonad.StackSet as W  import           Data.Ratio@@ -65,11 +67,11 @@ -- @[N,N+1]@, as though each real-valued coordinate had been rounded (either -- down or up) to the nearest integers. So each pixel, from zero, is listed as: -- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this--- considers pixels as row/colum indices.  While easiest to reason with,+-- considers pixels as row/column indices.  While easiest to reason with, -- indices are unable to represent zero-dimension rectangles. -- -- Consider pixels as indices. Do not use this on empty rectangles.-pixelsToIndices :: Rectangle -> (PointRectangle Integer)+pixelsToIndices :: Rectangle -> PointRectangle Integer pixelsToIndices (Rectangle px py dx dy) =     PointRectangle (fromIntegral px)                    (fromIntegral py)@@ -77,7 +79,7 @@                    (fromIntegral py + fromIntegral dy - 1)  -- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles.-pixelsToCoordinates :: Rectangle -> (PointRectangle Integer)+pixelsToCoordinates :: Rectangle -> PointRectangle Integer pixelsToCoordinates (Rectangle px py dx dy) =     PointRectangle (fromIntegral px)                    (fromIntegral py)@@ -85,7 +87,7 @@                    (fromIntegral py + fromIntegral dy)  -- | Invert 'pixelsToIndices'.-indicesToRectangle :: (PointRectangle Integer) -> Rectangle+indicesToRectangle :: PointRectangle Integer -> Rectangle indicesToRectangle (PointRectangle x1 y1 x2 y2) =     Rectangle (fromIntegral x1)               (fromIntegral y1)@@ -93,7 +95,7 @@               (fromIntegral $ y2 - y1 + 1)  -- | Invert 'pixelsToCoordinates'.-coordinatesToRectangle :: (PointRectangle Integer) -> Rectangle+coordinatesToRectangle :: PointRectangle Integer -> Rectangle coordinatesToRectangle (PointRectangle x1 y1 x2 y2) =     Rectangle (fromIntegral x1)               (fromIntegral y1)@@ -105,7 +107,7 @@ empty :: Rectangle -> Bool empty (Rectangle _ _ _ 0) = True empty (Rectangle _ _ 0 _) = True-empty (Rectangle _ _ _ _) = False+empty Rectangle{}         = False  -- | True if the intersection of the set of points comprising each rectangle is -- not the empty set. Therefore any rectangle containing the initial points of@@ -141,21 +143,13 @@     where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1           PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2           -- top - assuming (0,0) is top-left-          rt = if r2_y1 > r1_y1 && r2_y1 < r1_y2-               then [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1]-               else []+          rt = [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1 | r2_y1 > r1_y1 && r2_y1 < r1_y2]           -- right-          rr = if r2_x2 > r1_x1 && r2_x2 < r1_x2-               then [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2]-               else []+          rr = [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2 | r2_x2 > r1_x1 && r2_x2 < r1_x2]           -- bottom-          rb = if r2_y2 > r1_y1 && r2_y2 < r1_y2-               then [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2]-               else []+          rb = [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2 | r2_y2 > r1_y1 && r2_y2 < r1_y2]           -- left-          rl = if r2_x1 > r1_x1 && r2_x1 < r1_x2-               then [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2)]-               else []+          rl = [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2) | r2_x1 > r1_x1 && r2_x1 < r1_x2]  -- | Fit a 'Rectangle' within the given borders of itself. Given insufficient -- space, borders are minimized while preserving the ratio of opposite borders.@@ -198,8 +192,8 @@ -- | Calculate the center - @(x,y)@ - as if the 'Rectangle' were bounded. center :: Rectangle -> (Ratio Integer,Ratio Integer) center (Rectangle x y w h) = (cx,cy)-    where cx = fromIntegral x + (fromIntegral w) % 2-          cy = fromIntegral y + (fromIntegral h) % 2+    where cx = fromIntegral x + fromIntegral w % 2+          cy = fromIntegral y + fromIntegral h % 2  -- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip -- conversion may not result in the original value. The first 'Rectangle' is@@ -209,6 +203,6 @@ -- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5) toRatio :: Rectangle -> Rectangle -> W.RationalRect toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) =-    let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2]-        [w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]-    in  W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)+    W.RationalRect ((fi x1 - fi x2) / fi w2)+                   ((fi y1 - fi y2) / fi h2)+                   (fi w1 / fi w2) (fi h1 / fi h2)
XMonad/Util/RemoteWindows.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.RemoteWindows+-- Description :  A module to find out whether the window is remote or local. -- Copyright   :  (c) Anton Vorontsov <anton@enomsg.org> 2014 -- License     :  BSD-style (as xmonad) --@@ -38,13 +40,11 @@  import XMonad import XMonad.Util.WindowProperties-import Data.Monoid-import Data.Maybe-import Control.Monad+import XMonad.Prelude import System.Posix.Env  -- $usage--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Util.RemoteWindows@@ -54,7 +54,7 @@ -- >    { manageHook = manageRemote =<< io getHostName }  guessHostName :: IO String-guessHostName = pickOneMaybe `liftM` (getEnv `mapM` vars)+guessHostName = pickOneMaybe <$> (getEnv `mapM` vars)   where     pickOneMaybe = last . (mzero:) . take 1 . catMaybes     vars = ["XAUTHLOCALHOSTNAME","HOST","HOSTNAME"]@@ -63,9 +63,8 @@ setRemoteProp w host = do     d <- asks display     p <- getAtom "XMONAD_REMOTE"-    t <- getAtom "CARDINAL"     v <- hasProperty (Machine host) w-    io $ changeProperty32 d w p t propModeReplace+    io $ changeProperty32 d w p cARDINAL propModeReplace                           [fromIntegral . fromEnum $ not v]  -- | Given a window, tell if it is a local or a remote process. Normally,@@ -74,7 +73,7 @@ -- checking environment variables and assuming that hostname never -- changes. isLocalWindow :: Window -> X Bool-isLocalWindow w = getProp32s "XMONAD_REMOTE" w >>= \p -> case p of+isLocalWindow w = getProp32s "XMONAD_REMOTE" w >>= \case     Just [y] -> return $ y == 0     _ -> io guessHostName >>= \host -> hasProperty (Machine host) w
XMonad/Util/Replace.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Replace+-- Description :  Implements a @--replace@ flag outside of core. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -28,8 +28,7 @@     ) where  import XMonad-import Data.Function-import Control.Monad+import XMonad.Prelude  -- $usage -- You must run the 'replace' action before starting xmonad proper, this@@ -79,11 +78,11 @@     rootw  <- rootWindow dpy dflt      -- check for other WM-    wmSnAtom <- internAtom dpy ("WM_S" ++ (show dflt)) False+    wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False     currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom     when (currentWmSnOwner /= 0) $ do-        putStrLn $ "Screen " ++ (show dflt) ++ " on display \""-                    ++ (displayString dpy) ++ "\" already has a window manager."+        putStrLn $ "Screen " ++ show dflt ++ " on display \""+                    ++ displayString dpy ++ "\" already has a window manager."          -- prepare to receive destroyNotify for old WM         selectInput dpy currentWmSnOwner structureNotifyMask@@ -98,19 +97,19 @@             createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes          -- try to acquire wmSnAtom, this should signal the old WM to terminate-        putStrLn $ "Replacing existing window manager..."+        putStrLn "Replacing existing window manager..."         xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime          -- SKIPPED: check if we acquired the selection         -- SKIPPED: send client message indicating that we are now the WM          -- wait for old WM to go away-        putStr $ "Waiting for other window manager to terminate... "+        putStr "Waiting for other window manager to terminate... "         fix $ \again -> do             evt <- allocaXEvent $ \event -> do                 windowEvent dpy currentWmSnOwner structureNotifyMask event                 get_EventType event              when (evt /= destroyNotify) again-        putStrLn $ "done"+        putStrLn "done"     closeDisplay dpy
XMonad/Util/Run.hs view
@@ -1,56 +1,125 @@+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Run--- Copyright   :  (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu+-- Description :  Several commands, as well as an EDSL, to run external processes.+-- Copyright   :  (C) 2007  Spencer Janssen, Andrea Rossato, glasser@mit.edu+--                    2022  Tony Zorman -- License     :  BSD-style (see LICENSE) ----- Maintainer  :  Christian Thiemann <mail@christian-thiemann.de>+-- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org> -- Stability   :  unstable -- Portability :  unportable ----- This modules provides several commands to run an external process.--- It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by--- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and--- XMonad.Util.RunInXTerm (by Andrea Rossato).+-- This module provides several commands to run an external process.+-- Additionally, it provides an abstraction—particularly geared towards+-- programs like terminals or Emacs—to specify these processes from+-- XMonad in a compositional way. --+-- Originally, this module was composed of functions formerly defined in+-- "XMonad.Util.Dmenu" (by Spencer Janssen), "XMonad.Util.Dzen" (by+-- glasser\@mit.edu) and @XMonad.Util.RunInXTerm@ (by Andrea Rossato). -----------------------------------------------------------------------------  module XMonad.Util.Run (-                          -- * Usage-                          -- $usage-                          runProcessWithInput,-                          runProcessWithInputAndWait,-                          safeSpawn,-                          safeSpawnProg,-                          unsafeSpawn,-                          runInTerm,-                          safeRunInTerm,-                          seconds,-                          spawnPipe,+  -- * Usage+  -- $usage+  runProcessWithInput,+  runProcessWithInputAndWait,+  safeSpawn,+  safeSpawnProg,+  unsafeSpawn,+  runInTerm,+  safeRunInTerm,+  seconds,+  spawnPipe,+  spawnPipeWithLocaleEncoding,+  spawnPipeWithUtf8Encoding,+  spawnPipeWithNoEncoding, -                          hPutStr, hPutStrLn  -- re-export for convenience-                         ) where+  -- * Compositionally Spawning Processes #EDSL#+  -- $EDSL -import Codec.Binary.UTF8.String-import System.Posix.IO-import System.Posix.Process (createSession, executeFile, forkProcess)+  -- ** Configuration and Running+  ProcessConfig (..),+  Input,+  spawnExternalProcess,+  proc,+  getInput,+  toInput,++  -- ** Programs+  inEditor,+  inTerm,+  termInDir,+  inProgram,++  -- ** General Combinators+  (>->),+  (>-$),+  (>&&>),+  (>||>),+  inWorkingDir,+  eval,+  execute,+  executeNoQuote,+  setXClass,+  asString,++  -- ** Emacs Integration+  EmacsLib (..),+  setFrameName,+  withEmacsLibs,+  inEmacs,+  elispFun,+  asBatch,+  require,+  progn,+  quote,+  findFile,+  list,+  saveExcursion,++  -- * Re-exports+  hPutStr,+  hPutStrLn,+) where++import XMonad+import XMonad.Prelude+import qualified XMonad.Util.ExtensibleConf as XC++import Codec.Binary.UTF8.String (encodeString) import Control.Concurrent (threadDelay)+import System.Directory (getDirectoryContents) import System.IO+import System.Posix.IO+import System.Posix.Process (createSession, executeFile, forkProcess) import System.Process (runInteractiveProcess)-import XMonad-import Control.Monad --- $usage--- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh"------ For an example usage of 'runProcessWithInput' see--- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu",--- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions",--- "XMonad.Prompt.WorkspaceDir"------ For an example usage of 'runProcessWithInputAndWait' see--- "XMonad.Util.Dzen"+{- $usage +You can use this module by importing it in your @xmonad.hs@++> import XMonad.Util.Run++It then all depends on what you want to do:++  - If you want to compositionally spawn programs, see [the relevant+    extended documentation](#g:EDSL).++  - For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh".++  - For an example usage of 'runProcessWithInput' see+    "XMonad.Util.Dmenu", or "XMonad.Prompt.Shell".++  - For an example usage of 'runProcessWithInputAndWait' see+    "XMonad.Util.Dzen".+-}+ -- | Returns the output. runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String runProcessWithInput cmd args input = io $ do@@ -144,15 +213,350 @@ safeRunInTerm :: String -> String -> X () safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t [options, " -e " ++ command] --- | Launch an external application through the system shell and return a @Handle@ to its standard input.+-- | Launch an external application through the system shell and+-- return a 'Handle' to its standard input. Note that the 'Handle'+-- is a text 'Handle' using the current locale encoding. spawnPipe :: MonadIO m => String -> m Handle-spawnPipe x = io $ do+spawnPipe = spawnPipeWithLocaleEncoding++-- | Same as 'spawnPipe'.+spawnPipeWithLocaleEncoding :: MonadIO m => String -> m Handle+spawnPipeWithLocaleEncoding = spawnPipe' localeEncoding++-- | Same as 'spawnPipe', but forces the UTF-8 encoding regardless of locale.+spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle+spawnPipeWithUtf8Encoding = spawnPipe' utf8++-- | Same as 'spawnPipe', but forces the 'char8' encoding, so unicode strings+-- need 'Codec.Binary.UTF8.String.encodeString'. Should never be needed, but+-- some X functions return already encoded Strings, so it may possibly be+-- useful for someone.+spawnPipeWithNoEncoding :: MonadIO m => String -> m Handle+spawnPipeWithNoEncoding = spawnPipe' char8++spawnPipe' :: MonadIO m => TextEncoding -> String -> m Handle+spawnPipe' encoding x = io $ do     (rd, wr) <- createPipe     setFdOption wr CloseOnExec True     h <- fdToHandle wr+    hSetEncoding h encoding     hSetBuffering h LineBuffering     _ <- xfork $ do           _ <- dupTo rd stdInput           executeFile "/bin/sh" False ["-c", encodeString x] Nothing     closeFd rd     return h++{- $EDSL++To use the provided EDSL, you must first add the 'spawnExternalProcess'+combinator to your xmonad configuration, like so:++> main = xmonad $ … $ spawnExternalProcess def $ … $ def++See 'ProcessConfig' for a list of all default configuration options, in+case you'd like to change them—especially if you want to make use of the+Emacs integration.++After that, the real fun begins!  The format for spawning these+processes is always the same: a call to 'proc', its argument being a+bunch of function calls, separated by the pipe operator '(>->)'.  You+can just bind the resulting function to a key; no additional plumbing+required.  For example, using "XMonad.Util.EZConfig" syntax and with+@terminal = "alacritty"@ in you XMonad configuration, spawning a @ghci@+session with a special class name, "calculator", would look like++> ("M-y", proc $ inTerm >-> setXClass "calculator" >-> execute "ghci")++which would translate, more or less, to @\/usr\/bin\/sh -c "alacritty+--class calculator -e ghci"@.  The usefulness of this notation becomes+apparent with more complicated examples:++> proc $ inEmacs+>    >-> withEmacsLibs [OwnFile "mailboxes"]+>    >-> execute (elispFun "notmuch")+>    >-> setFrameName "mail"++This is equivalent to spawning++> emacs -l /home/slot/.config/emacs/lisp/mailboxes.el+>       -e '(notmuch)'+>       -F '(quote (name . "mail"))'++Notice how we did not have to specify the whole path to @mailboxes.el@,+since we had set the correct 'emacsLispDir' upon starting xmonad.  This+becomes especially relevant when running Emacs in batch mode, where one+has to include [M,Non-GNU]ELPA packages in the call, whose exact names+may change at any time.  Then the following++> do url <- getSelection  -- from XMonad.Util.XSelection+>    proc $ inEmacs+>       >-> withEmacsLibs [ElpaLib "dash", ElpaLib "s", OwnFile "arXiv-citation"]+>       >-> asBatch+>       >-> execute (elispFun $ "arXiv-citation" <> asString url)++becomes++> emacs -L /home/slot/.config/emacs/elpa/dash-20220417.2250+>       -L /home/slot/.config/emacs/elpa/s-20210616.619+>       -l /home/slot/.config/emacs/lisp/arXiv-citation.el+>       --batch+>       -e '(arXiv-citation "<url-in-the-primary-selection>")'++which would be quite bothersome to type indeed!++A blog post going into some more detail and also explaining how to+integrate this new language with the "XMonad.Util.NamedScratchpad"+module is available+<https://tony-zorman.com/posts/2022-05-25-calling-emacs-from-xmonad.html here>.+-}++-----------------------------------------------------------------------+-- Types and whatnot++-- | Additional information that might be useful when spawning external+-- programs.+data ProcessConfig = ProcessConfig+  { editor :: !String+    -- ^ Default editor.  Defaults to @"emacsclient -c -a ''"@.+  , emacsLispDir :: !FilePath+    -- ^ Directory for your custom Emacs lisp files.  Probably+    -- @user-emacs-directory@ or @user-emacs-directory/lisp@.  Defaults+    -- to @"~\/.config\/emacs\/lisp\/"@+  , emacsElpaDir :: !FilePath+    -- ^ Directory for all packages from [M,Non-GNU]ELPA; probably+    -- @user-emacs-directory/elpa@.  Defaults to+    -- @"~\/.config\/emacs\/elpa"@.+  , emacs :: !String+    -- ^ /Standalone/ Emacs executable; this should not be @emacsclient@+    -- since, for example, the client does not support @--batch@ mode.+    -- Defaults to @"emacs"@.+  }++-- | Given a 'ProcessConfig', remember it for spawning external+-- processes later on.+spawnExternalProcess :: ProcessConfig -> XConfig l -> XConfig l+spawnExternalProcess = XC.modifyDef . const++instance Default ProcessConfig where+  def :: ProcessConfig+  def = ProcessConfig+    { editor       = "emacsclient -c -a ''"+    , emacsLispDir = "~/.config/emacs/lisp/"+    , emacsElpaDir = "~/.config/emacs/elpa/"+    , emacs        = "emacs"+    }++-- | Convenient type alias.+type Input = ShowS++-----------------------------------------------------------------------+-- Combinators++-- | Combine inputs together.+(>->) :: X Input -> X Input -> X Input+(>->) = (<>)+infixr 3 >->++-- | Combine an input with an ordinary string.+(>-$) :: X Input -> X String -> X Input+(>-$) xi xs = xi >-> fmap mkDList xs+infixr 3 >-$++-- | @a >&&> b@ glues the different inputs @a@ and @b@ by means of @&&@.+-- For example,+--+-- @+-- pure "do something" >&&> pure "do another thing"+-- @+--+-- would result in @do something && do another thing@ being executed by a+-- shell.+(>&&>) :: X Input -> X Input -> X Input+a >&&> b = a <> toInput " && " <> b+infixr 2 >&&>++-- | Like '(>&&>)', but with @||@.+(>||>) :: X Input -> X Input -> X Input+a >||> b = a <> toInput " || " <> b+infixr 2 >||>++-- | Spawn a completed input.+proc :: X Input -> X ()+proc xi = spawn =<< getInput xi++-- | Create an effectful 'Input' from a 'String'.+toInput :: String -> X Input+toInput = pure . mkDList++-- | Get the completed input string.+getInput :: X Input -> X String+getInput xi = xi <&> ($ "")++-- | Use the 'editor'.+inEditor :: X Input+inEditor = XC.withDef $ \ProcessConfig{editor} -> pure $ mkDList editor++-- | Use the 'XMonad.Core.XConfig.terminal'.+inTerm :: X Input+inTerm = asks $ mkDList . terminal . config++-- | Execute the argument.  Current /thing/ must support a @-e@ option.+-- For programs such as Emacs, 'eval' may be the safer option; while+-- @emacsclient@ supports @-e@, the @emacs@ executable itself does not.+--+-- Note that this function always wraps its argument in single quotes;+-- see 'executeNoQuote' for an alternative.+execute :: String -> X Input+execute this = pure ((" -e " <> tryQuote this) <>)++-- | Like 'execute', but doesn't wrap its argument in single quotes.+executeNoQuote :: String -> X Input+executeNoQuote this = pure ((" -e " <> this) <>)++-- | Eval(uate) the argument.  Current /thing/ must support a @--eval@+-- option.+eval :: String -> X Input+eval this = pure ((" --eval " <> tryQuote this) <>)++-- | Use 'emacs'.+inEmacs :: X Input+inEmacs = XC.withDef $ \ProcessConfig{emacs} -> pure $ mkDList emacs++-- | Use the given program.+inProgram :: String -> X Input+inProgram = pure . mkDList++-- | Spawn /thing/ in the current working directory.  /thing/ must+-- support a @--working-directory@ option.+inWorkingDir :: X Input+inWorkingDir = pure (" --working-directory " <>)++-- | Set a frame name for the @emacsclient@.+--+-- Note that this uses the @-F@ option to set the+-- <https://www.gnu.org/software/emacs/manual/html_node/emacs/Frame-Parameters.html frame parameters>+-- alist, which the @emacs@ executable does not support.+setFrameName :: String -> X Input+setFrameName n = pure ((" -F '(quote (name . \"" <> n <> "\"))' ") <>)++-- | Set the appropriate X class for a window.  This will more often+-- than not actually be the+-- <https://tronche.com/gui/x/icccm/sec-4.html#WM_CLASS instance name>.+setXClass :: String -> X Input+setXClass = pure . mkDList . (" --class " <>)++-- | Spawn the 'XMonad.Core.XConfig.terminal' in some directory; it must+-- support the @--working-directory@ option.+termInDir :: X Input+termInDir = inTerm >-> inWorkingDir++-----------------------------------------------------------------------+-- Emacs++-- | Transform the given input into an elisp function; i.e., surround it+-- with parentheses.+--+-- >>> elispFun "arxiv-citation URL"+-- " '( arxiv-citation URL )' "+elispFun :: String -> String+elispFun f = " '( " <> f <> " )' "++-- | Treat an argument as a string; i.e., wrap it with quotes.+--+-- >>> asString "string"+-- " \"string\" "+asString :: String -> String+asString s = " \"" <> s <> "\" "++-- | Wrap the given commands in a @progn@.  The given commands need not+-- be wrapped in parentheses (but can); this will be done by the+-- function.  For example:+--+-- >>> progn [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"]+-- "(progn (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))"+progn :: [String] -> String+progn = inParens . ("progn " <>) . unwords . map inParens++-- | Require a package.+--+-- >>> require "arxiv-citation"+-- "(require (quote arxiv-citation))"+require :: String -> String+require = inParens . ("require " <>) . quote++-- | Quote a symbol.+--+-- >>> quote "new-process"+-- "(quote new-process)"+quote :: String -> String+quote = inParens . ("quote " <>)++-- | Call @find-file@.+--+-- >>> findFile "/path/to/file"+-- "(find-file \"/path/to/file\" )"+findFile :: String -> String+findFile = inParens . ("find-file" <>) . asString++-- | Make a list of the given inputs.+--+-- >>> list ["foo", "bar", "baz", "qux"]+-- "(list foo bar baz qux)"+list :: [String] -> String+list = inParens . ("list " <>) . unwords++-- | Like 'progn', but with @save-excursion@.+--+-- >>> saveExcursion [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"]+-- "(save-excursion (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))"+saveExcursion :: [String] -> String+saveExcursion = inParens . ("save-excursion " <>) . unwords . map inParens++-----------------------------------------------------------------------+-- Batch mode++-- | Tell Emacs to enable batch-mode.+asBatch :: X Input+asBatch = pure (" --batch " <>)++-- | An Emacs library.+data EmacsLib+  = OwnFile !String+    -- ^ A /file/ from 'emacsLispDir'.+  | ElpaLib !String+    -- ^ A /directory/ in 'emacsElpaDir'.+  | Special !String+    -- ^ Special /files/; these will not be looked up somewhere, but+    -- forwarded verbatim (as a path).++-- | Load some Emacs libraries.  This is useful when executing scripts+-- in batch mode.+withEmacsLibs :: [EmacsLib] -> X Input+withEmacsLibs libs = XC.withDef $ \ProcessConfig{emacsLispDir, emacsElpaDir} -> do+  lispDir <- mkAbsolutePath emacsLispDir+  elpaDir <- mkAbsolutePath emacsElpaDir+  lisp    <- liftIO $ getDirectoryContents lispDir+  elpa    <- liftIO $ getDirectoryContents elpaDir++  let getLib :: EmacsLib -> Maybe String = \case+        OwnFile f -> (("-l " <> lispDir) <>) <$> find (f          `isPrefixOf`) lisp+        ElpaLib d -> (("-L " <> elpaDir) <>) <$> find ((d <> "-") `isPrefixOf`) elpa+        Special f -> Just $ " -l " <> f+  pure . mkDList . unwords . mapMaybe getLib $ libs++-----------------------------------------------------------------------+-- Util++mkDList :: String -> ShowS+mkDList = (<>) . (<> " ")++inParens :: String -> String+inParens s = case s of+  '(' : _ -> s+  _       -> "(" <> s <> ")"++tryQuote :: String -> String+tryQuote s = case dropWhile (== ' ') s of+  '\'' : _ -> s+  _        -> "'" <> s <> "'"
XMonad/Util/Scratchpad.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Scratchpad+-- Description :  Very handy hotkey-launched toggleable floating terminal window. -- Copyright   :  (c) Braden Shepherdson 2008 -- License     :  BSD-style (as xmonad) --@@ -12,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.Scratchpad (+module XMonad.Util.Scratchpad {-# DEPRECATED "Use XMonad.Util.NamedScratchpad instead" #-} (   -- * Usage   -- $usage   scratchpadSpawnAction@@ -26,6 +27,7 @@ import XMonad import qualified XMonad.StackSet as W import XMonad.Util.NamedScratchpad+import XMonad.Util.WorkspaceCompare (filterOutWs)   -- $usage@@ -108,13 +110,13 @@ scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating rect)]  --- | Transforms a workspace list containing the SP workspace into one that--- doesn't contain it. Intended for use with logHooks.+-- | Transforms a workspace list containing the NSP workspace into one that+-- doesn't contain it. Intended for use with 'logHook's (see+-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops"+-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort'). scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]-scratchpadFilterOutWorkspace = namedScratchpadFilterOutWorkspace+scratchpadFilterOutWorkspace = filterOutWs [scratchpadWorkspaceTag]   scratchpadDefaultRect :: W.RationalRect scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25--
XMonad/Util/SessionStart.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.SessionStart+-- Description :  A module for detectiong session startup. -- Copyright   :  (c) Markus Ongyerth 2017 -- License     :  BSD3-style (see LICENSE) --@@ -22,8 +21,7 @@     ) where -import Control.Monad (when)-import Control.Applicative ((<$>))+import XMonad.Prelude (when)  import XMonad import qualified XMonad.Util.ExtensibleState as XS@@ -34,13 +32,13 @@ -- Add 'setSessionStarted' at the end of the 'startupHook' to set the -- flag. ----- To do something only when the session is started up, use +-- To do something only when the session is started up, use -- 'isSessionStart' to query or wrap it in 'doOnce' to only do it when -- the flag isn't set. -- --------------------------------------------------------------------- -data SessionStart = SessionStart { unSessionStart :: Bool }-    deriving (Read, Show, Typeable)+newtype SessionStart = SessionStart { unSessionStart :: Bool }+    deriving (Read, Show)  instance ExtensionClass SessionStart where     initialValue = SessionStart True
XMonad/Util/SpawnNamedPipe.hs view
@@ -1,16 +1,15 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.SpawnNamedPipe--- Copyright   :  (c) Christian Wills 2014 +-- Description :  A module for spawning a pipe whose handle lives in the XMonad state.+-- Copyright   :  (c) Christian Wills 2014 -- License     :  BSD3-style (see LICENSE) -- -- Maintainer  :  cwills.dev@gmail.com -- Stability   :  unstable -- Portability :  not portable ----- A module for spawning a pipe whose "Handle" lives in the Xmonad state.+-- A module for spawning a pipe whose 'Handle' lives in the Xmonad state. -- ----------------------------------------------------------------------------- @@ -25,7 +24,7 @@ import XMonad.Util.Run import System.IO import qualified XMonad.Util.ExtensibleState as XS-import Control.Monad+import XMonad.Prelude import qualified Data.Map as Map  -- $usage@@ -35,42 +34,41 @@ -- -- > import XMonad.Util.SpawnNamedPipe -- > import Data.Maybe--- > +-- > -- > -- StartupHook--- > startupHook' = spawnNamedPipe "dzen2" "dzenPipe" --- > +-- > startupHook' = spawnNamedPipe "dzen2" "dzenPipe"+-- > -- > -- LogHook -- > logHook' = do--- >     mh <- getNamedPipeHandle "dzenPipe" --- >         dynamicLogWithPP $ defaultPP {+-- >     mh <- getNamedPipeHandle "dzenPipe"+-- >         dynamicLogWithPP $ def { -- >             ppOutput = maybe (\s -> return ()) (hPutStrLn) mh} -- > -- > -- Main--- > main = xmonad $ defaultConfig {--- >                      startupHook = startupHook'--- >                    , logHook = logHook'}+-- > main = xmonad $ def { startupHook = startupHook'+-- >                     , logHook = logHook'} -- -data NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle }-    deriving (Show, Typeable)+newtype NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle }+    deriving (Show)  instance ExtensionClass NamedPipes where-    initialValue = NamedPipes Map.empty +    initialValue = NamedPipes Map.empty --- | When 'spawnNamedPipe' is executed with a command "String" and a name--- "String" respectively.  The command string is spawned with 'spawnPipe' (as--- long as the name chosen hasn't been used already) and the "Handle" returned--- is saved in Xmonad's state associated with the name "String". +-- | When 'spawnNamedPipe' is executed with a command 'String' and a name+-- 'String' respectively.  The command string is spawned with 'spawnPipe' (as+-- long as the name chosen hasn't been used already) and the 'Handle' returned+-- is saved in Xmonad's state associated with the name 'String'. spawnNamedPipe :: String -> String -> X () spawnNamedPipe cmd name = do-  b <- XS.gets (Map.member name . pipeMap) +  b <- XS.gets (Map.member name . pipeMap)   unless b $ do-    h <- spawnPipe cmd -    XS.modify (NamedPipes . Map.insert name h . pipeMap)   +    h <- spawnPipe cmd+    XS.modify (NamedPipes . Map.insert name h . pipeMap) --- | Attempts to retrieve a "Handle" to a pipe previously stored in Xmonad's+-- | Attempts to retrieve a 'Handle' to a pipe previously stored in Xmonad's -- state associated with the given string via a call to 'spawnNamedPipe'. If the -- given string doesn't exist in the map stored in Xmonad's state Nothing is--- returned.   +-- returned. getNamedPipe :: String -> X (Maybe Handle) getNamedPipe name = XS.gets (Map.lookup name . pipeMap)
XMonad/Util/SpawnOnce.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.SpawnOnce+-- Description :  A module for spawning a command once, and only once. -- Copyright   :  (c) Spencer Janssen 2009 -- License     :  BSD3-style (see LICENSE) --@@ -11,20 +10,28 @@ -- Portability :  not portable -- -- A module for spawning a command once, and only once.  Useful to start--- status bars and make session settings inside startupHook.+-- status bars and make session settings inside startupHook. See also+-- "XMonad.Util.SessionStart" for a different and more flexible way to+-- run commands only on first startup. -- ----------------------------------------------------------------------------- -module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where+module XMonad.Util.SpawnOnce (spawnOnce,+                              -- * 'SpawnOn' helpers+                              -- $spawnon+                              manageSpawn,+                              spawnOnOnce,+                              spawnNOnOnce,+                              spawnAndDoOnce) where  import XMonad import XMonad.Actions.SpawnOn import Data.Set as Set import qualified XMonad.Util.ExtensibleState as XS-import Control.Monad+import XMonad.Prelude -data SpawnOnce = SpawnOnce { unspawnOnce :: (Set String) }-    deriving (Read, Show, Typeable)+newtype SpawnOnce = SpawnOnce { unspawnOnce :: Set String }+    deriving (Read, Show)  instance ExtensionClass SpawnOnce where     initialValue = SpawnOnce Set.empty@@ -33,7 +40,7 @@ doOnce :: (String -> X ()) -> String -> X () doOnce f s = do     b <- XS.gets (Set.member s . unspawnOnce)-    when (not b) $ do+    unless b $ do         f s         XS.modify (SpawnOnce . Set.insert s . unspawnOnce) @@ -42,19 +49,24 @@ -- that command is executed.  Subsequent invocations for a command do -- nothing. spawnOnce :: String -> X ()-spawnOnce cmd = doOnce spawn cmd+spawnOnce = doOnce spawn --- | Like spawnOnce but launches the application on the given workspace.+-- $spawnon+-- These functions combine 'spawnOnce' with their relatives in+-- "XMonad.Actions.SpawnOn". You must add 'manageSpawn' to your+-- @manageHook@ for them to work, as with @SpawnOn@.++-- | Like 'spawnOnce' but launches the application on the given workspace. spawnOnOnce :: WorkspaceId -> String -> X ()-spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd+spawnOnOnce ws = doOnce (spawnOn ws)  -- | Lanch the given application n times on the specified -- workspace. Subsequent attempts to spawn this application will be -- ignored. spawnNOnOnce :: Int -> WorkspaceId -> String -> X ()-spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd+spawnNOnOnce n ws = doOnce (replicateM_ n . spawnOn ws)  -- | Spawn the application once and apply the manage hook. Subsequent -- attempts to spawn this application will be ignored. spawnAndDoOnce :: ManageHook -> String -> X ()-spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd+spawnAndDoOnce mh = doOnce (spawnAndDo mh)
XMonad/Util/Stack.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Stack+-- Description :  Utility functions for manipulating @Maybe Stack@s. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -26,6 +27,7 @@                          , toIndex                          , fromTags                          , toTags+                         , zipperFocusedAtFirstOf                             -- * 'Zipper' manipulation functions                            -- ** Insertion, movement@@ -80,10 +82,7 @@                          ) where  import qualified XMonad.StackSet as W-import Control.Applicative ((<|>),(<$>),(<$))-import Control.Monad (guard,liftM)-import Data.List (sortBy)-+import XMonad.Prelude (guard, sortBy, (!?), (<|>))   type Zipper a = Maybe (W.Stack a)@@ -125,6 +124,18 @@ toTags (Just s) = map Left (reverse . W.up $ s) ++ [Right . W.focus $ s]                   ++ map Left (W.down s) +-- | @differentiate zs xs@ takes the first @z@ from @z2 that also belongs to+-- @xs@ and turns @xs@ into a stack with @z@ being the current element. Acts+-- as 'XMonad.StackSet.differentiate' if @zs@ and @xs@ don't intersect.+zipperFocusedAtFirstOf :: Eq q => [q] -> [q] -> Zipper q+zipperFocusedAtFirstOf []       xs = W.differentiate xs+zipperFocusedAtFirstOf (z : zs) xs+  | z `elem` xs = Just $+        W.Stack { W.focus = z+                , W.up    = reverse $ takeWhile (/= z) xs+                , W.down  = drop 1  $ dropWhile (/= z) xs+                }+  | otherwise = zipperFocusedAtFirstOf zs xs  -- * Zipper functions @@ -164,25 +175,25 @@ focusUpZ Nothing = Nothing focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s) focusUpZ (Just s) | null $ W.down s = Just s-focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (reverse (init down) ++ [f]) []+focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (drop 1 (reverse down) ++ [f]) []  -- | Move the focus to the next element focusDownZ :: Zipper a -> Zipper a focusDownZ Nothing = Nothing focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down focusDownZ (Just s) | null $ W.up s = Just s-focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (reverse (init up) ++ [f])+focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (drop 1 (reverse up) ++ [f])  -- | Move the focus to the first element focusMasterZ :: Zipper a -> Zipper a focusMasterZ Nothing = Nothing focusMasterZ (Just (W.Stack f up down)) | not $ null up-    = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)+    = Just $ W.Stack (last up) [] (drop 1 (reverse up) ++ [f] ++ down) focusMasterZ (Just s) = Just s  -- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to --   @Nothing@.-findS :: Eq a => (a -> Bool) -> W.Stack a -> Maybe (W.Stack a)+findS :: (a -> Bool) -> W.Stack a -> Maybe (W.Stack a) findS p st = st <$ (guard . p . W.focus) st <|> findUp st <|> findDown st   where findDown = reverseZ . findUp . reverseS         findUp s | u:ups <- W.up s = (if p u then Just else findUp)@@ -190,11 +201,10 @@                  | otherwise       = Nothing  -- | Refocus a @Zipper a@ on an element satisfying the predicate, or fail to---   @Nothing@. Never returns @Just Nothing@, so the second layer of @Maybe@ is---   actually redundant.-findZ :: Eq a => (a -> Bool) -> Zipper a -> Maybe (Zipper a)+--   @Nothing@.+findZ :: (a -> Bool) -> Zipper a -> Zipper a findZ _ Nothing   = Nothing-findZ p (Just st) = Just <$> findS p st+findZ p (Just st) = findS p st  -- ** Extraction @@ -222,7 +232,7 @@ -- | Map a function over a stack. The boolean argument indcates whether -- the current element is the focused one mapZ :: (Bool -> a -> b) -> Zipper a -> Zipper b-mapZ f as = fromTags . map (mapE f) . toTags $ as+mapZ f = fromTags . map (mapE f) . toTags  -- | 'mapZ' without the 'Bool' argument mapZ_ :: (a -> b) -> Zipper a -> Zipper b@@ -230,7 +240,7 @@  -- | Monadic version of 'mapZ' mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b)-mapZM f as = fromTags `liftM` (mapM (mapEM f) . toTags) as+mapZM f as = fromTags <$> (mapM (mapEM f) . toTags) as   -- | Monadic version of 'mapZ_'@@ -287,7 +297,7 @@ -- | Delete the ith element deleteIndexZ :: Int -> Zipper a -> Zipper a deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z-                       number j ea = mapE (\_ a -> (j,a)) ea+                       number j = mapE (\_ a -> (j,a))                    in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered  -- ** Folds@@ -320,7 +330,7 @@  -- | Find whether an element is present in a stack. elemZ :: Eq a => a -> Zipper a -> Bool-elemZ a as = foldlZ_ step False as+elemZ a = foldlZ_ step False     where step True _ = True           step False a' = a' == a @@ -329,9 +339,8 @@  -- | Safe version of '!!' getI :: Int -> [a] -> Maybe a-getI _ [] = Nothing-getI 0 (a:_) = Just a-getI i (_:as) = getI (i-1) as+getI i xs = xs !? i+{-# DEPRECATED getI "Use XMonad.Prelude.(!?) instead." #-}  -- | Map a function across both 'Left's and 'Right's. -- The 'Bool' argument is 'True' in a 'Right', 'False'@@ -345,8 +354,8 @@  -- | Monadic version of 'mapE' mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b)-mapEM f (Left a) = Left `liftM` f False a-mapEM f (Right a) = Right `liftM` f True a+mapEM f (Left a) = Left <$> f False a+mapEM f (Right a) = Right <$> f True a  mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b) mapEM_ = mapEM . const
+ XMonad/Util/StickyWindows.hs view
@@ -0,0 +1,142 @@+-- |+-- Module      :  XMonad.Util.StickyWindows+-- Description :  Make windows sticky to a screen across workspace changes.+-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module provides functionality to make windows \"sticky\" to a particular+-- screen. When a window is marked as sticky on a screen, it will automatically+-- follow that screen across workspace changes, staying visible even when you+-- switch to a different workspace.+--+-- This is particularly useful for windows you want to keep visible at all times+-- on a specific monitor, such as Picture-in-Picture videos, music players,+-- communication apps, or reference documentation.+module XMonad.Util.StickyWindows (+    -- * Usage+    -- $usage+    sticky,+    stick,+    unstick,+) where++import qualified Data.Map as M+import qualified Data.Set as S+import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS++-- $usage+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Util.StickyWindows+--+-- To enable sticky windows, wrap your config with 'sticky':+--+-- > main = xmonad $ … . sticky . … $ def { ... }+--+-- This adds the necessary hooks to manage sticky windows. Next, add keybindings+-- to stick and unstick windows:+--+-- > , ((modMask, xK_s), withFocused stick)+-- > , ((modMask .|. shiftMask, xK_s), withFocused unstick)+--+-- Now you can:+--+--   1. Focus a window and press @Mod-s@ to make it sticky to the current screen+--   2. Switch workspaces on that screen, and the sticky window will follow+--   3. Press @Mod-Shift-s@ to unstick the window+--+-- Note that windows are sticky to a /specific screen/, not to all screens. If you+-- have multiple monitors, a window marked sticky on screen 0 will only follow+-- workspace changes on screen 0, not on other screens.+--+-- The sticky state persists across XMonad restarts.++data StickyState = SS+    { lastWs :: !(M.Map ScreenId WorkspaceId)+    , stickies :: !(M.Map ScreenId (S.Set Window))+    }+    deriving (Show, Read)++instance ExtensionClass StickyState where+    initialValue = SS mempty mempty+    extensionType = PersistentExtension++modifySticky ::+    (S.Set Window -> S.Set Window) -> ScreenId -> StickyState -> StickyState+modifySticky f sid (SS ws ss) =+    SS ws $ M.alter (Just . f . fromMaybe S.empty) sid ss++modifyStickyM :: (S.Set Window -> S.Set Window) -> ScreenId -> X ()+modifyStickyM f sid = XS.modify (modifySticky f sid)++stick' :: Window -> ScreenId -> X ()+stick' = modifyStickyM . S.insert++unstick' :: Window -> ScreenId -> X ()+unstick' = modifyStickyM . S.delete++-- | Remove the sticky status from the given window on the current screen.+-- The window will no longer automatically follow workspace changes.+--+-- Typically used with 'withFocused':+--+-- > , ((modMask .|. shiftMask, xK_s), withFocused unstick)+unstick :: Window -> X ()+unstick w = unstick' w =<< currentScreen++-- | Mark the given window as sticky to the current screen. The window will+-- automatically follow this screen across workspace changes until explicitly+-- unstuck with 'unstick' or until the window is destroyed.+--+-- Typically used with 'withFocused':+--+-- > , ((modMask, xK_s), withFocused stick)+stick :: Window -> X ()+stick w = stick' w =<< currentScreen++currentScreen :: X ScreenId+currentScreen = gets $ W.screen . W.current . windowset++-- | Incorporates sticky window functionality into an 'XConfig'. This adds+-- the necessary log hook and event hook to:+--+--   * Automatically move sticky windows when workspaces change on their screen+--   * Clean up sticky state when windows are destroyed+--+-- Example usage:+--+-- > main = xmonad $ … . sticky .  … $ def { ... }+sticky :: XConfig l -> XConfig l+sticky xconf =+    xconf+        { logHook = logHook xconf >> stickyLogHook+        , handleEventHook = handleEventHook xconf <> stickyEventHook+        }++stickyLogHook :: X ()+stickyLogHook = do+    lastWS_ <- XS.gets lastWs+    screens <- withWindowSet $ return . map (\s -> (W.screen s, W.tag . W.workspace $ s)) . W.screens+    for_ screens $ \(sid, wsTag) -> do+        unless (M.lookup sid lastWS_ == Just wsTag) $+            -- We need to update the last workspace before moving windows to avoid+            -- getting stuck in a loop: This is a log hook, and calling moveWindows+            -- (which in turn calls 'windows') would trigger another log hook.+            XS.modify (\(SS ws ss) -> SS (M.insert sid wsTag ws) ss)+                >> XS.gets (M.lookup sid . stickies)+                >>= maybe mempty (moveWindows wsTag)++moveWindows :: WorkspaceId -> S.Set Window -> X ()+moveWindows wsTag = traverse_ (\w -> windows $ W.focusDown . W.shiftWin wsTag w)++stickyEventHook :: Event -> X All+stickyEventHook DestroyWindowEvent{ev_window = w} =+    XS.modify (\(SS ws ss) -> SS ws (M.map (S.delete w) ss)) $> All True+stickyEventHook _ = return (All True)
XMonad/Util/StringProp.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.StringProp+-- Description :  Internal utility functions for storing Strings with the root window. -- Copyright   :  (c) Nicolas Pouillard 2009 -- License     :  BSD-style (see LICENSE) --@@ -20,8 +21,6 @@     ) where  import XMonad-import Control.Monad(liftM)-import Control.Applicative((<$>)) import Foreign.C.String (castCCharToChar,castCharToCChar)  type StringProp = String@@ -48,7 +47,7 @@ -- | Given a property name, returns its contents as a list. It uses the empty -- list as default value. getStringListProp :: (MonadIO m) => Display -> StringProp -> m [String]-getStringListProp dpy prop = maybe [] words `liftM` getStringProp dpy prop+getStringListProp dpy prop = maybe [] words <$> getStringProp dpy prop  -- | Given a property name and a list, sets the value of this property with -- the list given as argument.
XMonad/Util/Themes.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Themes+-- Description :  A collection of themes for decorated layouts. -- Copyright   :  (C) 2007 Andrea Rossato -- License     :  BSD3 --@@ -19,6 +20,8 @@     , ppThemeInfo     , xmonadTheme     , smallClean+    , adwaitaTheme+    , adwaitaDarkTheme     , robertTheme     , darkTheme     , deiflTheme@@ -83,14 +86,16 @@ newTheme = TI "" "" "" def  ppThemeInfo :: ThemeInfo -> String-ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t-    where "" <> x = x-          x <> y = x ++ " - " ++ y+ppThemeInfo t = themeName t `add` themeDescription t `add` "by" `add` themeAuthor t+    where "" `add` x = x+          x `add` y = x ++ " - " ++ y   listOfThemes :: [ThemeInfo] listOfThemes = [ xmonadTheme                , smallClean+               , adwaitaTheme+               , adwaitaDarkTheme                , darkTheme                , deiflTheme                , oxymor00nTheme@@ -132,6 +137,48 @@                                       }              } +-- | Matching decorations for Adwaita GTK theme+adwaitaTheme :: ThemeInfo+adwaitaTheme =+    newTheme { themeName        = "adwaitaTheme"+             , themeAuthor      = "Alex Griffin"+             , themeDescription = "Matching decorations for Adwaita GTK theme"+             , theme            = def { activeColor         = "#dfdcd8"+                                      , inactiveColor       = "#f6f5f4"+                                      , urgentColor         = "#3584e4"+                                      , activeBorderColor   = "#bfb8b1"+                                      , inactiveBorderColor = "#cdc7c2"+                                      , urgentBorderColor   = "#1658a7"+                                      , activeTextColor     = "#2e3436"+                                      , inactiveTextColor   = "#929595"+                                      , urgentTextColor     = "#ffffff"+                                      , fontName            = "xft:Cantarell:bold:size=11"+                                      , decoWidth           = 400+                                      , decoHeight          = 35+                                      }+             }++-- | Matching decorations for Adwaita-dark GTK theme+adwaitaDarkTheme :: ThemeInfo+adwaitaDarkTheme =+    newTheme { themeName        = "adwaitaDarkTheme"+             , themeAuthor      = "Alex Griffin"+             , themeDescription = "Matching decorations for Adwaita-dark GTK theme"+             , theme            = def { activeColor         = "#2d2d2d"+                                      , inactiveColor       = "#353535"+                                      , urgentColor         = "#15539e"+                                      , activeBorderColor   = "#070707"+                                      , inactiveBorderColor = "#1c1c1c"+                                      , urgentBorderColor   = "#030c17"+                                      , activeTextColor     = "#eeeeec"+                                      , inactiveTextColor   = "#929291"+                                      , urgentTextColor     = "#ffffff"+                                      , fontName            = "xft:Cantarell:bold:size=11"+                                      , decoWidth           = 400+                                      , decoHeight          = 35+                                      }+             }+ -- | Don's preferred colors - from DynamicLog...;) donaldTheme  :: ThemeInfo donaldTheme =@@ -354,4 +401,3 @@                                       , inactiveTextColor   = "black"                                       }              }-
XMonad/Util/Timer.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Timer+-- Description :  A module for setting up timers. -- Copyright   :  (c) Andrea Rossato and David Roundy 2007 -- License     :  BSD-style (see xmonad/LICENSE) --@@ -19,14 +21,14 @@     , TimerId     ) where -import XMonad-import Control.Applicative import Control.Concurrent import Data.Unique+import XMonad+import XMonad.Prelude (listToMaybe)  -- $usage -- This module can be used to setup a timer to handle deferred events.--- See 'XMonad.Layout.ShowWName' for an usage example.+-- See "XMonad.Layout.ShowWName" for an usage example.  type TimerId = Int @@ -42,7 +44,7 @@     a <- internAtom d "XMONAD_TIMER" False     allocaXEvent $ \e -> do          setEventType e clientMessage-         setClientMessageEvent e rw a 32 (fromIntegral u) currentTime+         setClientMessageEvent e rw a 32 (fromIntegral u) 0          sendEvent d rw False structureNotifyMask e     sync d False   return u@@ -50,10 +52,9 @@ -- | Given a 'TimerId' and an 'Event', run an action when the 'Event' -- has been sent by the timer specified by the 'TimerId' handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)-handleTimer ti (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) action = do+handleTimer ti ClientMessageEvent{ev_message_type = mt, ev_data = dt} action = do   d <- asks display   a <- io $ internAtom d "XMONAD_TIMER" False-  if mt == a && dt /= [] && fromIntegral (head dt) == ti-     then action-     else return Nothing+  if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action+     | otherwise -> return Nothing handleTimer _ _ _ = return Nothing
XMonad/Util/TreeZipper.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.TreeSelect+-- Description :  Zipper over "Data.Tree". -- Copyright   :  (c) Tom Smeets <tom.tsmeets@gmail.com> -- License     :  BSD3-style (see LICENSE) --
XMonad/Util/Types.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Types+-- Description :  Miscellaneous commonly used types. -- Copyright   :  (c) Daniel Schoepe (2009) -- License     :  BSD3-style (see LICENSE) --@@ -17,14 +17,12 @@                          ,Direction2D(..)                          ) where -import Data.Typeable (Typeable)- -- | One-dimensional directions:-data Direction1D = Next | Prev deriving (Eq,Read,Show,Typeable)+data Direction1D = Next | Prev deriving (Eq,Read,Show)  -- | Two-dimensional directions: data Direction2D = U -- ^ Up                  | D -- ^ Down                  | R -- ^ Right                  | L -- ^ Left-                   deriving (Eq,Read,Show,Ord,Enum,Bounded,Typeable)+                   deriving (Eq,Read,Show,Ord,Enum,Bounded)
XMonad/Util/Ungrab.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Ungrab+-- Description :  Release xmonad's keyboard and pointer grabs immediately. -- Copyright   :  (c) 2016 Brandon S Allbery -- License     :  BSD-style (see xmonad/LICENSE) --@@ -12,12 +14,16 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.Ungrab+module XMonad.Util.Ungrab {-# DEPRECATED "Use XMonad.Operations.unGrab instead" #-}     ( -- * Usage:       -- $usage       unGrab     ) where +#if MIN_VERSION_xmonad(0, 17, 9)+import XMonad.Operations (unGrab)+#else+import Graphics.X11.Xlib (sync) import Graphics.X11.Xlib.Extras (currentTime) import Graphics.X11.Xlib.Misc (ungrabKeyboard, ungrabPointer) import XMonad.Core@@ -40,4 +46,5 @@  -- | Release xmonad's keyboard grab, so other grabbers can do their thing. unGrab :: X ()-unGrab = withDisplay $ \d -> io (ungrabKeyboard d currentTime >> ungrabPointer d currentTime)+unGrab = withDisplay $ \d -> io (ungrabKeyboard d currentTime >> ungrabPointer d currentTime >> sync d False)+#endif
XMonad/Util/WindowProperties.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.WindowProperties+-- Description :  EDSL for specifying window properties. -- Copyright   :  (c) Roman Cheplyaka -- License     :  BSD-style (see LICENSE) --@@ -22,10 +23,10 @@     getProp32, getProp32s) where -import Control.Monad import Foreign.C.Types (CLong) import XMonad import XMonad.Actions.TagWindows (hasTag)+import XMonad.Prelude (filterM) import qualified XMonad.StackSet as W  -- $edsl@@ -45,14 +46,14 @@               | Or  Property Property               | Not Property               | Const Bool-              | Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows'+              | Tagged String -- ^ Tagged via "XMonad.Actions.TagWindows"               deriving (Read, Show) infixr 9 `And` infixr 8 `Or`  -- | Does given window have this property? hasProperty :: Property -> Window -> X Bool-hasProperty p w = runQuery (propertyToQuery p) w+hasProperty p = runQuery (propertyToQuery p)  -- | Does the focused window have this property? focusedHasProperty :: Property -> X Bool@@ -79,7 +80,7 @@ propertyToQuery (Machine s) = stringProperty "WM_CLIENT_MACHINE" =? s propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2 propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2-propertyToQuery (Not p) = not `fmap` propertyToQuery p+propertyToQuery (Not p) = not <$> propertyToQuery p propertyToQuery (Const b) = return b propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w)
XMonad/Util/WindowState.hs view
@@ -1,11 +1,9 @@-{-#-  LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving,-  FlexibleInstances, MultiParamTypeClasses,-  FlexibleContexts -- ghc-6.12 only-  #-}+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving,+  FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Util.WindowState+-- Description  :  Functions for saving per-window data. -- Copyright    : (c) Dmitry Bogatov <KAction@gnu.org> -- License      : BSD --@@ -27,7 +25,6 @@ import Control.Monad.Reader(ReaderT(..)) import Control.Monad.State.Class import Data.Typeable (typeOf)-import Control.Applicative((<$>), Applicative) -- $usage -- -- This module allow to store state data with some 'Window'.@@ -36,22 +33,22 @@ -- -- This module have advantage over "XMonad.Actions.TagWindows" in that it -- hides from you implementation details and provides simple type-safe--- interface.  Main datatype is "StateQuery", which is simple wrapper around--- "Query", which is instance of MonadState, with 'put' and 'get' are--- functions to acess data, stored in "Window".+-- interface.  Main datatype is 'StateQuery', which is simple wrapper around+-- 'Query', which is instance of MonadState, with 'put' and 'get' are+-- functions to acess data, stored in 'Window'. -- -- To save some data in window you probably want to do following: -- > (runStateQuery  (put $ Just value)  win) :: X () -- To retrive it, you can use -- > (runStateQuery get win) :: X (Maybe YourValueType)--- "Query" can be promoted to "StateQuery" simply by constructor,+-- 'Query' can be promoted to 'StateQuery' simply by constructor, -- and reverse is 'getQuery'. -- -- For example, I use it to have all X applications @russian@ or @dvorak@ -- layout, but emacs have only @us@, to not screw keybindings. Use your -- imagination! --- | Wrapper around "Query" with phanom type @s@, representing state, saved in+-- | Wrapper around 'Query' with phantom type @s@, representing state, saved in -- window. newtype StateQuery s a = StateQuery {       getQuery :: Query a@@ -60,18 +57,18 @@ packIntoQuery :: (Window -> X a) -> Query a packIntoQuery = Query . ReaderT --- | Apply "StateQuery" to "Window".+-- | Apply 'StateQuery' to 'Window'. runStateQuery :: StateQuery s a -> Window ->  X a runStateQuery = runQuery . getQuery --- | Lifted to "Query" version of 'catchX'+-- | Lifted to 'Query' version of 'catchX' catchQuery :: Query a -> Query (Maybe a) catchQuery q = packIntoQuery $ \win -> userCode $ runQuery q win  -- | Instance of MonadState for StateQuery. instance (Show s, Read s, Typeable s) => MonadState (Maybe s) (StateQuery s) where     get = StateQuery  $ read' <$> get' undefined where-        get'   :: (Maybe s) -> Query String+        get'   :: Maybe s -> Query String         get' x = stringProperty (typePropertyName x)         read'  :: (Read s) => String -> Maybe s         read' "" = Nothing
XMonad/Util/WorkspaceCompare.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.WorkspaceCompare+-- Description :  Functions for examining, comparing, and sorting workspaces. -- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -11,6 +12,7 @@ -----------------------------------------------------------------------------  module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort+                                    , filterOutWs                                     , getWsIndex                                     , getWsCompare                                     , getWsCompareByTag@@ -24,15 +26,19 @@  import XMonad import qualified XMonad.StackSet as S-import Data.List-import Data.Maybe-import Data.Monoid (mconcat)+import XMonad.Prelude import XMonad.Actions.PhysicalScreens (ScreenComparator(ScreenComparator), getScreenIdAndRectangle, screenComparatorById)-import Data.Function (on)  type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering type WorkspaceSort = [WindowSpace] -> [WindowSpace] +-- | Transforms a workspace list by filtering out the workspaces that+-- correspond to the given 'tag's.  Intended for use with 'logHook's (see+-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops"+-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort').+filterOutWs :: [WorkspaceId] -> WorkspaceSort+filterOutWs ws = filter (\S.Workspace{ S.tag = tag } -> tag `notElem` ws)+ -- | Lookup the index of a workspace id in the user's config, return Nothing -- if that workspace does not exist in the config. getWsIndex :: X (WorkspaceId -> Maybe Int)@@ -62,7 +68,7 @@  -- | A comparison function for Xinerama based on visibility, workspace --   and screen id. It produces the same ordering as---   'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'.+--   'XMonad.Hooks.StatusBar.PP.pprWindowSetXinerama'. getXineramaWsCompare :: X WorkspaceCompare getXineramaWsCompare = getXineramaPhysicalWsCompare $ screenComparatorById compare @@ -98,7 +104,7 @@ getSortByTag = mkWsSort getWsCompareByTag  -- | Sort serveral workspaces for xinerama displays, in the same order---   produced by 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama': first+--   produced by 'XMonad.Hooks.StatusBar.PP.pprWindowSetXinerama': first --   visible workspaces, sorted by screen, then hidden workspaces, --   sorted by tag. getSortByXineramaRule :: X WorkspaceSort
XMonad/Util/XSelection.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {- | Module      :  XMonad.Util.XSelection+Description :  A module for accessing and manipulating the primary selection. Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman License     :  BSD3 @@ -17,14 +18,14 @@ module XMonad.Util.XSelection (  -- * Usage                                  -- $usage                                  getSelection,+                                 getClipboard,+                                 getSecondarySelection,                                  promptSelection,                                  safePromptSelection,                                  transformPromptSelection,                                  transformSafePromptSelection) where -import Control.Exception.Extensible as E (catch,SomeException(..))-import Control.Monad (liftM, join)-import Data.Maybe (fromMaybe)+import Control.Exception as E (catch,SomeException(..)) import XMonad import XMonad.Util.Run (safeSpawn, unsafeSpawn) @@ -32,31 +33,47 @@  {- $usage    Add @import XMonad.Util.XSelection@ to the top of Config.hs-   Then make use of getSelection or promptSelection as needed; if-   one wanted to run Firefox with the selection as an argument (perhaps++   If one wanted to run Firefox with the selection as an argument (perhaps    the selection string is an URL you just highlighted), then one could add    to the xmonad.hs a line like thus:     > , ((modm .|. shiftMask, xK_b), promptSelection "firefox") +   To add a 'paste' keybinding in your prompts, use:++   > prompt_extra_bindings = [+   >   ((mod1Mask, xK_v), getClipboard >>= insertString) -- Alt+v to paste+   >   ]+   > +   > prompt_conf = def {+   >   promptKeymap =+   >     foldl (\m (k, a) -> M.insert k a m) defaultXPKeymap prompt_extra_bindings,+   >   -- other prompt config+   > }++   Next use it to construct a prompt, for example in your bindings:++   > ("M-p", shellPrompt prompt_conf),+    Future improvements for XSelection:     * More elaborate functionality: Emacs' registers are nice; if you-      don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> -}+      don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> --- | Returns a String corresponding to the current mouse selection in X;---   if there is none, an empty string is returned.------ WARNING: this function is fundamentally implemented incorrectly and may, among other possible failure modes,--- deadlock or crash. For details, see <http://code.google.com/p/xmonad/issues/detail?id=573>.--- (These errors are generally very rare in practice, but still exist.)-getSelection :: MonadIO m => m String-getSelection = io $ do+   WARNING: these functions are fundamentally implemented incorrectly and may,+   among other possible failure modes, deadlock or crash. For details, see+   <http://code.google.com/p/xmonad/issues/detail?id=573>.+   (These errors are generally very rare in practice, but still exist.) -}++-- Query the content of a selection in X+getSelectionNamed :: String -> IO String+getSelectionNamed sel_name = do   dpy <- openDisplay ""   let dflt = defaultScreen dpy   rootw  <- rootWindow dpy dflt   win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0-  p <- internAtom dpy "PRIMARY" True+  p <- internAtom dpy sel_name True   ty <- E.catch                (E.catch                      (internAtom dpy "UTF8_STRING" False)@@ -69,11 +86,27 @@     ev <- getEvent e     result <- if ev_event_type ev == selectionNotify                  then do res <- getWindowProperty8 dpy clp win-                         return $ decode . map fromIntegral . fromMaybe [] $ res-                 else destroyWindow dpy win >> return ""+                         return $ decode . maybe [] (map fromIntegral) $ res+                 else return ""+    destroyWindow dpy win     closeDisplay dpy     return result +-- | Returns a String corresponding to the current mouse selection in X;+--   if there is none, an empty string is returned.+getSelection :: MonadIO m => m String+getSelection = io $ getSelectionNamed "PRIMARY"++-- | Returns a String corresponding to the current clipboard in X;+--   if there is none, an empty string is returned.+getClipboard :: MonadIO m => m String+getClipboard = io $ getSelectionNamed "CLIPBOARD"++-- | Returns a String corresponding to the secondary selection in X;+--   if there is none, an empty string is returned.+getSecondarySelection :: MonadIO m => m String+getSecondarySelection = io $ getSelectionNamed "SECONDARY"+ {- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument.   This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to          @promptSelection \"firefox\"@;@@ -85,8 +118,8 @@   details on the advantages and disadvantages of using safeSpawn. -} promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () promptSelection = unsafePromptSelection-safePromptSelection app = join $ io $ liftM (safeSpawn app . return) getSelection-unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection+safePromptSelection app = safeSpawn app . return =<< getSelection+unsafePromptSelection app = unsafeSpawn . (\x -> app ++ " " ++ x) =<< getSelection  {- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the      first is a function that transforms strings, and the second is the application to run.@@ -94,5 +127,5 @@      One example is to wrap code, such as a command line action copied out of the browser      to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. -} transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()-transformPromptSelection f app = join $ io $ liftM (safeSpawn app . return) (fmap f getSelection)-transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)+transformPromptSelection f app = (safeSpawn app . return . f) =<< getSelection+transformSafePromptSelection f app = unsafeSpawn . (\x -> app ++ " " ++ x) . f =<< getSelection
XMonad/Util/XUtils.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE TupleSections   #-}+{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.XUtils+-- Description :  A module for painting on the screen. -- Copyright   :  (c) 2007 Andrea Rossato --                    2010 Alejandro Serrano -- License     :  BSD-style (see xmonad/LICENSE)@@ -16,7 +21,11 @@ module XMonad.Util.XUtils     ( -- * Usage:       -- $usage-      averagePixels+      withSimpleWindow+    , showSimpleWindow+    , WindowConfig(..)+    , WindowRect(..)+    , averagePixels     , createNewWindow     , showWindow     , showWindows@@ -32,21 +41,29 @@     , fi     ) where -import Data.Maybe+import XMonad.Prelude import XMonad import XMonad.Util.Font import XMonad.Util.Image-import Control.Monad+import qualified XMonad.StackSet as W+import Data.Bits ((.&.))  -- $usage -- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or -- "XMonad.Layout.Decoration" for usage examples --- | Compute the weighted average the colors of two given Pixel values.+-- | Compute the weighted average the colors of two given 'Pixel' values.+--+-- This function masks out any alpha channel in the passed pixels, and the+-- result has no alpha channel. X11 mishandles @Pixel@ values with alpha+-- channels and throws errors while producing black pixels. averagePixels :: Pixel -> Pixel -> Double -> X Pixel-averagePixels p1 p2 f =+averagePixels p1' p2' f =     do d <- asks display        let cm = defaultColormap d (defaultScreen d)+           mask p = p .&. 0x00FFFFFF+           p1 = mask p1'+           p2 = mask p2'        [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0]        let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f))        Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)@@ -128,8 +145,8 @@               -> X () paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do     d <- asks display-    strPositions <- forM (zip als strs) $ \(al, str) ->-        stringPosition d fs (Rectangle 0 0 wh ht) al str+    strPositions <- forM (zip als strs) $+        uncurry (stringPosition d fs (Rectangle 0 0 wh ht))     let ms = Just (fs,ffc,fbc, zip strs strPositions)     paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms Nothing @@ -151,12 +168,91 @@                   -> X () paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do     d <- asks display-    strPositions <- forM (zip als strs) $ \(al, str) ->-        stringPosition d fs (Rectangle 0 0 wh ht) al str-    let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons)+    strPositions <- forM (zip als strs) $ uncurry (stringPosition d fs (Rectangle 0 0 wh ht))+    let iconPositions = zipWith (iconPosition (Rectangle 0 0 wh ht)) i_als icons         ms = Just (fs,ffc,fbc, zip strs strPositions)         is = Just (ffc, fbc, zip iconPositions icons)     paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is++-- | The config for a window, as interpreted by 'showSimpleWindow'.+--+-- The font @winFont@ can either be specified in the TODO format or as an+-- xft font.  For example:+--+-- > winFont = "xft:monospace-20"+--+-- or+--+-- > winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+data WindowConfig = WindowConfig+  { winFont :: !String      -- ^ Font to use.+  , winBg   :: !String      -- ^ Background color.+  , winFg   :: !String      -- ^ Foreground color.+  , winRect :: !WindowRect  -- ^ Position and size of the rectangle.+  }++instance Default WindowConfig where+  def = WindowConfig+    {+#ifdef XFT+      winFont = "xft:monospace-20"+#else+      winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+#endif+    , winBg   = "black"+    , winFg   = "white"+    , winRect = CenterWindow+    }++-- | What kind of window we should be.+data WindowRect+  = CenterWindow         -- ^ Centered, big enough to fit all the text.+  | CustomRect Rectangle -- ^ Completely custom dimensions.++-- | Create a window, then fill and show it with the given text.  If you+-- are looking for a version of this function that also takes care of+-- destroying the window, refer to 'withSimpleWindow'.+showSimpleWindow :: WindowConfig -- ^ Window config.+                 -> [String]     -- ^ Lines of text to show.+                 -> X Window+showSimpleWindow WindowConfig{..} strs = do+  let pad = 20+  font <- initXMF winFont+  dpy  <- asks display+  Rectangle sx sy sw sh <- getRectangle winRect++  -- Text extents for centering all fonts+  extends <- maximum . map (uncurry (+)) <$> traverse (textExtentsXMF font) strs+  -- Height and width of entire window+  height <- pure . fi $ (1 + length strs) * fi extends+  width  <- (+ pad) . fi . maximum <$> traverse (textWidthXMF dpy font) strs++  let -- x and y coordinates that specify the upper left corner of the window+      x = sx + (fi sw - width  + 2) `div` 2+      y = sy + (fi sh - height + 2) `div` 2+      -- y position of first string+      yFirst = (height + 2 * extends) `div` fi (2 + length strs)+      -- (x starting, y starting) for all strings+      strPositions = map (pad `div` 2, ) [yFirst, yFirst + extends ..]++  w <- createNewWindow (Rectangle x y (fi width) (fi height)) Nothing "" True+  let ms = Just (font, winFg, winBg, zip strs strPositions)+  showWindow w+  paintWindow' w (Rectangle 0 0 (fi width) (fi height)) 0 winBg "" ms Nothing+  releaseXMF font+  pure w+ where+  getRectangle :: WindowRect -> X Rectangle+  getRectangle = \case+    CenterWindow -> gets $ screenRect . W.screenDetail . W.current . windowset+    CustomRect r -> pure r++-- | Like 'showSimpleWindow', but fully manage the window; i.e., destroy+-- it after the given function finishes its execution.+withSimpleWindow :: WindowConfig -> [String] -> X a -> X a+withSimpleWindow wc strs doStuff = do+  w <- showSimpleWindow wc strs+  doStuff <* withDisplay (io . (`destroyWindow` w))  -- This stuff is not exported
− scripts/generate-configs 
@@ -1,302 +0,0 @@-#!/bin/bash--# generate-configs - Docstring parser for generating xmonad build configs with-#                    default settings for extensions-# Author: Alex Tarkovsky <alextarkovsky@gmail.com>-# Released into the public domain--# This script parses custom docstrings specifying build-time configuration data-# from xmonad extension source files, then inserts the data into copies of-# xmonad's Config.hs and xmonad.cabal files accordingly.-#-# Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR-#-# OPTIONS:-#   --active,  -a              Insert data in active mode (default: passive)-#   --contrib, -c CONTRIB_DIR  Path to contrib repository base directory-#   --help,    -h              Show help-#   --main,    -m MAIN_DIR     Path to main repository base directory-#   --output,  -o OUTPUT_DIR   Output directory (default: CONTRIB_DIR)-#-# Data parsed from the extension source files is inserted into Config.hs in-# either active or passive mode. The default is passive mode, in which the-# inserted data is commented out. The --active option inserts the data-# uncommented. Data inserted into xmonad.cabal is always inserted in active-# mode regardless of specified options.-#-# The docstring markup can be extended as needed. Currently the following tags-# are defined, shown with some examples:-#-# ~~~~~-#-# %cabalbuilddep-#-#     Cabal build dependency. Value is appended to the "build-depends" line in-#     xmonad.cabal and automatically prefixed with ", ".  NB: Don't embed-#     comments in this tag!-#-# -- %cabalbuilddep readline>=1.0-#-# %def-#-#     General definition. Value is appended to the end of Config.sh.-#-# -- %def commands :: [(String, X ())]-# -- %def commands = defaultCommands-#-# %import-#-#     Module needed by Config.sh to build the extension. Value is appended to-#     the end of the default import list in Config.sh and automatically-#     prefixed with "import ".-#-# -- %import XMonad.Layout.Accordion-# -- %import qualified XMonad.Actions.FlexibleManipulate as Flex-#-# %keybind-#-#     Tuple defining a key binding. Must be prefixed with ", ". Value is-#     inserted at the end of the "keys" list in Config.sh.-#-# -- %keybind , ((modMask, xK_d), date)-#-# %keybindlist-#-#     Same as %keybind, but instead of a key binding tuple the definition is a-#     list of key binding tuples (or a list comprehension producing them). This-#     list is concatenated to the "keys" list must begin with the "++" operator-#     rather than ", ".-#-# -- %keybindlist ++-# -- %keybindlist -- mod-[1..9] @@ Switch to workspace N-# -- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N-# -- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N-# -- %keybindlist [((m .|. modMask, k), f i)-# -- %keybindlist     | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..]-# -- %keybindlist     , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]]-#-# %layout-#-#     A layout. Must be prefixed with ", ". Value is inserted at the end of the-#     "defaultLayouts" list in Config.sh.-#-# -- %layout , accordion-#-# %mousebind-#-#     Tuple defining a mouse binding. Must be prefixed with ", ". Value is-#     inserted at the end of the "mouseBindings" list in Config.sh.-#-# -- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w))-#-# ~~~~~-#-# NB: '/' and '\' characters must be escaped with a '\' character!-#-# Tags may also contain comments, as illustrated in the %keybindlist examples-# above. Comments are a good place for special user instructions:-#-# -- %def -- comment out default logHook definition above if you uncomment this:-# -- %def logHook = dynamicLog--# Markup tag to search for in source files.-TAG_CABALBUILDDEP="%cabalbuilddep"-TAG_DEF="%def"-TAG_IMPORT="%import"-TAG_KEYBIND="%keybind"-TAG_KEYBINDLIST="%keybindlist"-TAG_LAYOUT="%layout"-TAG_MOUSEBIND="%mousebind"--# Insert markers to search for in Config.sh and xmonad.cabal. Values are-# extended sed regular expressions.-INS_MARKER_CABALBUILDDEP='^build-depends:.*'-INS_MARKER_IMPORT='-- % Extension-provided imports$'-INS_MARKER_LAYOUT='-- % Extension-provided layouts$'-INS_MARKER_KEYBIND='-- % Extension-provided key bindings$'-INS_MARKER_KEYBINDLIST='-- % Extension-provided key bindings lists$'-INS_MARKER_MOUSEBIND='-- % Extension-provided mouse bindings$'-INS_MARKER_DEF='-- % Extension-provided definitions$'--# Literal indentation strings. Values may contain escaped chars such as \t.-INS_INDENT_CABALBUILDDEP=""-INS_INDENT_DEF=""-INS_INDENT_IMPORT=""-INS_INDENT_KEYBIND="    "-INS_INDENT_KEYBINDLIST="    "-INS_INDENT_LAYOUT="                 "-INS_INDENT_MOUSEBIND="    "--# Prefix applied to inserted passive data after indent strings have been applied.-INS_PREFIX_DEF="-- "-INS_PREFIX_IMPORT="--import "-INS_PREFIX_KEYBIND="-- "-INS_PREFIX_KEYBINDLIST="-- "-INS_PREFIX_LAYOUT="-- "-INS_PREFIX_MOUSEBIND="-- "--# Prefix applied to inserted active data after indent strings have been applied.-ACTIVE_INS_PREFIX_CABALBUILDDEP=", "-ACTIVE_INS_PREFIX_DEF=""-ACTIVE_INS_PREFIX_IMPORT="import "-ACTIVE_INS_PREFIX_KEYBIND=""-ACTIVE_INS_PREFIX_KEYBINDLIST=""-ACTIVE_INS_PREFIX_LAYOUT=""-ACTIVE_INS_PREFIX_MOUSEBIND=""--# Don't touch these-opt_active=0-opt_contrib=""-opt_main=""-opt_output=""--generate_configs() {-    for extension_srcfile in $(ls --color=never -1 "${opt_contrib}"/*.hs | head -n -1 | sort -r) ; do-        for tag in $TAG_CABALBUILDDEP \-                   $TAG_DEF \-                   $TAG_IMPORT \-                   $TAG_KEYBIND \-                   $TAG_KEYBINDLIST \-                   $TAG_LAYOUT \-                   $TAG_MOUSEBIND ; do--            ifs="$IFS"-            IFS=$'\n'-            tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") )-            IFS="${ifs}"--            case $tag in-                $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP-                                    ins_marker=$INS_MARKER_CABALBUILDDEP-                                    ins_prefix=$ACTIVE_INS_PREFIX_CABALBUILDDEP-                                    ;;-                $TAG_DEF)           ins_indent=$INS_INDENT_DEF-                                    ins_marker=$INS_MARKER_DEF-                                    ins_prefix=$INS_PREFIX_DEF-                                    ;;-                $TAG_IMPORT)        ins_indent=$INS_INDENT_IMPORT-                                    ins_marker=$INS_MARKER_IMPORT-                                    ins_prefix=$INS_PREFIX_IMPORT-                                    ;;-                $TAG_KEYBIND)       ins_indent=$INS_INDENT_KEYBIND-                                    ins_marker=$INS_MARKER_KEYBIND-                                    ins_prefix=$INS_PREFIX_KEYBIND-                                    ;;-                $TAG_KEYBINDLIST)   ins_indent=$INS_INDENT_KEYBINDLIST-                                    ins_marker=$INS_MARKER_KEYBINDLIST-                                    ins_prefix=$INS_PREFIX_KEYBINDLIST-                                    ;;-                $TAG_LAYOUT)        ins_indent=$INS_INDENT_LAYOUT-                                    ins_marker=$INS_MARKER_LAYOUT-                                    ins_prefix=$INS_PREFIX_LAYOUT-                                    ;;-                $TAG_MOUSEBIND)     ins_indent=$INS_INDENT_MOUSEBIND-                                    ins_marker=$INS_MARKER_MOUSEBIND-                                    ins_prefix=$INS_PREFIX_MOUSEBIND-                                    ;;-            esac--            # Insert in reverse so values will ultimately appear in correct order.-            for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do-                [ -z "${tags[i]}" ] && continue-                if [[ $tag == $TAG_CABALBUILDDEP ]] ; then-                    sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE}"-                else-                    sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE}"-                fi-            done--            if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then-                ins_group_comment="${ins_indent}--   For extension $(basename $extension_srcfile .hs):"-                sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE}"-            fi-        done-    done-}--parse_opts() {-    [[ -z "$1" ]] && show_usage 1--    while [[ $# > 0 ]] ; do-        case "$1" in-            --active|-a)  opt_active=1-                          shift ;;--            --contrib|-c) shift-                          if [[ -z "$1" || ! -d "$1" ]] ; then-                              echo "Error: Option --contrib requires a directory as argument. See: generate-configs -h"-                              exit 1-                          fi-                          opt_contrib="$1"-                          shift ;;--            --help|-h)    show_usage ;;--            --main|-m)    shift-                          if [[ -z "$1" || ! -d "$1" ]] ; then-                              echo "Error: Option --main requires a directory as argument. See: generate-configs -h"-                              exit 1-                          fi-                          opt_main="$1"-                          shift ;;--            --output|-o)  shift-                          if [[ -z "$1" || ! -d "$1" ]] ; then-                              echo "Error: Option --output requires a directory as argument. See: generate-configs -h"-                              exit 1-                          fi-                          opt_output="$1"-                          shift ;;--            -*)           echo "Error: Unknown option ${1}. See: generate-configs -h"-                          exit 1 ;;--            *)            show_usage 1 ;;-        esac-    done--    if [[ -z "$opt_main" ]] ; then-      echo "Error: Missing required option --main. See: generate-configs -h"-      exit 1-    fi--    if [[ -z "$opt_contrib" ]] ; then-      echo "Error: Missing required option --contrib. See: generate-configs -h"-      exit 1-    fi-}--show_usage() {-cat << EOF-Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR--OPTIONS:-  --active,  -a              Insert data in active mode (default: passive)-  --contrib, -c CONTRIB_DIR  Path to contrib repository base directory-  --help,    -h              Show help-  --main,    -m MAIN_DIR     Path to main repository base directory-  --output,  -o OUTPUT_DIR   Output directory (default: CONTRIB_DIR)-EOF-    exit ${1:-0}-}--parse_opts $*--[[ -z "$opt_output" ]] && opt_output="$opt_contrib"--CABAL_FILE="${opt_output}/xmonad.cabal"-CONFIG_FILE="${opt_output}/Config.hs"--cp -f "${opt_main}/xmonad.cabal" "${CABAL_FILE}"-cp -f "${opt_main}/Config.hs" "${CONFIG_FILE}"--if [[ $opt_active == 1 ]] ; then-    INS_PREFIX_DEF=$ACTIVE_INS_PREFIX_DEF-    INS_PREFIX_IMPORT=$ACTIVE_INS_PREFIX_IMPORT-    INS_PREFIX_KEYBIND=$ACTIVE_INS_PREFIX_KEYBIND-    INS_PREFIX_KEYBINDLIST=$ACTIVE_INS_PREFIX_KEYBINDLIST-    INS_PREFIX_LAYOUT=$ACTIVE_INS_PREFIX_LAYOUT-    INS_PREFIX_MOUSEBIND=$ACTIVE_INS_PREFIX_MOUSEBIND-fi--generate_configs
+ scripts/xmonadctl.hs view
@@ -0,0 +1,73 @@+#!/usr/bin/env runhaskell++-- Copyright: (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007+-- License: BSD-style (see xmonad/LICENSE)+--+-- Compile with @ghc --make xmonadctl.hs@+-- For usage help, do @xmonadctl -h@++import Control.Monad+import Data.Char+import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras+import System.Environment+import System.IO++main :: IO ()+main = parse True "XMONAD_COMMAND" =<< getArgs++parse :: Bool -> String -> [String] -> IO ()+parse input addr args = case args of+        ["--"] | input -> repl addr+               | otherwise -> return ()+        ("--":xs) -> sendAll addr xs+        ("-a":a:xs) -> parse input a xs+        ("-h":_) -> showHelp+        ("--help":_) -> showHelp+        ("-?":_) -> showHelp+        (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a)++        (x:xs) -> sendCommand addr x >> parse False addr xs+        [] | input -> repl addr+           | otherwise -> return ()+++repl :: String -> IO ()+repl addr = do e <- isEOF+               unless e $ do+                 l <- getLine+                 sendCommand addr l+                 repl addr++sendAll :: String -> [String] -> IO ()+sendAll addr = foldr (\a b -> sendCommand addr a >> b) (return ())++sendCommand :: String -> String -> IO ()+sendCommand addr s = do+  d   <- openDisplay ""+  rw  <- rootWindow d $ defaultScreen d+  a <- internAtom d addr False+  m <- internAtom d s False+  allocaXEvent $ \e -> do+                  setEventType e clientMessage+                  setClientMessageEvent e rw a 32 m 0+                  sendEvent d rw False structureNotifyMask e+                  sync d False++showHelp :: IO ()+showHelp = do+    pn <- getProgName+    mapM_ putStrLn+        [ "Send commands to a running instance of xmonad."+        , "(xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.)"+        , ""+        , "-a atomname can be used at any point in the command line arguments to"+        , "change which atom it is sending on. The atom defaults to XMONAD_COMMAND."+        , ""+        , "If sent with no arguments or only -a atom arguments, it will read commands from stdin."+        , ""+        , "Ex:"+        , pn ++ " cmd1 cmd2"+        , pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world"+        , pn ++ " -a XMONAD_PRINT # will read data from stdin."+        ]
+ scripts/xmonadpropread.hs view
@@ -0,0 +1,58 @@+#!/usr/bin/env runhaskell++{-# LANGUAGE LambdaCase #-}++-- Copyright Spencer Janssen <spencerjanssen@gmail.com>+-- BSD3 (see LICENSE)+--+-- Reads from an X property on the root window and writes to standard output.+--+-- May be used together with XMonad.Hooks.StatusBar.xmonadPropLog and a+-- status bar that doesn't support reading from properties itself, such as+-- dzen.+--+-- Usage:+--+--  $ xmonadpropread | dzen2+--+-- or+--+--  $ xmonadpropread _XMONAD_LOG_CUSTOM | dzen2++import Control.Monad+import Graphics.X11+import Graphics.X11.Xlib.Extras+import Codec.Binary.UTF8.String as UTF8+import Foreign.C (CChar)+import System.Environment+import System.IO++main :: IO ()+main = do+    hSetBuffering stdout LineBuffering++    atom <- flip fmap getArgs $ \case+        [a] -> a+        _   -> "_XMONAD_LOG"++    d <- openDisplay ""+    xlog <- internAtom d atom False++    root  <- rootWindow d (defaultScreen d)+    selectInput d root propertyChangeMask++    let printProp = do+            mwp <- getWindowProperty8 d xlog root+            maybe (return ()) (putStrLn . decodeCChar) mwp++    printProp++    allocaXEvent $ \ep -> forever $ do+        nextEvent d ep+        e <- getEvent ep+        case e of+            PropertyEvent { ev_atom = a } | a ==  xlog -> printProp+            _ -> return ()++decodeCChar :: [CChar] -> String+decodeCChar = UTF8.decode . map fromIntegral
+ tests/CycleRecentWS.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS_GHC -Wall #-}+module CycleRecentWS where++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck++import XMonad.Actions.CycleRecentWS (unView)+import XMonad.StackSet (view, greedyView, mapLayout)++import Instances+import Utils (tags)++spec :: Spec+spec = do+    prop "prop_unView" prop_unView++prop_unView :: T -> Property+prop_unView ss = conjoin+    [ counterexample desc (unView ss (state (v t ss)) === state ss)+    | t <- tags ss+    , (desc, v) <- [("view " <> show t, view), ("greedyView " <> show t, greedyView)] ]+  where+    state = mapLayout succ
+ tests/EZConfig.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE DerivingStrategies         #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE ViewPatterns               #-}+module EZConfig (spec) where++import Control.Arrow (first, (>>>))+import Data.Coerce+import Foreign.C.Types (CUInt(..))+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import XMonad+import XMonad.Prelude+import XMonad.Util.EZConfig+import XMonad.Util.Parser++spec :: Spec+spec = do+  prop "prop_decodePreservation" prop_decodePreservation+  prop "prop_encodePreservation" prop_encodePreservation++  context "parseKey" $ do+    let prepare = unzip . map (first surround)+        testParseKey (ns, ks) = traverse (runParser parseKey) ns `shouldBe` Just ks+    it "parses all regular keys"    $ testParseKey (unzip   regularKeys   )+    it "parses all function keys"   $ testParseKey (prepare functionKeys  )+    it "parses all special keys"    $ testParseKey (prepare specialKeys   )+    it "parses all multimedia keys" $ testParseKey (prepare multimediaKeys)+  context "parseModifier" $ do+    it "parses all combinations of modifiers" $+      nub . map sort <$> traverse (runParser (many $ parseModifier def))+                                     modifiers+        `shouldBe` Just [[ shiftMask, controlMask+                         , mod1Mask, mod1Mask      -- def M and M1+                         , mod2Mask, mod3Mask, mod4Mask, mod5Mask+                         ]]++  -- Checking for regressions+  describe "readKeySequence" $+    it "Fails on the non-existent key M-10" $+      readKeySequence def "M-10" `shouldBe` Nothing++-- | Parsing preserves all info that printing does.+prop_encodePreservation :: KeyString -> Property+prop_encodePreservation (coerce -> s) = parse s === (parse . pp =<< parse s)+ where parse = runParser (parseKeySequence def)+       pp    = unwords . map keyToString++-- | Printing preserves all info that parsing does.+prop_decodePreservation :: NonEmptyList (AKeyMask, AKeySym) -> Property+prop_decodePreservation (getNonEmpty >>> coerce -> xs) =+  Just (pp xs) === (fmap pp . parse $ pp xs)+ where parse = runParser (parseKeySequence def)+       pp    = unwords . map keyToString++-- | QuickCheck can handle the 8! combinations just fine.+modifiers :: [String]+modifiers = map concat $ permutations mods++mods :: [String]+mods = ["M-", "C-", "S-", "M1-", "M2-", "M3-", "M4-", "M5-"]++surround :: String -> String+surround s = "<" <> s <> ">"++-----------------------------------------------------------------------+-- Newtypes and Arbitrary instances++newtype AKeyMask = AKeyMask KeyMask+  deriving newtype (Show)++instance Arbitrary AKeyMask where+  arbitrary :: Gen AKeyMask+  arbitrary = fmap (coerce . sum . nub) . listOf . elements $+    [noModMask, shiftMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask]++newtype AKeySym = AKeySym KeySym+  deriving newtype (Show)++instance Arbitrary AKeySym where+  arbitrary :: Gen AKeySym+  arbitrary = elements . coerce . map snd $ regularKeys <> allSpecialKeys++newtype KeyString = KeyString String+  deriving newtype (Show)++instance Arbitrary KeyString where+  arbitrary :: Gen KeyString+  arbitrary = coerce . unwords <$> listOf keybinding+   where+    keybinding :: Gen String+    keybinding = do+      let keyStr = map fst $ regularKeys <> allSpecialKeys+      mks <- nub <$> listOf (elements ("" : mods))+      k   <- elements keyStr+      ks  <- listOf . elements $ keyStr+      pure $ concat mks <> k <> " " <> unwords ks
+ tests/ExtensibleConf.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_GHC -Wall #-}+module ExtensibleConf where++import Test.Hspec++import XMonad+import qualified XMonad.Util.ExtensibleConf as XC++spec :: Spec+spec = do+    specify "lookup" $+        XC.lookup def `shouldBe` (Nothing :: Maybe ())+    specify "lookup . add" $+        XC.lookup (XC.add "a" def) `shouldBe` Just "a"+    specify "lookup . add . add" $+        XC.lookup (XC.add "b" (XC.add "a" def)) `shouldBe` Just "ab"+    specify "lookup @String . add @String . add @[Int]" $+        XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` Just "a"+    specify "lookup @[Int] . add @String . add @[Int]" $+        XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` Just [1 :: Int]+    specify "lookup @() . add @String . add @[Int]" $+        XC.lookup (XC.add "a" (XC.add [1 :: Int] def)) `shouldBe` (Nothing :: Maybe ())++    specify "once" $ do+        let c = XC.once incBorderWidth "a" def+        borderWidth c `shouldBe` succ (borderWidth def)+        XC.lookup c `shouldBe` Just "a"+    specify "once . once" $ do+        let c = XC.once incBorderWidth "b" (XC.once incBorderWidth "a" def)+        borderWidth c `shouldBe` succ (borderWidth def)+        XC.lookup c `shouldBe` Just "ab"++    specify "modifyDef" $ do+        let c = XC.modifyDef (<> "a") def+        XC.lookup c `shouldBe` Just "a"+    specify "modifyDef . modifyDef" $ do+        let c = XC.modifyDef (<> "b") (XC.modifyDef (<> "a") def)+        XC.lookup c `shouldBe` Just "ab"++incBorderWidth :: XConfig l -> XConfig l+incBorderWidth c = c{ borderWidth = succ (borderWidth c) }
+ tests/GridSelect.hs view
@@ -0,0 +1,15 @@+module GridSelect where++import Test.Hspec+import Test.Hspec.QuickCheck++import XMonad.Actions.GridSelect++spec :: Spec+spec = do+  prop "prop_stringToRatio_valuesInRange"  prop_stringToRatio_valuesInRange++prop_stringToRatio_valuesInRange :: String -> Bool+prop_stringToRatio_valuesInRange s =+  let r = stringToRatio s+  in r >= 0 && r <= 1
+ tests/Instances.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Instances where -- copied (and adapted) from the core library+++import           XMonad.Hooks.ManageDocks+import           XMonad.Layout.LimitWindows+import           Test.QuickCheck+import           Utils++import           XMonad.StackSet+import           Control.Monad+import           Data.List                      ( nub )++import           Graphics.X11                   ( Rectangle(Rectangle) )++arbNat :: Gen Int+arbNat = abs <$> arbitrary++arbPos :: Gen Int+arbPos = (+ 1) . abs <$> arbitrary++instance Arbitrary (Stack Int) where+  arbitrary = do+    xs <- arbNat+    ys <- arbNat+    return $ Stack { up    = [xs - 1, xs - 2 .. 0]+                   , focus = xs+                   , down  = [xs + 1 .. xs + ys]+                   }++instance Arbitrary (Selection a) where+  arbitrary = do+    nm <- arbNat+    st <- arbNat+    Sel nm (st + nm) <$> arbPos++--+-- The all important Arbitrary instance for StackSet.+--+instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)+         => Arbitrary (StackSet i l a s sd) where+  arbitrary = do+      -- TODO: Fix this to be a reasonable higher number, Possibly use PositiveSized+    numWs        <- choose (1, 20)    -- number of workspaces, there must be at least 1.+    numScreens   <- choose (1, numWs) -- number of physical screens, there must be at least 1+    lay          <- arbitrary                  -- pick any layout++    wsIdxInFocus <- choose (1, numWs) -- pick index of WS to be in focus++    -- The same screen id's will be present in the list, with high possibility.+    screenDims   <- replicateM numScreens arbitrary++    -- Generate a list of "windows" for each workspace.+    wsWindows    <- vector numWs :: Gen [[a]]++    -- Pick a random window "number" in each workspace, to give focus.+    foc          <- sequence+      [ if null windows+          then return Nothing+          else Just <$> choose (0, length windows - 1)+      | windows <- wsWindows+      ]++    let tags'          = [1 .. fromIntegral numWs]+        focusWsWindows = zip foc wsWindows+        wss            = zip tags' focusWsWindows -- tmp representation of a workspace (tag, windows)+        initSs         = new lay tags' screenDims+    return $ view (fromIntegral wsIdxInFocus) $ foldr+      (\(tag', (focus', windows)) ss -> -- Fold through all generated (tags,windows).+              -- set workspace active by tag and fold through all+              -- windows while inserting them.  Apply the given number+              -- of `focusUp` on the resulting StackSet.+        applyN focus' focusUp $ foldr insertUp (view tag' ss) windows+      )+      initSs+      wss+++--+-- Just generate StackSets with Char elements.+--+type Tag = Int+type Window = Char+type T = StackSet Tag Int Window Int Int++++newtype EmptyStackSet = EmptyStackSet T+    deriving Show++instance Arbitrary EmptyStackSet where+  arbitrary = do+    (NonEmptyNubList ns ) <- arbitrary+    (NonEmptyNubList sds) <- arbitrary+    l                     <- arbitrary+    -- there cannot be more screens than workspaces:+    return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds++++newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T+    deriving Show++instance Arbitrary NonEmptyWindowsStackSet where+  arbitrary =+    NonEmptyWindowsStackSet+      `fmap` (arbitrary `suchThat` (not . null . allWindows))++instance Arbitrary RectC where+  arbitrary = do+    (x :: Int, y :: Int) <- arbitrary+    NonNegative w        <- arbitrary+    NonNegative h        <- arbitrary+    return $ RectC+      ( fromIntegral x+      , fromIntegral y+      , fromIntegral $ x + w+      , fromIntegral $ y + h+      )++instance Arbitrary Rectangle where+  arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary RationalRect where+  arbitrary = RationalRect <$> dim <*> dim <*> dim <*> dim+   where+    dim = arbitrary `suchThat` liftM2 (&&) (>= 0) (<= 1)++newtype SizedPositive = SizedPositive Int+    deriving (Eq, Ord, Show, Read)++instance Arbitrary SizedPositive where+  arbitrary = sized $ \s -> do+    x <- choose (1, max 1 s)+    return $ SizedPositive x++++newtype NonEmptyNubList a = NonEmptyNubList [a]+    deriving ( Eq, Ord, Show, Read )++instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where+  arbitrary =+    NonEmptyNubList `fmap` (fmap nub arbitrary `suchThat` (not . null))++++-- | Pull out an arbitrary tag from the StackSet. This removes the need for the+-- precondition "n `tagMember x` in many properties and thus reduces the number+-- of discarded tests.+--+--  n <- arbitraryTag x+--+-- We can do the reverse with a simple `suchThat`:+--+-- n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x+arbitraryTag :: T -> Gen Tag+arbitraryTag x = do+  let ts = tags x+  -- There must be at least 1 workspace, thus at least 1 tag.+  idx <- choose (0, length ts - 1)+  return $ ts !! idx++-- | Pull out an arbitrary window from a StackSet that is guaranteed to have a+-- non empty set of windows. This eliminates the precondition "i `member` x" in+-- a few properties.+--+--+-- foo (nex :: NonEmptyWindowsStackSet) = do+--   let NonEmptyWindowsStackSet x = nex+--   w <- arbitraryWindow nex+--   return $ .......+--+-- We can do the reverse with a simple `suchThat`:+--+--   n <- arbitrary `suchThat` \n' -> not $ n `member` x+arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window+arbitraryWindow (NonEmptyWindowsStackSet x) = do+  let ws = allWindows x+  -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.+  idx <- choose (0, length ws - 1)+  return $ ws !! idx
+ tests/Main.hs view
@@ -0,0 +1,57 @@+module Main where++import Test.Hspec+import Test.Hspec.QuickCheck++import qualified ExtensibleConf+import qualified ManageDocks+import qualified NoBorders+import qualified RotateSome+import qualified Selective+import qualified SwapWorkspaces+import qualified XPrompt+import qualified CycleRecentWS+import qualified OrgMode+import qualified GridSelect+import qualified EZConfig+import qualified WindowNavigation++main :: IO ()+main = hspec $ do+    context "ManageDocks" $ do+        prop "prop_r2c_c2r" ManageDocks.prop_r2c_c2r+        prop "prop_c2r_r2c" ManageDocks.prop_c2r_r2c+    context "Selective" $ do+        prop "prop_select_length"     Selective.prop_select_length+        prop "prop_update_idem"       Selective.prop_update_idem+        prop "prop_select_master"     Selective.prop_select_master+        prop "prop_select_focus"      Selective.prop_select_focus+        prop "prop_select_increasing" Selective.prop_select_increasing+        prop "prop_select_two_consec" Selective.prop_select_two_consec+        prop "prop_update_nm"         Selective.prop_update_nm+        prop "prop_update_start"      Selective.prop_update_start+        prop "prop_update_nr"         Selective.prop_update_nr+        prop "prop_update_focus_up"   Selective.prop_update_focus_up+        prop "prop_update_focus_down" Selective.prop_update_focus_down+    context "RotateSome" $ do+        prop "prop_rotate_some_length"  RotateSome.prop_rotate_some_length+        prop "prop_rotate_some_cycle"   RotateSome.prop_rotate_some_cycle+        prop "prop_rotate_some_anchors" RotateSome.prop_rotate_some_anchors+        prop "prop_rotate_some_rotate"  RotateSome.prop_rotate_some_rotate+        prop "prop_rotate_some_focus"   RotateSome.prop_rotate_some_focus+    context "SwapWorkspaces" $ do+        prop "prop_double_swap"       SwapWorkspaces.prop_double_swap+        prop "prop_invalid_swap"      SwapWorkspaces.prop_invalid_swap+        prop "prop_swap_only_two"     SwapWorkspaces.prop_swap_only_two+        prop "prop_swap_with_current" SwapWorkspaces.prop_swap_with_current+    context "XPrompt" $ do+        prop "prop_split"            XPrompt.prop_split+        prop "prop_spliInSubListsAt" XPrompt.prop_spliInSubListsAt+        prop "prop_skipGetLastWord"  XPrompt.prop_skipGetLastWord+    context "NoBorders"      NoBorders.spec+    context "ExtensibleConf" ExtensibleConf.spec+    context "CycleRecentWS"  CycleRecentWS.spec+    context "OrgMode"        OrgMode.spec+    context "GridSelect"     GridSelect.spec+    context "EZConfig"       EZConfig.spec+    context "WindowNavigation" WindowNavigation.spec
tests/ManageDocks.hs view
@@ -1,18 +1,6 @@ module ManageDocks where-import XMonad-import XMonad.Hooks.ManageDocks-import Test.QuickCheck-import Foreign.C.Types-import Properties--instance Arbitrary CLong where-    arbitrary = fromIntegral `fmap` (arbitrary :: Gen Int)-instance Arbitrary RectC where-    arbitrary = do-        (x,y) <- arbitrary-        NonNegative w <- arbitrary-        NonNegative h <- arbitrary-        return $ RectC (x,y,x+w,y+h)+import           XMonad                         ( Rectangle )+import           XMonad.Hooks.ManageDocks  prop_r2c_c2r :: RectC -> Bool prop_r2c_c2r r = r2c (c2r r) == r
+ tests/NoBorders.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE ViewPatterns    #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wall #-}+module NoBorders where++import Instances ()+import Test.Hspec+import Test.Hspec.QuickCheck++import qualified Data.Map as M++import XMonad hiding (Screen)+import qualified XMonad.Layout.NoBorders as NB+import XMonad.Prelude+import XMonad.StackSet++spec :: Spec+spec = do+    describe "dualhead, fullscreen float on each" $ do+        let s1 = differentiate [1]+        let s2 = differentiate [2]+        let floats = [(1, rrFull), (2, rrFull)]+        let ws = wsDualHead s1 s2 floats+        context "Ambiguity(Never)" $ do+            let amb = NB.Never+            it "removes border on current screen" $ do+                NB.hiddens amb ws r1 s1 [] `shouldBe` [1]+                NB.hiddens amb ws r3 s1 [] `shouldBe` [1]+            it "removes border on visible screen" $ do+                NB.hiddens amb ws r2 s2 [] `shouldBe` [2]+                NB.hiddens amb ws r4 s2 [] `shouldBe` [2]+        context "Ambiguity(OnlyScreenFloat)" $ do+            let amb = NB.OnlyScreenFloat+            it "removes border on current screen" $ do+                NB.hiddens amb ws r1 s1 [] `shouldBe` [1]+                NB.hiddens amb ws r3 s1 [] `shouldBe` [1]+            it "removes border on visible screen" $ do+                NB.hiddens amb ws r2 s2 [] `shouldBe` [2]+                NB.hiddens amb ws r4 s2 [] `shouldBe` [2]+        context "Ambiguity(OnlyLayoutFloat)" $ do+            let amb = NB.OnlyLayoutFloat+            it "removes border on current screen" $ do+                NB.hiddens amb ws r1 s1 [] `shouldBe` [1]+            it "removes border on visible screen" $ do+                NB.hiddens amb ws r2 s2 [] `shouldBe` [2]+        prop "prop_OnlyFloat" prop_OnlyFloat++-- | All floating windows should be borderless.+prop_OnlyFloat+    :: [Window]       -- ^ Windows on the first monitor+    -> [Window]       -- ^ Windows on the second monitor+    -> [RationalRect] -- ^ Floating window rectangles+    -> Bool           -- ^ Whether to consider focused or visible screen+    -> Bool+prop_OnlyFloat (nub -> w1) (nub -> w2) frs b+     = sort (w `intersect` map fst floats)+    == sort (NB.hiddens NB.OnlyFloat ws r (differentiate w) [])+  where+    (w, w', r) = if b then (w1, w2, r1) else (w2, w1, r2)+    ws         = wsDualHead (differentiate w1) (differentiate w2) floats+    floats     = zip (interleave w w') frs++    interleave :: [a] -> [a] -> [a]+    interleave (x : xs) (y : ys) = x : y : interleave xs ys+    interleave []       ys       = ys+    interleave xs       []       = xs++-- +------+------++-- |  r1  |  r2  |+-- |      |      |+-- |+----+|+----+|+-- || r3 ||| r4 ||+-- |+----+|+----+|+-- +------+------++r1, r2, r3, r4 :: Rectangle+r1 = Rectangle   0  0 100 100+r2 = Rectangle 100  0 100 100+r3 = Rectangle  10 10  80  80+r4 = Rectangle 110 10  80  80++rrFull :: RationalRect+rrFull = RationalRect 0 0 1 1++-- | Current screen @r1@ with window stack @w1@,+-- visible screen @r2@ with ws @w2@,+-- no hidden screens, maybe some floats.+wsDualHead :: Maybe (Stack Window) -> Maybe (Stack Window)+           -> [(Window, RationalRect)] -> WindowSet+wsDualHead w1 w2 f = StackSet{..}+    where+        current = mkScreen 1 r1 w1; visible = [mkScreen 2 r2 w2]; hidden = []+        floating = M.fromList f++mkScreen :: ScreenId -> Rectangle -> Maybe (Stack Window)+         -> Screen WorkspaceId l Window ScreenId ScreenDetail+mkScreen i r s = Screen{ workspace = w, screen = i, screenDetail = sd }+    where+        w = Workspace{ tag = show i, layout = undefined, stack = s }+        sd = SD{ screenRect = r }
+ tests/OrgMode.hs view
@@ -0,0 +1,250 @@+{-# OPTIONS_GHC -Wno-orphans             #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+{-# LANGUAGE InstanceSigs       #-}+{-# LANGUAGE TypeApplications   #-}+{-# LANGUAGE TupleSections      #-}+{-# LANGUAGE LambdaCase         #-}+module OrgMode where++import XMonad.Prelude hiding ((!?))+import XMonad.Prompt.OrgMode++import qualified Data.Map.Strict as Map++import Data.Map.Strict (Map, (!), (!?))+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+++spec :: Spec+spec = do+  prop "prop_encodePreservation" prop_encodePreservation+  prop "prop_decodePreservation" prop_decodePreservation++  -- Checking for regressions+  describe "pInput" $ do+    it "works with todo +d 22 january 2021" $ do+      pInput "todo +d 22 ja 2021"+        `shouldBe` Just+          ( Deadline+              "todo"+              (Time {date = Date (22, Just 1, Just 2021), tod = Nothing})+              NoPriority+          )+    it "works with todo +d 22 01 2022" $ do+      pInput "todo +d 22 01 2022"+        `shouldBe` Just+          ( Deadline+              "todo"+              (Time {date = Date (22, Just 1, Just 2022), tod = Nothing})+              NoPriority+          )+    it "works with todo +d 1 01:01" $ do+      pInput "todo +d 1 01:01"+        `shouldBe` Just+          ( Deadline+              "todo"+              (Time {date = Date (1, Nothing, Nothing), tod = Just $ MomentInTime(HHMM 1 1)})+              NoPriority+          )+    it "works with todo +d 22 jan 2021 01:01 #b" $ do+      pInput "todo +d 22 jan 2021 01:01 #b"+        `shouldBe` Just+          ( Deadline+                "todo"+                (Time {date = Date (22, Just 1, Just 2021), tod = Just $ MomentInTime(HHMM 1 1)})+                B+          )+    it "parses no day as today when given a time" $ do+      pInput "todo +s 12:00"+        `shouldBe` Just (Scheduled "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 12 0)}) NoPriority)+      pInput "todo +d 14:05 #B"+        `shouldBe` Just (Deadline "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 14 5)}) B)+    it "parses `blah+d`, `blah +d`, `blah +d `, and `blah +d #B` as normal messages" $ do+      pInput "blah+d"+        `shouldBe` Just (NormalMsg "blah+d" NoPriority)+      pInput "blah +d"+        `shouldBe` Just (NormalMsg "blah +d" NoPriority)+      pInput "blah +d "+        `shouldBe` Just (NormalMsg "blah +d " NoPriority)+      pInput "blah +d #B"+        `shouldBe` Just (NormalMsg "blah +d" B)++  context "no priority#b" $ do+    it "parses to the correct thing" $+      pInput "no priority#b"+        `shouldBe` Just (NormalMsg "no priority#b" NoPriority)+    it "encode" $ prop_encodePreservation (OrgMsg "no priority#b")+    it "decode" $ prop_decodePreservation (NormalMsg "no priority#b" NoPriority)++  context "+d +d f" $ do+    it "encode" $ prop_encodePreservation (OrgMsg "+d +d f")+    it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}) NoPriority)+  context "+d f 1 +d f #c" $ do+    it "encode" $ prop_encodePreservation (OrgMsg "+d +d f")+    it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}) C)+  context "+d f 1 +d f" $ do+    it "encode" $ prop_encodePreservation (OrgMsg "+d f 1 +d f")+    it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}) NoPriority)+  context "+d f 1 +d f #b" $ do+    it "encode" $ prop_encodePreservation (OrgMsg "+d f 1 +d f #b")+    it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}) B)++-- | Parsing preserves all info that printing does.+prop_encodePreservation :: OrgMsg -> Property+prop_encodePreservation (OrgMsg s) = pInput s === (pInput . ppNote =<< pInput s)++-- | Printing preserves all info that parsing does.+prop_decodePreservation :: Note -> Property+prop_decodePreservation n = Just (ppNote n) === (fmap ppNote . pInput $ ppNote n)++------------------------------------------------------------------------+-- Pretty Printing++ppNote :: Note -> String+ppNote = \case+  Scheduled str t p -> str <> " +s " <> ppTime t <> ppPrio p+  Deadline  str t p -> str <> " +d " <> ppTime t <> ppPrio p+  NormalMsg str   p -> str                       <> ppPrio p++ppPrio :: Priority -> String+ppPrio = \case+  NoPriority -> ""+  prio       -> " #" <> show prio++ppTime :: Time -> String+ppTime (Time d t) = ppDate d <> ppOrgTime t+ where+  ppOrgTime :: Maybe OrgTime -> String+  ppOrgTime = maybe "" ((' ' :) . show)++  ppDate :: Date -> String+  ppDate dte = case days !? dte of+    Just v  -> v+    Nothing -> case d of -- only way it can't be in the map+      Date (d', mbM, mbY) -> show d'+                          <> maybe "" ((' ' :) . (months !)) mbM+                          <> maybe "" ((' ' :) . show)       mbY++------------------------------------------------------------------------+-- Arbitrary Instances++-- | An arbitrary (correct) message string.+newtype OrgMsg = OrgMsg String+  deriving (Show)++instance Arbitrary OrgMsg where+  arbitrary :: Gen OrgMsg+  arbitrary+    = OrgMsg <$> randomString                                             -- note+            <<>> elements [" +s ", " +d ", ""] <<>> dateGen <<>> hourGen  -- time and date+            <<>> elements ("" : map (reverse . (: " #")) "AaBbCc")        -- priority+   where+    dateGen :: Gen String+    dateGen = oneof+      [ pure $ days ! Today+      , pure $ days ! Tomorrow+      , elements $ (days !) . Next <$> [Monday .. Sunday]+      , rNat                                                   -- 17+      , unwords <$> sequenceA [rNat, monthGen]                 -- 17 jan+      , unwords <$> sequenceA [rNat, monthGen, rYear]          -- 17 jan 2021+      , unwords <$> traverse (fmap show) [rNat, rMonth]        -- 17 01+      , unwords <$> traverse (fmap show) [rNat, rMonth, rYear] -- 17 01 2021+      ]+     where+      rNat, rYear, rMonth :: Gen String+      rNat   = show <$> posInt+      rMonth = show <$> posInt `suchThat` (<= 12)+      rYear  = show <$> posInt `suchThat` (>  25)++      monthGen :: Gen String+      monthGen = elements $ Map.elems months++    hourGen :: Gen String+    hourGen = oneof+      [ pure " " <<>> (pad <$> hourInt) <<>> pure ":" <<>> (pad <$> minuteInt)+      , pure " " <<>> (pad <$> hourInt) <<>>               (pad <$> minuteInt)+      , pure ""+      ]+     where+      pad :: Int -> String+      pad n = (if n <= 9 then "0" else "") <> show n++instance Arbitrary Note where+  arbitrary :: Gen Note+  arbitrary = do+    msg <- randomString+    t   <- arbitrary+    p   <- arbitrary+    elements [Scheduled msg t p, Deadline msg t p, NormalMsg msg p]++instance Arbitrary Priority where+  arbitrary :: Gen Priority+  arbitrary = elements [A, B, C, NoPriority]++instance Arbitrary Time where+  arbitrary :: Gen Time+  arbitrary = Time <$> arbitrary <*> arbitrary++instance Arbitrary Date where+  arbitrary :: Gen Date+  arbitrary = oneof+    [ pure Today+    , pure Tomorrow+    , Next . toEnum <$> choose (0, 6)+    , do d <- posInt `suchThat` (<= 31)+         m <- mbPos `suchThat` (<= Just 12)+         Date . (d, m, ) <$> if   isNothing m+                             then pure Nothing+                             else mbPos `suchThat` (>= Just 25)+    ]++instance Arbitrary TimeOfDay where+  arbitrary :: Gen TimeOfDay+  arbitrary = HHMM <$> hourInt <*> minuteInt++instance Arbitrary OrgTime where+  arbitrary :: Gen OrgTime+  arbitrary = oneof+    [ MomentInTime <$> arbitrary+    , TimeSpan <$> arbitrary <*> arbitrary+    ]++------------------------------------------------------------------------+-- Util++randomString :: Gen String+randomString = listOf arbitraryPrintableChar <<>> (noSpace <&> (: []))+ where+  noSpace :: Gen Char+  noSpace = arbitraryPrintableChar `suchThat` (/= ' ')++days :: Map Date String+days = Map.fromList+  [ (Today, "tod"), (Tomorrow, "tom"), (Next Monday, "m"), (Next Tuesday, "tu")+  , (Next Wednesday, "w"), (Next Thursday, "th"), (Next Friday, "f")+  , (Next Saturday,"sa"), (Next Sunday,"su")+  ]++months :: Map Int String+months = Map.fromList+  [ (1, "ja"), (2, "f"), (3, "mar"), (4, "ap"), (5, "may"), (6, "jun")+  , (7, "jul"), (8, "au"), (9, "s"), (10, "o"), (11, "n"), (12, "d")+  ]++posInt :: Gen Int+posInt = getPositive <$> arbitrary @(Positive Int)++hourInt :: Gen Int+hourInt = posInt `suchThat` (<= 23)++minuteInt :: Gen Int+minuteInt = posInt `suchThat` (<= 59)++mbPos :: Num a => Gen (Maybe a)+mbPos = fmap (fromIntegral . getPositive) <$> arbitrary @(Maybe (Positive Int))++infixr 6 <<>>+(<<>>) :: (Applicative f, Monoid a) => f a -> f a -> f a+(<<>>) = liftA2 (<>)
+ tests/RotateSome.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module RotateSome where++import Utils+import Test.QuickCheck (Arbitrary, arbitrary, choose)+import XMonad.StackSet (Stack, integrate, up)+import XMonad.Actions.RotateSome (rotateSome)++newtype Divisor = Divisor Int deriving Show+instance Arbitrary Divisor where+  arbitrary = Divisor <$> choose (1, 5)++isMultOf :: Int -> Int -> Bool+x `isMultOf` n = (x `rem` n) == 0++-- Total number of elements does not change.+prop_rotate_some_length (Divisor d) (stk :: Stack Int) =+  length (integrate stk) == length (integrate $ rotateSome (`isMultOf` d) stk)++-- Applying rotateSome N times completes a cycle, where N is the number of+-- elements that satisfy the predicate.+prop_rotate_some_cycle (Divisor d) (stk :: Stack Int) =+  stk == applyN (Just n) (rotateSome (`isMultOf` d)) stk+  where+    n = length $ filter (`isMultOf` d) (integrate stk)++-- Elements that do not satisfy the predicate remain anchored in place.+prop_rotate_some_anchors (Divisor d) (stk :: Stack Int) =+  all check $+    zip+      (integrate stk)+      (integrate $ rotateSome (`isMultOf` d) stk)+  where+    check (before, after) = (before `isMultOf` d) || before == after++-- Elements that satisfy the predicate rotate by one position.+prop_rotate_some_rotate (Divisor d) (stk :: Stack Int) =+  drop 1 before ++ take 1 before == after+  where+    before = filter p (integrate stk)+    after = filter p (integrate $ rotateSome p stk)+    p = (`isMultOf` d)++-- Focus position is preserved.+prop_rotate_some_focus (Divisor d) (stk :: Stack Int) =+  length (up stk) == length (up $ rotateSome (`isMultOf` d) stk)
tests/Selective.hs view
@@ -1,36 +1,17 @@-{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Selective where  -- Tests for limitSelect-related code in L.LimitWindows. -- To run these tests, export (select,update,Selection(..),updateAndSelect) from -- L.LimitWindows. + import XMonad.Layout.LimitWindows import XMonad.StackSet hiding (focusUp, focusDown, filter)-import Control.Applicative ((<$>)) import Test.QuickCheck-import Control.Arrow (second) -instance Arbitrary (Stack Int) where-    arbitrary = do-                    xs <- arbNat-                    ys <- arbNat-                    return $ Stack { up=[xs-1,xs-2..0], focus=xs, down=[xs+1..xs+ys] }-    coarbitrary = undefined--instance Arbitrary (Selection a) where-    arbitrary = do-                    nm <- arbNat-                    st <- arbNat-                    nr <- arbPos-                    return $ Sel nm (st+nm) nr-    coarbitrary = undefined--arbNat = abs <$> arbitrary-arbPos = (+1) . abs <$> arbitrary---- as many windows as possible should be selected +-- as many windows as possible should be selected -- (when the selection is normalized) prop_select_length sel (stk :: Stack Int) =     (length . integrate $ select sel' stk) == ((nMaster sel' + nRest sel') `min` length (integrate stk))@@ -41,47 +22,58 @@     where sel' = update sel stk  -- select selects the master pane-prop_select_master sel (stk :: Stack Int) = +prop_select_master sel (stk :: Stack Int) =     take (nMaster sel) (integrate stk) == take (nMaster sel) (integrate $ select sel stk)  -- the focus should always be selected in normalized selections-prop_select_focus sel (stk :: Stack Int) = focus stk == (focus $ select sel' stk)+prop_select_focus sel (stk :: Stack Int) = focus stk == focus (select sel' stk)     where sel' = update sel stk  -- select doesn't change order (or duplicate elements) -- relies on the Arbitrary instance for Stack Int generating increasing stacks+prop_select_increasing :: Selection l -> Stack Int -> Bool prop_select_increasing sel (stk :: Stack Int) =     let res = integrate $ select sel stk-     in and . zipWith (<) res $ tail res+     in and . zipWith (<) res $ drop 1 res  -- selection has the form [0..l] ++ [m..n] -- relies on the Arbitrary instance for Stack Int generating stacks like [0..k]+prop_select_two_consec :: Selection l -> Stack Int -> Bool prop_select_two_consec sel (stk :: Stack Int) =     let wins = integrate $ select sel stk-     in (length . filter not . zipWith ((==) . (+1)) wins $ tail wins) <= 1+     in (length . filter not . zipWith ((==) . (+1)) wins $ drop 1 wins) <= 1  -- update preserves invariants on selections+prop_update_nm :: Selection l -> Stack Int -> Bool prop_update_nm sel (stk :: Stack Int) = nMaster (update sel stk) >= 0++prop_update_start :: Selection l -> Stack Int -> Bool prop_update_start sel (stk :: Stack Int) = nMaster sel' <= start sel'     where sel' = update sel stk++prop_update_nr :: Selection l -> Stack Int -> Bool prop_update_nr sel (stk :: Stack Int) = nRest (update sel stk) >= 0  -- moving the focus to a window that's already selected doesn't change the selection+prop_update_focus_up :: Selection l -> Stack Int -> Int -> Property prop_update_focus_up sel (stk :: Stack Int) x' =-    (length (up stk) >= x) && ((up stk !! (x-1)) `elem` integrate stk') ==> +    (length (up stk) >= x) && ((up stk !! (x-1)) `elem` integrate stk') ==>         sel' == update sel' (iterate focusUp stk !! x)     where         x = 1 + abs x'         sel' = update sel stk         stk' = select sel' stk +prop_update_focus_down :: Selection l -> Stack Int -> Int -> Property prop_update_focus_down sel (stk :: Stack Int) x' =-    (length (down stk) >= x) && ((down stk !! (x-1)) `elem` integrate stk') ==> +    (length (down stk) >= x) && ((down stk !! (x-1)) `elem` integrate stk') ==>         sel' == update sel' (iterate focusDown stk !! x)     where         x = 1 + abs x'         sel' = update sel stk         stk' = select sel' stk +focusUp :: Stack a -> Stack a focusUp stk = stk { up=tail (up stk), focus=head (up stk), down=focus stk:down stk }+focusDown :: Stack a -> Stack a focusDown stk = stk { down=tail (down stk), focus=head (down stk), up=focus stk:up stk }
tests/SwapWorkspaces.hs view
@@ -1,27 +1,29 @@ {-# LANGUAGE ScopedTypeVariables #-}-module SwapWorkspaces where+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -import Data.List(find,union)-import Data.Maybe(fromJust)+module SwapWorkspaces where+import Instances import Test.QuickCheck  import XMonad.StackSet-import Properties(T, NonNegative) -- requires tests/Properties.hs from xmonad-core import XMonad.Actions.SwapWorkspaces + -- Ensures that no "loss of information" can happen from a swap.-prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =-  t1 `tagMember` ss && t2 `tagMember` ss ==>-  ss == swap (swap ss)-  where swap = swapWorkspaces t1 t2+prop_double_swap (ss :: T) = do+  t1 <- arbitraryTag ss+  t2 <- arbitraryTag ss+  let swap = swapWorkspaces t1 t2+  return $ ss == swap (swap ss)  -- Degrade nicely when given invalid data.-prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =-  not (t1 `tagMember` ss || t2 `tagMember` ss) ==>-  ss == swapWorkspaces t1 t2 ss+prop_invalid_swap (ss :: T) = do+  t1 <- arbitrary `suchThat` (not . (`tagMember` ss))+  t2 <- arbitrary `suchThat` (not . (`tagMember` ss))+  return $ ss == swapWorkspaces t1 t2 ss  -- This doesn't pass yet. Probably should.--- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+-- prop_half_invalid_swap (ss :: T) (NonNegative t1) (NonNegative t2) = --   t1 `tagMember` ss && not (t2 `tagMember` ss) ==> --   ss == swapWorkspaces t1 t2 ss @@ -32,26 +34,15 @@                           zipWith f (hidden s)  (hidden t)  -- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.-prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =-  t1 `tagMember` ss && t2 `tagMember` ss ==>-  and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)-  where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2+prop_swap_only_two (ss :: T) = do+  t1 <- arbitraryTag ss+  t2 <- arbitraryTag ss+  let mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2+  return $ and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)  -- swapWithCurrent stays on current-prop_swap_with_current (ss :: T) (t :: NonNegative Int) =-  t `tagMember` ss ==>-  layout before == layout after && stack before == stack after-  where before = workspace $ current ss-        after  = workspace $ current $ swapWithCurrent t ss--main = do-  putStrLn "Testing double swap"-  quickCheck prop_double_swap-  putStrLn "Testing invalid swap"-  quickCheck prop_invalid_swap-  -- putStrLn "Testing half-invalid swap"-  -- quickCheck prop_half_invalid_swap-  putStrLn "Testing swap only two"-  quickCheck prop_swap_only_two-  putStrLn "Testing swap with current"-  quickCheck prop_swap_with_current+prop_swap_with_current (ss :: T) = do+  t <- arbitraryTag ss+  let before = workspace $ current ss+  let after  = workspace $ current $ swapWithCurrent t ss+  return $ layout before == layout after && stack before == stack after
+ tests/Utils.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE RankNTypes #-}+module Utils where -- copied from the core library++import XMonad.StackSet hiding (filter)+import Graphics.X11.Xlib.Types (Rectangle(..))+import Data.List (sortBy)++-- Useful operation, the non-local workspaces+hiddenSpaces :: StackSet i l a sid sd -> [Workspace i l a]+hiddenSpaces x = map workspace (visible x) ++ hidden x+++-- normalise workspace list+normal :: Ord i => StackSet i l a s sd -> StackSet i l a s sd+normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }+    where+        f a b = tag (workspace a) `compare` tag (workspace b)+        g a b = tag a `compare` tag b+++noOverlaps :: [Rectangle] -> Bool+noOverlaps []  = True+noOverlaps [_] = True+noOverlaps xs  = and [ verts a `notOverlap` verts b+                     | a <- xs+                     , b <- filter (a /=) xs+                     ]+    where+      verts (Rectangle a b w h) = (a,b,a + fromIntegral w - 1, b + fromIntegral h - 1)++      notOverlap (left1,bottom1,right1,top1)+                 (left2,bottom2,right2,top2)+        =  (top1 < bottom2 || top2 < bottom1)+        || (right1 < left2 || right2 < left1)+++applyN :: (Integral n) => Maybe n -> (a -> a) -> a -> a+applyN Nothing  _ v = v+applyN (Just 0) _ v = v+applyN (Just n) f v = applyN (Just $ n - 1) f (f v)++tags :: StackSet i l a sid sd -> [i]+tags x = map tag $ workspaces x+++-- | noOverflows op a b is True if @a `op` fromIntegral b@ overflows (or+-- otherwise gives the same answer when done using Integer+noOverflows :: (Integral b, Integral c) =>+  (forall a. Integral a => a -> a -> a) -> b -> c -> Bool+noOverflows op a b = toInteger (a `op` fromIntegral b) == toInteger a `op` toInteger b
+ tests/WindowNavigation.hs view
@@ -0,0 +1,635 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module WindowNavigation where++import Test.Hspec++import qualified Data.Map as M+import qualified Data.Set as S+import Data.Functor.Identity++import XMonad+import XMonad.Util.Types (Direction2D(..))+import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState)+import qualified XMonad.StackSet as W++spec :: Spec+spec = do+  it "two-window adjacent go right (empty state)" $ do+    -- Simplest case - just move the focus once.+    -- ┌─────┬──────┐+    -- │ 1 ──┼─►  2 │+    -- └─────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)+    runNav R M.empty (mkws 1 [] [2])+      `shouldBe` (mkstate 960 640, mkws 2 [1] [])++  it "two-window adjacent go right (populated state)" $ do+    -- Like the previous test, but this time internal stat is already populated with a position.+    -- ┌─────┬──────┐+    -- │ 1 ──┼─►  2 │+    -- └─────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)+    runNav R (mkstate 100 100) (mkws 1 [] [2])+      `shouldBe` (mkstate 960 100, mkws 2 [1] [])++  it "two-window adjacent go right (incorrectly-populated state)" $ do+    -- This time we set the position incorrectly, testing if it will be reset to the center of focused window.+    -- ┌─────┬──────┐+    -- │ 1 ──┼─►  2 │+    -- └─────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)+    runNav R (mkstate 1000 100) (mkws 1 [] [2])+      `shouldBe` (mkstate 960 640, mkws 2 [1] [])++  it "swap windows" $ do+    -- Swap windows around.+    -- ┌─────┬──────┐+    -- │ 1 ◄─┼─►  2 │+    -- └─────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          ]+    runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))+      `shouldBe` (mkstate 960 640, mkws 1 [2] [])++  it "tall layout, go up" $ do+    -- ┌─────┬─────┐+    -- │     │ 2 ▲ │+    -- │  1  ├───┼─┤+    -- │     │ 3 │ │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 640)+          , (3, Rectangle 960 640 960 640)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect)+    runNav U M.empty (mkws 3 [] [1, 2])+      `shouldBe` (mkstate 1440 639, mkws 2 [1, 3] [])++  it "tall layout, go down" $ do+    -- ┌─────┬─────┐+    -- │     │ 2   │+    -- │     ├─────┤+    -- │  1  │ 3 │ │+    -- │     ├───┼─┤+    -- │     │ 4 ▼ │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    runNav D M.empty (mkws 3 [] [1, 2, 4])+      `shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] [])++  it "tall layout, go left" $ do+    -- ┌─────┬─────┐+    -- │   ◄─┼── 2 │+    -- │     ├─────┤+    -- │ 1   │   3 │+    -- │     ├─────┤+    -- │     │   4 │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    runNav L M.empty (mkws 2 [] [1, 3, 4])+      `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])++  it "tall layout, go left and then right (window 2)" $ do+    -- ┌─────┬─────┐+    -- │   ◄─┼── 2 │+    -- │   ──┼─►   │+    -- │     ├─────┤+    -- │ 1   │   3 │+    -- │     ├─────┤+    -- │     │   4 │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4])+    (st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4])++  it "tall layout, go left and then right (window 3)" $ do+    -- ┌─────┬─────┐+    -- │     │   2 │+    -- │     ├─────┤+    -- │ 1 ◄─┼── 3 │+    -- │   ──┼─►   │+    -- │     ├─────┤+    -- │     │   4 │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4])+    (st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4])++  it "tall layout, go left and then right (window 4)" $ do+    -- ┌─────┬─────┐+    -- │     │   2 │+    -- │     ├─────┤+    -- │ 1   │   3 │+    -- │     ├─────┤+    -- │   ◄─┼── 4 │+    -- │   ──┼─►   │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3])+    (st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3])++  it "grid layout, go in a circle" $ do+    -- ┌─────┬─────┐+    -- │ 1 ──┼─► 2 │+    -- │     │     │+    -- │ ▲   │   │ │+    -- ├─┼───┼───┼─┤+    -- │ │   │   ▼ │+    -- │     │     │+    -- │ 3 ◄─┼── 4 │+    -- └─────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 640)+          , (2, Rectangle 960 0 960 640)+          , (3, Rectangle 0 640 960 640)+          , (4, Rectangle 960 640 960 640)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4])+    (st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4])+    let (st3, ws3) = runNav D st2 ws2+    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] [])+    let (st4, ws4) = runNav L st3 ws3+    (st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4])+    let (st5, ws5) = runNav U st4 ws4+    (st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4])++  it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do+    -- ┌─────┬──────┬──────┐+    -- │ ┌───┴──────┴────┐ │+    -- │ │   |  4   |    │ │+    -- │ └───┬──────┬────┘ │+    -- │  1  │  2 ──┼─► 3  │+    -- └─────┴──────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 600 1280)+          , (2, Rectangle 600 0 600 1280)+          , (3, Rectangle 1200 0 720 1280)+          , (4, Rectangle 200 200 1520 400)+          ]+    runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect))+      `shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4])++  it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do+    -- ┌─────────────────┐+    -- │     ┌──────┐    │+    -- │  1  │      │    │+    -- ├─────┤------├────┤+    -- │     │      │    │+    -- │  2  │  4 ──┼─►  │+    -- │     │      │    │+    -- ├─────┤------├────┤+    -- │  3  │      │    │+    -- │     └──────┘    │+    -- └─────────────────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 1920 400)+          , (2, Rectangle 0 400 1920 400)+          , (3, Rectangle 0 800 1920 480)+          , (4, Rectangle 800 200 400 880)+          ]+    runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect))+      `shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3])++  it "go from inner window to outer" $ do+    -- ┌───────────────┐+    -- │      ┌──────┐ │+    -- │  1 ◄─┼── 2  │ │+    -- │      └──────┘ │+    -- └───────────────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 1920 1280)+          , (2, Rectangle 600 600 600 600)+          ]+    runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect))+      `shouldBe` (mkstate 599 900, mkws 1 [2] [])++  it "if there are multiple outer windows, go to the smaller one" $ do+    -- ┌────────────────────────┐+    -- │  ┌───────────────┐     │+    -- │  │      ┌──────┐ │     │+    -- │  │  2 ◄─┼── 3  │ │  1  │+    -- │  │      └──────┘ │     │+    -- │  └───────────────┘     │+    -- └────────────────────────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 1920 1280)+          , (2, Rectangle 200 200 1520 880)+          , (3, Rectangle 400 400 400 400)+          ]+    runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect))+      `shouldBe` (mkstate 399 600, mkws 2 [1, 3] [])++  it "two tiled and one floating, floating fully inside" $ do+    -- ┌───────────────────┬─────┐+    -- │   ┌───────┐       │     │+    -- │ ──┼─►   ──┼─►   ──┼─►   │+    -- │   │   3   │   1   │   2 │+    -- │   │     ◄─┼──   ◄─┼──   │+    -- │   └───────┘       │     │+    -- └───────────────────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          , (3, Rectangle 400 400 400 400)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)+    let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3])+    (st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] [])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3])+    let (st4, ws4) = runNav R st3 ws3+    (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3])+    let (st5, ws5) = runNav L st4 ws4+    (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3])+    let (st6, ws6) = runNav L st5 ws5+    (st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] [])++  it "two floating windows inside one big tiled one" $ do+    -- ┌─────────┐+    -- │    │    │+    -- │ ┌──┼──┐ │+    -- │ │  ▼  │ │+    -- │ │  3  │ │+    -- │ └──┼──┘ │+    -- │    ▼    │+    -- │    1    │+    -- │ ┌──┼──┐ │+    -- │ │  ▼  │ │+    -- │ │  4  │ │+    -- │ └──┼──┘ │+    -- │    ▼    │+    -- ├────┼────┤+    -- │    ▼    │+    -- │    2    │+    -- └─────────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 1920 640)+          , (2, Rectangle 0 640 1920 640)+          , (3, Rectangle 200 200 100 100)+          , (4, Rectangle 1000 400 100 100)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4])+    (st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4])+    let (st3, ws3) = runNav D st2 ws2+    (st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4])+    let (st4, ws4) = runNav D st3 ws3+    (st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] [])+    let (st5, ws5) = runNav D st4 ws4+    (st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4])+    let (st6, ws6) = runNav D st5 ws5+    (st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4])++  it "floating window between two tiled ones" $ do+    -- ┌───────┬────────┐+    -- │ 1 ┌───┴───┐  2 │+    -- │ ──┼─► 3 ──┼─►  │+    -- │   └───┬───┘    │+    -- └───────┴────────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          , (3, Rectangle 860 540 200 200)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)+    let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3])+    (st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] [])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3])++  it "floating window overlapping four tiled ones" $ do+    -- ┌───────┬───────┐+    -- │   ┌───┴───┐   │+    -- │ 1 │       │ 2 │+    -- ├───┤       ├───┤+    -- │ ──┼─► 5 ──┼─► │+    -- │ 3 └───┬───┘ 4 │+    -- └───────┴───────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 640)+          , (2, Rectangle 960 0 960 640)+          , (3, Rectangle 0 640 960 640)+          , (4, Rectangle 960 640 960 640)+          , (5, Rectangle 760 440 400 400)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)+    let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5])+    (st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] [])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5])++  it "sequential inner floating windows" $ do+    -- ┌───────────────────────────────────┬──────┐+    -- │   ┌───────┐                       │      │+    -- │   │       │       ┌───────┐       │      │+    -- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─►   ──┼─► 2  │+    -- │ ◄─┼──   ◄─┼──   ◄─┼──   ◄─┼──   ◄─┼──    │+    -- │   └───────┘       │       │       │      │+    -- │                   └───────┘       │      │+    -- └───────────────────────────────────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          , (3, Rectangle 200 200 200 200)+          , (4, Rectangle 600 600 200 200)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4])+    (st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4])+    let (st4, ws4) = runNav R st3 ws3+    (st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] [])+    let (st5, ws5) = runNav R st4 ws4+    (st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4])+    let (st6, ws6) = runNav R st5 ws5+    (st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4])+    let (st7, ws7) = runNav L st6 ws6+    (st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4])+    let (st8, ws8) = runNav L st7 ws7+    (st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] [])+    let (st9, ws9) = runNav L st8 ws8+    (st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4])+    let (st10, ws10) = runNav L st9 ws9+    (st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4])+    let (st11, ws11) = runNav L st10 ws10+    (st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4])++  it "overlapping inner floating windows" $ do+    -- ┌─────────────────────┬──────┐+    -- │ ┌─────────┐         │      │+    -- │ │  3 ┌────┴─┐       │      │+    -- │ │  ──┼─►  ──┼─► 1 ──┼─►  2 │+    -- │ │  ◄─┼──  ◄─┼──   ◄─┼──    │+    -- │ │    │  4   │       │      │+    -- │ └────┤      │       │      │+    -- │      └──────┘       │      │+    -- └─────────────────────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          , (3, Rectangle 200 200 400 400)+          , (4, Rectangle 300 300 400 400)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+    let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4])+    (st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] [])+    let (st3, ws3) = runNav R st2 ws2+    (st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4])+    let (st4, ws4) = runNav R st3 ws3+    (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4])+    let (st5, ws5) = runNav L st4 ws4+    (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4])+    let (st6, ws6) = runNav L st5 ws5+    (st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] [])+    let (st7, ws7) = runNav L st6 ws6+    (st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4])++  it "bounce back from the wall to the floating window" $ do+    -- ┌────────────────┬─────┐+    -- │  1   ┌──────┐  │     │+    -- │  ┌───┼─►  3 │  │  2  │+    -- │  └── │      │  │     │+    -- │      └──────┘  │     │+    -- └────────────────┴─────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 1280)+          , (3, Rectangle 400 400 200 200)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)+    runNav L (mkstate 100 640) (mkws 1 [] [2, 3])+      `shouldBe` (mkstate 400 599, mkws 3 [2, 1] [])++  it "jump between screens" $ do+    -- ┌─────┬──────┐  ┌────────┐+    -- │     │  2   │  │    5   │+    -- │     ├──────┤  ├────────┤+    -- │  1  │  3 ──┼──┼─►  6   │+    -- │     ├──────┤  └────────┘+    -- │     │  4   │+    -- └─────┴──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          , (5, Rectangle 1920 0 1280 384)+          , (6, Rectangle 1920 384 1280 384)+          ]+        initWindowSet =+          W.StackSet+          { W.current =+              W.Screen+              { W.workspace =+                  W.Workspace+                  { W.tag = "A"+                  , W.layout = Layout NullLayout+                  , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }+                  }+              , W.screen = 1+              , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }+              }+          , W.visible =+              [ W.Screen+                { W.workspace =+                    W.Workspace+                    { W.tag = "B"+                    , W.layout = Layout NullLayout+                    , W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] }+                    }+                , W.screen = 2+                , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }+                }+              ]+          , W.hidden = []+          , W.floating = M.empty+          }+        expectedWindowSet =+          W.StackSet+          { W.current =+              W.Screen+              { W.workspace =+                  W.Workspace+                  { W.tag = "B"+                  , W.layout = Layout NullLayout+                  , W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] }+                  }+              , W.screen = 2+              , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }+              }+          , W.visible =+              [ W.Screen+                { W.workspace =+                    W.Workspace+                    { W.tag = "A"+                    , W.layout = Layout NullLayout+                    , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }+                    }+                , W.screen = 1+                , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }+                }+              ]+          , W.hidden = []+          , W.floating = M.empty+          }++    runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect))+      `shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet)++  it "floating window overlapping fully in the orthogonal direction" $ do+    -- ┌─────┬──────────────────┐+    -- │     │      ┌───────┐   │+    -- │     │    2 │       │   │+    -- │     ├──────┤-------├───┤+    -- │  1  │    3 │       │ 3 │+    -- │   ◄─┼──  ◄─┼── 5 ◄─┼── │+    -- │     ├──────┤-------├───┤+    -- │     │    4 │       │   │+    -- │     │      └───────┘   │+    -- └─────┴──────────────────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 960 0 960 400)+          , (3, Rectangle 960 400 960 400)+          , (4, Rectangle 960 800 960 480)+          , (5, Rectangle 1360 200 200 800)+          ]+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)+    let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5])+    (st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] [])+    let (st3, ws3) = runNav L st2 ws2+    (st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5])+    let (st4, ws4) = runNav L st3 ws3+    (st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5])++  it "navigation to free-floating windows on the same screen" $ do+    -- ┌──────┐+    -- │      │  ┌──────┐+    -- │      │  │      │+    -- │    ──┼──┼─►  2 │+    -- │      │  │      │+    -- │   1  │  └──────┘+    -- │      │+    -- │      │+    -- └──────┘+    let windowRect w =+          Identity $ M.lookup w $ M.fromList+          [ (1, Rectangle 0 0 960 1280)+          , (2, Rectangle 1200 400 400 400)+          ]+    runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))+      `shouldBe` (mkstate 1200 640, mkws 2 [1] [])++  it "switch between windows in Full layout" $ do+    let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)]+    runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect))+      `shouldBe` (M.empty, mkws 2 [1] [3])++data NullLayout a = NullLayout deriving (Show, Read, Eq)+instance LayoutClass NullLayout a++-- to make WindowSets comparable+instance Eq (Layout w) where+  (==) a b = show a == show b+  (/=) a b = show a /= show b++-- make a state with a position for a single workspace+mkstate :: Position -> Position -> WNState+mkstate px py = M.fromList [("A", Point px py)]++-- make a single-workspace WindowSet+mkws :: Window -> [Window] -> [Window] -> WindowSet+mkws focusedWindow upWindows downWindows = W.StackSet+  { W.current = W.Screen+    { W.workspace = W.Workspace+      { W.tag = "A"+      , W.layout = Layout NullLayout+      , W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows }+      }+    , W.screen = 1+    , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }+    }+  , W.visible = []+  , W.hidden = []+  , W.floating = M.empty+  }
tests/XPrompt.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ------------------------------------- -- -- Tests for XPrompt and ShellPrompt@@ -6,49 +7,35 @@ ------------------------------------- module XPrompt where -import Data.Char import Test.QuickCheck -import Data.List-+import XMonad.Prelude (chunksOf) import XMonad.Prompt import qualified XMonad.Prompt.Shell as S-import Properties- -{--instance Arbitrary Char where-    arbitrary     = choose ('\32', '\255')-    coarbitrary c = variant (ord c `rem` 4) --}--doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p-deepCheck p = check (defaultConfig { configMaxTest = 10000}) p-deepestCheck p = check (defaultConfig { configMaxTest = 100000}) p- -- brute force check for exceptions-prop_split (str :: [Char]) =+prop_split (str :: String) =     forAll (elements str) $ \e -> S.split e str == S.split e str  -- check if the first element of the new list is indeed the first part -- of the string.-prop_spliInSubListsAt (x :: Int) (str :: [Char]) =+prop_spliInSubListsAt (x :: Int) (str :: String) =     x < length str ==> result == take x str-    where result = case splitInSubListsAt x str of+    where result = case chunksOf x str of                      [] -> []-                     x -> head x+                     y -> head y  -- skipLastWord is complementary to getLastWord, unless the only space -- in the string is the final character, in which case skipLastWord -- and getLastWord will produce the same result.-prop_skipGetLastWord (str :: [Char]) =+prop_skipGetLastWord (str :: String) =     skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str   -- newIndex and newCommand get only non empy lists elemGen :: Gen ([String],String) elemGen = do-  a <- arbitrary :: Gen [[Char]]+  a <- arbitrary :: Gen [String]   let l = case filter (/= []) a of             [] -> ["a"]             x -> x@@ -67,15 +54,6 @@ -- this is actually the definition of newCommand... -- just to check something. {--prop_newCommandIndex = +prop_newCommandIndex =     forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l)))  == newCommand c l -}--main = do-  putStrLn "Testing ShellPrompt.split"-  deepCheck prop_split-  putStrLn "Testing spliInSubListsAt"-  deepCheck prop_spliInSubListsAt-  putStrLn "Testing skip + get lastWord"-  deepCheck prop_skipGetLastWord-
− tests/genMain.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE ViewPatterns #-}-{- | generate another Main from all modules in the current directory,-extracting all functions with @prop_@.--Usage (your QuickCheck-1 version may vary):--> ln -s ../../xmonad/tests/Properties.hs .-> runghc genMain.hs > Main.hs-> ghc -DTESTING -i.. -i. -package QuickCheck-1.2.0.0 Main.hs -e ':main 200'---}-module Main where--import Control.Monad.List-import Data.Char-import Data.IORef-import Data.List-import qualified Data.Set as S-import System.Directory-import System.FilePath-import Text.PrettyPrint.HughesPJ--main = do-    imports <- newIORef S.empty-    props <- runListT $ do-        f @ ((isUpper -> True) : (takeExtension -> ".hs"))-            <- ListT (getDirectoryContents ".")-        guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"]-        let b = takeBaseName f-        nesting <- io $ newIORef 0-        decl : _ <- ListT $ (map words . lines) `fmap` readFile f-        case decl of-            "{-" -> io $ modifyIORef nesting succ-            "-}" -> io $ modifyIORef nesting pred-            _ -> return ()-        0 <- io $ readIORef nesting-        guard $ "prop_" `isPrefixOf` decl-        io $ modifyIORef imports (S.insert b)-        return (b ++ "." ++ decl)-    imports <- S.toList `fmap` readIORef imports-    print $ genModule imports props--genModule :: [String] -> [String] -> Doc-genModule imports props = vcat [header,imports', main ]-    where-        header = text "module Main where"-        imports' = text "import Test.QuickCheck; import Data.Maybe; \-                            \import System.Environment; import Text.Printf; \-                            \import Properties hiding (main); import Control.Monad"-                $$ vcat [ text "import qualified" <+> text im | im <- imports ]-        props' = [ parens $ doubleQuotes (text p) <> comma <> text "mytest" <+> text p-                            | p <- props ]-        main = hang (text "main = do") 4 $-                    text "n <- maybe (return 100) readIO . listToMaybe =<< getArgs"-                    $$-                    hang (text "let props = ") 8-                        (brackets $ foldr1 (\x xs -> x <> comma $$ xs) props')-                    $$-                    text "(results, passed) <- liftM unzip $ \-                            \mapM (\\(s,a) -> printf \"%-40s: \" s >> a n) props"-                    $$-                    text "printf \"Passed %d tests!\\n\" (sum passed)"-                    $$-                    text "when (any not results) $ fail \"Not all tests passed!\""--io x = liftIO x
xmonad-contrib.cabal view
@@ -1,10 +1,12 @@ name:               xmonad-contrib-version:            0.15-homepage:           http://xmonad.org/-synopsis:           Third party extensions for xmonad+version:            0.18.2+-- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_*++homepage:           https://xmonad.org/+synopsis:           Community-maintained extensions for xmonad description:-    Third party tiling algorithms, configurations and scripts to xmonad,-    a tiling window manager for X.+    Community-maintained tiling algorithms and extension modules for xmonad,+    an X11 tiling window manager.     .     For an introduction to building, configuring and using xmonad     extensions, see "XMonad.Doc". In particular:@@ -21,22 +23,22 @@ license-file:       LICENSE author:             Spencer Janssen & others maintainer:         xmonad@haskell.org-extra-source-files: README.md CHANGES.md scripts/generate-configs scripts/run-xmonad.sh+extra-source-files: README.md+                    CHANGES.md+                    scripts/run-xmonad.sh                     scripts/window-properties.sh-                    scripts/xinitrc scripts/xmonad-acpi.c+                    scripts/xinitrc+                    scripts/xmonad-acpi.c                     scripts/xmonad-clock.c-                    tests/genMain.hs-                    tests/ManageDocks.hs-                    tests/Selective.hs-                    tests/SwapWorkspaces.hs-                    tests/XPrompt.hs+                    scripts/xmonadctl.hs+                    scripts/xmonadpropread.hs                     XMonad/Config/dmwit.xmobarrc                     XMonad/Config/Example.hs-cabal-version:      >= 1.6+cabal-version:      1.12 build-type:         Simple bug-reports:        https://github.com/xmonad/xmonad-contrib/issues -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1+tested-with:        GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.3 || == 9.12.2 || == 9.14.1  source-repository head   type:     git@@ -46,41 +48,48 @@ flag use_xft   description: Use Xft to render text -flag testing-  description: Testing mode-  manual: True-  default: False+flag pedantic+  description: Be pedantic (-Werror and the like)+  default:     False+  manual:      True  library-    build-depends: base >= 4.5 && < 5,-                   bytestring >= 0.10 && < 0.11,-                   containers >= 0.5 && < 0.7,+    build-depends: base >= 4.12 && < 5,+                   bytestring >= 0.10 && < 0.13,+                   containers >= 0.5 && < 0.9,                    directory,-                   extensible-exceptions,                    filepath,-                   old-locale,-                   old-time,+                   time >= 1.8 && < 1.16,                    process,                    random,                    mtl >= 1 && < 3,+                   transformers,                    unix,-                   X11>=1.6.1 && < 1.10,-                   xmonad >= 0.15 && < 0.16,+                   X11 >= 1.10 && < 1.11,+                   xmonad >= 0.18.0 && < 0.19,                    utf8-string,-                   semigroups+                   deepseq+    default-language: Haskell2010 -    if flag(use_xft)-        build-depends: X11-xft >= 0.2-        cpp-options: -DXFT+    cpp-options:   -DXMONAD_CONTRIB_VERSION_MAJOR=0+                   -DXMONAD_CONTRIB_VERSION_MINOR=18+                   -DXMONAD_CONTRIB_VERSION_PATCH=2+    ghc-options:   -Wall -Wno-unused-do-bind -    if true-        ghc-options:    -fwarn-tabs -Wall+    if flag(pedantic)+       ghc-options: -Werror -Wwarn=deprecations+    if impl(ghc >= 9.10)+       ghc-options: -Wno-incomplete-record-selectors -    if flag(testing)-        ghc-options:    -fwarn-tabs -Werror+    -- Keep this in sync with the oldest version in 'tested-with'+    if impl(ghc > 8.8.4)+       -- don't treat unused-imports warning as errors, they may be necessary+       -- for compatibility with older versions of base (or other deps)+       ghc-options: -Wwarn=unused-imports -    if impl(ghc >= 6.12.1)-        ghc-options:    -fno-warn-unused-do-bind+    if flag(use_xft)+        build-depends: X11-xft >= 0.2+        cpp-options: -DXFT      exposed-modules:    XMonad.Actions.AfterDrag                         XMonad.Actions.BluetileCommands@@ -98,6 +107,7 @@                         XMonad.Actions.DynamicWorkspaceGroups                         XMonad.Actions.DynamicWorkspaceOrder                         XMonad.Actions.DynamicWorkspaces+                        XMonad.Actions.EasyMotion                         XMonad.Actions.FindEmptyWorkspace                         XMonad.Actions.FlexibleManipulate                         XMonad.Actions.FlexibleResize@@ -111,30 +121,42 @@                         XMonad.Actions.LinkWorkspaces                         XMonad.Actions.MessageFeedback                         XMonad.Actions.Minimize+                        XMonad.Actions.MostRecentlyUsed                         XMonad.Actions.MouseGestures                         XMonad.Actions.MouseResize                         XMonad.Actions.Navigation2D                         XMonad.Actions.NoBorders                         XMonad.Actions.OnScreen+                        XMonad.Actions.PerLayoutKeys+                        XMonad.Actions.PerWindowKeys                         XMonad.Actions.PerWorkspaceKeys                         XMonad.Actions.PhysicalScreens                         XMonad.Actions.Plane+                        XMonad.Actions.Prefix+                        XMonad.Actions.Profiles                         XMonad.Actions.Promote                         XMonad.Actions.RandomBackground+                        XMonad.Actions.RepeatAction+                        XMonad.Actions.Repeatable                         XMonad.Actions.RotSlaves+                        XMonad.Actions.RotateSome                         XMonad.Actions.Search                         XMonad.Actions.ShowText+                        XMonad.Actions.Sift                         XMonad.Actions.SimpleDate                         XMonad.Actions.SinkAll                         XMonad.Actions.SpawnOn                         XMonad.Actions.Submap-                        XMonad.Actions.SwapWorkspaces                         XMonad.Actions.SwapPromote+                        XMonad.Actions.SwapWorkspaces                         XMonad.Actions.TagWindows+                        XMonad.Actions.TiledWindowDragging+                        XMonad.Actions.ToggleFullFloat                         XMonad.Actions.TopicSpace                         XMonad.Actions.TreeSelect                         XMonad.Actions.UpdateFocus                         XMonad.Actions.UpdatePointer+                        XMonad.Actions.UpKeys                         XMonad.Actions.Warp                         XMonad.Actions.WindowBringer                         XMonad.Actions.WindowGo@@ -161,34 +183,46 @@                         XMonad.Doc.Configuring                         XMonad.Doc.Developing                         XMonad.Doc.Extending+                        XMonad.Hooks.BorderPerWindow                         XMonad.Hooks.CurrentWorkspaceOnTop                         XMonad.Hooks.DebugEvents                         XMonad.Hooks.DebugKeyEvents                         XMonad.Hooks.DebugStack                         XMonad.Hooks.DynamicBars                         XMonad.Hooks.DynamicHooks+                        XMonad.Hooks.DynamicIcons                         XMonad.Hooks.DynamicLog                         XMonad.Hooks.DynamicProperty                         XMonad.Hooks.EwmhDesktops                         XMonad.Hooks.FadeInactive                         XMonad.Hooks.FadeWindows+                        XMonad.Hooks.FloatConfigureReq                         XMonad.Hooks.FloatNext-                        XMonad.Hooks.ICCCMFocus+                        XMonad.Hooks.Focus                         XMonad.Hooks.InsertPosition                         XMonad.Hooks.ManageDebug                         XMonad.Hooks.ManageDocks                         XMonad.Hooks.ManageHelpers                         XMonad.Hooks.Minimize+                        XMonad.Hooks.Modal+                        XMonad.Hooks.OnPropertyChange                         XMonad.Hooks.Place                         XMonad.Hooks.PositionStoreHooks-                        XMonad.Hooks.RestoreMinimized+                        XMonad.Hooks.RefocusLast+                        XMonad.Hooks.Rescreen                         XMonad.Hooks.ScreenCorners                         XMonad.Hooks.Script                         XMonad.Hooks.ServerMode                         XMonad.Hooks.SetWMName+                        XMonad.Hooks.ShowWName+                        XMonad.Hooks.StatusBar+                        XMonad.Hooks.StatusBar.PP+                        XMonad.Hooks.StatusBar.WorkspaceScreen+                        XMonad.Hooks.TaffybarPagerHints                         XMonad.Hooks.ToggleHook                         XMonad.Hooks.UrgencyHook                         XMonad.Hooks.WallpaperSetter+                        XMonad.Hooks.WindowSwallowing                         XMonad.Hooks.WorkspaceByPos                         XMonad.Hooks.WorkspaceHistory                         XMonad.Hooks.XPropManage@@ -200,23 +234,37 @@                         XMonad.Layout.BorderResize                         XMonad.Layout.BoringWindows                         XMonad.Layout.ButtonDecoration+                        XMonad.Layout.CenterMainFluid+                        XMonad.Layout.CenteredIfSingle                         XMonad.Layout.CenteredMaster                         XMonad.Layout.Circle+                        XMonad.Layout.CircleEx                         XMonad.Layout.Column+                        XMonad.Layout.Columns                         XMonad.Layout.Combo                         XMonad.Layout.ComboP                         XMonad.Layout.Cross                         XMonad.Layout.Decoration+                        XMonad.Layout.DecorationEx+                        XMonad.Layout.DecorationEx.Common+                        XMonad.Layout.DecorationEx.Engine+                        XMonad.Layout.DecorationEx.Geometry+                        XMonad.Layout.DecorationEx.Widgets+                        XMonad.Layout.DecorationEx.LayoutModifier+                        XMonad.Layout.DecorationEx.TextEngine+                        XMonad.Layout.DecorationEx.DwmGeometry+                        XMonad.Layout.DecorationEx.TabbedGeometry                         XMonad.Layout.DecorationAddons                         XMonad.Layout.DecorationMadness                         XMonad.Layout.Dishes-                        XMonad.Layout.MultiDishes                         XMonad.Layout.DragPane                         XMonad.Layout.DraggingVisualizer                         XMonad.Layout.Drawer                         XMonad.Layout.Dwindle                         XMonad.Layout.DwmStyle+                        XMonad.Layout.FixedAspectRatio                         XMonad.Layout.FixedColumn+                        XMonad.Layout.FocusTracking                         XMonad.Layout.Fullscreen                         XMonad.Layout.Gaps                         XMonad.Layout.Grid@@ -233,7 +281,6 @@                         XMonad.Layout.ImageButtonDecoration                         XMonad.Layout.IndependentScreens                         XMonad.Layout.LayoutBuilder-                        XMonad.Layout.LayoutBuilderP                         XMonad.Layout.LayoutCombinators                         XMonad.Layout.LayoutHints                         XMonad.Layout.LayoutModifier@@ -250,6 +297,7 @@                         XMonad.Layout.MosaicAlt                         XMonad.Layout.MouseResizableTile                         XMonad.Layout.MultiColumns+                        XMonad.Layout.MultiDishes                         XMonad.Layout.MultiToggle                         XMonad.Layout.MultiToggle.Instances                         XMonad.Layout.MultiToggle.TabBarDecoration@@ -263,10 +311,12 @@                         XMonad.Layout.PositionStoreFloat                         XMonad.Layout.Reflect                         XMonad.Layout.Renamed+                        XMonad.Layout.ResizableThreeColumns                         XMonad.Layout.ResizableTile                         XMonad.Layout.ResizeScreen                         XMonad.Layout.Roledex                         XMonad.Layout.ShowWName+                        XMonad.Layout.SideBorderDecoration                         XMonad.Layout.SimpleDecoration                         XMonad.Layout.SimpleFloat                         XMonad.Layout.Simplest@@ -281,15 +331,19 @@                         XMonad.Layout.SubLayouts                         XMonad.Layout.TabBarDecoration                         XMonad.Layout.Tabbed+                        XMonad.Layout.TallMastersCombo                         XMonad.Layout.ThreeColumns                         XMonad.Layout.ToggleLayouts                         XMonad.Layout.TrackFloating                         XMonad.Layout.TwoPane+                        XMonad.Layout.TwoPanePersistent+                        XMonad.Layout.VoidBorders                         XMonad.Layout.WindowArranger                         XMonad.Layout.WindowNavigation                         XMonad.Layout.WindowSwitcherDecoration                         XMonad.Layout.WorkspaceDir                         XMonad.Layout.ZoomRow+                        XMonad.Prelude                         XMonad.Prompt                         XMonad.Prompt.AppLauncher                         XMonad.Prompt.AppendFile@@ -301,6 +355,7 @@                         XMonad.Prompt.Input                         XMonad.Prompt.Layout                         XMonad.Prompt.Man+                        XMonad.Prompt.OrgMode                         XMonad.Prompt.Pass                         XMonad.Prompt.RunOrRaise                         XMonad.Prompt.Shell@@ -310,14 +365,24 @@                         XMonad.Prompt.Window                         XMonad.Prompt.Workspace                         XMonad.Prompt.XMonad+                        XMonad.Prompt.Zsh+                        XMonad.Util.ActionCycle+                        XMonad.Util.ActionQueue+                        XMonad.Util.ClickableWorkspaces                         XMonad.Util.Cursor                         XMonad.Util.CustomKeys                         XMonad.Util.DebugWindow                         XMonad.Util.Dmenu+                        XMonad.Util.DynamicScratchpads                         XMonad.Util.Dzen                         XMonad.Util.EZConfig+                        XMonad.Util.ExclusiveScratchpads+                        XMonad.Util.ExtensibleConf                         XMonad.Util.ExtensibleState                         XMonad.Util.Font+                        XMonad.Util.Grab+                        XMonad.Util.Hacks+                        XMonad.Util.History                         XMonad.Util.Image                         XMonad.Util.Invisible                         XMonad.Util.Loggers@@ -327,18 +392,21 @@                         XMonad.Util.NamedScratchpad                         XMonad.Util.NamedWindows                         XMonad.Util.NoTaskbar+                        XMonad.Util.Parser                         XMonad.Util.Paste                         XMonad.Util.PositionStore+                        XMonad.Util.Process                         XMonad.Util.PureX                         XMonad.Util.Rectangle                         XMonad.Util.RemoteWindows                         XMonad.Util.Replace                         XMonad.Util.Run                         XMonad.Util.Scratchpad-                        XMonad.Util.SpawnNamedPipe                         XMonad.Util.SessionStart+                        XMonad.Util.SpawnNamedPipe                         XMonad.Util.SpawnOnce                         XMonad.Util.Stack+                        XMonad.Util.StickyWindows                         XMonad.Util.StringProp                         XMonad.Util.Themes                         XMonad.Util.Timer@@ -350,3 +418,104 @@                         XMonad.Util.WorkspaceCompare                         XMonad.Util.XSelection                         XMonad.Util.XUtils++test-suite tests+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  other-modules:  CycleRecentWS+                  EZConfig+                  ExtensibleConf+                  GridSelect+                  Instances+                  ManageDocks+                  NoBorders+                  OrgMode+                  RotateSome+                  Selective+                  SwapWorkspaces+                  WindowNavigation+                  Utils+                  XMonad.Actions.CopyWindow+                  XMonad.Actions.CycleRecentWS+                  XMonad.Actions.CycleWS+                  XMonad.Actions.FocusNth+                  XMonad.Actions.GridSelect+                  XMonad.Actions.PhysicalScreens+                  XMonad.Actions.Repeatable+                  XMonad.Actions.RotateSome+                  XMonad.Actions.Submap+                  XMonad.Actions.SwapWorkspaces+                  XMonad.Actions.TagWindows+                  XMonad.Actions.WindowBringer+                  XMonad.Actions.WindowGo+                  XMonad.Actions.WindowNavigation+                  XMonad.Hooks.ManageDocks+                  XMonad.Hooks.ManageHelpers+                  XMonad.Hooks.UrgencyHook+                  XMonad.Hooks.WorkspaceHistory+                  XMonad.Hooks.StatusBar.PP+                  XMonad.Layout.Decoration+                  XMonad.Layout.LayoutModifier+                  XMonad.Layout.LimitWindows+                  XMonad.Layout.NoBorders+                  XMonad.Layout.WindowArranger+                  XMonad.Prelude+                  XMonad.Prompt+                  XMonad.Prompt.OrgMode+                  XMonad.Prompt.Shell+                  XMonad.Util.Dmenu+                  XMonad.Util.Dzen+                  XMonad.Util.EZConfig+                  XMonad.Util.ExtensibleConf+                  XMonad.Util.ExtensibleState+                  XMonad.Util.Font+                  XMonad.Util.Image+                  XMonad.Util.Invisible+                  XMonad.Util.NamedActions+                  XMonad.Util.NamedWindows+                  XMonad.Util.Parser+                  XMonad.Util.Process+                  XMonad.Util.PureX+                  XMonad.Util.Rectangle+                  XMonad.Util.Run+                  XMonad.Util.Stack+                  XMonad.Util.Timer+                  XMonad.Util.Types+                  XMonad.Util.WindowProperties+                  XMonad.Util.WorkspaceCompare+                  XMonad.Util.XSelection+                  XMonad.Util.XUtils+                  XPrompt+  hs-source-dirs: tests, .+  build-depends: base >= 4.12 && < 5+               , QuickCheck >= 2+               , X11 >= 1.10 && < 1.11+               , bytestring >= 0.10 && < 0.13+               , containers+               , directory+               , time >= 1.8 && < 1.16+               , hspec >= 2.4.0 && < 3+               , mtl+               , random+               , process+               , unix+               , utf8-string+               , deepseq+               , xmonad >= 0.16.9999 && < 0.19+  cpp-options: -DTESTING+  ghc-options: -Wall -Wno-unused-do-bind+  default-language: Haskell2010++  if flag(pedantic)+     ghc-options: -Werror -Wwarn=deprecations+     if impl(ghc >= 9.10)+       ghc-options: -Wno-incomplete-record-selectors++  -- Keep this in sync with the oldest version in 'tested-with'+  if impl(ghc > 8.8.4)+     -- don't treat unused-imports warning as errors, they may be necessary+     -- for compatibility with older versions of base (or other deps)+     ghc-options: -Wwarn=unused-imports++  if impl(ghc > 9.8)+    ghc-options:   -Wno-x-partial