packages feed

xmonad-contrib 0.16 → 0.17.0

raw patch · 314 files changed

+13106/−6277 lines, 314 filesdep +QuickCheckdep +hspecdep +timedep −extensible-exceptionsdep −old-localedep −old-timedep ~X11dep ~basedep ~bytestringnew-uploader

Dependencies added: QuickCheck, hspec, time

Dependencies removed: extensible-exceptions, old-locale, old-time, semigroups

Dependency ranges changed: X11, base, bytestring, containers, mtl, xmonad

Files

CHANGES.md view
@@ -1,5 +1,777 @@ # Change Log / Release Notes +## 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.++  * `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`.+ ## 0.16  ### Breaking Changes@@ -39,6 +811,11 @@     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`@@ -431,7 +1208,8 @@    * `XMonad.Hooks.ManageHelpers` -    Make type of ManageHook combinators more general.+    - Make type of ManageHook combinators more general.+    - New manage hook `doSink` for sinking windows (as upposed to the `doFloat` manage hook)    * `XMonad.Prompt` @@ -529,6 +1307,12 @@   * `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`@@ -562,7 +1346,7 @@  ### Bug Fixes and Minor Changes -  * `XMonad.Hooks.ManageDocks`,+  * `XMonad.Hooks.ManageDocks`      - Fix a very annoying bug where taskbars/docs would be       covered by windows.
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,97 @@-# 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/workflow/status/xmonad/xmonad-contrib/Stack?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/workflow/status/xmonad/xmonad-contrib/Haskell-CI?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/workflow/status/xmonad/xmonad-contrib/Nix?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>+</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,8 +20,9 @@                 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@: --@@ -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,7 +25,6 @@  import XMonad import qualified XMonad.StackSet as W-import XMonad.Layout.LayoutCombinators import System.Exit  -- $usage@@ -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,7 +33,7 @@  import qualified Data.Map as M import System.Exit-import Data.Maybe+import XMonad.Prelude  -- $usage --@@ -61,18 +62,18 @@ -- | 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) --@@ -44,7 +45,6 @@ -- | 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     sh <- io $ getWMNormalHints d w     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))@@ -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,17 +20,19 @@                                  -- * 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@@ -76,19 +80,25 @@ -- "XMonad.Doc.Extending#Editing_key_bindings".  -- $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@@ -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,10 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.CycleRecentWS+-- Description :  Cycle through most recently used workspaces. -- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com> -- License     :  BSD3-style (see LICENSE) --@@ -19,12 +23,24 @@                                 -- * Usage                                 -- $usage                                 cycleRecentWS,-                                cycleWindowSets+                                cycleRecentNonEmptyWS,+                                cycleWindowSets,+                                toggleRecentWS,+                                toggleRecentNonEmptyWS,+                                toggleWindowSets,+                                recentWS,++#ifdef TESTING+                                unView,+#endif ) where  import XMonad hiding (workspaces)-import XMonad.StackSet+import XMonad.StackSet hiding (filter) +import Control.Arrow ((&&&))+import Data.Function (on)+ -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: --@@ -47,33 +63,61 @@               -> 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 <- gets $ genOptions . windowset+  (options, unView') <- gets $ (genOptions &&& unView) . 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+  let setOption n = do windows $ view (options `cycref` n) . unView'                        (t, s) <- io event                        case () of                          () | t == keyPress   && s == keyNext  -> setOption (n+1)@@ -83,3 +127,37 @@   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime   setOption 0   io $ ungrabKeyboard d currentTime+ where+  cycref :: [a] -> Int -> a+  cycref l i = l !! (i `mod` length l)++-- | 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+  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,27 +19,21 @@     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@: ----- > 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,
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)@@ -112,9 +116,9 @@ -- 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@@ -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,7 @@ -------------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.CycleWindows+-- Description  : Cycle windows while maintaining focus in place. -- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com> -- License      : BSD3-style (see LICENSE) --@@ -116,7 +117,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  @@ -205,7 +206,7 @@ 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+rotFocused' f s@W.Stack{} = rotSlaves' f s                    -- otherwise   -- $unfocused
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,14 +23,12 @@   , 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 qualified XMonad.StackSet as W @@ -51,7 +49,7 @@                    return (t, s)       handleEvent (t, s)         | t == keyRelease && s `elem` mods = return ()-        | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent+        | otherwise = pressHandler t s >> getNextEvent >>= handleEvent    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime   getNextEvent >>= handleEvent@@ -83,9 +81,9 @@         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 $
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) --
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) --
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, makeAbsolute)+import XMonad.Prelude import XMonad import XMonad.Actions.DynamicWorkspaces import XMonad.Prompt@@ -130,14 +125,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 +140,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,17 +166,17 @@       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+  modeAction (ProjectPrompt _ DirMode _) buf auto = do     let dir' = if null auto then buf else auto     dir <- io $ makeAbsolute dir'     modifyProject (\p -> p { projectDirectory = dir })@@ -231,7 +226,7 @@ -------------------------------------------------------------------------------- -- | 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@@ -327,11 +322,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,17 +33,22 @@     , 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:@@ -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 @@ -44,7 +45,7 @@  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@@ -67,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 -- >     ...@@ -89,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
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,14 +34,12 @@                                          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.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 @@ -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,7 +105,7 @@   maybe (return ()) (windows . job) wtag     where       ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)-      ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap+      ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap   mkCompl :: [String] -> String -> IO [String]@@ -127,14 +124,14 @@  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 +238,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,388 @@+{-# LANGUAGE CPP #-}+{-# 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\/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 dpy th visibleWindows+    PerScreenKeys m ->+      fmap concat+        $ sequence+        $ M.elems+        $ M.mapWithKey (\sid ks -> buildOverlays ks <$> sortedOverlayWindows sid) m+     where+      screenById :: ScreenId -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+      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 dpy 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 ks = appendChords (maxChordLen c) ks++  buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]+  buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws++  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 :: Display -> Position -> Window -> X OverlayWindow+  buildOverlayWin dpy th w = do+    wAttrs <- io $ getWindowAttributes dpy w+    let r = overlayF c th $ makeRect wAttrs+    o <- createNewWindow r Nothing "" True+    return 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 = tail $ 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,9 +19,7 @@     viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace   ) where -import Data.List-import Data.Maybe ( isNothing )-+import XMonad.Prelude import XMonad import XMonad.StackSet
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,8 +24,9 @@ ) where  import XMonad+import XMonad.Prelude ((<&>)) 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, map, otherwise, round, snd, uncurry, ($), (.))  -- $usage -- First, add this import to your @~\/.xmonad\/xmonad.hs@:@@ -79,24 +81,23 @@ --   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+    [wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs     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@@ -113,7 +114,7 @@ pairUp :: [a] -> [(a,a)] pairUp [] = [] pairUp [_] = []-pairUp (x:y:xs) = (x, y) : (pairUp xs)+pairUp (x:y:xs) = (x, y) : pairUp xs  mapP :: (a -> b) -> (a, a) -> (b, b) mapP f (x, y) = (f x, f y)@@ -132,4 +133,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,7 +21,7 @@ ) where  import XMonad-import XMonad.Util.XUtils (fi)+import XMonad.Prelude (fi) import Foreign.C.Types  -- $usage@@ -50,7 +51,6 @@   -> Window   -- ^ The window to resize.   -> X () mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do-    io $ raiseWindow d w     wa <- io $ getWindowAttributes d w     sh <- io $ getWMNormalHints d w     (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w@@ -62,16 +62,17 @@         (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 --@@ -22,6 +23,7 @@                 ) where  import XMonad+import XMonad.Prelude (fi)  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -43,10 +45,9 @@ --   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))+    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@@ -61,14 +62,14 @@ -- > 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)))+    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 +81,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 +91,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     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 @@ -96,14 +95,14 @@ snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do     wa <- io $ getWindowAttributes d w     (_, _, _, 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@@ -121,18 +120,17 @@     -> 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      (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 +150,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@@ -171,7 +169,6 @@     -> 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      nx <- handleAxis True d wa@@ -194,8 +191,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 @@ -212,7 +209,6 @@  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     ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w @@ -252,7 +248,6 @@  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     mr <- case dir of               L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w@@ -274,9 +269,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 +285,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 +300,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 +315,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,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.FocusNth+-- Description  : Focus the nth window of the current workspace. -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de> -- License      : BSD --@@ -39,7 +40,7 @@ focusNth = windows . modify' . focusNth'  focusNth' :: Int -> Stack a -> Stack a-focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s+focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s                               | otherwise = listToStack n (integrate s)  -- | Swap current window with nth. Focus stays in the same position@@ -51,12 +52,9 @@   | (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)--
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,7 +95,7 @@ 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)  -- $usage@@ -107,13 +106,13 @@ -- -- Then add a keybinding, e.g. ----- >    , ((modm, xK_g), goToSelected defaultGSConfig)+-- >    , ((modm, xK_g), goToSelected def) -- -- This module also supports displaying arbitrary information in a grid and letting -- the user select from it. E.g. to spawn an application from a given list, you -- can use the following: ----- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])+-- >   , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])  -- $commonGSConfig --@@ -123,7 +122,7 @@ -- > {-# LANGUAGE NoMonomorphismRestriction #-} -- > import XMonad -- > ...--- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }+-- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 } -- -- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig' -- in order to specify a custom colorizer is @gsconfig2@ (found in@@ -222,18 +221,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 +259,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  @@ -308,8 +303,8 @@   -- 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..]@@ -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,9 +387,9 @@     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,+        s@TwoDState { td_paneX = px, td_paneY = py,                          td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get         let gridX = (fi x - (px - cw) `div` 2) `div` cw             gridY = (fi y - (py - ch) `div` 2) `div` ch@@ -403,7 +398,7 @@              Nothing -> contEventloop     | otherwise = contEventloop -stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop+stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop  stdHandle _ contEventloop = contEventloop @@ -435,7 +430,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 +445,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 +545,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 +559,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 +571,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 +589,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 +630,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.@@ -662,14 +654,14 @@     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 = head coords,                                                 td_availSlots = coords,                                                 td_elements = elements,                                                 td_gsconfig = gsconfig,@@ -680,7 +672,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,20 +694,17 @@ 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@@ -770,7 +759,7 @@ -- -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace) -- >--- > gridselectWorkspace' defaultGSConfig+-- > gridselectWorkspace' def -- >                          { gs_navigate   = navNSearch -- >                          , gs_rearranger = searchStringRearrangerGenerator id -- >                          }@@ -789,7 +778,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,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ---------------------------------------------------------------------- -- | -- Module      : XMonad.Actions.GroupNavigation+-- Description : Cycle through groups of windows across workspaces. -- Copyright   : (c) nzeh@cs.dal.ca -- License     : BSD3-style (see LICENSE) --@@ -35,15 +34,17 @@  import Control.Monad.Reader import Control.Monad.State-import Data.Foldable as Fold-import Data.Map as Map-import Data.Sequence as Seq-import Data.Set as Set+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 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 @@ -127,12 +128,12 @@ -- Returns the list of windows ordered by workspace as specified in -- ~/.xmonad/xmonad.hs orderedWindowList :: Direction -> X (Seq Window)-orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get+orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get orderedWindowList dir     = withWindowSet $ \ss -> do   wsids <- asks (Seq.fromList . workspaces . config)   let wspcs = orderedWorkspaceList ss wsids       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@@ -146,7 +147,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'     where       wspcs      = SS.workspaces ss-      wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs+      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) @@ -155,7 +156,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)  instance ExtensionClass HistoryDB where @@ -172,26 +173,11 @@ updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do   let newcur   = SS.peek ss       wins     = Set.fromList $ SS.allWindows ss-      newhist  = flt (`Set.member` wins) (ins oldcur oldhist)+      newhist  = Seq.filter (`Set.member` wins) (ins oldcur oldhist)   return $ 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 -------------------------------------------- @@ -205,7 +191,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 --------------------------------------------------- @@ -237,6 +223,5 @@   ws <- liftX $ gets windowset   let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws       visibleWs = w `elem` allVisible-      unfocused = maybe True (w /=) $ SS.peek ws+      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]
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,8 +62,8 @@ 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@@ -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)@@ -59,7 +60,7 @@ -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -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@@ -51,13 +52,11 @@  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       ( isJust, liftA2, void )+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@:@@ -108,7 +107,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 +139,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
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) --@@ -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,9 +45,6 @@ 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 @@ -120,7 +119,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 +129,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/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,14 +22,13 @@     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 --@@ -111,7 +111,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) --@@ -56,7 +57,7 @@ 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,7 +40,6 @@                                    , withNavigation2DConfig                                    , Navigation2DConfig(..)                                    , def-                                   , defaultNavigation2DConfig                                    , Navigation2D                                    , lineNavigation                                    , centerNavigation@@ -58,11 +58,10 @@                                    , 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@@ -386,7 +385,7 @@                                                        -- 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@@ -451,10 +450,6 @@                                                           >> XS.put conf2d                                             } -{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}-defaultNavigation2DConfig :: Navigation2DConfig-defaultNavigation2DConfig = def- instance Default Navigation2DConfig where     def                   = Navigation2DConfig { defaultTiledNavigation = lineNavigation                                                , floatNavigation        = centerNavigation@@ -482,7 +477,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 +487,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 +495,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 +503,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@@ -654,7 +644,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 +664,7 @@     nav     = maximum             $ map ( fromMaybe (defaultTiledNavigation conf)                   . flip L.lookup (layoutNavigation conf)-                  )-            $ layouts+                  ) layouts  -- | Implements navigation for the float layer doFloatNavigation :: Navigation2DConfig@@ -720,7 +709,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 +750,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@@ -821,7 +809,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@@ -849,7 +837,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 +858,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@@ -895,14 +883,10 @@ 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 +923,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 +934,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) --@@ -27,7 +28,7 @@ toggleBorder w = do     bw <- asks (borderWidth . config)     withDisplay $ \d -> io $ do-        cw <- wa_border_width `fmap` getWindowAttributes d w+        cw <- wa_border_width <$> getWindowAttributes d w         if cw == 0             then setWindowBorderWidth d w bw             else setWindowBorderWidth d w 0
XMonad/Actions/OnScreen.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.OnScreen+-- Description :  Control workspaces on different screens (in xinerama mode). -- Copyright   :  (c) 2009 Nils Schweinsberg -- License     :  BSD3-style (see LICENSE) --@@ -26,11 +27,8 @@     ) where  import XMonad+import XMonad.Prelude (fromMaybe, guard) import XMonad.StackSet hiding (new)--import Control.Monad (guard)--- import Control.Monad.State.Class (gets)-import Data.Maybe (fromMaybe)   -- | Focus data definitions
+ 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\/xmonad.hs@:+--+-- >  import XMonad.Actions.PerWindowKeys+--+-- >   ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)])+--+-- >   ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)])+--+-- If you want an action that will always run, but also want to do something for+-- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True,+-- alwaysDoThisAction)]@.+--+-- Similarly, if you want a default action to be run if all the others failed,+-- you can use @'bindFirst' [(query1, action1), ..., (pure True,+-- doThisIfTheOthersFail)]@.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Run an action if a Query holds true. Doesn't stop at the first one that+-- does, however, and could potentially run all actions.+bindAll :: [(Query Bool, X ())] -> X ()+bindAll = mapM_ choose where+  choose (mh,action) = withFocused $ \w -> whenX (runQuery mh w) action++-- | Run the action paired with the first Query that holds true.+bindFirst :: [(Query Bool, X ())] -> X ()+bindFirst = withFocused . chooseOne++chooseOne :: [(Query Bool, X ())] -> Window -> X ()+chooseOne [] _ = return ()+chooseOne ((mh,a):bs) w = do+  c <- runQuery mh w+  if c then a+       else chooseOne bs w
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) --@@ -46,4 +47,3 @@         Nothing -> case lookup "" bindings of             Just action -> action             Nothing -> return ()-
XMonad/Actions/PhysicalScreens.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.PhysicalScreens+-- Description  : Manipulate screens ordered by physical location instead of ID. -- Copyright    : (c) Nelson Elhage <nelhage@mit.edu> -- License      : BSD --@@ -30,11 +31,9 @@                                       ) where  import XMonad+import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy) 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@@ -72,7 +71,7 @@ -- | 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 @@ -89,8 +88,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 +130,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
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,11 +39,9 @@     )     where -import Control.Monad-import Data.List-import Data.Map hiding (split)-import Data.Maybe+import Data.Map (Map, fromList) +import XMonad.Prelude import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Run
+ XMonad/Actions/Prefix.hs view
@@ -0,0 +1,212 @@+{-# 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+       , 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)++{- $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 :: [(KeyMask, KeySym)] -> X ()+handlePrefixArg events = do+  ks <- asks keyActions+  logger <- asks (logHook . config)+  flip finallyX (XS.put None >> logger) $ do+    prefix <- XS.get+    case prefix of+      Raw a -> XS.put $ Raw (a + 1)+      None -> XS.put $ Raw 1+      _ -> return ()+    logger+    submapDefaultWithKey defaultKey ks+  where defaultKey key@(m, k) =+          if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask+          then do+            prefix <- XS.get+            let x = fromJust (Prelude.lookup k keyToNum)+            case prefix of+              Raw _ -> XS.put $ Numeric x+              Numeric a -> XS.put $ Numeric $ a * 10 + x+              None -> return () -- should never happen+            handlePrefixArg (key:events)+          else do+            prefix <- XS.get+            mapM_ (uncurry sendKey) $ case prefix of+              Raw a -> replicate a (head events) ++ [key]+              _ -> reverse (key:events)+        keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]++-- | Turn a prefix-aware X action into an X-action.+--+-- First, fetch the current prefix, then pass it as argument to the+-- original function.  You should use this to "run" your commands.+withPrefixArgument :: (PrefixArgument -> X ()) -> X ()+withPrefixArgument = (>>=) XS.get++-- | Test if 'PrefixArgument' is 'Raw' or not.+isPrefixRaw :: PrefixArgument -> Bool+isPrefixRaw (Raw _) = True+isPrefixRaw _ = False++-- | Test if 'PrefixArgument' is 'Numeric' or not.+isPrefixNumeric :: PrefixArgument -> Bool+isPrefixNumeric (Numeric _) = True+isPrefixNumeric _ = False++-- | Format the prefix using the Emacs convetion for use in a+-- statusbar, like xmobar.+--+-- To add this formatted prefix to printer output, you can set it up+-- like so+--+-- > myPrinter :: PP+-- > myPrinter = def { ppExtras = [ppFormatPrefix] }+--+-- And then 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/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) --
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/RotSlaves.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- 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) --@@ -40,8 +41,8 @@ -- | 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' (\l -> tail l++[head l]))+rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l))  -- | The actual rotation, as a pure function on the window stack. rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a@@ -49,12 +50,12 @@ 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))+           (revls',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' (\l -> tail l++[head l]))+rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l))  -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
+ XMonad/Actions/RotateSome.hs view
@@ -0,0 +1,161 @@+-----------------------------------------------------------------------------+-- |+-- 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 (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\/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', 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,@@ -35,12 +38,13 @@                                  debbts,                                  debpts,                                  dictionary,+                                 ebay,+                                 github,                                  google,                                  hackage,                                  hoogle,                                  images,                                  imdb,-                                 isohunt,                                  lucky,                                  maps,                                  mathworld,@@ -63,13 +67,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           (isAlphaNum, isAscii, isPrefixOf) import           XMonad.Prompt.Shell      (getBrowser) import           XMonad.Util.Run          (safeSpawn) import           XMonad.Util.XSelection   (getSelection)@@ -113,6 +116,10 @@  * 'dictionary' -- dictionary.reference.com search. +* 'ebay' -- Ebay keyword search.++* 'github' -- GitHub keyword search.+ * 'google' -- basic Google search.  * 'hackage' -- Hackage, the Haskell package database.@@ -125,8 +132,6 @@  * 'imdb'   -- the Internet Movie Database. -* 'isohunt' -- isoHunt search.- * 'lucky' -- Google "I'm feeling lucky" search.  * 'maps'   -- Google maps.@@ -137,7 +142,7 @@  * 'scholar' -- Google scholar academic search. -* 'thesaurus' -- thesaurus.reference.com search.+* 'thesaurus' -- thesaurus.com search.  * 'wayback' -- the Wayback Machine. @@ -191,7 +196,7 @@ > > searchList :: [(String, S.SearchEngine)] > searchList = [ ("g", S.google)->              , ("h", S.hoohle)+>              , ("h", S.hoogle) >              , ("w", S.wikipedia) >              ] @@ -210,7 +215,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 +253,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 +262,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 $ tail $ 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 +286,39 @@ 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,+amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle,+  images, imdb, 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="+amazon        = searchEngine "amazon"        "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="+alpha         = searchEngine "alpha"         "https://www.wolframalpha.com/input/?i="+codesearch    = searchEngine "codesearch"    "https://developers.google.com/s/results/code-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/"+ebay          = searchEngine "ebay"          "https://www.ebay.com/sch/i.html?_nkw="+github        = searchEngine "github"        "https://github.com/search?q="+google        = searchEngine "google"        "https://www.google.com/search?num=100&q="+hackage       = searchEngine "hackage"       "https://hackage.haskell.org/package/"+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="+openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query="+scholar       = searchEngine "scholar"       "https://scholar.google.com/scholar?q="+stackage      = searchEngine "stackage"      "https://www.stackage.org/lts/hoogle?q="+thesaurus     = searchEngine "thesaurus"     "https://thesaurus.com/browse/"+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="+wayback       = searchEngineF "wayback"      ("https://web.archive.org/web/*/"++)+vocabulary    = searchEngine "vocabulary"    "https://www.vocabulary.com/search?q=" duckduckgo    = searchEngine "duckduckgo"    "https://duckduckgo.com/?t=lm&q="  multi :: SearchEngine-multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]+multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle, images, imdb, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google]  {- | This function wraps up a search engine and creates a new one, which works    like the argument, but goes directly to a URL if one is given rather than@@ -320,9 +326,9 @@  > 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"@@ -342,6 +348,7 @@   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)+infixr 6 !>  {- | 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@@ -358,8 +365,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 ("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 (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,8 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.ShowText+-- Description :  Display text on the screen. -- Copyright   :  (c) Mario Pastorelli (2012) -- License     :  BSD-style (see xmonad/LICENSE) --@@ -17,17 +18,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, when) import XMonad.StackSet (current,screen) import XMonad.Util.Font (Align(AlignCenter)                        , initXMF@@ -37,7 +36,6 @@ import XMonad.Util.Timer (startTimer) import XMonad.Util.XUtils (createNewWindow                          , deleteWindow-                         , fi                          , showWindow                          , paintAndWrite) import qualified XMonad.Util.ExtensibleState as ES@@ -58,7 +56,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 +73,22 @@  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)+    when (mtyp == a && not (null d))+         (whenJust (lookup (fromIntegral $ head d) m) deleteWindow)     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\/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) --
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
XMonad/Actions/SpawnOn.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.SpawnOn+-- Description  : Modify a window spawned by a command. -- Copyright    : (c) Spencer Janssen -- License      : BSD --@@ -29,15 +29,13 @@ ) 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@@ -68,15 +66,15 @@ -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -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+getPPIDOf thisPid =+    case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger thisPid of       Left _         -> Nothing       Right contents -> case lines contents of                           []        -> Nothing@@ -85,11 +83,11 @@                                          _                    -> Nothing  getPPIDChain :: ProcessID -> [ProcessID]-getPPIDChain pid' = ppid_chain pid' []-    where ppid_chain pid acc =-              if pid == 0+getPPIDChain thisPid = ppid_chain thisPid []+    where ppid_chain pid' acc =+              if pid' == 0               then acc-              else case getPPIDOf pid of+              else case getPPIDOf pid' of                      Nothing   -> acc                      Just ppid -> ppid_chain ppid (ppid : acc) @@ -126,7 +124,7 @@  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 +145,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) --@@ -20,10 +21,9 @@                              submapDefaultWithKey                             ) where import Data.Bits-import Data.Maybe (fromMaybe)+import XMonad.Prelude (fix, fromMaybe) import XMonad hiding (keys) import qualified Data.Map as M-import Control.Monad.Fix (fix)  {- $usage @@ -93,5 +93,6 @@      io $ ungrabPointer d currentTime     io $ ungrabKeyboard d currentTime+    io $ sync d False      fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)
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,13 @@   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   -- $usage@@ -118,7 +114,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@@ -341,7 +337,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) --@@ -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,14 +27,12 @@                  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@@ -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 ()@@ -158,7 +156,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 +165,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 +178,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,94 @@+-----------------------------------------------------------------------------+-- |+-- 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\/xmonad.hs@:+--+-- > import XMonad.Actions.TiledWindowDragging+-- > import XMonad.Layout.DraggingVisualizer+--+-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:+--+-- > myLayout = draggingVisualizer $ layoutHook def+--+-- Then add a mouse binding for 'dragWindow':+--+-- > , ((modMask .|. shiftMask, button1), dragWindow)+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++++-- | Create a mouse binding for this to be able to drag your windows around.+-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.+dragWindow :: Window -> X ()+dragWindow window = whenX (isClient window) $ do+    focus window+    (offsetX, offsetY)                <- getPointerOffset window+    (winX, winY, winWidth, winHeight) <- getWindowPlacement window++    mouseDrag+        (\posX posY ->+          let rect = Rectangle (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 :: Window -> X (Int, Int, Int, Int)+getWindowPlacement window = do+    wa <- withDisplay (\d -> io $ getWindowAttributes d window)+    return (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+        let (ls, t : rs)       = break (== win) allWindowsSwitched+        let newStack           = W.Stack t (reverse ls) rs+        windows $ W.modify' $ const newStack+   where+    switchEntries a b x | x == a    = b+                        | x == b    = a+                        | otherwise = x
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@@ -75,110 +105,128 @@ -- of last focused topics.  -- $usage--- Here is an example of configuration using TopicSpace:+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: ----- > -- 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 +236,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 +318,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@@ -113,10 +114,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 +132,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 +161,8 @@ -- white       = 0xffffffff -- black       = 0xff000000 -- red         = 0xffff0000--- blue        = 0xff00ff00--- green       = 0xff0000ff+-- green       = 0xff00ff00+-- blue        = 0xff0000ff -- transparent = 0x00000000 -- @ @@ -258,6 +259,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 +318,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 +409,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 +452,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 +465,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 +527,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, _) <- 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+       | 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 +606,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)@@ -650,8 +657,16 @@ -- -- 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/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,13 +17,13 @@     -- * 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@@ -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,13 +25,12 @@     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.Exception (SomeException, try)+import Control.Arrow ((&&&), (***))+ -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --@@ -61,6 +61,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@@ -105,6 +110,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,7 +23,7 @@                            warpToWindow                           ) where -import Data.List+import XMonad.Prelude import XMonad import XMonad.StackSet as W @@ -101,7 +102,7 @@ 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,17 +22,17 @@                     WindowBringerConfig(..),                     gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',                     bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',-                    windowMap, windowMap', bringWindow, actionMenu+                    windowMap, windowAppMap, windowMap', bringWindow, actionMenu                    ) where -import Control.Applicative((<$>))+import 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)  -- $usage --@@ -51,12 +52,14 @@     { 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"]                              , windowTitler = decorateName+                             , windowFilter = \_ -> return True                              }  -- | Pops open a dmenu with window titles. Choose one, and you will be@@ -123,11 +126,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 +135,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 +156,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 it's 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,6 @@ {- | Module      :  XMonad.Actions.WindowGo+Description :  Operations for raising (traveling to) windows. License     :  Public domain  Maintainer  :  <gwern0@gmail.com>@@ -36,10 +37,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
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,7 +30,7 @@ import XMonad.Actions.GridSelect import XMonad.Layout.Maximize import XMonad.Actions.Minimize-import XMonad.Util.XUtils (fi)+import XMonad.Prelude (fi)  -- $usage --@@ -68,7 +69,7 @@                     | tag <- tags ]     runSelectedAction gsConfig actions -getSize :: Window -> X (Rectangle)+getSize :: Window -> X Rectangle getSize w = do   d  <- asks display   wa <- io $ getWindowAttributes d w
XMonad/Actions/WindowNavigation.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- 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>@@ -40,17 +41,14 @@                                        ) where  import XMonad+import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, 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 qualified Data.Map as M-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)-import Data.Ord (comparing) import qualified Data.Set as S  -- $usage@@ -65,6 +63,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.@@ -125,9 +128,12 @@                                    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 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@@ -137,11 +143,11 @@       setPosition posRef pos targetRect  trackMovement :: IORef WNState -> X ()-trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do+trackMovement posRef = fromCurrentPoint posRef $ \win pos ->                            windowRect win >>= flip whenJust (setPosition posRef pos . snd)  fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()-fromCurrentPoint posRef f = withFocused $ \win -> do+fromCurrentPoint posRef f = withFocused $ \win ->                                 currentPosition posRef >>= f win  -- Gets the current position from the IORef passed in, or if nothing (say, from@@ -193,7 +199,7 @@ windowRect :: Window -> X (Maybe (Window, Rectangle)) windowRect 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 (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))     `catchX` return Nothing  -- Modified from droundy's implementation of WindowNavigation:@@ -209,7 +215,7 @@                                             py >= ry && py < ry + fromIntegral h  sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]-sortby D = sortBy $ comparing (rect_y . snd)-sortby R = sortBy $ comparing (rect_x . snd)+sortby D = sortOn (rect_y . snd)+sortby R = sortOn (rect_x . snd) sortby U = reverse . sortby D sortby L = reverse . sortby R
XMonad/Actions/WithAll.hs view
@@ -1,21 +1,23 @@ ----------------------------------------------------------------------------- -- | -- 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@@ -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,7 @@ ----------------------------------------------------------------------------- -- | -- Module     :  XMonad.Actions.Workscreen+-- Description:  Display a set of workspaces on several screens. -- Copyright  :  (c) 2012 kedals0 -- License    :  BSD3-style (see LICENSE) --@@ -20,7 +21,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@@ -58,23 +58,23 @@ -- "XMonad.Doc.Extending#Editing_key_bindings".  -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)
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 (find, fromJust, guard, liftA2, toList, when, (<=<))  -- $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@@ -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
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,23 +35,27 @@     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.Hooks.StatusBar.PP (PP(..))+import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename) import XMonad.Prompt (mkXPrompt, XPConfig) 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:@@ -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: --@@ -85,7 +94,7 @@  -- | 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.@@ -129,27 +137,13 @@  -- | Prompt for a new name for the current workspace and set it. renameWorkspace :: XPConfig -> X ()-renameWorkspace conf = do+renameWorkspace conf =     mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName     where pr = Wor "Workspace name: " --- | 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-        }- -- | 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 +163,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) --@@ -22,7 +23,7 @@  import qualified Data.Map as M -import XMonad hiding ( (|||) )+import XMonad import qualified XMonad.StackSet as W  import XMonad.Actions.CycleWS@@ -30,7 +31,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@@ -147,8 +147,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 --@@ -46,7 +47,7 @@  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 --@@ -39,9 +40,8 @@  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,7 +26,7 @@     bluetileConfig     ) where -import XMonad hiding ( (|||) )+import XMonad  import XMonad.Layout.BorderResize import XMonad.Layout.BoringWindows@@ -33,7 +34,6 @@ 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@@ -62,8 +62,7 @@ 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@:@@ -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 $ (+bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $                         named "Floating" floating |||                         named "Tiled1" tiled1 |||                         named "Tiled2" tiled2 |||                         named "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  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 --@@ -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@@ -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     , layoutHook      = desktopLayoutModifiers $ layoutHook 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 #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Dmwit+-- Description :  Daniel Wagner's xmonad configuration.+--+------------------------------------------------------------------------ module XMonad.Config.Dmwit 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 import XMonad.Util.Dzen hiding (x, y) import XMonad.Util.SpawnOnce -- }}}@@ -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@@ -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),
XMonad/Config/Droundy.hs view
@@ -2,19 +2,20 @@ {-# 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 -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) )@@ -39,8 +40,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 +78,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)
XMonad/Config/Example.hs view
@@ -29,8 +29,9 @@   xmonad $ desktopConfig     { modMask    = mod4Mask -- Use the "Win" key for the mod key     , manageHook = myManageHook <+> manageHook desktopConfig-    , layoutHook = desktopLayoutModifiers $ myLayouts-    , logHook    = dynamicLogString def >>= xmonadPropLog+    , 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 --@@ -45,7 +46,7 @@     , 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 --@@ -47,12 +48,12 @@     { terminal = "konsole"     , 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
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Config.Mate+-- Description  : Config for integrating xmonad with MATE. -- Copyright    : (c) Brandon S Allbery KF8NH, 2014 -- License      : BSD --@@ -20,13 +21,18 @@     -- $usage     mateConfig,     mateRun,+    matePanel,     mateRegister,+    mateLogout,+    mateShutdown,     desktopLayoutModifiers     ) where  import XMonad import XMonad.Config.Desktop import XMonad.Util.Run (safeSpawn)+import XMonad.Util.Ungrab+import XMonad.Prelude (toUpper)  import qualified Data.Map as M @@ -47,21 +53,29 @@     , 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 +91,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 +100,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,9 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}+{-# 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) --@@ -115,7 +116,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))@@ -478,7 +479,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 +498,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,4 +1,10 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Sjanssen+-- Description :  Spencer Janssen's xmonad config.+--+------------------------------------------------------------------------ module XMonad.Config.Sjanssen (sjanssenConfig) where  import XMonad hiding (Tall(..))@@ -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@@ -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 --@@ -36,10 +37,10 @@ -- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop".  xfceConfig = desktopConfig-    { terminal = "Terminal"+    { 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,8 +9,9 @@ -- 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".@@ -148,4 +150,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@@ -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,1708 +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.+{-# 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+-- 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++    -- ** 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 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 report it as a bug+(<https://github.com/xmonad/xmonad-contrib/issues>)!++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 provided by xmonad.++See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to+edit your key bindings.++-}++{- $hooks++In the @XMonad.Hooks@ namespace you can find modules exporting+hooks. Hooks are 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+  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.++-}++{- $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".++-}++{- $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.++-}++{- $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 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. The module "XMonad.Hooks.StatusBar" offers another interface+to interact with status bars, that might be more convenient to use.  By default the 'XMonad.Core.logHook' doesn't produce anything. To enable it you need first to import "XMonad.Hooks.DynamicLog":
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) --@@ -25,7 +25,7 @@ import XMonad import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS-import Control.Monad(when)+import XMonad.Prelude (unless, when) import qualified Data.Map as M  -- $usage@@ -40,7 +40,7 @@ -- >  } -- -data CWOTState = CWOTS String deriving Typeable+newtype CWOTState = CWOTS String  instance ExtensionClass CWOTState where   initialValue = CWOTS ""@@ -55,15 +55,15 @@         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+        unless (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         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.Fail 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.C.Types import           Numeric                                     (showHex) import           System.Exit import           System.IO import           System.Process-import           Control.Applicative  -- | 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   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 ()@@ -226,12 +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 $@@ -281,13 +267,14 @@              ,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 a n w i  =  do@@ -313,9 +300,9 @@               vsp     case rc of       0 -> do-        fmt <- fromIntegral `fmap` peek fmtp+        fmt <- fromIntegral <$> peek fmtp         vs' <-                     peek vsp-        sz  <- fromIntegral `fmap` peek szp+        sz  <- fromIntegral <$> peek szp         case () of           () | fmt == none     -> xFree vs' >> return (Left   "(property deleted)"   )              | sz < 0          -> xFree vs' >> return (Left $ "(illegal bit size " ++@@ -325,9 +312,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)@@ -414,8 +401,8 @@ 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 @@ -527,12 +514,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@@ -610,7 +597,7 @@ dumpArray'          :: 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 ",") @@ -697,31 +684,30 @@ dumpString :: 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 (...)+       | fmt == sTRING        -> guardSize  8 $ do+                                   vs <- gets value+                                   modify (\r -> r {value = []})+                                   let ss = flip unfoldr (map twiddle vs) $+                                            \s -> if null s+                                                  then Nothing+                                                  else let (w,s'') = break (== '\NUL') s+                                                           s'      = if null s''+                                                                     then s''+                                                                     else tail s''+                                                        in Just (w,s')+                                   case ss of+                                     [s] -> append $ show s+                                     ss' -> let go (s:ss'') c = append c        >>+                                                                append (show s) >>+                                                                go ss'' ","+                                                go []       _ = append "]"+                                             in append "[" >> go ss' ""+       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)+       | otherwise            -> inX (atomName fmt) >>=+                                 failure . ("unrecognized string type " ++)  -- show who owns a selection dumpSelection :: Decoder Bool@@ -740,7 +726,7 @@ -- for now, not querying Xkb dumpXKlInds :: Decoder Bool dumpXKlInds =  guardType iNTEGER $ do-                 n <- fmap fromIntegral `fmap` getInt' 32+                 n <- fmap fromIntegral <$> getInt' 32                  case n of                    Nothing -> propShortErr                    Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])@@ -751,7 +737,7 @@                        | 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)@@ -826,10 +812,10 @@ 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+    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@@ -849,7 +835,7 @@                   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)@@ -901,7 +887,7 @@   guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL)                            ,("window",dumpWindow       ,wINDOW  )                            ]-             + -- the most common case dumpEnum    :: [String] -> Decoder Bool dumpEnum ss =  dumpEnum' ss cARDINAL@@ -945,7 +931,7 @@                       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@@ -1001,13 +987,13 @@         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 =  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"@@ -1025,7 +1011,7 @@                  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) ++ "%"@@ -1166,7 +1152,7 @@                 return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1) getInt' w  =  guardR width w  (\a e -> propSizeErr a e >> return Nothing) $               guardSize' (bytes w) (propShortErr >> return Nothing)       $-              Just `fmap` inhale w+              Just <$> inhale w  -- parse an integral value and feed it to a show-er of some kind getInt     :: Int -> (Integer -> String) -> Decoder Bool@@ -1178,28 +1164,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
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)@@ -57,27 +57,27 @@  -- | 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,7 +87,7 @@  -- | 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
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. --@@ -51,7 +48,6 @@ data DynamicHooks = DynamicHooks     { transients :: [(Query Bool, ManageHook)]     , permanent  :: ManageHook }-                    deriving Typeable  instance ExtensionClass DynamicHooks where     initialValue = DynamicHooks [] idHook@@ -62,16 +58,16 @@ -- 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)@@ -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) Will Pierlot <willp@outlook.com.au>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Will Pierlot <willp@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@: ----- >    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,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DynamicProperty+-- Description :  Apply a ManageHook to an already-mapped window. -- Copyright   :  (c) Brandon S Allbery, 2015 -- License     :  BSD3-style (see LICENSE) --@@ -21,23 +22,62 @@ -- 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.DynamicProperty where+module XMonad.Hooks.DynamicProperty ( -- * Usage+                                      -- $usage +                                      -- * Documentation+                                      dynamicPropertyChange+                                    , dynamicTitle+                                    ) where+ import XMonad-import Data.Monoid-import Control.Applicative-import Control.Monad (when)+import XMonad.Prelude +-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.DynamicProperty+--+-- Enable it by including in you handleEventHook definition:+--+-- >  main = xmonad $ def+-- >      { ...+-- >      , handleEventHook = dynamicPropertyChange "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 = dynamicPropertyChange "WM_NAME" myDynamicManageHook <+> handleEventHook baseConfig+-- >      , ...+-- >      }+--+ -- | -- 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+-- be very specific in your 'ManageHook' matching (lots of windows change -- their titles on the fly!): ----- dynamicPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2")--- +-- > 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. --@@ -46,10 +86,12 @@ -- Consider instead phrasing it like any -- other 'ManageHook': --+-- >  main = xmonad $ def+-- >      { ... -- >      , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <+> handleEventHook baseConfig--- > --- >    {- ... -}--- > +-- >      , ...+-- >      }+-- > -- >    myDynHook = composeAll [...] -- dynamicPropertyChange :: String -> ManageHook -> Event -> X All
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,39 +13,57 @@ -- 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,++    -- * Customization+    -- $customization++    -- ** Sorting/filtering of workspaces+    -- $customSort+    addEwmhWorkspaceSort, setEwmhWorkspaceSort,++    -- ** Renaming of workspaces+    -- $customRename+    addEwmhWorkspaceRename, setEwmhWorkspaceRename,++    -- ** Window activation+    -- $customActivate+    setEwmhActivateHook,++    -- * 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 System.IO.Unsafe  import XMonad-import Control.Monad+import XMonad.Prelude import qualified XMonad.StackSet as W +import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName-import qualified XMonad.Util.ExtensibleState as E-import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32)+import qualified XMonad.Util.ExtensibleConf as XC+import qualified XMonad.Util.ExtensibleState as XS  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -48,183 +71,331 @@ -- > 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 } --- |--- Initializes EwmhDesktops and advertises EWMH support to the X--- server++-- $customization+-- It's possible to customize the behaviour of 'ewmh' in several ways:++-- | 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+        }++instance Default EwmhDesktopsConfig where+    def = EwmhDesktopsConfig+        { workspaceSort = getSortByIndex+        , workspaceRename = pure pure+        , activateHook = doFocus+        }+++-- $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{…}++-- | 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) }++-- | Like 'addEwmhWorkspaceSort', but replace it instead of adding/composing.+setEwmhWorkspaceSort :: X WorkspaceSort -> XConfig l -> XConfig l+setEwmhWorkspaceSort f = XC.modifyDef $ \c -> c{ workspaceSort = f }+++-- $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) }++-- | 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" and "XMonad.Hooks.Focus"+-- for functions that can be useful here.++-- | Set (replace) the hook which is invoked when a client sends a+-- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus'+-- 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 }+++-- | Initializes EwmhDesktops and advertises EWMH support to the X server.+{-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-} ewmhDesktopsStartup :: X () ewmhDesktopsStartup = setSupported --- |--- Notifies pagers and window lists, such as those in the gnome-panel--- of the current state of workspaces and windows.+-- | 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 = ewmhDesktopsLogHookCustom id---- |--- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and--- @_NET_DESKTOP_NAMES@).-newtype DesktopNames = DesktopNames [String]-                     deriving (Eq)+ewmhDesktopsLogHook = XC.withDef ewmhDesktopsLogHook' -instance ExtensionClass DesktopNames where-    initialValue = DesktopNames []+-- | 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 } --- |--- Cached client list (e.g. @_NET_CLIENT_LIST@).-newtype ClientList = ClientList [Window]-                   deriving (Eq)+-- | Intercepts messages from pagers and similar applications and reacts on them.+--+-- Currently supports:+--+--  * _NET_CURRENT_DESKTOP (switching desktops)+--+--  * _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 = XC.withDef . ewmhDesktopsEventHook' -instance ExtensionClass ClientList where-    initialValue = ClientList []+-- | 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 } --- |--- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@).-newtype CurrentDesktop = CurrentDesktop Int-                       deriving (Eq)+-- | Cached @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@+newtype DesktopNames = DesktopNames [String] deriving Eq+instance ExtensionClass DesktopNames where initialValue = DesktopNames [] -instance ExtensionClass CurrentDesktop where-    initialValue = CurrentDesktop 0+-- | Cached @_NET_CLIENT_LIST@+newtype ClientList = ClientList [Window] deriving Eq+instance ExtensionClass ClientList where initialValue = ClientList [none] --- |--- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@).-newtype WindowDesktops = WindowDesktops (M.Map Window Int)-                       deriving (Eq)+-- | Cached @_NET_CLIENT_LIST_STACKING@+newtype ClientListStacking = ClientListStacking [Window] deriving Eq+instance ExtensionClass ClientListStacking where initialValue = ClientListStacking [none] -instance ExtensionClass WindowDesktops where-    initialValue = WindowDesktops M.empty+-- | Cached @_NET_CURRENT_DESKTOP@+newtype CurrentDesktop = CurrentDesktop Int deriving Eq+instance ExtensionClass CurrentDesktop where initialValue = CurrentDesktop (complement 0) --- |--- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property--- updates.-newtype ActiveWindow = ActiveWindow Window-                     deriving (Eq)+-- | Cached @_NET_WM_DESKTOP@+newtype WindowDesktops = WindowDesktops (M.Map Window Int) deriving Eq+instance ExtensionClass WindowDesktops where initialValue = WindowDesktops (M.singleton none (complement 0)) -instance ExtensionClass ActiveWindow where-    initialValue = ActiveWindow none+-- | Cached @_NET_ACTIVE_WINDOW@+newtype ActiveWindow = ActiveWindow Window deriving Eq+instance ExtensionClass ActiveWindow where initialValue = ActiveWindow (complement none)  -- | Compare the given value against the value in the extensible state. Run the -- action if it has changed. whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()-whenChanged v action = do-    v0 <- E.get-    unless (v == v0) $ do-        action-        E.put v+whenChanged = whenX . XS.modified . const --- |--- 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+ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()+ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename} = withWindowSet $ \s -> do+    sort' <- workspaceSort+    let ws = sort' $ W.workspaces s      -- Set number of workspaces and names thereof-    let desktopNames = map W.tag ws+    rename <- workspaceRename+    let desktopNames = [ rename (W.tag w) w | w <- ws ]     whenChanged (DesktopNames desktopNames) $ do         setNumberOfDesktops (length desktopNames)         setDesktopNames desktopNames -    -- Set client list; all windows, with focused windows last-    let clientList = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws+    -- 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 -    -- Remap the current workspace to handle any renames that f might be doing.-    let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])-        current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')-    whenChanged (CurrentDesktop $ fromMaybe 0 current) $ do+    -- Set stacking client list which should have bottom-to-top+    -- stacking order, i.e. focused window should be last+    let clientListStacking = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws+    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) $ do+    whenChanged (WindowDesktops windowDesktops) $         mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)      -- Set active window     let activeWindow' = fromMaybe none (W.peek s)     whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' --- |--- Intercepts messages from pagers and similar applications and reacts on them.--- Currently supports:------  * _NET_CURRENT_DESKTOP (switching desktops)------  * _NET_WM_DESKTOP (move windows to other desktops)------  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)-ewmhDesktopsEventHook :: Event -> X All-ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id+ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All+ewmhDesktopsEventHook'+        ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d}+        EwmhDesktopsConfig{workspaceSort, activateHook} =+    withWindowSet $ \s -> do+        sort' <- workspaceSort+        let ws = sort' $ W.workspaces s --- |--- 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)+        a_cd <- getAtom "_NET_CURRENT_DESKTOP"+        a_d <- getAtom "_NET_WM_DESKTOP"+        a_aw <- getAtom "_NET_ACTIVE_WINDOW"+        a_cw <- getAtom "_NET_CLOSE_WINDOW" -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+        if  | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->+                if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww)+            | mt == a_cd ->+                trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d+            | 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+            | mt == a_cw ->+                killWindow w+            | otherwise ->+                -- The Message is unknown to us, but that is ok, not all are meant+                -- to be handled by the window manager+                mempty -       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 ()+        mempty+ewmhDesktopsEventHook' _ _ = mempty --- |--- An event hook to handle applications that wish to fullscreen using the--- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()+-- | 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+  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 @@ -232,10 +403,9 @@       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 (managed && typ == wmstate && fi fullsc `elem` dats) $ do     when (action == add || (action == toggle && not isFull)) $ do       chWstate (fi fullsc:)       windows $ W.float win $ W.RationalRect 0 0 1 1@@ -250,16 +420,14 @@ 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@@ -272,26 +440,33 @@  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) +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]+ 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"@@ -301,13 +476,19 @@                          ,"_NET_WM_DESKTOP"                          ,"_NET_WM_STRUT"                          ]-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)+    io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp)      setWMName "xmonad" -setActiveWindow :: Window -> X ()-setActiveWindow w = withDisplay $ \dpy -> do+-- 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,8 +28,8 @@     ) 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@:@@ -64,8 +65,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 +92,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 +104,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 +112,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,18 +75,27 @@ -- >     , 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. --+-- 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.MoreManageHelpers", which -- exports a number of Queries that can be used in either @ManageHook@ -- or @FadeHook@.@@ -164,17 +172,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,7 +213,7 @@   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@@ -213,7 +221,7 @@ --   "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/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@@ -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,561 @@+{-# LANGUAGE FlexibleContexts       #-}+{-# 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)+instance Functor FocusQuery where+    fmap f (FocusQuery x) = FocusQuery (fmap f x)+instance Applicative FocusQuery where+    pure x                              = FocusQuery (pure x)+    (FocusQuery f) <*> (FocusQuery mx)  = FocusQuery (f <*> mx)+instance Monad FocusQuery where+    return x                = FocusQuery (return x)+    (FocusQuery mx) >>= f   = FocusQuery $ mx >>= \x ->+                              let FocusQuery y = f x in y+instance MonadReader Focus FocusQuery where+    ask                     = FocusQuery ask+    local f (FocusQuery mx) = FocusQuery (local f mx)+instance MonadIO FocusQuery where+    liftIO mx       = FocusQuery (liftIO mx)+instance Semigroup a => Semigroup (FocusQuery a) where+    (<>)            = liftM2 (<>)+instance Monoid a => Monoid (FocusQuery a) where+    mempty          = return mempty+    mappend         = (<>)++runFocusQuery :: FocusQuery a -> Focus -> Query a+runFocusQuery (FocusQuery m)    = runReaderT m++type FocusHook      = FocusQuery (Endo WindowSet)+++-- Lifting into 'FocusQuery'.+-- $lift++-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'.+liftQuery :: Query a -> FocusQuery a+liftQuery           = FocusQuery . lift++-- | Run 'Query' on new window.+new :: Query a -> FocusQuery a+new                 = liftQuery++-- | Run 'Query' on focused window on workspace, where new window appears. If+-- there is no focused window, return 'False'.+focused :: Query Bool -> FocusQuery Bool+focused m           = getAny <$> focused' (Any <$> m)+-- | More general version of 'focused'.+focused' :: Monoid a => Query a -> FocusQuery a+focused' m          = do+    mw <- asks focusedWindow+    liftQuery (maybe mempty (flip local m . const) mw)++-- | Run 'Query' on window focused at particular workspace. If there is no+-- focused window, return 'False'.+focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool+focusedOn i m       = getAny <$> focusedOn' i (Any <$> m)+-- | More general version of 'focusedOn'.+focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a+focusedOn' i m      = liftQuery $ do+    mw <- liftX $ withWindowSet (return . W.peek . W.view i)+    maybe mempty (flip local m . const) mw++-- | Run 'Query' on focused window on current workspace. If there is no+-- focused window, return 'False'.  Note,+--+-- > focused <&&> newOnCur != focusedCur+--+-- The first will affect only new or activated window appearing on current+-- workspace, while the last will affect any window: focus even for windows+-- appearing on other workpsaces will depend on focus on /current/ workspace.+focusedCur :: Query Bool -> FocusQuery Bool+focusedCur m        = getAny <$> focusedCur' (Any <$> m)+-- | More general version of 'focusedCur'.+focusedCur' :: Monoid a => Query a -> FocusQuery a+focusedCur' m       = asks currentWorkspace >>= \i -> focusedOn' i m++-- | Does new window appear at particular workspace?+newOn :: WorkspaceId -> FocusQuery Bool+newOn i             = 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 view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.ICCCMFocus+-- Description  : Deprecated. -- License      : BSD -- -- Maintainer   : Tony Morris <haskell@tmorris.net>@@ -38,5 +39,4 @@ takeTopFocus ::   X () takeTopFocus =-  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"-+  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) --@@ -21,11 +22,8 @@     ) where  import XMonad(ManageHook, MonadReader(ask))+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@:@@ -47,7 +45,7 @@ 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'
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) --@@ -29,14 +28,14 @@                                 ) where  import           XMonad+import           XMonad.Prelude (when) import           XMonad.Hooks.DebugStack 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+newtype ManageStackDebug = MSD (Bool,Bool) instance ExtensionClass ManageStackDebug where   initialValue = MSD (False,False)
XMonad/Hooks/ManageDocks.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-} ----------------------------------------------------------------------------- -- | -- 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,     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,14 +41,11 @@ 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 (All (..), fi, filterM, foldlM, void, when, (<=<))  import qualified Data.Set as S import qualified Data.Map as M-import Control.Monad (when, forM_, filterM)  -- $usage -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:@@ -54,7 +54,7 @@ -- -- 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.@@ -91,35 +91,62 @@             , 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+ -- | 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 +-- | 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 checkDock :: Query Bool checkDock = ask >>= \w -> liftX $ do@@ -127,39 +154,32 @@     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)+        Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs         _       -> return False  -- | 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 +187,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 _ = []@@ -182,7 +202,7 @@ calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) calcGap ss = withDisplay $ \dpy -> do     rootw <- asks theRoot-    struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache)+    struts <- filter careAbout . concat . 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@@ -206,13 +226,13 @@               -> 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 +258,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
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,12 +25,27 @@ -- >         ], -- >         ... -- >     }+--+-- 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+-- > q ***? x = fmap (`f` x) q+--+-- 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,@@ -39,6 +56,10 @@     MaybeManageHook,     transience,     transience',+    clientLeader,+    sameBy,+    shiftToSame,+    shiftToSame',     doRectFloat,     doFullFloat,     doCenterFloat,@@ -46,16 +67,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 +96,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 q 'isPrefixOf' x, return True+(^?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool+q ^? x = fmap (`isPrefixOf` x) q++-- | q ~? x. if the result of q 'isSuffixOf' x, return True+(~?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool+q ~? x = fmap (`isInfixOf` x) q++-- | q $? x. if the result of q 'isSuffixOf' x, return True+($?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool+q $? x = fmap (`isSuffixOf` x) q+ -- | q <==? x. if the result of q equals x, return True grouped with q-(<==?) :: Eq a => Query a -> a -> Query (Match a)+(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a) q <==? x = fmap (`eq` x) q     where     eq q' x' = Match (q' == x') q'  -- | q <\/=? x. if the result of q notequals x, return True grouped with q-(</=?) :: Eq a => Query a -> a -> Query (Match a)+(</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a) q </=? x = fmap (`neq` x) q     where     neq q' x' = Match (q' /= x') q'@@ -103,19 +136,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 +157,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@@ -150,12 +187,14 @@ isDialog :: Query Bool isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG" +-- | 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  -- | A predicate to check whether a window is Transient. -- It holds the result which might be the window it is transient to@@ -169,19 +208,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 +282,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 +298,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,11 +20,9 @@       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@:@@ -37,9 +36,9 @@ -- >                   , 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"
XMonad/Hooks/Place.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.Place+-- Description :  Automatic placement of floating windows. -- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) --@@ -34,18 +35,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@@ -166,16 +163,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 $@@ -190,13 +187,13 @@                         -- workspace's screen.                       let infos = filter ((window `elem`) . stackContents . S.stack . fst)                                      $ [screenInfo $ S.current theWS]-                                        ++ (map screenInfo $ S.visible theWS)+                                        ++ map screenInfo (S.visible theWS)                                         ++ zip (S.hidden theWS) (repeat currentRect)                        guard(not $ null infos)                        let (workspace, screen) = head infos-                          rs = catMaybes $ map (flip M.lookup allRs)+                          rs = mapMaybe (`M.lookup` allRs)                                $ organizeClients workspace window floats                           r' = purePlaceWindow p screen rs pointer r                           newRect = r2rr screen r'@@ -225,7 +222,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 +276,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 +326,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,16 +35,13 @@     ) 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@@ -95,12 +93,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
@@ -41,20 +41,19 @@   RecentWins(..),   RecentsMap(..),   RefocusLastLayoutHook(..),-  RefocusLastToggle(..)+  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 Data.Maybe (fromMaybe)-import Data.Monoid (All(..))-import Data.Foldable (asum) import qualified Data.Map.Strict as M-import Control.Monad (when)  -- }}} @@ -113,7 +112,7 @@ -- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace. --   Is an instance of @ExtensionClass@ with persistence of state. newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)-  deriving (Show, Read, Eq, Typeable)+  deriving (Show, Read, Eq)  instance ExtensionClass RecentsMap where   initialValue = RecentsMap M.empty@@ -129,7 +128,7 @@  -- | A newtype on @Bool@ to act as a universal toggle for refocusing. newtype RefocusLastToggle = RefocusLastToggle { refocusing :: Bool }-  deriving (Show, Read, Eq, Typeable)+  deriving (Show, Read, Eq)  instance ExtensionClass RefocusLastToggle where   initialValue  = RefocusLastToggle { refocusing = True }@@ -265,7 +264,7 @@  -- }}} --- --< Private Utilities >-- {{{+-- --< Utilities >-- {{{  -- | Focuses the first window in the list it can find on the current workspace. tryFocus :: [Window] -> WindowSet -> WindowSet@@ -284,12 +283,12 @@ -- | Perform an X action dependent on successful lookup of the RecentWins for --   the specified workspace, or return a default value. withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a-withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap-                       >>= maybe (return dflt) (\(Recent lw cw) -> f lw cw)+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,159 @@+{-# 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+    RescreenConfig(..),+    addAfterRescreenHook,+    addRandrChangeHook,+    rescreenHook,+    ) where++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, as well as to actually invoke+-- xrandr or autorandr when an output is (dis)connected.+--+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.RescreenHook+--+-- defining your custom hooks:+--+-- > myAfterRescreenHook :: X ()+-- > myAfterRescreenHook = …+--+-- > myRandrChangeHook :: X ()+-- > myRandrChangeHook = …+--+-- > rescreenCfg = def{+-- >     afterRescreenHook = myAfterRescreenHook,+-- >     randrChangeHook = myRandrChangeHook+-- > }+--+-- and adding 'rescreenHook' to your 'xmonad' config:+--+-- > main = xmonad $ … . rescreenHook rescreenCfg . … $ def{…}++-- | 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+    }++instance Default RescreenConfig where+    def = RescreenConfig+        { afterRescreenHook = mempty+        , randrChangeHook = mempty+        }++instance Semigroup RescreenConfig where+    RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch')++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.+--+-- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still+-- done just once and hooks are invoked in sequence, also just once.+rescreenHook :: RescreenConfig -> XConfig l -> XConfig l+rescreenHook = XC.once $ \c -> c+    { startupHook = startupHook c <> rescreenStartupHook+    , handleEventHook = handleEventHook c <> rescreenEventHook }++-- | Shortcut for 'rescreenHook'.+addAfterRescreenHook :: X () -> XConfig l -> XConfig l+addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }++-- | Shortcut for 'rescreenHook'.+addRandrChangeHook :: X () -> XConfig l -> XConfig l+addRandrChangeHook h = rescreenHook def{ randrChangeHook = h }++-- | 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.+    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 rescreen >> 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 view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.RestoreMinimized+-- Description :  Deprecated: Use XMonad.Hooks.Minimize. -- Copyright   :  (c) Jan Vornberger 2009 -- License     :  BSD3-style (see LICENSE) --@@ -22,7 +23,7 @@     , restoreMinimizedEventHook     ) where -import Data.Monoid+import XMonad.Prelude  import XMonad
XMonad/Hooks/ScreenCorners.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.ScreenCorners+-- Description :  Run X () actions by touching the edge of your screen with your mouse. -- Copyright   :  (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky -- License     :  BSD3-style (see LICENSE) --@@ -30,10 +31,8 @@     , screenCornerLayoutHook     ) where -import Data.Monoid-import Data.List (find)+import XMonad.Prelude import XMonad-import XMonad.Util.XUtils (fi) import XMonad.Layout.LayoutModifier  import qualified Data.Map as M@@ -45,14 +44,11 @@                   | SCLowerRight                   deriving (Eq, Ord, Show) -- -------------------------------------------------------------------------------- -- ExtensibleState modifications --------------------------------------------------------------------------------  newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))-    deriving Typeable  instance ExtensionClass ScreenCornerState where     initialValue = ScreenCornerState M.empty@@ -65,13 +61,13 @@     (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of                          Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions-                        Nothing           -> flip (,) xF `fmap` createWindowAt corner+                        Nothing           -> (, xF) <$> createWindowAt corner      XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'  -- | Add a list of @(ScreenCorner, X ())@ tuples addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()-addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)+addScreenCorners = mapM_ (uncurry addScreenCorner)   --------------------------------------------------------------------------------@@ -179,7 +175,7 @@ -- -- > myStartupHook = do -- >     ...--- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})+-- >     addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200}) -- >     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,7 @@ ----------------------------------------------------------------------------- -- | -- 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 +13,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,12 +27,10 @@     , 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@@ -118,7 +46,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 +56,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 +76,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 +88,14 @@ -- > 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+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+         let atom = fromIntegral (head dt)          cmd <- io $ getAtomName d atom          case cmd of               Just command -> func command-              Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))+              Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)         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 --@@ -36,17 +37,16 @@ -----------------------------------------------------------------------------  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 -    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/StatusBar.hs view
@@ -0,0 +1,566 @@+{-# 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,+  ) 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\/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 -> IO StatusBarConfig+-- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen+-- > barSpawner 1 = pure $ xmobar1+-- > barSpawner _ = mempty -- nothing on the rest of the screens+-- >+-- > main = xmonad $ dynamicSBs 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 -> IO 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 -> IO 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 -> IO 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 <- io $ 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)
+ XMonad/Hooks/StatusBar/PP.hs view
@@ -0,0 +1,545 @@+{-# 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,+    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 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 = 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 $ 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)+      | '^' == 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 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 = 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 ++ ">"++-- | 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/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 $ defaultConfig+-- > ...++-- | 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@@ -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,7 +197,7 @@ -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>                    h -> XConfig l -> XConfig l-withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf+withUrgencyHook hook = withUrgencyHookC hook urgencyConfig  -- | This lets you modify the defaults set in 'urgencyConfig'. An example: --@@ -217,10 +208,11 @@                     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@@ -276,7 +268,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 +280,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 +297,7 @@                          , window    :: Window                          , interval  :: Interval                          , remaining :: Maybe Int-                         } deriving (Show,Read,Eq,Typeable)+                         } deriving (Show,Read,Eq)  instance ExtensionClass [Reminder] where     initialValue = []@@ -321,14 +319,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 +335,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 +354,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 +381,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 +418,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 +492,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@@ -535,11 +535,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 @@ -85,7 +77,7 @@ instance Monoid WallpaperList where   mempty = WallpaperList []   mappend (WallpaperList w1) (WallpaperList w2) =-    WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)+    WallpaperList $ M.toList $ M.fromList w2 `M.union` M.fromList w1  instance Semigroup WallpaperList where   (<>) = mappend@@ -103,10 +95,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@@ -161,7 +161,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 +175,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,7 +184,7 @@   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)+      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   return foundpaths@@ -199,20 +198,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 @@ -224,4 +223,4 @@     Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in                      " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")                       ++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)"-                      ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "+                      ++ " -geometry +" ++ show (rect_x rect) ++ "+" ++ show (rect_y rect) ++ " -composite "
+ XMonad/Hooks/WindowSwallowing.hs view
@@ -0,0 +1,260 @@+{-# 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__: This module depends on @pstree@ to analyze the process hierarchy, so make+-- sure that is on your @$PATH@.+--+-- __NOTE__ that this does not always work perfectly:+--+-- - Because window swallowing needs to check the process hierarchy, it requires+--   both the child and the parent to be distinct processes. This means that+--   applications which implement instance sharing cannot be supported by window swallowing.+--   Most notably, this excludes some terminal emulators as well as tmux+--   from functioning as the parent process. It also excludes a good amount of+--   child programs, because many graphical applications do implement instance sharing.+--   For example, window swallowing will probably not work with your browser.+--+-- - To check the process hierarchy, we need to be able to get the process ID+--   by looking at the window. This requires the @_NET_WM_PID@ X-property to be set.+--   If any application you want to use this with does not provide the @_NET_WM_PID@,+--   there is not much you can do except for reaching out to the author of that+--   application and asking them to set that property.+-----------------------------------------------------------------------------+module XMonad.Hooks.WindowSwallowing+  ( -- * Usage+    -- $usage+    swallowEventHook, 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.Run                ( runProcessWithInput )+import qualified Data.Map.Strict               as M++-- $usage+-- You can use this module by including  the following in your @~\/.xmonad/xmonad.hs@:+--+-- > import XMonad.Hooks.WindowSwallowing+--+-- and using 'swallowEventHook' somewhere in your 'handleEventHook', for example:+--+-- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True)+--+-- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layouts.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 "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.Layouts.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+          (Just parent, Just oldStack) -> do+            -- If there actually is a corresponding swallowed parent window for this window,+            -- we will try to restore it.+            -- because there are some cases where the stack-state is not stored correctly in the ConfigureEvent hook,+            -- we have to first check if the stack-state is valid.+            -- if it is, we can restore the parent exactly where the child window was before being closed+            -- if the stored stack-state is invalid however, we still restore the window+            -- by just inserting it as the focused window in the stack.+            stackStoredCorrectly <- do+              curStack <- withWindowSet (return . currentStack)+              let oldLen = length (W.integrate oldStack)+              let curLen = length (W.integrate' curStack)+              return (oldLen - 1 == curLen && childWindow == W.focus oldStack)++            if stackStoredCorrectly+              then windows+                (\ws ->+                  updateCurrentStack+                      (const $ Just $ oldStack { W.focus = parent })+                    $ moveFloatingState childWindow parent+                    $ ws { W.floating = oldFloating }+                )+              else windows (insertIntoStack parent)+            -- after restoring, we remove the information about the swallowing from the state.+            XS.modify $ removeSwallowed childWindow+            XS.modify $ setStackBeforeWindowClosing Nothing+          _ -> return ()+        return ()+    _ -> return ()+  return $ All True++-- | insert a window as focused into the current stack, moving the previously focused window down the stack+insertIntoStack :: a -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd+insertIntoStack win = W.modify+  (Just $ W.Stack win [] [])+  (\s -> Just $ s { W.focus = win, W.down = W.focus s : W.down s })++-- | run a pure transformation on the Stack of the currently focused workspace.+updateCurrentStack+  :: (Maybe (W.Stack a) -> Maybe (W.Stack a))+  -> W.StackSet i l a sid sd+  -> W.StackSet i l a sid sd+updateCurrentStack f = W.modify (f Nothing) (f . Just)++currentStack :: W.StackSet i l a sid sd -> Maybe (W.Stack a)+currentStack = W.stack . W.workspace . W.current+++-- | move the floating state from one window to another, sinking the original window+moveFloatingState+  :: Ord a+  => a -- ^ window to move from+  -> a -- ^ window to move to+  -> W.StackSet i l a s sd+  -> W.StackSet i l a s sd+moveFloatingState from to ws = ws+  { W.floating = M.delete from $ maybe (M.delete to (W.floating ws))+                                       (\r -> M.insert to r (W.floating ws))+                                       (M.lookup from (W.floating ws))+  }++-- | check if a given process is a child of another process. This depends on "pstree" being in the PATH+-- NOTE: this does not work if the child process does any kind of process-sharing.+isChildOf+  :: Int -- ^ child PID+  -> Int -- ^ parent PID+  -> IO Bool+isChildOf child parent = do+  output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""+  return $ any (show child `isInfixOf`) $ lines output++data SwallowingState =+  SwallowingState+    { currentlySwallowed       :: M.Map Window Window         -- ^ mapping from child window window to the currently swallowed parent window+    , stackBeforeWindowClosing :: Maybe (W.Stack Window)      -- ^ current stack state right before DestroyWindowEvent is sent+    , floatingBeforeClosing    :: M.Map Window W.RationalRect -- ^ floating map of the stackset right before DestroyWindowEvent is sent+    } deriving (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,7 @@ ---------------------------------------------------------------------------- -- | -- 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,12 +22,10 @@     ) 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 (lift, runExceptT, throwError)  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -44,7 +43,7 @@ needsMoving w = withDisplay $ \d -> do     -- only relocate windows with non-zero position     wa <- io $ getWindowAttributes d w-    fmap (const Nothing `either` Just) . runErrorT $ do+    fmap (const Nothing `either` Just) . runExceptT $ do         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,7 @@-{-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.WorkspaceHistory+-- Description :  Keep track of workspace viewing order. -- Copyright   :  (c) 2013 Dmitri Iouchtchenko -- License     :  BSD3-style (see LICENSE) --@@ -19,20 +18,22 @@       -- $usage       -- * Hooking     workspaceHistoryHook+  , workspaceHistoryHookExclude       -- * Querying   , workspaceHistory   , workspaceHistoryByScreen   , workspaceHistoryWithScreen     -- * Handling edits   , workspaceHistoryTransaction+  , workspaceHistoryModify   ) where  import           Control.Applicative 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) import qualified XMonad.Util.ExtensibleState as XS  -- $usage@@ -49,12 +50,20 @@ -- >      , ... -- >      } --+-- 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)  instance ExtensionClass WorkspaceHistory where     initialValue = WorkspaceHistory []@@ -65,6 +74,12 @@ workspaceHistoryHook :: X () workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen) +-- | Like 'workspaceHistoryHook', but with the ability to exclude+-- certain workspaces.+workspaceHistoryHookExclude :: [WorkspaceId] -> X ()+workspaceHistoryHookExclude ws =+  gets windowset >>= XS.modify . updateLastActiveOnEachScreenExclude ws+ workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)] workspaceHistoryWithScreen = XS.gets history @@ -85,19 +100,29 @@ workspaceHistoryTransaction action = do   startingHistory <- XS.gets history   action-  new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset+  new <- flip updateLastActiveOnEachScreen (WorkspaceHistory startingHistory) <$> gets windowset   XS.put 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 $ 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,12 +20,10 @@                  ) 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@:@@ -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 --
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,12 +21,14 @@                              -- $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@@ -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,11 +27,10 @@  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 @@ -91,15 +91,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 +105,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 +132,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 +142,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 +175,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 +184,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 +204,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 +214,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) --@@ -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,9 +1,11 @@ {-# 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@@ -24,7 +26,7 @@   , BinarySpacePartition   , Rotate(..)   , Swap(..)-  , ResizeDirectional(..)+  , ResizeDirectional(.., ExpandTowards, ShrinkFrom, MoveSplit)   , TreeRotate(..)   , TreeBalance(..)   , FocusParent(..)@@ -34,6 +36,7 @@   ) where  import XMonad+import XMonad.Prelude hiding (insert) import qualified XMonad.StackSet as W import XMonad.Util.Stack hiding (Zipper) import XMonad.Util.Types@@ -45,10 +48,6 @@  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@@ -95,11 +94,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-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,@@ -109,38 +112,53 @@ -- > , ((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-data SplitShiftDirectional = SplitShift Direction1D deriving Typeable+-- | Message for shifting window by splitting its neighbour+newtype SplitShiftDirectional = SplitShift Direction1D instance Message SplitShiftDirectional  oppositeDirection :: Direction2D -> Direction2D@@ -179,10 +197,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@@ -240,9 +254,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@@ -270,10 +282,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@@ -284,104 +296,108 @@ swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)  insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)-insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)+insertLeftLeaf (Leaf n) (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 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) (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 Node{} z = Just z+insertRightLeaf _ _ = Nothing  findRightLeaf :: Zipper Split -> Maybe (Zipper Split)-findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf+findRightLeaf n@(Node{}, _) = goRight n >>= findRightLeaf findRightLeaf l@(Leaf _, _) = Just l  findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)-findLeftLeaf n@(Node _ _ _, _) = goLeft n+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, c:cs) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n+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, c:cs) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n+splitShiftRightCurrent l@(n, _) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n -isAllTheWay :: Direction2D -> Zipper Split -> Bool-isAllTheWay _ (_, []) = True-isAllTheWay R (_, LeftCrumb s _:_)+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@@ -491,7 +507,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 @@ -565,20 +581,20 @@ splitShiftNth Prev b = doToNth splitShiftLeftCurrent b splitShiftNth Next b = doToNth splitShiftRightCurrent b -growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a-growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP-growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b-growNthTowards dir b = doToNth (expandTreeTowards 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 -shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a-shrinkNthFrom _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP-shrinkNthFrom _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b-shrinkNthFrom dir b = doToNth (shrinkTreeFrom 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 -> BinarySpacePartition a -> BinarySpacePartition a-autoSizeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP-autoSizeNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b-autoSizeNth dir b = doToNth (autoSizeTree dir) 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@@ -676,13 +692,13 @@ -- 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  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)@@ -741,9 +757,9 @@                               , 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@@ -755,8 +771,8 @@           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" @@ -833,8 +849,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@@ -844,6 +860,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) --@@ -31,7 +32,7 @@ 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@@ -57,7 +58,7 @@  type RectWithBorders = (Rectangle, [BorderInfo]) -data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)+newtype BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)  brBorderSize :: Dimension brBorderSize = 2@@ -99,7 +100,7 @@  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,7 +110,7 @@ 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@@ -124,58 +125,58 @@     return (w, (r, borderInfos))  handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders-handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere+handleStillThere = M.map handleSingleStillThere  handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders handleSingleStillThere (Nothing, entry) = entry handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)     where         changedBorderBlueprints = prepareBorders rCurrent-        updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints+        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)+    [(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)     ]  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 +184,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 +215,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,11 +35,10 @@  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 (find, fromMaybe, listToMaybe, maybeToList, union, (\\))+import XMonad.Util.Stack (reverseS) import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -65,28 +67,40 @@ 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 +110,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 +139,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@@ -138,6 +169,19 @@ focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls++swapUp' :: W.Stack a -> W.Stack a+swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)+swapUp' (W.Stack t []     rs) = W.Stack t (reverse rs) []++siftUpSkipping :: Eq a => [a] -> W.Stack a -> W.Stack a+siftUpSkipping bs (W.Stack t ls rs)+  | (skips, l:ls') <- spanLeft  = W.Stack t ls' (reverse skips ++ l : rs)+  | (skips, r:rs') <- spanRight = W.Stack t (rs' ++ r : ls) (reverse skips)+  | otherwise                   = W.Stack t ls rs+  where+    spanLeft  = span (`elem` bs) ls+    spanRight = span (`elem` bs) (reverse rs)  {- $simplest
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) --@@ -48,7 +49,7 @@            -> 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"
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,6 +30,8 @@ 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.@@ -76,15 +79,15 @@  applyPosition pos wksp rect = do   let stack = W.stack wksp-  let ws = W.integrate' $ stack+  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 firstW = head ws+       let other  = tail ws+       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 +110,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,9 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Circle+-- Description :  An elliptical, overlapping layout. -- Copyright   :  (c) Peter De Wachter -- License     :  BSD-style (see LICENSE) --@@ -20,7 +21,7 @@                              Circle (..)                             ) where -- actually it's an ellipse -import Data.List+import XMonad.Prelude import XMonad import XMonad.StackSet (integrate, peek) @@ -72,4 +73,3 @@           ry = fromIntegral (sh - h) / 2           w = sw * 10 `div` 25           h = sh * 10 `div` 25-
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) --@@ -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/Combo.hs view
@@ -4,6 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Combo+-- Description :  A layout that combines multiple layouts. -- Copyright   :  (c) David Roundy <droundy@darcs.net> -- License     :  BSD-style (see LICENSE) --@@ -22,9 +23,8 @@                             CombineTwo                            ) where -import Data.List ( delete, intersect, (\\) )-import Data.Maybe ( isJust ) import XMonad hiding (focus)+import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\)) import XMonad.StackSet ( integrate', Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) ) import qualified XMonad.StackSet as W ( differentiate )@@ -77,14 +77,14 @@ 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 =@@ -102,17 +102,17 @@                      (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'@@ -139,6 +139,6 @@ 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,9 +25,7 @@                              Property(..)                             ) where -import Data.List ( delete, intersect, (\\) )-import Data.Maybe ( isJust )-import Control.Monad+import XMonad.Prelude import XMonad hiding (focus) import XMonad.StackSet ( Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation@@ -69,7 +68,7 @@  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 +78,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,7 +98,7 @@             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+            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@@ -107,8 +106,8 @@             ([((),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 +128,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 +165,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,7 +173,7 @@ 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
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) --@@ -19,7 +20,7 @@  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@:@@ -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,12 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE CPP                   #-} ----------------------------------------------------------------------------- -- | -- 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 +22,7 @@     ( -- * Usage:       -- $usage       decoration-    , Theme (..), defaultTheme, def+    , Theme (..), def     , Decoration     , DecorationMsg (..)     , DecorationStyle (..)@@ -30,12 +35,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@@ -89,6 +92,7 @@                                                            --    Inner @[Bool]@ is a row in a icon bitmap.           } deriving (Show, Read) +-- | The default xmonad 'Theme'. instance Default Theme where   def =     Theme { activeColor         = "#999999"@@ -103,21 +107,20 @@           , 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@@ -241,7 +244,6 @@                                 let ndwrs = zip toAdd $ repeat (Nothing,Nothing)                                 ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs                                 processState (s {decos = ndecos })-        | otherwise        = return (wrs, Nothing)          where           ws        = map fst wrs@@ -282,7 +284,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@@ -301,9 +303,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@@ -319,7 +321,7 @@             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 ()@@ -374,17 +376,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@@ -396,11 +402,11 @@   nw  <- 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+  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)
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/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) --@@ -82,7 +83,7 @@     , floatDwmStyle     , floatSimpleTabbed     , floatTabbed-    , def, defaultTheme, shrinkText+    , def, shrinkText     ) where  import XMonad
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,7 +24,7 @@  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@:@@ -42,7 +43,7 @@ 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>@@ -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) --@@ -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(..) )@@ -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 @@ -160,7 +161,7 @@         totals' = 0 : zipWith (+) sizes totals'         totals  = tail totals'         splits  = zip (tail sizes) totals-        ratios  = reverse $ map (\(l, r) -> l / r) splits+        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(..)
+ 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\/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 "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 "XMonad.Doc.Extending#Editing_key_bindings" 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 "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+  deriving Typeable++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,8 +23,6 @@         FixedColumn(..) ) where -import Control.Monad (msum)-import Data.Maybe (fromMaybe) import Graphics.X11.Xlib (Window, rect_width) import Graphics.X11.Xlib.Extras ( getWMNormalHints                                 , getWindowAttributes@@ -31,6 +30,7 @@                                 , sh_resize_inc                                 , wa_border_width) +import XMonad.Prelude (fromMaybe, msum, (<&>)) import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay) import XMonad.Layout (Resize(..), IncMasterN(..), tile) import XMonad.StackSet as W@@ -62,7 +62,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 @@ -84,8 +84,8 @@ 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+    bw <- fromIntegral . wa_border_width <$> getWindowAttributes 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/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+    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,15 +36,13 @@                           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: --@@ -109,7 +108,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 +177,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) --@@ -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) . tail . reverse . take n . tail . 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@@ -110,7 +106,7 @@ -- 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 (U i1 i2) = (U (i1+1) i2, map (U i1) [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,6 +191,7 @@     show (ToAll _) = "ToAll {...}"     show Refocus = "Refocus"     show (Modify _) = "Modify {...}"+    show (ModifyX _) = "ModifyX {...}"  instance Message GroupsMessage @@ -232,13 +227,13 @@                                         >>> 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)@@ -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  @@ -390,9 +385,9 @@                                    >>> 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@@ -402,18 +397,18 @@                                 >>> 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)+reID g eg ((id:ids, seen), egs) = if myID `elem` seen+                                  then ((ids, seen), mapE_ (setID id) eg:egs)+                                  else ((id:ids, myID:seen), eg:egs)     where myID = getID $ gLayout $ fromE eg           setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z @@ -421,7 +416,7 @@  -- | 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
@@ -4,6 +4,7 @@ ----------------------------------------------------------------------------- -- | -- 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 +38,6 @@                                      , fullTabs                                      , TiledTabsConfig(..)                                      , def-                                     , defaultTiledTabsConfig                                      , increaseNMasterGroups                                      , decreaseNMasterGroups                                      , shrinkMasterGroups@@ -48,12 +48,11 @@                                        -- * 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@@ -62,7 +61,6 @@ import XMonad.Layout.Tabbed import XMonad.Layout.Named import XMonad.Layout.Renamed-import XMonad.Layout.LayoutCombinators import XMonad.Layout.Decoration import XMonad.Layout.Simplest @@ -135,20 +133,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,10 +203,6 @@ 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@@ -233,13 +227,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
@@ -4,6 +4,7 @@ ----------------------------------------------------------------------------- -- | -- 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@@ -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'
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,10 +32,9 @@                                    -- * 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@@ -43,7 +43,6 @@ import XMonad.Layout.Tabbed import XMonad.Layout.Named import XMonad.Layout.Renamed-import XMonad.Layout.LayoutCombinators import XMonad.Layout.MessageControl import XMonad.Layout.Simplest @@ -92,7 +91,7 @@ -- | 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+          tabs = named "Tabs" Simplest           innerLayout = renamed [CutWordsLeft 3]                         $ addTabs s t                         $ ignore NextLayout@@ -131,4 +130,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  --------------------------------------------------------------------------------@@ -58,24 +61,26 @@ -- "XMonad.Doc.Extending#Editing_key_bindings".  ---------------------------------------------------------------------------------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,6 +112,9 @@ popNewestHiddenWindow :: X () popNewestHiddenWindow = sendMessage PopNewestHiddenWindow +popHiddenWindow :: Window -> X ()+popHiddenWindow = sendMessage . PopSpecificHiddenWindow+ -------------------------------------------------------------------------------- hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a)) hideWindowMsg (HiddenWindows hidden) win = do@@ -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 .@@ -62,15 +63,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 +97,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,7 +24,7 @@  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@:@@ -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) --@@ -34,6 +35,8 @@ import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties +import Control.Arrow (first)+ -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --@@ -97,14 +100,14 @@             -> 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.
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,17 +24,16 @@     , 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@:@@ -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)@@ -76,7 +77,7 @@ -- it easier to visualize  convertToBool' :: [Int] -> [Bool]-convertToBool' = map (\x -> x == 1)+convertToBool' = map (== 1)  convertToBool :: [[Int]] -> [[Bool]] convertToBool = map convertToBool'@@ -148,19 +149,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,7 +173,7 @@                    -> 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"
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,26 +19,27 @@     -- * Usage     -- $usage     VirtualWorkspace, PhysicalWorkspace,+    VirtualWindowSpace, PhysicalWindowSpace,     workspaces',-    withScreens, onCurrentScreen,+    withScreen, withScreens,+    onCurrentScreen,     marshallPP,     whenCurrentOn,     countScreens,+    workspacesOn,+    workspaceOnScreen, focusWindow', focusScreen, 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  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -54,7 +57,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 +65,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]@@ -80,6 +83,11 @@ 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 +107,66 @@ 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 workspace that is active on a given screen.+screenOnMonitor :: ScreenId -> WindowSet -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+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++-- | Focus a given screen.+focusScreen :: ScreenId -> WindowSet -> WindowSet+focusScreen screenId = withWspOnScreen screenId W.view++-- | 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 +178,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 +223,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 +266,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,11 +57,8 @@   LayoutN, ) where ----------------------------------------------------------------------------------import Control.Applicative ((<|>))-import Control.Monad (foldM)-import Data.Maybe import XMonad+import XMonad.Prelude (foldM, (<|>), isJust, fromMaybe, isNothing, listToMaybe) import qualified XMonad.StackSet as W import XMonad.Util.WindowProperties @@ -225,7 +222,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 +256,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 +367,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  --------------------------------------------------------------------------------
XMonad/Layout/LayoutBuilderP.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.LayoutBuilderP+-- Description :  (DEPRECATED) An old version of "XMonad.Layout.LayoutBuilderP". -- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru> -- License     :  BSD3-style (see LICENSE) --@@ -22,10 +23,8 @@   Predicate (..), Proxy(..),   ) where -import Control.Monad-import Data.Maybe (isJust)- import XMonad+import XMonad.Prelude hiding (Const) import qualified XMonad.StackSet as W import XMonad.Util.WindowProperties @@ -78,7 +77,7 @@   let a = alwaysTrue (Proxy :: Proxy a)   in  LayoutP Nothing Nothing a box Nothing sub Nothing -instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>+instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) =>     LayoutClass (LayoutP p l1 l2) w where          -- | Update window locations.@@ -86,7 +85,7 @@             = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf                  let selBox = if isJust nextf'                                 then box-                                else maybe box id mbox+                                else fromMaybe box mbox                   (sublist,sub') <- handle sub subs $ calcArea selBox rect @@ -97,14 +96,14 @@                  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+                                     let l' = fromMaybe l 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+            | Just Shrink         <- fromMessage m = sendFocus l m+            | Just Expand         <- fromMessage m = sendFocus l m             | otherwise = sendBoth l m          -- |  Descriptive name for layout.@@ -117,7 +116,7 @@ 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+                then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') next                 else Nothing  sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)@@ -127,7 +126,7 @@     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')+                then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') (Just $ fromMaybe next next')                 else Nothing  sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)@@ -147,13 +146,13 @@  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+isFocus (Just w) = do ms <- W.stack . W.workspace . W.current <$> 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+splitBy prop = foldM step ([], [])   where     step (good, bad) w = do       ok <- checkPredicate prop w@@ -175,11 +174,10 @@            )   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+    foc l f+      | W.focus s `elem` l = Just $ W.focus s+      | maybe False (`elem` l) f = f+      | otherwise = 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'@@ -192,7 +190,7 @@         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+                                 then fromIntegral tot+v                                  else v  differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
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@: ----- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )+-- > import XMonad.Layout.LayoutCombinators -- -- Then edit your @layoutHook@ to use the new layout combinators. For -- example:@@ -74,17 +65,6 @@ -- -- "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------ See below for more detailed documentation.  -- $combine -- Each of the following combinators combines two layouts into a@@ -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,10 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ParallelListComp, PatternGuards #-}+{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Layout.LayoutHints+-- Description :  Make layouts respect size hints. -- Copyright    : (c) David Roundy <droundy@darcs.net> -- License      : BSD --@@ -22,6 +24,8 @@     , LayoutHints     , LayoutHintsToCenter     , hintsEventHook+    -- * For developers+    , placeRectangle     )  where  import XMonad(LayoutClass(runLayout), mkAdjust, Window,@@ -29,22 +33,17 @@               X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,               (<&&>), io, applySizeHints, whenX, isClient, withDisplay,               getWindowAttributes, getWMNormalHints, WindowAttributes(..))+import XMonad.Prelude (All (..), fromJust, join, maximumBy, on, sortBy) 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@:@@ -101,7 +100,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 +146,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)@@ -175,7 +173,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 +193,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,9 +256,9 @@  -- | 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)
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 (..) )@@ -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
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- 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) --@@ -62,7 +63,7 @@ layoutScreens nscr l =     do rtrect <- asks theRoot >>= getWindowRectangle        (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 }) ->+       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            in  ws { W.current = W.Screen x 0 (SD s)@@ -75,11 +76,11 @@ 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 }) ->+       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            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 } @@ -89,7 +90,7 @@        return $ 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,12 +38,10 @@     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@:@@ -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 @@ -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,7 +30,7 @@ import XMonad.Layout.LayoutModifier  import XMonad.Actions.UpdatePointer (updatePointer)-import Data.Monoid(All(..))+import XMonad.Prelude(All(..)) import qualified Data.Map as M  -- $usage@@ -80,7 +81,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 +99,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,65 @@ module XMonad.Layout.Magnifier     ( -- * Usage       -- $usage++      -- * General combinators+      magnify,++      -- * Magnify Everything       magnifier,-      magnifier',       magnifierOff,       magnifiercz,-      magnifiercz',+      magnifierczOff,+      maxMagnifierOff,       maximizeVertical,++      -- * Don't Magnify the Master Window+      magnifier',+      magnifiercz',+      magnifierczOff',++      -- * 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@: -- -- > 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:+-- By default 'magnifier' increases the focused window's size by @1.5@. ----- > magnifiercz 1.2+-- You can also use @'magnifiercz' 1.2@ 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. ----- to use a custom level of magnification.  You can even make the focused--- window smaller for a pop in effect.+-- The most general combinator available is 'magnify'—all of the other+-- functions in this module are essentially just creative applications+-- of it. -- -- For more detailed instructions on editing the layoutHook see: -- -- "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)@@ -81,61 +103,119 @@ -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". +-- | 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 mt start = ModifiedLayout $+    Mag 1 (fromRational cz, fromRational cz) (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 +-- | 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 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 +226,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 +239,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,8 +27,9 @@ 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@: --@@ -72,7 +74,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 +87,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 +113,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 +137,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,7 +28,7 @@ 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@:@@ -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,8 +32,6 @@  import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) -import Data.Typeable (Typeable)-import Control.Applicative ((<$>)) import Control.Arrow (second)  -- $usage@@ -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
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,11 +33,11 @@     ) 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@:@@ -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,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, 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,20 +29,13 @@  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@: --@@ -73,7 +67,6 @@     | Wider     | Reset     | SlopeMod ([Rational] -> [Rational])-    deriving (Typeable)  instance Message Aspect @@ -118,7 +111,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
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,7 +34,7 @@ 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@@ -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) --@@ -36,7 +37,7 @@ import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import qualified XMonad.StackSet as W import XMonad.Util.XUtils-import Control.Applicative((<$>))+import Graphics.X11 as X  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -80,7 +81,6 @@                     | SetRightSlaveFraction Int Rational                     | ShrinkSlave                     | ExpandSlave-                    deriving Typeable instance Message MRTMessage  data DraggerInfo = MasterDragger Position Rational@@ -153,7 +153,7 @@                                                               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 +190,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 +243,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,7 +26,7 @@ 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@:@@ -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,7 +24,7 @@  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@:@@ -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@@ -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) --
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,16 +36,12 @@                                ) 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@@ -125,7 +123,6 @@     | ResetBorder Window         -- ^ Reset the effects of any 'HasBorder' messages on the specified         -- window.-    deriving (Typeable)  instance Message BorderMessage @@ -147,7 +144,7 @@ -- | Only necessary with 'BorderMessage' - remove non-existent windows from the -- 'alwaysHidden' or 'neverHidden' lists. borderEventHook :: Event -> X All-borderEventHook (DestroyWindowEvent { ev_window = w }) = do+borderEventHook DestroyWindowEvent{ ev_window = w } = do     broadcastMessage $ ResetBorder w     return $ All True borderEventHook _ = return $ All True@@ -156,7 +153,7 @@     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,7 +164,7 @@         | 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 =@@ -247,34 +244,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 +291,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 +310,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 +320,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) --@@ -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
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- 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) --@@ -70,8 +71,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 +80,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.@@ -124,7 +125,7 @@      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)+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts bool lt)      description (OnHost _ True  l1 _) = description l1     description (OnHost _ _     _ l2) = description l2@@ -136,7 +137,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.
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) --@@ -55,8 +56,8 @@ -- | 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)+                                      ++ divideBottom bottomRect bottomWs+                                      ++ divideRight rightRect rightWs       where ws = W.integrate stack             n = length ws             ht (Rectangle _ _ _ hh) = hh@@ -79,16 +80,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 +98,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 +117,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 +130,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,7 +26,7 @@ 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:@@ -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,7 +26,7 @@ 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:@@ -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,9 +30,7 @@ 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@:@@ -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,13 +24,12 @@                               ) 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:@@ -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) --@@ -46,6 +47,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 +63,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,161 @@+{-# 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 slave 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\/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 slave column should occupy. If both slave 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 slave columns.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "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+            total = up + length (W.down s) + 1+            pos = if up == (nmaster-1) || up == (total-1) 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) nslave1 r2+                       , splitVertically (drop (nmaster + nslave1) mf) 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+    nslave1      = ceiling (nslave % 2)+    nslave2      = n - nmaster - nslave1++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 $ fromIntegral (sh `div` fromIntegral n) * f)+  in Rectangle sx sy sw smallh :+       splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral 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,10 +22,9 @@                                    ) 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@:@@ -49,7 +49,7 @@ -- -- "XMonad.Doc.Extending#Editing_key_bindings". -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) --@@ -64,13 +65,12 @@ 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      pureMess (ResizeScreen d _) m
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 --@@ -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@@ -63,16 +66,16 @@  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 @@ -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/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(..)@@ -60,7 +60,7 @@            -> 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) --@@ -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,8 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Simplest+-- Description :  A very simple layout. -- Copyright   :  (c) 2007 Andrea Rossato -- License     :  BSD-style (see xmonad/LICENSE) --
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,11 +20,11 @@     , 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@@ -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,11 +25,8 @@   , 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@@ -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,14 +37,15 @@     , 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 @@ -57,10 +62,40 @@ -- -- > 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'.  -- | Represent the borders of a rectangle. data Border = Border@@ -146,7 +181,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)@@ -208,7 +243,6 @@     | ModifyScreenBorderEnabled (Bool -> Bool)     | ModifyWindowBorder (Border -> Border)     | ModifyWindowBorderEnabled (Bool -> Bool)-    deriving (Typeable)  instance Message SpacingModifier @@ -330,14 +364,9 @@ ----------------------------------------------------------------------------- {-# 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 @@ -349,7 +378,7 @@  -- | 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)+newtype ModifySpacing = ModifySpacing (Int -> Int)  instance Message ModifySpacing
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) --@@ -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@@ -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) --@@ -46,7 +47,7 @@  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,7 +24,7 @@  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@:
XMonad/Layout/StateFull.hs view
@@ -30,13 +30,10 @@ ) where  import XMonad hiding ((<&&>))+import XMonad.Prelude (fromMaybe, (<|>)) import qualified XMonad.StackSet as W import XMonad.Util.Stack (findZ) -import Data.Maybe (fromMaybe)-import Control.Applicative ((<|>),(<$>))-import Control.Monad (join)- -- $Usage -- -- To use it, first you need to:@@ -67,13 +64,14 @@  -- | A pattern synonym for the primary use case of the @FocusTracking@ --   transformer; using @Full@.+pattern StateFull :: FocusTracking Full a pattern StateFull = FocusTracking Nothing Full  instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where    description (FocusTracking _ child)-    | (chDesc == "Full")  = "StateFull"-    | (' ' `elem` chDesc) = "FocusTracking (" ++ chDesc ++ ")"+    | chDesc == "Full"  = "StateFull"+    | ' ' `elem` chDesc = "FocusTracking (" ++ chDesc ++ ")"     | otherwise           = "FocusTracking " ++ chDesc     where chDesc = description child @@ -82,7 +80,7 @@     mRealFoc <- gets (W.peek . windowset)     let mGivenFoc = W.focus <$> mSt         passedMSt = if mRealFoc == mGivenFoc then mSt-                    else join (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt+                    else (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt      (wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr     let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL'
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,8 +56,6 @@ 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@:@@ -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,8 @@-{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- 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) --@@ -51,19 +52,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 --@@ -187,7 +184,7 @@ --  >          $ 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 +196,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'),@@ -240,6 +237,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 +256,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 +287,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.@@ -300,21 +299,21 @@ 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+    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,_)@@ -391,7 +390,7 @@             in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs  -        | otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m+        | otherwise = join <$> sequenceA (catchLayoutMess <$> fromMessage m)      where gs = toGroups sls            fgs gs' = do                 st <- currentStack@@ -415,26 +414,8 @@  -- | 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 -- that the stack of tabs stays put.@@ -443,20 +424,49 @@  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.+toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a+toGroupStack gs st@(W.Stack f ls rs) =+    W.Stack (let Just f' = lu f in 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@@ -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@@ -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,15 +220,13 @@               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)-              fixHeightLoc i = y + fi (((fi ht) * fi i)) +              fixHeightLoc i = y + fi ht * fi i               fixHeightTab k = Rectangle k-                (maybe y (fixHeightLoc)+                (maybe y fixHeightLoc                  $ w `elemIndex` ws) (fi wt) (fi ht)               rightTab = fixHeightTab (x + fi (wh - wt))               leftTab = fixHeightTab x
+ XMonad/Layout/TallMastersCombo.hs view
@@ -0,0 +1,537 @@+-- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+---------------------------------------------------------------------------+-- |+-- 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 XMonad.Prelude (delete, find, foldM, fromMaybe, isJust)+import XMonad.StackSet (Workspace(..),integrate',Stack(..))+import qualified XMonad.StackSet as W+import qualified XMonad.Layout as LL+import XMonad.Layout.Simplest (Simplest(..))+import XMonad.Layout.Decoration++---------------------------------------------------------------------------------+-- $usage+-- You can use this module with the following in your @~\/.xmonad\/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 = if null w2 then Nothing else Just $ head 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 = if null w2 then Nothing else Just $ head 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++++-- 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++-- | Swap a given window with the focused window.+swapWindow :: (Eq a) => a -> Stack a -> Stack a+swapWindow w s =+  let upLst   = up s+      foc     = focus s+      downLst = down s+  in if w `elem` downLst+     then let us   = takeWhile (/= w) downLst+              d:ds = dropWhile (/= w) downLst+              us'  = reverse us ++ d : upLst+          in  Stack foc us' ds+     else let ds   = takeWhile (/= w) upLst+              u:us = dropWhile (/= w) upLst+              ds'  = reverse ds ++ u : downLst+          in  Stack foc us ds'+++-- | 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 = differentiate f' slst+        s1' = differentiate f' slst1+        s2' = differentiate 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,12 +26,11 @@                              ) 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@: --@@ -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,6 +21,7 @@     ) where  import XMonad+import XMonad.Prelude (fromMaybe) import XMonad.StackSet (Workspace (..))  -- $usage@@ -49,7 +51,7 @@ -- "XMonad.Doc.Extending#Editing_key_bindings".  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 :  Track focus in the tiled layer. Copyright   :  (c) 2010 & 2013 Adam Vogt                2011 Willem Vanlint License     :  BSD-style (see xmonad/LICENSE)@@ -11,8 +12,9 @@ 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.+or another sublayout is in use. This is particularly helpful for tiled layouts+where the focus determines what is visible. It can also be used to improve the+behaviour of a child layout that has not been given the focused window.  The relevant bugs are Issue 4 and 306: <http://code.google.com/p/xmonad/issues/detail?id=4>,@@ -32,55 +34,33 @@      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.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)+newtype TrackFloating a = TrackFloating (Maybe Window)+    deriving (Read,Show)   instance LayoutModifier TrackFloating Window where-    modifyLayoutWithUpdate os@(TrackFloating _wasF mw) ws@(W.Workspace{ W.stack = ms }) r+    modifyLayoutWithUpdate (TrackFloating 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+        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,-                let n = TrackFloating (fromMaybe False isF) newState-                in guard (n /= os) >> Just n)+        return (ran, guard (newState /= mw) >> Just (TrackFloating newState))   @@ -88,19 +68,19 @@ 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 +92,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:@@ -159,7 +129,7 @@  -} trackFloating ::  l a -> ModifiedLayout TrackFloating l a-trackFloating layout = ModifiedLayout (TrackFloating False Nothing) layout+trackFloating = ModifiedLayout (TrackFloating Nothing)  {- $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) --
XMonad/Layout/TwoPanePersistent.hs view
@@ -2,6 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.TwoPanePersistent+-- Description :  "XMonad.Layout.TwoPane" with a persistent stack window. -- Copyright   :  (c) Chayanon Wichitrnithed -- License     :  BSD3-style (see LICENSE) --@@ -38,8 +39,8 @@   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+  { 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)@@ -76,7 +77,7 @@                                     , 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)+                      Just win -> if win `elem` down s && (focus s /= win)                                   then ( [(focus s, left), (win, right)]                                        , Just $ TwoPanePersistent w delta split )                                   else nextSlave
+ XMonad/Layout/VoidBorders.hs view
@@ -0,0 +1,65 @@+{-# 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, this modifier will not restore the window+-- border if the windows are moved to a different workspace or the layout is+-- changed.+--+-- This modifier's primary use is to eliminate the "border flash" you get+-- while switching workspaces with the `noBorders` modifier. It won't return+-- the borders to their original width, however.+--+-----------------------------------------------------------------------------++module XMonad.Layout.VoidBorders ( -- * Usage+                                   -- $usage+                                   voidBorders+                                 ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.StackSet (integrate)++-- $usage+-- You can use this module with the following in your ~\/.xmonad/xmonad.hs+-- file:+--+-- > import XMonad.Layout.VoidBorders+--+-- and modify the layouts to call 'voidBorders' on the layouts you want to+-- remove borders from windows:+--+-- > layoutHook = ... ||| voidBorders Full ||| ...+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data VoidBorders a = VoidBorders deriving (Read, Show)++voidBorders :: l Window -> ModifiedLayout VoidBorders l Window+voidBorders = ModifiedLayout VoidBorders++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)++-- | Sets border width to 0 for every window from the specified layout.+setZeroBorder :: Window -> X ()+setZeroBorder w = withDisplay $ \d -> io $ setWindowBorderWidth d w 0
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,12 +27,11 @@     ) 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@@ -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) --@@ -21,11 +22,11 @@                                    Navigate(..), Direction2D(..),                                    MoveWindowToWindow(..),                                    navigateColor, navigateBrightness,-                                   noNavigateBorders, defaultWNConfig, def,-                                   WNConfig, WindowNavigation,+                                   noNavigateBorders, def, WNConfig,+                                   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@@ -64,12 +65,11 @@ -- "XMonad.Doc.Extending#Editing_key_bindings".  -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  data WNConfig =@@ -92,10 +92,6 @@ 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
@@ -2,6 +2,7 @@ ---------------------------------------------------------------------------- -- | -- 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,7 +31,7 @@ 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@@ -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"@@ -86,7 +87,7 @@     decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y     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"@@ -107,7 +108,7 @@     decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y     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 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 )@@ -58,14 +60,19 @@ -- -- >  , ((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". -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@@ -106,7 +106,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 +163,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 +185,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 +237,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,57 @@+{-# LANGUAGE BangPatterns #-}+--------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prelude+-- Description :  Utility functions and re-exports.+-- Copyright   :  slotThe <soliditsallgood@mailbox.org>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  slotThe <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,+    (.:),+    (!?),+) where++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+import Data.Function       as Exports+import Data.Functor        as Exports+import Data.List           as Exports+import Data.Maybe          as Exports+import Data.Monoid         as Exports+import Data.Traversable    as Exports++-- | 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++-- | Multivariant composition.+--+-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)+(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b+(.:) = (.) . (.)
XMonad/Prompt.hs view
@@ -1,5 +1,11 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Prompt@@ -34,7 +40,6 @@     , mkXPromptWithModes     , def     , amberXPConfig-    , defaultXPConfig     , greenXPConfig     , XPMode     , XPType (..)@@ -60,6 +65,7 @@     , moveHistory, setSuccess, setDone, setModeDone     , Direction1D(..)     , ComplFunction+    , ComplCaseSensitivity(..)     -- * X Utilities     -- $xutils     , mkUnmanagedWindow@@ -91,6 +97,7 @@     ) where  import           XMonad                       hiding (cleanMask, config)+import           XMonad.Prelude               hiding (toList) import qualified XMonad                       as X (numberlockMask) import qualified XMonad.StackSet              as W import           XMonad.Util.Font@@ -98,17 +105,14 @@ import           XMonad.Util.XSelection       (getSelection)  import           Codec.Binary.UTF8.String     (decodeString,isUTF8Encoded)-import           Control.Applicative          ((<$>))-import           Control.Arrow                (first, second, (&&&), (***))+import           Control.Arrow                (first, (&&&), (***)) import           Control.Concurrent           (threadDelay)-import           Control.Exception.Extensible as E hiding (handle)+import           Control.Exception            as E hiding (handle) import           Control.Monad.State+import           Data.Bifunctor               (bimap) 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.IO.Unsafe             (unsafePerformIO)@@ -129,15 +133,13 @@         , rootw                 :: !Window         , win                   :: !Window         , screen                :: !Rectangle-        , complWin              :: Maybe Window+        , winWidth              :: !Dimension -- ^ Width of the prompt window         , complWinDim           :: Maybe ComplWindowDim         , complIndex            :: !(Int,Int)-        -- | This IORef should always have the same value as-        -- complWin. Its purpose is to enable removal of the-        -- completion window if an exception occurs, since the most-        -- recent value of complWin is not available when handling-        -- exceptions.-        , complWinRef           :: IORef (Maybe Window)+        , 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@@ -169,10 +171,12 @@         , 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.+        , 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@@ -185,6 +189,8 @@         , 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?@@ -201,6 +207,8 @@ 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 @@ -212,17 +220,23 @@     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.+-- | 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. ----- This is an example of a XPrompt instance definition:+-- 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.@@ -256,7 +270,7 @@     -- 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"]+    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.@@ -290,7 +304,7 @@             , border        :: String   -- ^ Border color             } -amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig+amberXPConfig, greenXPConfig :: XPConfig  instance Default XPColor where     def =@@ -303,7 +317,11 @@  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@@ -316,18 +334,18 @@         , 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         }-{-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-}-defaultXPConfig = def greenXPConfig = def { bgColor           = "black"                     , fgColor           = "green"                     , promptBorderWidth = 0@@ -338,15 +356,16 @@                     }  initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode-          -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState-initState d rw w s opMode gc fonts h c nm =+          -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> Dimension+          -> XPState+initState d rw w s opMode gc fonts h c nm width =     XPS { dpy                   = d         , rootw                 = rw         , win                   = w         , screen                = s-        , complWin              = Nothing+        , winWidth              = width         , complWinDim           = Nothing-        , complWinRef        = unsafePerformIO (newIORef Nothing)+        , complWin              = unsafePerformIO (newIORef Nothing)         , showComplWin          = not (showCompletionOnTab c)         , operationMode         = opMode         , highlightedCompl      = Nothing@@ -393,13 +412,22 @@   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')+      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-      _ -> Just $ complMatrix !! col_index !! row_index+      _  -> 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@@ -407,9 +435,6 @@ 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@@ -481,16 +506,7 @@ mkXPromptWithReturn t conf compl action = do   st' <- mkXPromptImplementation (showXPrompt t) conf (XPSingleMode compl (XPT t))   if successful st'-    then do-      let selectedCompletion =-            case alwaysHighlight (config st') of-              -- When alwaysHighlight is True, autocompletion is-              -- handled with indexes.-              False -> command st'-              -- When it is false, it is handled depending on the-              -- prompt buffer's value.-              True -> fromMaybe (command st') $ highlightedCompl st'-      Just <$> action selectedCompletion+    then Just <$> action (selectedCompletion st')     else return Nothing  -- | Creates a prompt given:@@ -504,7 +520,7 @@ -- -- * 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 ()+mkXPrompt t conf compl action = void $ mkXPromptWithReturn t conf compl action  -- | Creates a prompt with multiple modes given: --@@ -525,14 +541,12 @@                           }       om = XPMultipleModes modeStack   st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om-  if successful st'-    then do-      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 ()+  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'.@@ -541,11 +555,13 @@   XConf { display = d, theRoot = rw } <- ask   s <- gets $ screenRect . W.screenDetail . W.current . windowset   numlock <- gets X.numberlockMask-  hist <- io readHistory+  cachedir <- asks (cacheDir . directories)+  hist <- io $ readHistory cachedir   fs <- initXMF (font conf)+  let width = getWinWidth s (position conf)   st' <- io $     bracket-      (createWin d rw conf s)+      (createPromptWin d rw conf s width)       (destroyWindow d)       (\w ->         bracket@@ -555,21 +571,28 @@             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 numlock+                st = initState d rw w s om gc fs hs conf numlock width             runXP st))   releaseXMF fs   when (successful st') $ do     let prune = take (historySize conf)-    io $ writeHistory $+    io $ writeHistory 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 [command st'])+      (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  -- | Removes numlock and capslock from a keymask. -- Duplicate of cleanMask from core, but in the@@ -592,17 +615,21 @@ runXP st = do   let d = dpy st       w = win st-  st' <- bracket+  bracket     (grabKeyboard d w True grabModeAsync grabModeAsync currentTime)     (\_ -> ungrabKeyboard d currentTime)     (\status ->-      (flip execStateT st $ do-        when (status == grabSuccess) $ do+      execStateT+        (when (status == grabSuccess) $ do+          ah <- gets (alwaysHighlight . config)+          when ah $ do+            compl <- listToMaybe <$> getCompletions+            modify' $ \xpst -> xpst{ highlightedCompl = compl }           updateWindows           eventLoop handleMain evDefaultStop)-      `finally` (mapM_ (destroyWindow d) =<< readIORef (complWinRef st))+        st+      `finally` (mapM_ (destroyWindow d) =<< readIORef (complWin st))       `finally` sync d False)-  return st'  type KeyStroke = (KeySym, String) @@ -616,7 +643,8 @@         []  -> do                 d <- gets dpy                 io $ allocaXEvent $ \e -> do-                    maskEvent d (exposureMask .|. keyPressMask) e+                    -- Also capture @buttonPressMask@, see Note [Allow ButtonEvents]+                    maskEvent d (exposureMask .|. keyPressMask .|. buttonPressMask) e                     ev <- getEvent e                     (ks,s) <- if ev_event_type ev == keyPress                               then lookupString $ asKeyEvent e@@ -630,20 +658,45 @@  -- | Default event loop stop condition. evDefaultStop :: XP Bool-evDefaultStop = (||) <$> (gets modeDone) <*> (gets done)+evDefaultStop = gets ((||) . modeDone) <*> gets done --- | Common patterns shared by all event handlers. Expose events can be--- triggered by switching virtual consoles.+-- | Common patterns shared by all event handlers. handleOther :: KeyStroke -> Event -> XP ()-handleOther _ (ExposeEvent {ev_window = w}) = do+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,_) (KeyEvent {ev_event_type = t, ev_state = m}) = do+handleMain stroke@(keysym,_) KeyEvent{ev_event_type = t, ev_state = m} = do     (compKey,modeKey) <- gets $ (completionKey &&& changeModeKey) . config     keymask <- cleanMask m     -- haven't subscribed to keyRelease, so just in case@@ -652,7 +705,7 @@            then getCurrentCompletions >>= handleCompletionMain            else do                 setCurrentCompletions Nothing-                if (keysym == modeKey)+                if keysym == modeKey                    then modify setNextMode >> updateWindows                    else handleInputMain keymask stroke handleMain stroke event = handleOther stroke event@@ -694,11 +747,10 @@     alwaysHlight <- gets $ alwaysHighlight . config     st <- get -    let updateWins  l = redrawWindows l-        updateState l = case alwaysHlight of-            False                                           -> simpleComplete l st-            True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st-                 | otherwise                                -> alwaysHighlightNext l st+    let updateWins  l = redrawWindows (pure ()) l+        updateState l = if alwaysHlight+            then hlComplete (getLastWord $ command st) l st+            else simpleComplete                        l st      case cs of       []  -> updateWindows@@ -718,33 +770,47 @@                            , 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 cs-          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'} cs-              newCommand = fromMaybe (command st) $ highlightedCompl'-          modify $ \s -> setHighlightedCompl highlightedCompl' $-                         setCommand newCommand $-                         s { complIndex = complIndex'-                           , offset = length newCommand-                           }+        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.+            length cs == 1 =+              if command st == hlCompl then put st else replaceCompletion (head cs)++            -- 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)   = nextComplIndex 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.@@ -763,7 +829,7 @@              -> KeyStroke              -> Event              -> XP ()-handleSubmap defaultAction keymap stroke (KeyEvent {ev_event_type = t, ev_state = m}) = do+handleSubmap defaultAction keymap stroke KeyEvent{ev_event_type = t, ev_state = m} = do     keymask <- cleanMask m     when (t == keyPress) $ handleInputSubmap defaultAction keymap keymask stroke handleSubmap _ _ stroke event = handleOther stroke event@@ -773,7 +839,7 @@                   -> KeyMask                   -> KeyStroke                   -> XP ()-handleInputSubmap defaultAction keymap keymask (keysym,keystr) = do+handleInputSubmap defaultAction keymap keymask (keysym,keystr) =     case M.lookup (keymask,keysym) keymap of         Just action -> action >> updateWindows         Nothing     -> unless (null keystr) $ defaultAction >> updateWindows@@ -806,7 +872,7 @@ -- * cont and drop -- --      * do nothing-promptBuffer :: (String -> String -> (Bool,Bool)) -> XP (String)+promptBuffer :: (String -> String -> (Bool,Bool)) -> XP String promptBuffer f = do     md <- gets modeDone     setModeDone False@@ -820,7 +886,7 @@              -> KeyStroke              -> Event              -> XP ()-handleBuffer f stroke event@(KeyEvent {ev_event_type = t, ev_state = m}) = do+handleBuffer f stroke event@KeyEvent{ev_event_type = t, ev_state = m} = do     keymask <- cleanMask m     when (t == keyPress) $ handleInputBuffer f keymask stroke event handleBuffer _ stroke event = handleOther stroke event@@ -830,14 +896,14 @@                   -> KeyStroke                   -> Event                   -> XP ()-handleInputBuffer f keymask (keysym,keystr) event = do+handleInputBuffer f keymask (keysym,keystr) event =     unless (null keystr || keymask .&. controlMask /= 0) $ do         (evB,inB) <- gets (eventBuffer &&& inputBuffer)         let keystr' = utf8Decode keystr         let (cont,keep) = f inB keystr'-        when (keep) $+        when keep $             modify $ \s -> s { inputBuffer = inB ++ keystr' }-        unless (cont) $+        unless cont $             setModeDone True         unless (cont || keep) $             modify $ \s -> s { eventBuffer = (keysym,keystr,event) : evB }@@ -847,23 +913,18 @@ bufferOne :: String -> String -> (Bool,Bool) bufferOne xs x = (null xs && null x,True) ---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 (_,_,_,_,xx,yy) -> let-    (ncols,nrows) = (length xx, 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)+-- | Return the @(column, row)@ of the next highlight, or @(0, 0)@ if+-- there is no prompt window or a wrap-around occurs.+nextComplIndex :: XPState -> (Int, Int)+nextComplIndex st = case complWinDim st of+  Nothing -> (0, 0)  -- no window dimensions (just destroyed or not created)+  Just ComplWindowDim{ cwCols, cwRows } ->+    let (currentcol, currentrow) = complIndex st+        (colm, rowm) =+          ((currentcol + 1) `mod` length cwCols, (currentrow + 1) `mod` length cwRows)+     in if rowm == currentrow + 1+        then (currentcol, currentrow + 1)  -- We are not in the last row, so go down+        else (colm, rowm)                  -- otherwise advance to the next column  tryAutoComplete :: XP Bool tryAutoComplete = do@@ -1068,25 +1129,25 @@         , (xK_F,            promptBuffer bufferOne >>= toHeadChar Prev)         ]     deleteVimXPKeymap = M.fromList $-        map ((first $ (,) 0) . (second $ flip (>>) (setModeDone True)))+        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 ((first $ (,) shiftMask) . (second $ flip (>>) (setModeDone True)))+        map (bimap (shiftMask ,) (>> setModeDone True))         [ (xK_dollar,       killAfter >> moveCursor Prev)         ]     changeVimXPKeymap = M.fromList $-        map ((first $ (,) 0) . (second $ flip (>>) (setModeDone True)))+        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 ((first $ (,) shiftMask) . (second $ flip (>>) (setModeDone True)))+        map (bimap (shiftMask, ) (>> setModeDone True))         [ (xK_dollar,       killAfter)         ] @@ -1145,7 +1206,7 @@   o <- gets offset   c <- gets command   let (f,ss)        = splitAt o c-      delNextWord   = snd . break p . dropWhile p+      delNextWord   = dropWhile (not . p) . dropWhile p       delPrevWord   = reverse . delNextWord . reverse       (ncom,noff)   =           case d of@@ -1158,11 +1219,11 @@ -- * 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 = f <$> getInput <*> getOffset <*> (pure p) >>= id+changeWord p = join $ f <$> getInput <*> getOffset <*> pure p     where         f :: String -> Int -> (Char -> Bool) -> XP ()         f str off _ | length str <= off ||-                      length str <= 0       = return ()+                      null str              = return ()         f str off p'| p' $ str !! off       = killWord' (not . p') Next                     | otherwise             = killWord' p' Next @@ -1183,14 +1244,19 @@ --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+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 =+insertString str = do+  insertString' str+  modify resetComplIndex++insertString' :: String -> XP ()+insertString' str =   modify $ \s -> let-    cmd = (c (command s) (offset s))-    st = resetComplIndex $ s { offset = o (offset s)}+    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@@ -1205,7 +1271,7 @@ -- | A variant of 'pasteString' which allows modifying the X selection before -- pasting. pasteString' :: (String -> String) -> XP ()-pasteString' f = join $ io $ liftM (insertString . f) getSelection+pasteString' f = insertString . f =<< getSelection  -- | Remove a character at the cursor position deleteString :: Direction1D -> XP ()@@ -1268,12 +1334,12 @@   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)+                Prev -> max 0 $ (o + 1) - length c                 Next -> 0       len = max 0 . flip (-) 1 . (gap +)           . uncurry (+)-          . (length *** (length . fst . break p))-          . break (not . p)+          . (length *** (length . takeWhile (not . p)))+          . span p       newoff = case d of                 Prev -> o - len (reverse f)                 Next -> o + len ss@@ -1301,9 +1367,9 @@     off <- gets offset     let c = head s         off' = (if d == Prev then negate . fst else snd)-             . join (***) (fromMaybe 0 . fmap (+1) . elemIndex c)+             . join (***) (maybe 0 (+1) . elemIndex c)              . (reverse *** drop 1)-             $ (splitAt off cmd)+             $ splitAt off cmd     modify $ \st -> st { offset = offset st + off' }  updateHighlightedCompl :: XP ()@@ -1311,244 +1377,267 @@   st <- get   cs <- getCompletions   alwaysHighlight' <- gets $ alwaysHighlight . config-  when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs}+  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 = do-  d <- gets dpy-  drawWin-  c <- getCompletions-  case c  of-    [] -> destroyComplWin >> return ()-    l  -> redrawComplWin l-  io $ sync d False+updateWindows = redrawWindows (void destroyComplWin) =<< getCompletions -redrawWindows :: [String] -> XP ()-redrawWindows c = do+-- | 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-  case c of-    [] -> return ()+  case compls of+    [] -> emptyAction     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+ 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 -drawWin :: XP ()-drawWin = do-  st <- get-  let (c,(cr,(d,(w,gc)))) = (config &&& color &&& 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 (bgNormal cr)-  Just borderC <- io $ initColor d (border cr)-  p <- io $ createPixmap d w wh ht-                         (defaultDepthOfScreen scr)-  io $ fillDrawable d p gc borderC bgcolor (fi bw) wh ht-  printPrompt p-  io $ copyArea d p w gc 0 0 wh ht 0 0-  io $ freePixmap d p+-- | Redraw the completion window, if necessary.+redrawComplWin ::  [String] -> XP ()+redrawComplWin compl = do+  XPS{ showComplWin, complWinDim, complWin } <- get+  nwi <- getComplWinDim compl+  let recreate = do destroyComplWin+                    w <- createComplWin nwi+                    drawComplWin w compl+  if compl /= [] && 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 <- get-  let (pr,(cr,gc)) = (prompter &&& color &&& gcon) st-      (c,(d,fs)) = (config &&& dpy &&& fontS) st-      (prt,(com,off)) = (pr . show . currentXPMode &&& command &&& offset) st+  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-      (f,p,ss) = if off >= length com+      (preCursor, cursor, postCursor) = if offset >= length com                  then (str, " ","") -- add a space: it will be our cursor ;-)-                 else let (a,b) = (splitAt off com)+                 else let (a, b) = splitAt offset 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++  -- 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 -  let draw = printStringXMF d drw fs gc+  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 cr) (bgNormal cr) x y f+  draw (fgNormal color) (bgNormal color) x y preCursor   -- reverse the colors and print the "cursor" ;-)-  draw (bgNormal cr) (fgNormal cr) (x + fromIntegral fsl) y p-  -- reverse the colors and print the rest of the string-  draw (fgNormal cr) (bgNormal cr) (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+  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 --- Completions+-- | Get all available completions for the current input. getCompletions :: XP [String] getCompletions = do-  s <- get-  let q     = commandToComplete (currentXPMode s) (command s)-      compl = getCompletionFunction s-      srt   = sorter (config s)-  io $ (srt q <$> compl q) `E.catch` \(SomeException _) -> return []--setComplWin :: Window -> ComplWindowDim -> XP ()-setComplWin w wi = do-  wr <- gets complWinRef-  io $ writeIORef wr (Just w)-  modify (\s -> s { complWin = Just w, complWinDim = Just wi })+  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-  d  <- gets dpy-  cw <- gets complWin-  wr <- gets complWinRef-  case cw of-    Just w -> do io $ destroyWindow d w-                 io $ writeIORef wr Nothing-                 modify (\s -> s { complWin = Nothing, complWinDim = Nothing })+  XPS{ dpy, complWin } <- get+  io (readIORef complWin) >>= \case+    Just w -> do io $ destroyWindow dpy w+                 updateComplWin Nothing 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-+-- | Given the completions that we would like to show, calculate the+-- required dimensions for the completion windows. 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+  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 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)..]+  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 -  return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy)+      maxColumns  = maybe id min (maxComplColumns cfg)+      columns     = max 1 . maxColumns $ winWidth `div` fi maxComplLen+      columnWidth = winWidth `div` columns -drawComplWin :: Window -> [String] -> XP ()-drawComplWin w compl = do-  st <- get-  let c   = config st-      cr  = color st-      d   = dpy st-      scr = defaultScreenOfDisplay d-      bw  = promptBorderWidth c-      gc  = gcon st-  Just bgcolor <- io $ initColor d (bgNormal cr)-  Just borderC <- io $ initColor d (border cr)+      (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 -  (_,_,wh,ht,xx,yy) <- getComplWinDim compl+      -- 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+              ) -  p <- io $ createPixmap d w wh ht-                         (defaultDepthOfScreen scr)-  io $ fillDrawable d p gc borderC bgcolor (fi bw) wh ht-  let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl)+  -- Get font ascent and descent.  Coherence condition: we will print+  -- everything using the same font.+  (asc, desc) <- io $ textExtentsXMF fs $ 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 -  printComplList d p gc (fgNormal cr) (bgNormal cr) 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+      xp    = (asc + desc) `div` 2                           -- x position of the first column+      xCols = take (fi columns) [xp, xp + fi columnWidth ..] -- x positions of all columns -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+  pure $ ComplWindowDim x y winWidth rowHeight xCols yRows --- 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)+-- | Draw the completion window.+drawComplWin :: Window -> [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 -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 (fgHighlight $ color st,bgHighlight $ color st)-                     else (fc,bc)-                  False ->-                    -- compare item with buffer's value-                    if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st)-                    then (fgHighlight $ color st,bgHighlight $ color st)-                    else (fc,bc)-            printStringXMF d drw (fontS st) gc f b x y item)-        ys ss) xs sss+  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+  -> [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) 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]@@ -1556,21 +1645,21 @@ emptyHistory :: History emptyHistory = M.empty -getHistoryFile :: IO FilePath-getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir+getHistoryFile :: FilePath -> FilePath+getHistoryFile cachedir = cachedir ++ "/prompt-history" -readHistory :: IO History-readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory+readHistory :: FilePath -> IO History+readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory  where     readHist = do-        path <- getHistoryFile-        xs <- bracket (openFile path ReadMode) hClose hGetLine+        let path = getHistoryFile cachedir+        xs <- withFile path ReadMode hGetLine         readIO xs -writeHistory :: History -> IO ()-writeHistory hist = do-  path <- getHistoryFile-  let filtered = M.filter (not . null) hist+writeHistory :: FilePath -> History -> IO ()+writeHistory cachedir hist = do+  let path = getHistoryFile cachedir+      filtered = M.filter (not . null) hist   writeFile path (show filtered) `E.catch` \(SomeException e) ->                           hPutStrLn stderr ("error writing history: "++show e)   setFileMode path mode@@ -1606,19 +1695,18 @@  -- | 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+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' :: [String] -> String -> IO [String]-mkComplFunFromList' l [] = return l-mkComplFunFromList' l s =-  return $ filter (\x -> take (length s) x == s) l-+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@@ -1640,9 +1728,8 @@  -- | 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+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@@ -1664,14 +1751,17 @@ -- | '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 :: X 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 (++) []+historyCompletionP :: (String -> Bool) -> X ComplFunction+historyCompletionP p = do+    cd <- asks (cacheDir . directories)+    pure $ \x ->+        let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []+         in toComplList . M.filterWithKey (const . p) <$> readHistory cd  -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off --   laziness and stability for efficiency.@@ -1706,7 +1796,7 @@                 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+       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) --@@ -31,7 +32,6 @@ import XMonad.Prompt  import System.IO-import Control.Exception.Extensible (bracket)  -- $usage --@@ -60,7 +60,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" -- >        ) --@@ -70,7 +70,7 @@ -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -data AppendFile = AppendFile FilePath+newtype AppendFile = AppendFile FilePath  instance XPrompt AppendFile where     showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": "@@ -78,7 +78,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 +91,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 = io . withFile fn AppendMode . flip hPutStrLn . trans
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,9 +27,8 @@  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@@ -65,7 +65,7 @@ -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -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,6 +24,7 @@  import XMonad.Core import XMonad.Util.Run+import XMonad.Prelude (void) import XMonad.Prompt import XMonad.Prompt.Input @@ -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,9 +19,7 @@                                 , fuzzySort                                 ) where -import Data.Char-import Data.Function-import Data.List+import XMonad.Prelude  -- $usage --@@ -80,7 +79,8 @@ 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)]
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,12 +50,12 @@ -- @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"+-- > firingPrompt' = inputPromptWithCompl def "Fire" -- >                     (mkComplFunFromList employees) ?+ fireEmployee -- -- Now all he has to do is add a keybinding to @firingPrompt@ (or@@ -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,12 +19,11 @@                              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@:@@ -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,6 +26,7 @@   import XMonad+import XMonad.Prelude import XMonad.Prompt import XMonad.Util.Run import XMonad.Prompt.Shell (split)@@ -33,10 +35,7 @@ import System.Process import System.IO -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@:@@ -60,7 +59,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@@ -75,17 +74,17 @@   mans <- forM (nub dirs) $ \d -> do             exists <- doesDirectoryExist d             if exists-              then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`+              then map (stripExt . stripSuffixes [".gz", ".bz2"]) <$>                    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. --@@ -108,7 +107,7 @@  stripSuffixes :: Eq a => [[a]] -> [a] -> [a] stripSuffixes sufs fn =-    head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn]+    head . catMaybes $ map (`rstrip` fn) sufs ++ [Just fn]  rstrip :: Eq a => [a] -> [a] -> Maybe [a] rstrip suf lst
+ XMonad/Prompt/OrgMode.hs view
@@ -0,0 +1,452 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE InstanceSigs        #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE StrictData          #-}+{-# LANGUAGE ScopedTypeVariables #-}+--------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.OrgMode+-- Description :  A prompt for interacting with org-mode.+-- Copyright   :  (c) 2021  slotThe <soliditsallgood@mailbox.org>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  slotThe <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, or use+-- the system's clipboard (really: the primary selection) as the+-- contents of the note.+--+--------------------------------------------------------------------+module XMonad.Prompt.OrgMode (+    -- * Usage+    -- $usage++    -- * Prompts+    orgPrompt,              -- :: XPConfig -> String -> FilePath -> X ()+    orgPromptPrimary,       -- :: XPConfig -> String -> FilePath -> X ()++    -- * Types+    ClipboardSupport (..),+    OrgMode,                -- abstract++#ifdef TESTING+    pInput,+    Note (..),+    Date (..),+    Time (..),+    TimeOfDay (..),+    DayOfWeek (..),+#endif++) where++import XMonad.Prelude++import XMonad (X, io)+import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt)+import XMonad.Util.XSelection (getSelection)++import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian)+import System.Directory (getHomeDirectory)+import System.IO (IOMode (AppendMode), hPutStrLn, withFile)+import Text.ParserCombinators.ReadP (ReadP, munch, munch1, readP_to_S, skipSpaces, string, (<++))++{- $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@ format.  The minutes may be+omitted, in which case we assume a full hour is specified.++A few examples are probably in order.  Suppose we have bound the key+above, pressed it, and are now confronted with a prompt:++  - @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 +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'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.++-}++{- 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+  }++-- | 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 = mkOrgPrompt xpc .: OrgMode 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 = mkOrgPrompt xpc .: OrgMode PrimarySelection++-- | Create the actual prompt.+mkOrgPrompt :: XPConfig -> OrgMode -> X ()+mkOrgPrompt xpc oc@OrgMode{ todoHeader, orgFile, clpSupport } =+  mkXPrompt 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++    -- Expand path if applicable+    fp <- case orgFile of+      '/'       : _ -> pure orgFile+      '~' : '/' : _ -> getHomeDirectory <&> (<> drop 1 orgFile)+      _             -> getHomeDirectory <&> (<> ('/' : orgFile))++    withFile fp AppendMode . flip hPutStrLn+      <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput+        $ input++------------------------------------------------------------------------+-- Time++-- | A 'Time' is a 'Date' with the possibility of having a specified+-- @HH:MM@ time.+data Time = Time+  { date :: Date+  , tod  :: Maybe TimeOfDay+  }+  deriving (Eq, Show)++-- | The time in HH:MM.+data TimeOfDay = TimeOfDay Int Int+  deriving (Eq)++instance Show TimeOfDay where+  show :: TimeOfDay -> String+  show (TimeOfDay h m) = pad h <> ":" <> pad m+   where+    pad :: Int -> String+    pad n = (if n <= 9 then "0" else "") <> show n++-- | 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 TimeOfDay -> Day -> String+toOrgFmt tod day =+  mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"]+ where+  time   :: String = maybe "" ((' ' :) . show) tod+  isoDay :: String = formatTime defaultTimeLocale (iso8601DateFormat Nothing) day++-- | 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+  | Deadline  String Time+  | NormalMsg String+  deriving (Eq, Show)++-- | Pretty print a given 'Note'.+ppNote :: Clp -> String -> Note -> IO String+ppNote clp todo = \case+  Scheduled str time -> mkLine str "SCHEDULED: " (Just time)+  Deadline  str time -> mkLine str "DEADLINE: "  (Just time)+  NormalMsg str      -> mkLine str ""            Nothing+ where+  mkLine :: String -> String -> Maybe Time -> IO String+  mkLine str sched time = do+    t <- case time of+      Nothing -> pure ""+      Just ti -> (("\n  " <> sched) <>) <$> ppDate ti+    pure $ case clp of+      Body   c -> mconcat ["* ", todo, " ", str, t, c]+      Header c -> mconcat ["* ", todo, " [[", c, "][", str,"]]", t]++------------------------------------------------------------------------+-- Parsing++-- | Parse the given string into a 'Note'.+pInput :: String -> Maybe Note+pInput inp = fmap fst . listToMaybe . (`readP_to_S` inp) . lchoice $+  [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay)+  , Deadline  <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay)+  , NormalMsg <$> munch1 (const True)+  ]+ where+  getLast :: String -> ReadP String+  getLast ptn =  reverse+              .  dropWhile (== ' ')    -- trim whitespace at the end+              .  drop (length ptn)     -- drop only the last pattern+              .  reverse+              .  concat+             <$> endBy1 (go "") (pure ptn)+   where+    go :: String -> ReadP String+    go consumed = do+      str  <- munch  (/= head ptn)+      word <- munch1 (/= ' ')+      bool go pure (word == ptn) $ consumed <> str <> word++-- | Try to parse a 'Time'.+pTimeOfDay :: ReadP (Maybe TimeOfDay)+pTimeOfDay = lchoice+  [ Just <$> (TimeOfDay <$> pInt <* string ":" <*> pInt  ) -- HH:MM+  , Just <$> (TimeOfDay <$> pInt               <*> pure 0) -- HH+  , pure Nothing+  ]++-- | Parse a 'Date'.+pDate :: ReadP Date+pDate = skipSpaces *> lchoice+  [ pString "tod" "ay"    Today+  , pString "tom" "orrow" Tomorrow+  , Next     <$> pNext+  , Date     <$> pDate1 <++ pDate2 <++ pDate3+  ] <* skipSpaces  -- cleanup+ where+  pNext :: ReadP DayOfWeek = lchoice+    [ pString "m"  "onday"    Monday   , pString "tu" "esday"  Tuesday+    , pString "w"  "ednesday" Wednesday, pString "th" "ursday" Thursday+    , pString "f"  "riday"    Friday   , pString "sa" "turday" Saturday+    , pString "su" "nday"     Sunday+    ]++  -- XXX: This is really horrible, but I can't see a way to not have+  -- exponential blowup with ReadP otherwise.+  pDate1, pDate2, pDate3 :: ReadP (Int, Maybe Int, Maybe Integer)+  pDate1 = pDate' (fmap Just)            (fmap Just)+  pDate2 = pDate' (fmap Just)            (const (pure Nothing))+  pDate3 = pDate' (const (pure Nothing)) (const (pure Nothing))+  pDate'+    :: (ReadP Int     -> ReadP (f Int    ))+    -> (ReadP Integer -> ReadP (f Integer))+    -> ReadP (Int, f Int, f Integer)+  pDate' p p' =+    (,,) <$> pInt+         <*> p (skipSpaces *> lchoice+               [ pString "ja"  "nuary"    1 , pString "f"   "ebruary" 2+               , pString "mar" "ch"       3 , pString "ap"  "ril"     4+               , pString "may" ""         5 , pString "jun" "e"       6+               , pString "jul" "y"        7 , pString "au"  "gust"    8+               , pString "s"   "eptember" 9 , pString "o"   "ctober"  10+               , pString "n"   "ovember"  11, pString "d"   "ecember" 12+               ])+         <*> p' (skipSpaces *> pInt >>= \i -> guard (i >= 25) $> i)++-- | Parse a @start@ and see whether the rest of the word (separated by+-- spaces) fits the @leftover@.+pString :: String -> String -> a -> ReadP a+pString start leftover ret = do+  void $ string start+  l <- munch (/= ' ')+  guard (l `isPrefixOf` leftover)+  pure ret++-- | Parse a number.+pInt :: (Read a, Integral a) => ReadP a+pInt = read <$> munch1 isDigit++-- | Like 'choice', but with '(<++)' instead of '(+++)', stopping+-- parsing when the left-most parser succeeds.+lchoice :: [ReadP a] -> ReadP a+lchoice = foldl' (<++) empty++-- | Like 'Text.ParserCombinators.ReadP.endBy1', but only return the+-- parse where @parser@ had the highest number of applications.+endBy1 :: ReadP a -> ReadP sep -> ReadP [a]+endBy1 parser sep = many1 (parser <* sep)+ where+  -- | Like 'Text.ParserCombinators.ReadP.many1', but use '(<++)'+  -- instead of '(+++)'.+  many1 :: ReadP a -> ReadP [a]+  many1 p = (:) <$> p <*> (many1 p <++ pure [])
XMonad/Prompt/Pass.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- 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,28 +9,32 @@ -- Stability   :  unstable -- Portability :  unportable ----- This module provides 5 <XMonad.Prompt>s to ease password--- manipulation (generate, read, edit, 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.+-- - two functions to lookup passwords in the password-store: ----- - one to edit a password for a given password label that the user---   inputs.+--     - 'passPrompt' copies the password directly to the clipboard. ----- - one to delete a stored password for a given password label that+--     - 'passTypePrompt' uses @xdotool@ to type the password+--       directly.+--+-- - '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. ----- All those prompts benefit from the completion system provided by--- the module <XMonad.Prompt>.+-- - '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.+-- @$PASSWORD_STORE_DIR@, or @$HOME\/.password-store@ if it is unset.+-- The editor is determined from the environment variable @$EDITOR@. -- -- Source: --@@ -40,18 +45,27 @@ -- ----------------------------------------------------------------------------- -module XMonad.Prompt.Pass (-                            -- * Usage-                            -- $usage-                              passPrompt-                            , passOTPPrompt-                            , passGeneratePrompt-                            , passGenerateAndCopyPrompt-                            , passRemovePrompt-                            , passEditPrompt-                            , passTypePrompt-                            ) where+module XMonad.Prompt.Pass+    ( -- * Usage+      -- $usage +      -- * Retrieving passwords+      passPrompt+    , passTypePrompt++      -- * Editing passwords+    , passEditPrompt+    , passRemovePrompt+    , passGeneratePrompt+    , passGenerateAndCopyPrompt++      -- * Misc+    , passOTPPrompt+    ) where++import System.Directory (getHomeDirectory)+import System.FilePath (combine, dropExtension, takeExtension)+import System.Posix.Env (getEnv) import XMonad.Core import XMonad.Prompt ( XPrompt                      , showXPrompt@@ -61,9 +75,6 @@                      , XPConfig                      , mkXPrompt                      , searchPredicate)-import System.Directory (getHomeDirectory)-import System.FilePath (takeExtension, dropExtension, combine)-import System.Posix.Env (getEnv) import XMonad.Util.Run (runProcessWithInput)  -- $usage@@ -74,16 +85,17 @@ -- Then add a keybinding for 'passPrompt', 'passGeneratePrompt', -- 'passRemovePrompt', 'passEditPrompt' or 'passTypePrompt': ----- >   , ((modMask , xK_p)                              , passPrompt xpconfig)--- >   , ((modMask .|. controlMask, xK_p)               , passGeneratePrompt xpconfig)--- >   , ((modMask .|. shiftMask, xK_p)                 , passEditPrompt 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) -- -- For detailed instructions on: -- -- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". -- -- - how to setup the password store, see <http://git.zx2c4.com/password-store/about/>+--   or @man 1 pass@. --  type Predicate = String -> String -> Bool@@ -100,13 +112,13 @@   commandToComplete _ c           = c   nextCompletion      _           = getNextCompletion --- | Default password store folder in $HOME/.password-store+-- | Default password store folder in @$HOME/.password-store@. -- passwordStoreFolderDefault :: String -> String passwordStoreFolderDefault home = combine home ".password-store"  -- | Compute the password store's location.--- Use the PASSWORD_STORE_DIR environment variable to set the password store.+-- 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@@ -115,7 +127,7 @@   where computePasswordStoreDir Nothing         = fmap passwordStoreFolderDefault getHomeDirectory         computePasswordStoreDir (Just storeDir) = return storeDir --- | A pass prompt factory+-- | A pass prompt factory. -- mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () mkPassPrompt promptLabel passwordFunction xpconfig = do@@ -127,7 +139,9 @@ passPrompt :: XPConfig -> X () passPrompt = mkPassPrompt "Select password" selectPassword --- | A prompt to retrieve a OTP 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. -- passOTPPrompt :: XPConfig -> X () passOTPPrompt = mkPassPrompt "Select OTP" selectOTP@@ -169,7 +183,7 @@ selectPassword :: String -> X () selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\"" --- | Select a OTP.+-- | Select an OTP. -- selectOTP :: String -> X () selectOTP passLabel = spawn $ "pass otp --clip \"" ++ escapeQuote passLabel ++ "\""@@ -206,10 +220,11 @@ escapeQuote :: String -> String escapeQuote = concatMap escape   where escape :: Char -> String-        escape '"' = ['\\', '\"']-        escape x = return x+        escape '"' = "\\\""+        escape x   = [x]  -- | Retrieve the list of passwords from the password store 'passwordStoreDir+-- getPasswords :: FilePath -> IO [String] getPasswords passwordStoreDir = do   files <- runProcessWithInput "find" [
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,14 +22,14 @@     ) where  import XMonad hiding (config)+import XMonad.Prelude (isNothing, isSuffixOf, liftA2) 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@@ -59,15 +60,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 +81,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 @@ -94,24 +100,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@@ -126,11 +201,9 @@ 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,10 +29,6 @@ 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 @@ -54,22 +52,22 @@  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@@ -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@@ -25,19 +24,14 @@  ) where  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 Control.Arrow (second)  import XMonad+import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run import XMonad.Prompt@@ -49,7 +43,7 @@   nextCompletion Unicode = getNextCompletion  newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, BS.ByteString)] }-  deriving (Typeable, Read, Show)+  deriving (Read, Show)  instance ExtensionClass UnicodeData where   initialValue = UnicodeData []@@ -85,7 +79,7 @@           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 (BS.length . snd) $ parseUnicodeData dat           return True     else return True @@ -96,24 +90,33 @@           [(c,"")] <- return . readHex $ BS.unpack field1           return (chr c, field2) -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, BS.ByteString)] -> Predicate -> String -> [(Char, String)]+searchUnicode entries p s = map (second BS.unpack) $ filter go entries+  where w = filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s+        go (_, d) = all (`p` BS.unpack 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, BS.ByteString)] -> 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,6 +23,7 @@     windowPrompt,     windowMultiPrompt,     allWindows,+    allApplications,     wsWindows,     XWindowMap, @@ -31,7 +33,7 @@     windowPromptBringCopy,     ) where -import Control.Monad (forM)+import XMonad.Prelude (forM) import qualified Data.Map as M  import qualified XMonad.StackSet as W@@ -71,13 +73,14 @@ -- "XMonad.Doc.Extending#Editing_key_bindings".  -- 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 @@ -95,13 +98,15 @@     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@@ -120,12 +125,16 @@ 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 --@@ -37,7 +38,7 @@ -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -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,13 +18,14 @@                              -- $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@:@@ -38,10 +40,10 @@ -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -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\/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+"XMonad.Doc.Extending#Editing_key_bindings". -}++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/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,6 +18,7 @@                               ) where  import XMonad+import XMonad.Prelude ((<&>)) import Control.Monad.Reader  import qualified Data.Map as M@@ -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,13 +19,10 @@ 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           Control.Exception                                     as E import           Foreign import           Foreign.C.String import           Numeric                         (showHex)@@ -41,7 +39,7 @@   case w' of     Nothing                                   ->       return $ "(deleted window " ++ wx ++ ")"-    Just (WindowAttributes+    Just WindowAttributes       { wa_x                 = x       , wa_y                 = y       , wa_width             = wid@@ -49,7 +47,7 @@       , wa_border_width      = bw       , wa_map_state         = m       , wa_override_redirect = o-      }) -> do+      } -> do       c' <- withDisplay $ \d ->             io (getWindowProperty8 d wM_CLASS w)       let c = case c' of@@ -63,9 +61,9 @@                                                           then s''                                                           else tail 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'@@ -73,7 +71,7 @@       -- 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'+      let p = if null p' then "" else wrap $ unwords p'       nWP <- getAtom "_NET_WM_PID"       pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w       let pid = case pid' of@@ -96,7 +94,7 @@                       ,show x                       ,',':show y                       ,if null c then "" else ' ':c-                      ,if null cmd then "" else ' ':cmd +                      ,if null cmd then "" else ' ':cmd                       ,rb                       ] @@ -114,19 +112,19 @@   t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a   [s] <- catchX' (tryUTF8     t) $          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 (peekCString 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 +141,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 @@ -161,7 +159,7 @@   s <- xGetWindowAttributes d w p   case s of     0 -> return Nothing-    _ -> Just `fmap` peek p+    _ -> Just <$> peek p  -- and so is getCommand safeGetCommand     :: Display -> Window -> X [String]
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,103 @@+-----------------------------------------------------------------------------+-- |+-- 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 (+  -- * 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 scrachpads 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++-- | Spawn the specified dynamic scratchpad+spawnDynamicSP :: String -- ^ Scratchpad name+               -> X ()+spawnDynamicSP s = do+    (SPStorage m) <- XS.get+    maybe mempty spawnDynamicSP' (M.lookup s m)++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,7 @@ -------------------------------------------------------------------- -- | -- 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)@@ -29,19 +30,22 @@                              mkKeymap, checkKeymap,                              mkNamedKeymap, -                             parseKey -- used by XMonad.Util.Paste+                             -- * Parsers++                             parseKey, -- used by XMonad.Util.Paste+                             parseKeyCombo,+                             parseKeySequence, readKeySequence                             ) where  import XMonad import XMonad.Actions.Submap+import XMonad.Prelude hiding (many)  import XMonad.Util.NamedActions +import Control.Arrow (first, (&&&)) 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 @@ -82,7 +86,7 @@ -- 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 }  -- | Like 'additionalKeys', except using short @String@ key --   descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as@@ -105,7 +109,7 @@ -- >                 `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 }  -- | Like 'removeKeys', except using short @String@ key descriptors --   like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the@@ -121,13 +125,12 @@ -- | 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 }  -- | 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 }   --------------------------------------------------------------@@ -352,6 +355,7 @@ -- > <XF86_ClearGrab> -- > <XF86_Next_VMode> -- > <XF86_Prev_VMode>+-- > <XF86Bluetooth>  mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ()) mkKeymap c = M.fromList . mkSubmaps . readKeymap c@@ -378,9 +382,6 @@                       subm . mkSubmaps' subm $ map (first tail) ks)         fstKey = (==) `on` (head . fst) -on :: (a -> a -> b) -> (c -> a) -> c -> c -> b-op `on` f = \x y -> f x `op` f y- -- | 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@@ -673,7 +674,8 @@                  , "XF86_Ungrab"                  , "XF86_ClearGrab"                  , "XF86_Next_VMode"-                 , "XF86_Prev_VMode" ]+                 , "XF86_Prev_VMode"+                 , "XF86Bluetooth" ]  -- | Given a configuration record and a list of (key sequence --   description, action) pairs, check the key sequence descriptions@@ -709,9 +711,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 (("\""++) . (++"\""))
XMonad/Util/ExclusiveScratchpads.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.ExclusiveScratchpads+-- Description :  Named scratchpads that can be mutually exclusive. -- Copyright   :  Bruce Forte (2017) -- License     :  BSD-style (see LICENSE) --@@ -36,9 +37,7 @@   customFloating   ) where -import Control.Applicative ((<$>))-import Control.Monad ((<=<),filterM,liftM2)-import Data.Monoid (appEndo)+import XMonad.Prelude (appEndo, filterM, liftA2, (<=<)) import XMonad import XMonad.Actions.Minimize import XMonad.Actions.TagWindows (addTag,delTag)@@ -150,7 +149,7 @@                                   (w:_) -> do toggleWindow w                                               whenX (runQuery isExclusive w) (hideOthers xs n)   where-    toggleWindow w = liftM2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case+    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@@ -172,8 +171,8 @@   let ys = filterM (flip runQuery w . query) xs    unlessX (null <$> ys) $ do-    mh <- (head . map hook) <$> ys  -- ys /= [], so `head` is fine-    n  <- (head . map name) <$> ys  -- same+    mh <- head . map hook <$> ys  -- ys /= [], so `head` is fine+    n  <- head . map name <$> ys  -- same      (windows . appEndo <=< runQuery mh) w     hideOthers xs n@@ -216,7 +215,7 @@  -- | Useful queries isExclusive, isMaximized :: Query Bool-isExclusive = (notElem "_XSP_NOEXCLUSIVE" . words) <$> stringProperty "_XMONAD_TAGS"+isExclusive = notElem "_XSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS" isMaximized = not <$> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"  -- -----------------------------------------------------------------------------------
+ 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 (MyConf [i]) $ \c -> c{ logHook = logHook c <> lh }+-- >   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) --@@ -22,6 +24,7 @@                               , get                               , gets                               , modified+                              , modifiedM                               ) where  import Data.Typeable (typeOf,cast)@@ -29,7 +32,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 +41,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 +61,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 []@@ -97,7 +99,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 +110,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 +123,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,15 +35,12 @@     ) 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 Graphics.X11.Xrender #endif@@ -118,7 +116,7 @@         return (Xft xftdraw)   else #endif-      fmap Utf8 $ initUtf8Font s+      Utf8 <$> initUtf8Font s #ifdef XFT   where xftPrefix = "xft:" #endif@@ -146,15 +144,15 @@ 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+  ascent  <- fi <$> xftfont_ascent  xftfont+  descent <- fi <$> xftfont_descent xftfont   return (ascent, descent) #endif @@ -206,7 +204,3 @@          \draw -> withXftColorName dpy visual colormap fc $                    \color -> xftDrawString draw color font x y s #endif---- | Short-hand for 'fromIntegral'-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral
+ XMonad/Util/Hacks.hs view
@@ -0,0 +1,147 @@+-----------------------------------------------------------------------------+-- |+-- 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,+  ) where+++import XMonad+import XMonad.Prelude (All (All), 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++-- | 'trayAbovePanelEventHook' 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
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) --@@ -46,7 +47,7 @@ -- | 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 +73,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,6 @@                             , fromIMaybe                             ) where -import Control.Applicative import Control.Monad.Fail  -- $usage
XMonad/Util/Loggers.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- 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 +10,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 +32,12 @@      -- * XMonad Loggers     -- $xmonad-    , logCurrent, logLayout, logTitle-+    , logCurrent, logLayout, logTitle, logTitles+    , logConst, logDefault, (.|)+    -- * XMonad: Screen-specific Loggers+    -- $xmonad-screen+    , logCurrentOnScreen, logLayoutOnScreen+    , logTitleOnScreen, logWhenActive, logTitlesOnScreen     -- * Formatting Utilities     -- $format     , onLogger@@ -41,27 +46,21 @@     , shortenL     , dzenColorL, xmobarColorL -    , (<$>)-   ) where -import XMonad (liftIO)+import XMonad (liftIO, Window, gets) import XMonad.Core import qualified XMonad.StackSet as W-import XMonad.Hooks.DynamicLog+import XMonad.Hooks.StatusBar.PP import XMonad.Util.Font (Align (..)) import XMonad.Util.NamedWindows (getName) -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)+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@@ -72,35 +71,34 @@ -- > 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 +116,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 +127,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@@ -177,6 +174,42 @@ logTitle :: Logger logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek +-- | 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 = (`withScreen` sid) $ \screen -> do+  let focWin = fmap W.focus . W.stack . W.workspace $ screen+      wins   = maybe [] W.integrate . W.stack . W.workspace $ screen+  winNames <- traverse (fmap show . getName) wins+  pure . Just+       . unwords+       $ zipWith (\w n -> if Just w == focWin then formatFoc n else formatUnfoc n)+                 wins+                 winNames++-- | Like 'logTitlesOnScreen', but directly use the "focused" screen+-- (the one with the currently focused workspace).+logTitles :: (String -> String) -> (String -> String) -> Logger+logTitles formatFoc formatUnfoc = do+  sid <- gets $ W.screen . W.current . windowset+  logTitlesOnScreen sid formatFoc formatUnfoc+ -- | Get the name of the current layout. logLayout :: Logger logLayout = withWindowSet $ return . Just . ld@@ -186,17 +219,81 @@ 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 =+  withScreen+    $ traverse (fmap show . getName)+    . (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 shortcut to a screen+type WindowScreen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail++-- | 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 +302,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) --@@ -12,8 +13,6 @@ -- ----------------------------------------------------------------------------- -{-# 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@@ -56,7 +53,7 @@ -- 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 [] @@ -88,12 +85,12 @@ -- -- > , 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,11 @@   import XMonad.Actions.Submap(submap)+import XMonad.Prelude (groupBy) 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 System.Exit(exitSuccess)  import qualified Data.Map as M import qualified XMonad.StackSet as W@@ -114,13 +112,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 ()@@ -196,7 +195,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 +204,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.@@ -230,7 +227,7 @@ -- | 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 +265,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,7 @@-{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- 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,24 +17,30 @@   -- * Usage   -- $usage   NamedScratchpad(..),+  scratchpadWorkspaceTag,   nonFloating,   defaultFloating,   customFloating,   NamedScratchpads,   namedScratchpadAction,+  spawnHereNamedScratchpadAction,+  customRunNamedScratchpadAction,   allNamedScratchpadAction,   namedScratchpadManageHook,   namedScratchpadFilterOutWorkspace,-  namedScratchpadFilterOutWorkspacePP+  namedScratchpadFilterOutWorkspacePP,+  nsHideOnFocusLoss,   ) where  import XMonad-import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)-import XMonad.Hooks.DynamicLog (PP, ppSort)+import XMonad.Actions.SpawnOn (spawnHere)+import XMonad.Hooks.StatusBar.PP (PP, ppSort)+import XMonad.Hooks.ManageHelpers (doRectFloat)+import XMonad.Hooks.RefocusLast (withRecentsIn)+import XMonad.Prelude (filterM, find, unless, when) -import Control.Monad (filterM)-import Data.Maybe (listToMaybe)+import qualified Data.List.NonEmpty as NE  import qualified XMonad.StackSet as W @@ -84,6 +90,19 @@ -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings" --+-- 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.+--+-- 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@@ -109,46 +128,90 @@  -- | Finds named scratchpad configuration by name findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad-findByName c s = listToMaybe $ filter ((s==) . name) c+findByName c s = find ((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 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.+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.+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)+ 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 = withWindowSet $ \winSet -> do+    let cur = W.currentTag winSet+    withRecentsIn cur () $ \lastFocus _ ->+        when (lastFocus `elem` W.index winSet && cur /= scratchpadWorkspaceTag) $+            whenX (isNS lastFocus) $+                shiftToNSP (W.workspaces winSet) ($ lastFocus)+  where+    isNS :: Window -> X Bool+    isNS w = or <$> traverse ((`runQuery` w) . query) scratches++-- | execute some action on a named scratchpad+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 scratchpadConfig scratchpadName =+    case findByName scratchpadConfig scratchpadName of+        Just conf -> withWindowSet $ \winSet -> do+            let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ 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 -> case NE.nonEmpty matchingOnAll of+                    Nothing   -> runApp conf+                    Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins --- 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 ()++-- | Tag of the scratchpad workspace scratchpadWorkspaceTag :: String scratchpadWorkspaceTag = "NSP" @@ -157,10 +220,19 @@                           -> ManageHook namedScratchpadManageHook = composeAll . fmap (\c -> query c --> hook c) +-- | 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)+ -- | 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 +249,6 @@ namedScratchpadFilterOutWorkspacePP pp = pp {   ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp)   }+{-# DEPRECATED namedScratchpadFilterOutWorkspacePP "Use XMonad.Hooks.StatusBar.PP.filterOutWsPP [scratchpadWorkspaceTag] instead" #-}  -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
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/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,8 +28,7 @@ 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, listToMaybe) import XMonad.Util.XSelection (getSelection) import XMonad.Util.EZConfig (parseKey) import Text.ParserCombinators.ReadP (readP_to_S)@@ -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+pasteChar m c = sendKey m $ maybe (unicodeToKeysym c) fst                 $ listToMaybe $ readP_to_S 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/PureX.hs view
@@ -3,6 +3,7 @@ ----------------------------------------------------------------------------- -- | -- 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 (Any (..), liftA2) 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 >-- {{{@@ -136,7 +136,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 +156,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 +168,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,7 +214,7 @@  -- | 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)@@ -272,5 +272,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) --@@ -69,7 +70,7 @@ -- 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 +78,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 +86,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 +94,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 +106,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 +142,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 +191,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
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,9 +40,7 @@  import XMonad import XMonad.Util.WindowProperties-import Data.Monoid-import Data.Maybe-import Control.Monad+import XMonad.Prelude import System.Posix.Env  -- $usage@@ -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,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Util.Run+-- Description :  This modules provides several commands to run an external process. -- Copyright   :  (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu -- License     :  BSD-style (see LICENSE) --@@ -27,7 +28,9 @@                           safeRunInTerm,                           seconds,                           spawnPipe,-+                          spawnPipeWithLocaleEncoding,+                          spawnPipeWithUtf8Encoding,+                          spawnPipeWithNoEncoding,                           hPutStr, hPutStrLn  -- re-export for convenience                          ) where @@ -38,7 +41,7 @@ import System.IO import System.Process (runInteractiveProcess) import XMonad-import Control.Monad+import XMonad.Prelude  -- $usage -- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh"@@ -144,12 +147,33 @@ 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
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) --@@ -26,6 +27,7 @@ import XMonad import qualified XMonad.StackSet as W import XMonad.Util.NamedScratchpad+import XMonad.Util.WorkspaceCompare (filterOutWs)   -- $usage@@ -109,12 +111,12 @@   -- | Transforms a workspace list containing the SP workspace into one that--- doesn't contain it. Intended for use with logHooks.+-- 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,9 +1,8 @@-{-# 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@@ -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". +-- 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 -- 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) --@@ -21,10 +20,10 @@ 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 +32,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 +41,19 @@ -- 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. 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) --@@ -80,10 +81,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)@@ -182,7 +180,7 @@  -- | 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 +188,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 +219,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 +227,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_'@@ -320,7 +317,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 +326,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 +341,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/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 --@@ -85,9 +86,9 @@ 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]@@ -400,4 +401,3 @@                                       , inactiveTextColor   = "black"                                       }              }-
XMonad/Util/Timer.hs view
@@ -1,6 +1,7 @@ ----------------------------------------------------------------------------- -- | -- 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) --@@ -20,7 +21,6 @@     ) where  import XMonad-import Control.Applicative import Control.Concurrent import Data.Unique @@ -42,7 +42,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,7 +50,7 @@ -- | 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
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,7 @@ ----------------------------------------------------------------------------- -- | -- 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) --@@ -18,6 +19,7 @@       unGrab     ) where +import Graphics.X11.Xlib (sync) import Graphics.X11.Xlib.Extras (currentTime) import Graphics.X11.Xlib.Misc (ungrabKeyboard, ungrabPointer) import XMonad.Core@@ -40,4 +42,4 @@  -- | 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)
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@@ -52,7 +53,7 @@  -- | 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'.@@ -71,7 +68,7 @@ -- | 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 @@ -22,9 +23,7 @@                                  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) @@ -69,7 +68,7 @@     ev <- getEvent e     result <- if ev_event_type ev == selectionNotify                  then do res <- getWindowProperty8 dpy clp win-                         return $ decode . map fromIntegral . fromMaybe [] $ res+                         return $ decode . maybe [] (map fromIntegral) $ res                  else destroyWindow dpy win >> return ""     closeDisplay dpy     return result@@ -85,8 +84,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 +93,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,7 @@ ----------------------------------------------------------------------------- -- | -- 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)@@ -32,11 +33,10 @@     , fi     ) where -import Data.Maybe+import XMonad.Prelude import XMonad import XMonad.Util.Font import XMonad.Util.Image-import Control.Monad  -- $usage -- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or@@ -128,8 +128,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,9 +151,8 @@                   -> 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
+ 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/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,53 @@+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++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
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,165 @@+{-# 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_encodeLinearity" prop_encodeLinearity+  prop "prop_decodeLinearity" prop_decodeLinearity++  -- Checking for regressions+  context "+d +d f" $ do+    it "encode" $ prop_encodeLinearity (OrgMsg "+d +d f")+    it "decode" $ prop_decodeLinearity (Deadline "+d" (Time {date = Next Friday, tod = Nothing}))+  context "+d f 1 +d f" $ do+    it "encode" $ prop_encodeLinearity (OrgMsg "+d f 1 +d f")+    it "decode" $ prop_decodeLinearity (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}))++-- | Printing omits no information from output.+prop_encodeLinearity :: OrgMsg -> Property+prop_encodeLinearity (OrgMsg s) = Just s === (ppNote <$> pInput s)++-- | Parsing discards no information from input.+prop_decodeLinearity :: Note -> Property+prop_decodeLinearity n = Just n === pInput (ppNote n)++------------------------------------------------------------------------+-- Pretty Printing++ppNote :: Note -> String+ppNote = \case+  Scheduled str t -> str <> " +s " <> ppTime t+  Deadline  str t -> str <> " +d " <> ppTime t+  NormalMsg str   -> str++ppTime :: Time -> String+ppTime (Time d t) = ppDate d <> ppTOD t+ where+  ppTOD :: Maybe TimeOfDay -> String+  ppTOD = 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 <<>> elements [" +s ", " +d ", ""] <<>> dateGen <<>> hourGen+   where+    dateGen :: Gen String+    dateGen = oneof+      [ pure $ days ! Today+      , pure $ days ! Tomorrow+      , elements $ (days !) . Next <$> [Monday .. Sunday]+      , rNat+      , unwords <$> sequenceA [rNat, monthGen]+      , unwords <$> sequenceA [rNat, monthGen, show <$> posInt `suchThat` (> 25)]+      ]+     where+      rNat :: Gen String+      rNat = show <$> posInt++      monthGen :: Gen String+      monthGen = elements $ Map.elems months++    hourGen :: Gen String+    hourGen = oneof+      [ pure " " <<>> (pad <$> hourInt) <<>> pure ":" <<>> (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+    elements [Scheduled msg t, Deadline msg t, NormalMsg msg]++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+         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 = TimeOfDay <$> hourInt <*> minuteInt++------------------------------------------------------------------------+-- 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  -- 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  -- 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/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.16-homepage:           http://xmonad.org/-synopsis:           Third party extensions for xmonad+version:            0.17.0+-- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_*++homepage:           https://xmonad.org/+synopsis:           Community-maintained extensions 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:@@ -25,18 +27,13 @@                     scripts/window-properties.sh                     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                     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==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1+tested-with:        GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1  source-repository head   type:     git@@ -46,41 +43,44 @@ 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.9 && < 5,-                   bytestring >= 0.10 && < 0.11,+    build-depends: base >= 4.11 && < 5,+                   bytestring >= 0.10 && < 0.12,                    containers >= 0.5 && < 0.7,                    directory,-                   extensible-exceptions,                    filepath,-                   old-locale,-                   old-time,+                   time >= 1.8 && < 1.13,                    process,                    random,                    mtl >= 1 && < 3,                    unix,-                   X11>=1.6.1 && < 1.10,-                   xmonad >= 0.15 && < 0.16,-                   utf8-string,-                   semigroups+                   X11 >= 1.10 && < 1.11,+                   xmonad >= 0.16.99999 && < 0.18,+                   utf8-string+    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=17+                   -DXMONAD_CONTRIB_VERSION_PATCH=0+    ghc-options:   -Wall -Wno-unused-do-bind -    if true-        ghc-options:    -fwarn-tabs -Wall+    if flag(pedantic)+       ghc-options: -Werror -Wwarn=deprecations -    if flag(testing)-        ghc-options:    -fwarn-tabs -Werror+    -- Keep this in sync with the oldest version in 'tested-with'+    if impl(ghc > 8.4.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 +98,7 @@                         XMonad.Actions.DynamicWorkspaceGroups                         XMonad.Actions.DynamicWorkspaceOrder                         XMonad.Actions.DynamicWorkspaces+                        XMonad.Actions.EasyMotion                         XMonad.Actions.FindEmptyWorkspace                         XMonad.Actions.FlexibleManipulate                         XMonad.Actions.FlexibleResize@@ -116,21 +117,26 @@                         XMonad.Actions.Navigation2D                         XMonad.Actions.NoBorders                         XMonad.Actions.OnScreen+                        XMonad.Actions.PerWindowKeys                         XMonad.Actions.PerWorkspaceKeys                         XMonad.Actions.PhysicalScreens                         XMonad.Actions.Plane+                        XMonad.Actions.Prefix                         XMonad.Actions.Promote                         XMonad.Actions.RandomBackground                         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.TopicSpace                         XMonad.Actions.TreeSelect                         XMonad.Actions.UpdateFocus@@ -167,12 +173,14 @@                         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.FloatNext+                        XMonad.Hooks.Focus                         XMonad.Hooks.ICCCMFocus                         XMonad.Hooks.InsertPosition                         XMonad.Hooks.ManageDebug@@ -182,14 +190,19 @@                         XMonad.Hooks.Place                         XMonad.Hooks.PositionStoreHooks                         XMonad.Hooks.RefocusLast+                        XMonad.Hooks.Rescreen                         XMonad.Hooks.RestoreMinimized                         XMonad.Hooks.ScreenCorners                         XMonad.Hooks.Script                         XMonad.Hooks.ServerMode                         XMonad.Hooks.SetWMName+                        XMonad.Hooks.StatusBar+                        XMonad.Hooks.StatusBar.PP+                        XMonad.Hooks.TaffybarPagerHints                         XMonad.Hooks.ToggleHook                         XMonad.Hooks.UrgencyHook                         XMonad.Hooks.WallpaperSetter+                        XMonad.Hooks.WindowSwallowing                         XMonad.Hooks.WorkspaceByPos                         XMonad.Hooks.WorkspaceHistory                         XMonad.Hooks.XPropManage@@ -211,12 +224,12 @@                         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.Fullscreen                         XMonad.Layout.Gaps@@ -251,6 +264,7 @@                         XMonad.Layout.MosaicAlt                         XMonad.Layout.MouseResizableTile                         XMonad.Layout.MultiColumns+                        XMonad.Layout.MultiDishes                         XMonad.Layout.MultiToggle                         XMonad.Layout.MultiToggle.Instances                         XMonad.Layout.MultiToggle.TabBarDecoration@@ -264,6 +278,7 @@                         XMonad.Layout.PositionStoreFloat                         XMonad.Layout.Reflect                         XMonad.Layout.Renamed+                        XMonad.Layout.ResizableThreeColumns                         XMonad.Layout.ResizableTile                         XMonad.Layout.ResizeScreen                         XMonad.Layout.Roledex@@ -282,16 +297,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@@ -303,6 +321,7 @@                         XMonad.Prompt.Input                         XMonad.Prompt.Layout                         XMonad.Prompt.Man+                        XMonad.Prompt.OrgMode                         XMonad.Prompt.Pass                         XMonad.Prompt.RunOrRaise                         XMonad.Prompt.Shell@@ -312,15 +331,21 @@                         XMonad.Prompt.Window                         XMonad.Prompt.Workspace                         XMonad.Prompt.XMonad+                        XMonad.Prompt.Zsh+                        XMonad.Util.ActionCycle+                        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.Hacks                         XMonad.Util.Image                         XMonad.Util.Invisible                         XMonad.Util.Loggers@@ -338,8 +363,8 @@                         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.StringProp@@ -353,3 +378,85 @@                         XMonad.Util.WorkspaceCompare                         XMonad.Util.XSelection                         XMonad.Util.XUtils++test-suite tests+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  other-modules:  CycleRecentWS+                  ExtensibleConf+                  GridSelect+                  Instances+                  ManageDocks+                  NoBorders+                  OrgMode+                  RotateSome+                  Selective+                  SwapWorkspaces+                  Utils+                  XMonad.Actions.CycleRecentWS+                  XMonad.Actions.CycleWS+                  XMonad.Actions.FocusNth+                  XMonad.Actions.GridSelect+                  XMonad.Actions.PhysicalScreens+                  XMonad.Actions.RotateSome+                  XMonad.Actions.SwapWorkspaces+                  XMonad.Actions.TagWindows+                  XMonad.Actions.WindowBringer+                  XMonad.Hooks.ManageDocks+                  XMonad.Hooks.ManageHelpers+                  XMonad.Hooks.UrgencyHook+                  XMonad.Hooks.WorkspaceHistory+                  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.ExtensibleConf+                  XMonad.Util.ExtensibleState+                  XMonad.Util.Font+                  XMonad.Util.Image+                  XMonad.Util.Invisible+                  XMonad.Util.NamedWindows+                  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+               , QuickCheck >= 2+               , X11 >= 1.10 && < 1.11+               , containers+               , directory+               , time >= 1.8 && < 1.13+               , hspec >= 2.4.0 && < 3+               , mtl+               , random+               , process+               , unix+               , utf8-string+               , xmonad >= 0.16.9999 && < 0.18+  cpp-options: -DTESTING+  ghc-options: -Wall -Wno-unused-do-bind+  default-language: Haskell2010++  if flag(pedantic)+     ghc-options: -Werror -Wwarn=deprecations++  -- Keep this in sync with the oldest version in 'tested-with'+  if impl(ghc > 8.4.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