xmonad-contrib-0.18.0/0000755000000000000000000000000007346545000012715 5ustar0000000000000000xmonad-contrib-0.18.0/CHANGES.md0000644000000000000000000022747307346545000014326 0ustar0000000000000000# Change Log / Release Notes ## 0.18.0 (February 3, 2024) ### Breaking Changes * Deprecated `XMonad.Layout.Cross` due to bitrot; refer to `XMonad.Layout.Circle` and `XMonad.Layout.ThreeColumns` for alternatives. * Deprecated the `XMonad.Layout.StateFull` module and `XMonad.Layout.TrackFloating.(t|T)rackFloating` in favour of `XMonad.Layout.FocusTracking`. * Dropped support for GHC 8.4. * `XMonad.Util.ExclusiveScratchpads` - Deprecated the module in favour of the (new) exclusive scratchpad functionality of `XMonad.Util.NamedScratchpad`. * `XMonad.Actions.CycleWorkspaceByScreen` - The type of `repeatableAction` has changed, and it's deprecated in favour of `X.A.Repeatable.repeatable`. * `XMonad.Hooks.DynamicProperty` - Deprecated the module in favour of the more aptly named `XMonad.Hooks.OnPropertyChange`. * `XMonad.Util.Scratchpad`: - Deprecated the module; use `XMonad.Util.NamedScratchpad` instead. * `XMonad.Actions.Navigation2D` - Removed deprecated function `hybridNavigation`. * `XMonad.Layout.Spacing` - Removed deprecated functions `SpacingWithEdge`, `SmartSpacing`, `SmartSpacingWithEdge`, `ModifySpacing`, `setSpacing`, and `incSpacing`. * `XMonad.Actions.MessageFeedback` - Removed deprecated functions `send`, `sendSM`, `sendSM_`, `tryInOrder`, `tryInOrder_`, `tryMessage`, and `tryMessage_`. * `XMonad.Prompt.Window` - Removed deprecated functions `windowPromptGoto`, `windowPromptBring`, and `windowPromptBringCopy`. * `XMonad.Hooks.ICCCMFocus` - Removed deprecated module. This was merged into xmonad. * `XMonad.Layout.LayoutBuilderP` - Removed deprecated module; use `XMonad.Layout.LayoutBuilder` instead. * `XMonad.Hooks.RestoreMinimized` - Removed deprecated module; use `XMonad.Hooks.Minimize` instead. * `XMonad.Layout.Named` - Deprecated the entire module, use `XMonad.Layout.Renamed` (which newly provides `named` for convenience) instead. * `XMonad.Actions.SinkAll` - Deprecated the entire module, use `XMonad.Actions.WithAll` instead. * `XMonad.Layout.Circle`: - Deprecated the entire module, use the `circle` function from `XMonad.Layout.CircleEx` instead. * `XMonad.Hooks.EwmhDesktops` - `_NET_CLIENT_LIST_STACKING` puts windows in the current workspace at the top in bottom-to-top order, followed by visible workspaces, followed by invisible workspaces. Within visible and invisible groups, workspaces are ordered lexicographically, as before. Currently focused window will always be the topmost, meaning the last in the list. * `XMonad.Util.NamedScratchpad` - Added `nsSingleScratchpadPerWorkspace`—a logHook to allow only one active scratchpad per workspace. * `XMonad.Util.EZConfig` - The function `readKeySequence` now returns a non-empty list if it succeeded. * Deprecate `XMonad.Util.Ungrab`; it was moved to `XMonad.Operations` in core. ### New Modules * `XMonad.Layout.CenterMainFluid` - A three column layout with main column in the center and two stack column surrounding it. Master window will be on center column and spaces on the sides are reserved. * `XMonad.Layout.FocusTracking`. - Replaces `X.L.StateFull` and half of `X.L.TrackFloating`. * `XMonad.Actions.MostRecentlyUsed` - Tab through windows by recency of use. Based on the Alt+Tab behaviour common outside of xmonad. * `XMonad.Util.History` - Track history in *O(log n)* time. Provides `History`, a variation on a LIFO stack with a uniqueness property. In order to achieve the desired asymptotics, the data type is implemented as an ordered Map. * `XMonad.Actions.Repeatable` - Actions you'd like to repeat. Factors out the shared logic of `X.A.CycleRecentWS`, `X.A.CycleWorkspaceByScreen` and `X.A.CycleWindows`. * `XMonad.Hooks.OnPropertyChange`: - A new module replicating the functionality of `XMonad.Hooks.DynamicProperty`, but with more discoverable names. * `XMonad.Actions.ToggleFullFloat`: - Fullscreen (float) a window while remembering its original state. There's both an action to be bound to a key, and hooks that plug into `XMonad.Hooks.EwmhDesktops`. * `XMonad.Layout.CircleEx`: - A new window layout, similar to X.L.Circle, but with more possibilities for customisation. * `XMonad.Layout.DecorationEx`: - A new, more extensible, mechanism for window decorations, and some standard types of decorations, including usual bar on top of window, tabbed decorations and dwm-like decorations. ### Bug Fixes and Minor Changes * `XMonad.Layout.Magnifier` - Added `magnifyxy` to allow for different magnification in the horizontal and vertical directions. Added `magnifierxy`, `magnifierxy'`, `magnifierxyOff`, and `magnifierxyOff'` as particular combinators. * `XMonad.Util.Loggers` - Added `logClassname`, `logClassnames`, `logClassnames'`, `logClassnameOnScreen`, `logClassnamesOnScreen`, `logClassnamesOnScreen'`, and `ClassnamesFormat`. These are all equivalents of their `Title` counterparts, allowing logging the window classname instead. * `XMonad.Hooks.StatusBar.PP` - `dynamicLogString` now forces its result and produces an error string if it throws an exception. Use `dynamicLogString'` if for some reason you need the old behavior. * `XMonad.Util.EZConfig` - Added `remapKeysP`, which remaps keybindings from one binding to another. - Made `additionalKeys{,P}`, `removeKeys{,P}`, `remapKeysP`, and `{additional,remove}MouseBindings` `infixl 4` so they can more easily be concatenated with `(++)`. * `XMonad.Util.NamedScratchpad` - Added `addExclusives`, `resetFocusedNSP`, `setNoexclusive`, `resizeNoexclusive`, and `floatMoveNoexclusive` in order to augment named scratchpads with the exclusive scratchpad functionality of `XMonad.Util.ExclusiveScratchpads`. * `XMonad.Layout.BorderResize` - Added `borderResizeNear` as a variant of `borderResize` that can control how many pixels near a border resizing still works. * `XMonad.Util.Run` - It is now ensured that all arguments of `execute` and `eval` are quoted. Likewise, `executeNoQuote` is added as a version of `execute` that does not do that. - Added `findFile` as a shorthand to call `find-file`. - Added `list` and `saveExcursion` to the list of Emacs commands. - Added `toList` to easily lift a `String` to an `X Input`. - Added `>&&>` and `>||>` to glue together different inputs. * `XMonad.Util.Parser` - Added the `gather`, `count`, `between`, `option`, `optionally`, `skipMany`, `skipMany1`, `chainr`, `chainr1`, `chainl`, `chainl1`, and `manyTill` functions, in order to achieve feature parity with `Text.ParserCombinators.ReadP`. * `XMonad.Actions.FloatKeys` - Added `directionMoveWindow` and `directionMoveWindow` as more alternatives to the existing functions. * `XMonad.Hooks.InsertPosition` - Added `setupInsertPosition` as a combinator alternative to `insertPosition`. * `XMonad.Actions.Navigation2D` - Added `sideNavigation` as a fallback to the default tiling strategy, in case `lineNavigation` can't find a window. This benefits especially users who use `XMonad.Layout.Spacing`. * `XMonad.Prompt.OrgMode` - Added `orgPromptRefile` and `orgPromptRefileTo` for interactive and targeted refiling of the entered note into some existing tree of headings, respectively. - Allowed the time specification in `HHMM` format. * `XMonad.Actions.Search` - Added `aur`, `flora`, `ncatlab`, `protondb`, `rosettacode`, `sourcehut`, `steam`, `voidpgks_x86_64`, `voidpgks_x86_64_musl`, `arXiv`, `clojureDocs`, `cratesIo`, `rustStd`, `noogle`, `nixos`, `homeManager`, and `zbmath` search engines. * `XMonad.Layout.ResizableThreeColumns` - Fixed an issue where the bottom right window would not respond to `MirrorShrink` and `MirrorExpand` messages. * `XMonad.Hooks.EwmhDesktops` - Added `disableEwmhManageDesktopViewport` to avoid setting the `_NET_DESKTOP_VIEWPORT` property, as it can lead to issues with some status bars (see this [polybar issue](https://github.com/polybar/polybar/issues/2603)). - Added `setEwmhFullscreenHooks` to override the default fullfloat/sink behaviour of `_NET_WM_STATE_FULLSCREEN` requests. See also `XMonad.Actions.ToggleFullFloat` for a float-restoring implementation of fullscreening. - Added `ewmhDesktops(Maybe)ManageHook` that places windows in their preferred workspaces. This is useful when restoring a browser session after a restart. * `XMonad.Hooks.StatusBar` - Added `startAllStatusBars` to start the configured status bars. * `XMonad.Util.NamedActions` - Changed `addDescrKeys` and `addDescrKeys'` to not discard the keybindings in the current config. * `XMonad.Prompt` - The `emacsLikeXPKeymap` and `vimLikeXPKeymap` keymaps now treat `C-m` the same as `Return`. - Added `prevCompletionKey` to `XPConfig`, facilitating the ability to cycle through the completions backwards. This is bound to `S-` by default. - The `vimLikeXPKeymap` now accepts the prompt upon pressing enter in normal mode. * `XMonad.Actions.Prefix` - Added `orIfPrefixed`, a combinator to decide upon an action based on whether any prefix argument was given. * `XMonad.Actions.WorkspaceNames` - Enabled prompt completion (from history) in `renameWorkspace`. * `XMonad.Prompt.Pass` - Added `passOTPTypePrompt` to type out one-time-passwords via `xdotool`. * `XMonad.Util.Stack` - Added `zipperFocusedAtFirstOf` to differentiate two lists into a zipper. ### Other changes ## 0.17.1 (September 3, 2022) ### Breaking Changes * `XMonad.Util.EZConfig` - The functions `parseKey`, `parseKeyCombo`, and `parseKeySequence` now return a `Parser` (from `XMonad.Util.Parser`) instead of a `ReadP`. * `XMonad.Config.{Arossato,Dmwit,Droundy,Monad,Prime,Saegesser,Sjanssen}` - Deprecated all of these modules. The user-specific configuration modules may still be found [on the website]. * `XMonad.Util.NamedScratchpad` - Scratchpads are now only based on the argument given to `namedScratchpadManageHook`; all other scratchpad arguments are, while still present, ignored. Users passing all of their scratchpads to functions like `namedScratchpadAction` (as is shown in the module's documentation) should _not_ notice any difference in behaviour. * `XMonad.Util.DynamicScratchpads` - Deprecated the module; use the new dynamic scratchpad functionality of `XMonad.Util.NamedScratchpad` instead. * `XMonad.Hooks.UrgencyHook` - Deprecated `urgencyConfig`; use `def` from the new `Default` instance of `UrgencyConfig` instead. [on the website]: https://xmonad.org/configurations.html ### New Modules * `XMonad.Actions.PerLayoutKeys` Customizes a keybinding on a per-layout basis. Based on PerWorkspaceKeys. * `XMonad.Layout.CenteredIfSingle` Layout modifier that, if only a single window is on screen, places that window in the middle of the screen. * `XMonad.Util.ActionQueue` Put XMonad actions in the queue to be executed every time the `logHook` (or, alternatively, a hook of your choice) runs. * `XMonad.Hooks.BorderPerWindow` While XMonad provides config to set all window borders at the same width, this extension lets user set border width for a specific window using a ManageHook. * `XMonad.Util.Parser` A wrapper around the 'ReadP' parser combinator, providing behaviour that's closer to the more popular parser combinator libraries. * `XMonad.Hooks.StatusBar.WorkspaceScreen` In multi-head setup, it might be useful to have screen information of the visible workspaces combined with the workspace name, for example in a status bar. This module provides utility functions to do just that. * `XMonad.Hooks.ShowWName` Flashes the name of the current workspace when switching to it. Like `XMonad.Layout.ShowWName`, but as a logHook. * `XMonad.Actions.RepeatAction` A module for adding a keybinding to repeat the last action, similar to Vim's `.` or Emacs's `dot-mode`. * `XMonad.Util.Grab` Utilities for making grabbing and ungrabbing keys more convenient. * `XMonad.Hooks.Modal` This module implements modal keybindings for xmonad. * `XMonad.Layout.SideBorderDecoration` This module allows for having a configurable border position around windows; i.e., it can move the border to either cardinal direction. ### Bug Fixes and Minor Changes * `XMonad.Prompt.Pass` - Added new versions of the `pass` functions that allow user-specified prompts. * `XMonad.Prompt.AppendFile` - Use `XMonad.Prelude.mkAbsolutePath` to force names to be relative to the home directory and support `~/` prefixes. * `XMonad.Prompt.OrgMode` - Fixed the date parsing issue such that entries with a format of `todo +d 12 02 2024` work. - Added the ability to specify alphabetic (`#A`, `#B`, and `#C`) [priorities] at the end of the input note. * `XMonad.Prompt.Unicode` - Fixed the display of non-ASCII characters in the description of Unicode characters * `XMonad.Prompt` - Added `transposeChars` to interchange the characters around the point and bound it to `C-t` in the Emacs XPKeymaps. - Added xft-based font fallback support. This may be used by appending other fonts to the given string: `xft:iosevka-11,FontAwesome-9`. Note that this requires `xmonad-contrib` to be compiled with `X11-xft` version 0.3.4 or higher. * `XMonad.Hooks.WindowSwallowing` - Fixed windows getting lost when used in conjunction with `smartBorders` and a single window. - No longer needs `pstree` to detect child/parent relationships. - Fixed some false positives in child/parent relationship detection. * `XMonad.Actions.SpawnOn` - Fixed parsing of `/proc/*/stat` to correctly handle complex process names. * `XMonad.Util.EZConfig` - Added support for Modifier Keys `KeySym`s for Emacs-like `additionalKeysP`. * `XMonad.Hooks.ManageHelpers` - Flipped how `(^?)`, `(~?)`, and `($?)` work to more accurately reflect how one uses these operators. - Added `isMinimized` * `XMonad.Actions.WindowNavigation` - Fixed navigation getting "stuck" in certain situations for widescreen resolutions. * `XMonad.Layout.BinarySpacePartition` - Hidden windows are now ignored by the layout so that hidden windows in the stack don't offset position calculations in the layout. * `XMonad.Layout.MagicFocus` - The focused window will always be at the master area in the stack being passed onto the modified layout, even when focus leaves the workspace using the modified layout. * `XMonad.Actions.TreeSelect` - Added xft-based font fallback support. This may be used by appending other fonts to the given string: `xft:iosevka-11,FontAwesome-9`. Note that this requires `xmonad-contrib` to be compiled with `X11-xft` version 0.3.4 or higher. * `XMonad.Actions.FloatKeys` - Changed type signature of `keysMoveWindow` from `D -> Window -> X ()` to `ChangeDim -> Window -> X ()` to allow negative numbers without compiler warnings. * `XMonad.Util.Hacks` - Added `trayerPaddingXmobarEventHook` (plus generic variants for other trays/panels) to communicate trayer resize events to XMobar so that padding space may be reserved on xmobar for the tray. Requires `xmobar` version 0.40 or higher. * `XMonad.Layout.VoidBorders` - Added new layout modifier `normalBorders` which can be used for resetting borders back in layouts where you want borders after calling `voidBorders`. * `XMonad.Prelude` - Added `keymaskToString` and `keyToString` to show a key mask and a key in the style of `XMonad.Util.EZConfig`. - Added `WindowScreen`, which is a type synonym for the specialized `Screen` type, that results from the `WindowSet` definition in `XMonad.Core`. - Modified `mkAbsolutePath` to support a leading environment variable, so things like `$HOME/NOTES` work. If you want more general environment variable support, comment on [this PR]. * `XMonad.Util.XUtils` - Added `withSimpleWindow`, `showSimpleWindow`, `WindowConfig`, and `WindowRect` in order to simplify the handling of simple popup windows. * `XMonad.Actions.Submap` - Added `visualSubmap` to visualise the available keys and their actions when inside a submap. * `XMonad.Prompt`, `XMonad.Actions.TreeSelect`, `XMonad.Actions.GridSelect` - Key bindings now behave similarly to xmonad core: State of mouse buttons and XKB layout groups is ignored. Translation of key codes to symbols ignores modifiers, so `Shift-Tab` is now just `(shiftMap, xK_Tab)` instead of `(shiftMap, xK_ISO_Left_Tab)`. * `XMonad.Util.NamedScratchpad` - Added support for dynamic scratchpads in the form of `dynamicNSPAction` and `toggleDynamicNSP`. * `XMonad.Hooks.EwmhDesktops` - Added support for `_NET_DESKTOP_VIEWPORT`, which is required by some status bars. * `XMonad.Util.Run` - Added an EDSL—particularly geared towards programs like terminals or Emacs—to spawn processes from XMonad in a compositional way. * `XMonad.Hooks.UrgencyHook` - Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`. [this PR]: https://github.com/xmonad/xmonad-contrib/pull/744 [priorities]: https://orgmode.org/manual/Priorities.html ### Other changes * Migrated the sample build scripts from the deprecated `xmonad-testing` repo to `scripts/build`. This will be followed by a documentation update in the `xmonad` repo. ## 0.17.0 (October 27, 2021) ### Breaking Changes * All modules that export bitmap fonts as their default - If xmonad is compiled with XFT support (the default), use an XFT font instead. The previous default expected an X11 misc font (PCF), which is not supported in pango 1.44 anymore and thus some distributions have stopped shipping these. This fixes the silent `user error (createFontSet)`; this would break the respective modules. * `XMonad.Prompt` - Now `mkComplFunFromList` and `mkComplFunFromList'` take an additional `XPConfig` argument, so that they can take into account the given `searchPredicate`. - A `complCaseSensitivity` field has been added to `XPConfig`, indicating whether case-sensitivity is desired when performing completion. - `historyCompletion` and `historyCompletionP` now both have an `X` constraint (was: `IO`), due to changes in how the xmonad core handles XDG directories. - The prompt window now sets a `WM_CLASS` property. This allows other applications, like compositors, to properly match on it. * `XMonad.Hooks.EwmhDesktops` - It is no longer recommended to use `fullscreenEventHook` directly. Instead, use `ewmhFullscreen` which additionally advertises fullscreen support in `_NET_SUPPORTED` and fixes fullscreening of applications that explicitly check it, e.g. mupdf-gl, sxiv, … `XMonad.Layout.Fullscreen.fullscreenSupport` now advertises it as well, and no configuration changes are required in this case. - Deprecated `ewmhDesktopsLogHookCustom` and `ewmhDesktopsEventHookCustom`; these are now replaced by a composable `XMonad.Util.ExtensibleConf`-based interface. Users are advised to just use the `ewmh` XConfig combinator and customize behaviour using the provided `addEwmhWorkspaceSort`, `addEwmhWorkspaceRename` functions, or better still, use integrations provided by modules such as `XMonad.Actions.WorkspaceNames`. This interface now additionally allows customization of what happens when clients request window activation. This can be used to ignore activation of annoying applications, to mark windows as urgent instead of focusing them, and more. There's also a new `XMonad.Hooks.Focus` module extending the ManageHook EDSL with useful combinators. - Ordering of windows that are set to `_NET_CLIENT_LIST` and `_NET_CLIENT_LIST_STACKING` was changed to be closer to the spec. From now these two lists will have differently sorted windows. - `_NET_WM_STATE_DEMANDS_ATTENTION` was added to the list of supported hints (as per `_NET_SUPPORTED`). This hint has long been understood by `UrgencyHook`. This enables certain applications (e.g. kitty terminal emulator) that check whether the hint is supported to use it. * All modules still exporting a `defaultFoo` constructor - All of these were now removed. You can use the re-exported `def` from `Data.Default` instead. * `XMonad.Hooks.Script` - `execScriptHook` now has an `X` constraint (was: `MonadIO`), due to changes in how the xmonad core handles XDG directories. * `XMonad.Actions.WorkspaceNames` - The type of `getWorkspaceNames` was changed to fit into the new `ppRename` field of `PP`. * `XMonad.Hooks.StatusBar`, `XMonad.Hooks.StatusBar.PP` (previously `XMonad.Hooks.DynamicLog`) and `XMonad.Util.Run` - `spawnPipe` no longer uses binary mode handles but defaults to the current locale encoding instead. `dynamicLogString`, the output of which usually goes directly into such a handle, no longer encodes its output in UTF-8, but returns a normal `String` of Unicode codepoints instead. When these two are used together, everything should continue to work as it always has, but in isolation behaviour might change. (To get the old `spawnPipe` behaviour, `spawnPipeWithNoEncoding` can now be used, and `spawnPipeWithUtf8Encoding` was added as well to force UTF-8 regardless of locale. These shouldn't normally be necessary, though.) - `xmonadPropLog` and `xmonadPropLog'` now encode the String in UTF-8. Again, no change when used together with `dynamicLogString`, but other uses of these in user configs might need to be adapted. * `XMonad.Actions.TopicSpace` - Deprecated the `maxTopicHistory` field, as well as the `getLastFocusedTopics` and `setLastFocusedTopic` functions. It is now recommended to directly use `XMonad.Hooks.WorkspaceHistory` instead. - Added `TopicItem`, as well as the helper functions `topicNames`, `tiActions`, `tiDirs`, `noAction`, and `inHome` for a more convenient specification of topics. * `XMonad.Actions.CycleRecentWS` - Changed the signature of `recentWS` to return a `[WorkspaceId]` instead of a `[WindowSet]`, while `cycleWindowSets` and `toggleWindowSets` now take a function `WindowSet -> [WorkspaceId]` instead of one to `[WindowSet]` as their first argument. This fixes the interplay between this module and any layout that stores state. * `XMonad.Layout.LayoutCombinators` - Moved the alternative `(|||)` function and `JumpToLayout` to the xmonad core. They are re-exported by the module, but do not add any new functionality. `NewSelect` now exists as a deprecated type alias to `Choose`. - Removed the `Wrap` and `NextLayoutNoWrap` data constructors. - `XMonad.Actions.CycleWS` - Deprecated `EmptyWS`, `HiddenWS`, `NonEmptyWS`, `HiddenNonEmptyWS`, `HiddenEmptyWS`, `AnyWS` and `WSTagGroup`. - `XMonad.Actions.GridSelect` - `colorRangeFromClassName` now uses different hash function, so colors of inactive window tiles will be different (but still inside the provided color range). * `XMonad.Actions.Search` - Removed outdated `isohunt` search engine. - Updated URLs for `codesearch`, `openstreetmap`, and `thesaurus` search engines. - Added `github` search engine. ### New Modules * `XMonad.Layout.FixedAspectRatio` Layout modifier for user provided per-window aspect ratios. * `XMonad.Hooks.TaffybarPagerHints` Add a module that exports information about XMonads internal state that is not available through EWMH that is used by the taffybar status bar. * `XMonad.Hooks.StatusBar.PP` Originally contained inside `XMonad.Hooks.DynamicLog`, this module provides the pretty-printing abstraction and utilities, used primarly with `logHook`. Below are changes from `XMonad.Hooks.DynamicLog`, that now are included in this module: - Added `shortenLeft` function, like existing `shorten` but shortens by truncating from left instead of right. Useful for showing directories. - Added `shorten'` and `shortenLeft'` functions with customizable overflow markers. - Added `filterOutWsPP` for filtering out certain workspaces from being displayed. - Added `xmobarBorder` for creating borders around strings and `xmobarFont` for selecting an alternative font. - Added `ppRename` to `PP`, which makes it possible for extensions like `workspaceNamesPP`, `marshallPP` and/or `clickablePP` (which need to access the original `WorkspaceId`) to compose intuitively. - Added `ppPrinters`, `WSPP` and `fallbackPrinters` as a generalization of the `ppCurrent`, `ppVisible`… sextet, which makes it possible for extensions like `copiesPP` (which acts as if there was a `ppHiddenWithCopies`) to compose intuitively. * `XMonad.Hooks.StatusBar` This module provides a new interface that replaces `XMonad.Hooks.DynamicLog`, by providing composoble status bars. Supports property-based as well as pipe-based status bars. * `XMonad.Util.Hacks` A collection of hacks and fixes that should be easily acessible to users: - `windowedFullscreenFix` fixes fullscreen behaviour of chromium based applications when using windowed fullscreen. - `javaHack` helps when dealing with Java applications that might not work well with xmonad. - `trayerAboveXmobarEventHook` reliably stacks trayer on top of xmobar and below other windows * `XMonad.Util.ActionCycle` A module providing a simple way to implement "cycling" `X` actions, useful for things like alternating toggle-style keybindings. * `XMonad.Actions.RotateSome` Functions for rotating some elements around the stack while keeping others anchored in place. Useful in combination with layouts that dictate window visibility based on stack position, such as `XMonad.Layout.LimitWindows`. Export `surfaceNext` and `surfacePrev` actions, which treat the focused window and any hidden windows as a ring that can be rotated through the focused position. Export `rotateSome`, a pure function that rotates some elements around a stack while keeping others anchored in place. * `XMonad.Actions.Sift` Provide `siftUp` and `siftDown` actions, which behave like `swapUp` and `swapDown` but handle the wrapping case by exchanging the windows at either end of the stack instead of rotating the stack. * `XMonad.Hooks.DynamicIcons` Dynamically augment workspace names logged to a status bar via DynamicLog based on the contents (windows) of the workspace. * `XMonad.Hooks.WindowSwallowing` HandleEventHooks that implement window swallowing or sublayouting: Hide parent windows like terminals when opening other programs (like image viewers) from within them, restoring them once the child application closes. * `XMonad.Actions.TiledWindowDragging` An action that allows you to change the position of windows by dragging them around. * `XMonad.Layout.ResizableThreeColumns` A layout based on `XMonad.Layout.ThreeColumns` but with each slave window's height resizable. * `XMonad.Layout.TallMastersCombo` A layout combinator that support Shrink, Expand, and IncMasterN just as the `Tall` layout, and also support operations of two master windows: a main master, which is the original master window; a sub master, the first window of the second pane. This combinator can be nested, and has a good support for using `XMonad.Layout.Tabbed` as a sublayout. * `XMonad.Actions.PerWindowKeys` Create actions that run on a `Query Bool`, usually associated with conditions on a window, basis. Useful for creating bindings that are excluded or exclusive for some windows. * `XMonad.Util.DynamicScratchpads` Declare any window as a scratchpad on the fly. Once declared, the scratchpad behaves like `XMonad.Util.NamedScratchpad`. * `XMonad.Prompt.Zsh` A version of `XMonad.Prompt.Shell` that lets you use completions supplied by zsh. * `XMonad.Util.ClickableWorkspaces` Provides `clickablePP`, which when applied to the `PP` pretty-printer used by `XMonad.Hooks.StatusBar.PP`, will make the workspace tags clickable in XMobar (for switching focus). * `XMonad.Layout.VoidBorders` Provides a modifier that semi-permanently (requires manual intervention) disables borders for windows from the layout it modifies. * `XMonad.Hooks.Focus` Extends ManageHook EDSL to work on focused windows and current workspace. * `XMonad.Config.LXQt` This module provides a config suitable for use with the LXQt desktop environment. * `XMonad.Prompt.OrgMode` A prompt for interacting with [org-mode](https://orgmode.org/). It can be used to quickly save TODOs, NOTEs, and the like with the additional capability to schedule/deadline a task, or use the primary selection as the contents of the note. * `XMonad.Util.ExtensibleConf` Extensible and composable configuration for contrib modules. Allows contrib modules to store custom configuration values inside `XConfig`. This lets them create custom hooks, ensure they hook into xmonad core only once, and possibly more. * `XMonad.Hooks.Rescreen` Custom hooks for screen (xrandr) configuration changes. These can be used to restart/reposition status bars or systrays automatically after xrandr, as well as to actually invoke xrandr or autorandr when an output is (dis)connected. * `XMonad.Actions.EasyMotion` A new module that allows selection of visible screens using a key chord. Inspired by [vim-easymotion](https://github.com/easymotion/vim-easymotion). See the animation in the vim-easymotion repo to get some idea of the functionality of this EasyMotion module. ### Bug Fixes and Minor Changes * Add support for GHC 9.0.1. * `XMonad.Actions.WithAll` - Added `killOthers`, which kills all unfocused windows on the current workspace. * `XMonad.Prompt.XMonad` - Added `xmonadPromptCT`, which allows you to create an XMonad prompt with a custom title. * `XMonad.Actions.DynamicWorkspaceGroups` - Add support for `XMonad.Actions.TopicSpace` through `viewTopicGroup` and `promptTopicGroupView`. * `XMonad.Actions.TreeSelect` - Fix swapped green/blue in foreground when using Xft. - The spawned tree-select window now sets a `WM_CLASS` property. This allows other applications, like compositors, to properly match on it. * `XMonad.Layout.Fullscreen` - Add fullscreenSupportBorder which uses smartBorders to remove window borders when the window is fullscreen. * `XMonad.Config.Mate` - Split out the logout dialog and add a shutdown dialog. The default behavior remains the same but there are now `mateLogout` and `mateShutdown` actions available. - Add mod-d keybinding to open the Mate main menu. * `XMonad.Actions.DynamicProjects` - The `changeProjectDirPrompt` function respects the `complCaseSensitivity` field of `XPConfig` when performing directory completion. - `modifyProject` is now exported. * `XMonad.Layout.WorkspaceDir` - The `changeDir` function respects the `complCaseSensitivity` field of `XPConfig` when performing directory completion. - `Chdir` message is exported, so it's now possible to change the directory programmaticaly, not just via a user prompt. * `XMonad.Prompt.Directory` - Added `directoryMultipleModes'`, like `directoryMultipleModes` with an additional `ComplCaseSensitivity` argument. - Directory completions are now sorted. - The `Dir` constructor now takes an additional `ComplCaseSensitivity` argument to indicate whether directory completion is case sensitive. * `XMonad.Prompt.FuzzyMatch` - `fuzzySort` will now accept cases where the input is not a subsequence of every completion. * `XMonad.Prompt.Shell` - Added `getShellCompl'`, like `getShellCompl` with an additional `ComplCaseSensitivity` argument. - Added `compgenDirectories` and `compgenFiles` to get the directory/filename completion matches returned by the compgen shell builtin. - Added `safeDirPrompt`, which is like `safePrompt`, but optimized for the use-case of a program that needs a file as an argument. * `XMonad.Prompt.Unicode` - Reworked internally to call `spawnPipe` (asynchronous) instead of `runProcessWithInput` (synchronous), which fixes `typeUnicodePrompt`. - Now respects `searchPredicate` and `sorter` from user-supplied `XPConfig`. * `XMonad.Hooks.DynamicLog` - Added `xmobarProp`, for property-based alternative to `xmobar`. - Add the -dock argument to the dzen spawn arguments - The API for this module is frozen: this is now a compatibility wrapper. - References for this module are updated to point to `X.H.StatusBar` or `X.H.StatusBar.PP` * `XMonad.Layout.BoringWindows` - Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions. - Added `markBoringEverywhere` function, to mark the currently focused window boring on all layouts, when using `XMonad.Actions.CopyWindow`. * `XMonad.Util.NamedScratchpad` - Added two new exported functions to the module: - `customRunNamedScratchpadAction` (provides the option to customize the `X ()` action the scratchpad is launched by) - `spawnHereNamedScratchpadAction` (uses `XMonad.Actions.SpawnOn.spawnHere` to initially start the scratchpad on the workspace it was launched on) - Deprecated `namedScratchpadFilterOutWorkspace` and `namedScratchpadFilterOutWorkspacePP`. Use `XMonad.Util.WorkspaceCompare.filterOutWs` respectively `XMonad.Hooks.DynamicLog.filterOutWsPP` instead. - Exported the `scratchpadWorkspaceTag`. - Added a new logHook `nsHideOnFocusLoss` for hiding scratchpads when they lose focus. * `XMonad.Prompt.Window` - Added `allApplications` function which maps application executable names to its underlying window. - Added a `WithWindow` constructor to `WindowPrompt` to allow executing actions of type `Window -> X ()` on the chosen window. * `XMonad.Prompt.WindowBringer` - Added `windowAppMap` function which maps application executable names to its underlying window. - A new field `windowFilter` was added to the config, which allows the user to provide a function which will decide whether each window should be included in the window bringer menu. * `XMonad.Actions.Search` - The `hoogle` function now uses the new URL `hoogle.haskell.org`. - Added `promptSearchBrowser'` function to only suggest previous searches of the selected search engine (instead of all search engines). * `XMonad.Layout.MouseResizableTile` - When we calculate dragger widths, we first try to get the border width of the focused window, before failing over to using the initial `borderWidth`. * `XMonad.Actions.CycleRecentWS` - Added `cycleRecentNonEmptyWS` function which behaves like `cycleRecentWS` but is constrainded to non-empty workspaces. - Added `toggleRecentWS` and `toggleRecentNonEmptyWS` functions which toggle between the current and most recent workspace, and continue to toggle back and forth on repeated presses, rather than cycling through other workspaces. - Added `recentWS` function which allows the recency list to be filtered with a user-provided predicate. * `XMonad.Layout.Hidden` - Export `HiddenWindows` type constructor. - Export `popHiddenWindow` function restoring a specific window. * `XMonad.Hooks.ManageDocks` - Export `AvoidStruts` constructor - Restored compatibility with pre-0.13 configs by making the startup hook unnecessary for correct functioning (strut cache is initialized on-demand). This is a temporary measure, however. The individual hooks are now deprecated in favor of the `docks` combinator, `xmonad --recompile` now reports deprecation warnings, and the hooks will be removed soon. - Fixed ignoring of strut updates from override-redirect windows, which is default for xmobar. Previously, if one wanted xmobar to reposition itself after xrandr changes and have xmonad handle that repositioning, one would need to configure xmobar with `overrideRedirect = False`, which would disable lowering on start and thus cause other problems. This is no longer necessary. * `XMonad.Hooks.ManageHelpers` - Export `doSink` - Added `doLower` and `doRaise` - Added `shiftToSame` and `clientLeader` which allow a hook to be created that shifts a window to the workspace of other windows of the application (using either the `WM_CLIENT_LEADER` or `_NET_WM_PID` property). - Added `windowTag` - Added `(^?)`, `(~?)` and `($?)` operators as infix versions of `isPrefixOf`, `isInfixOf` and `isSuffixOf` working with `ManageHook`s. * `XMonad.Util.EZConfig` - Added support for XF86Bluetooth. * `XMonad.Util.Loggers` - Make `battery` and `loadAvg` distro-independent. - Added `logTitleOnScreen`, `logCurrentOnScreen` and `logLayoutOnScreen` as screen-specific variants of `logTitle`, `logCurrent` and `logLayout`. - Added `logWhenActive` to have loggers active only when a certain screen is active. - Added `logConst` to log a constant `String`, and `logDefault` (infix: `.|`) to combine loggers. - Added `logTitles` to log all window titles (focused and unfocused ones) on the focused workspace, as well as `logTitlesOnScreen` as a screen-specific variant thereof. - Added `logTitles'` and `logTitleOnScreen'`. These act like `logTitles` and `logTitlesOnScreen` but use a record as an input to enable logging for more window types. For example, currently urgent windows are additionally supported. * `XMonad.Layout.Minimize` - Export `Minimize` type constructor. * `XMonad.Actions.WorkspaceNames` - Added `workspaceNamesEwmh` which makes workspace names visible to external pagers. * `XMonad.Util.PureX` - Added `focusWindow` and `focusNth` which don't refresh (and thus possibly flicker) when they happen to be a no-op. - Added `shiftWin` as a refresh tracking version of `W.shiftWin`. * Several `LayoutClass` instances now have an additional `Typeable` constraint which may break some advanced configs. The upside is that we can now add `Typeable` to `LayoutClass` in `XMonad.Core` and make it possible to introspect the current layout and its modifiers. * `XMonad.Actions.TopicSpace` - `switchTopic` now correctly updates the last used topics. - `setLastFocusedTopic` will now check whether we have exceeded the `maxTopicHistory` and prune the topic history as necessary, as well as cons the given topic onto the list __before__ filtering it. - Added `switchNthLastFocusedExclude`, which works like `switchNthLastFocused` but is able to exclude certain topics. - Added `switchTopicWith`, which works like `switchTopic`, but one is able to give `setLastFocusedTopic` a custom filtering function as well. - Instead of a hand-rolled history, use the one from `XMonad.Hooks.WorkspaceHistory`. - Added the screen-aware functions `getLastFocusedTopicsByScreen` and `switchNthLastFocusedByScreen`. * `XMonad.Hooks.WorkspaceHistory` - Added `workspaceHistoryModify` to modify the workspace history with a pure function. - Added `workspaceHistoryHookExclude` for excluding certain workspaces to ever enter the history. * `XMonad.Util.DebugWindow` - Fixed a bottom in `debugWindow` when used on windows with UTF8 encoded titles. * `XMonad.Config.Xfce` - Set `terminal` to `xfce4-terminal`. * `XMonad.Hooks.WorkspaceCompare` - Added `filterOutWs` for workspace filtering. * `XMonad.Prompt` - Accommodate completion of multiple words even when `alwaysHighlight` is enabled. - Made the history respect words that were "completed" by `alwaysHighlight` upon confirmation of the selection by the user. - Fixed a crash when focusing a new window while the prompt was up by allowing pointer events to pass through the custom prompt event loop. - The prompt now cycles through its suggestions if one hits the ends of the suggestion list and presses `TAB` again. - Added `maxComplColumns` field to `XPConfig`, to limit the number of columns in the completion window. - Redefine `ComplCaseSensitivity` to a proper sum type as opposed to a `newtype` wrapper around `Bool`. * `XMonad.Actions.TreeSelect` - Fixed a crash when focusing a new window while the tree select window was up by allowing pointer events to pass through the custom tree select event loop. * `XMonad.Layout.NoBorders` - Fixed handling of floating window borders in multihead setups that was broken since 0.14. - Added `OnlyFloat` constructor to `Ambiguity` to unconditionally remove all borders on floating windows. * `XMonad.Hooks.UrgencyHook` - It's now possible to clear urgency of selected windows only using the newly exported `clearUrgents'` function. Also, this and `clearUrgents` now clear the `_NET_WM_STATE_DEMANDS_ATTENTION` bit as well. - Added a variant of `filterUrgencyHook` that takes a generic `Query Bool` to select which windows should never be marked urgent. - Added `askUrgent` and a `doAskUrgent` manage hook helper for marking windows as urgent from inside of xmonad. This can be used as a less intrusive action for windows requesting focus. * `XMonad.Hooks.ServerMode` - To make it easier to use, the `xmonadctl` client is now included in `scripts/`. * `XMonad.Layout.TrackFloating` - Fixed a bug that prevented changing focus on inactive workspaces. * `XMonad.Layout.Magnifier` - Added `magnifierczOff` and `magnifierczOff'` for custom-size magnifiers that start out with magnifying disabled. - Added `magnify` as a more general combinator, including the ability to postpone magnifying until there are a certain number of windows on the workspace. * `XMonad.Layout.Renamed` - Added `KeepWordsLeft` and `KeepWordsRight` for keeping certain number of words in left or right direction in layout description. * `XMonad.Hooks.WallpaperSetter` - Added `defWPNamesPng`, which works like `defWPNames` but maps `ws-name` to `ws-name.png` instead of `ws-name.jpg`. - Added `defWPNamesJpg` as an alias to `defWPNames` and deprecated the latter. * `XMonad.Layout.SubLayouts` - Floating windows are no longer moved to the end of the window stack. * `XMonad.Layout.BinarySpacePartition` - Add the ability to increase/decrease the window size by a custom rational number. E.g: `sendMessage $ ExpandTowardsBy L 0.02` * `XMonad.Layout.Decoration` - The decoration window now sets a `WM_CLASS` property. This allows other applications, like compositors, to properly match on it. * `XMonad.Layout.IndependentScreens` - Fixed a bug where `marshallPP` always sorted workspace names lexically. This changes the default behaviour of `marshallPP`—the given `ppSort` now operates in the _physical_ workspace names. The documentation of `marshallSort` contains an example of how to get the old behaviour, where `ppSort` operates in virtual names, back. - Added `workspacesOn` for filtering workspaces on the current screen. - Added `withScreen` to specify names for a given single screen. - Added new aliases `PhysicalWindowSpace` and `VirtualWindowSpace` for a `WindowSpace` for easier to read function signatures. - Added a few useful utility functions related to simplify using the module; namely `workspaceOnScreen`, `focusWindow'`, `focusScreen`, `nthWorkspace`, and `withWspOnScreen`. - Fixed wrong type-signature of `onCurrentScreen`. * `XMonad.Actions.CopyWindow` - Added `copiesPP` to make a `PP` aware of copies of the focused window. - `XMonad.Actions.CycleWS` - Added `:&:`, `:|:` and `Not` data constructors to `WSType` to logically combine predicates. - Added `hiddenWS`, `emptyWS` and `anyWS` to replace deprecated constructors. - Added `ingoringWSs` as a `WSType` predicate to skip workspaces having a tag in a given list. - `XMonad.Actions.DynamicWorkspaceOrder` - Added `swapWithCurrent` and `swapOrder` to the list of exported names. - `XMonad.Actions.Submap`, `XMonad.Util.Ungrab`: - Fixed issue with keyboard/pointer staying grabbed when a blocking action like `runProcessWithInput` was invoked. - `XMonad.Actions.UpdateFocus` - Added `focusUnderPointer`, that updates the focus based on pointer position, an inverse of `X.A.UpdatePointer`, which moves the mouse pointer to match the focused window). Together these can be used to ensure focus stays in sync with mouse. - `XMonad.Layout.MultiToggle` - Added `isToggleActive` for querying the toggle state of transformers. Useful to show the state in a status bar. * `XMonad.Layout.Spacing` - Removed deprecations for `spacing`, `spacingWithEdge`, `smartSpacing`, and `smartSpacingWithEdge`. * `XMonad.Actions.DynamicWorkspaces` - Fixed a system freeze when using `X.A.CopyWindow.copy` in combination with `removeWorkspace`. - `withWorkspace` now honors the users `searchPredicate`, for example `fuzzyMatch` from `Prompt.FuzzyMatch`. ## 0.16 ### Breaking Changes * `XMonad.Layout.Decoration` - Added `Theme` record fields for controlling decoration border width for active/inactive/urgent windows. * `XMonad.Prompt` - Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and `vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt actions. - Prompt supports dynamic colors. Colors are now specified by the `XPColor` type in `XPState` while `XPConfig` colors remain unchanged for backwards compatibility. - Fixes `showCompletionOnTab`. - The behavior of `moveWord` and `moveWord'` has changed; brought in line with the documentation and now internally consistent. The old keymaps retain the original behavior; see the documentation to do the same your XMonad configuration. * `XMonad.Util.Invisble` - Requires `MonadFail` for `Read` instance ### New Modules * `XMonad.Layout.TwoPanePersistent` A layout that is like TwoPane but keeps track of the slave window that is currently beside the master. In TwoPane, the default behavior when the master is focused is to display the next window in the stack on the slave pane. This is a problem when a different slave window is selected without changing the stack order. * `XMonad.Util.ExclusiveScratchpads` Named scratchpads that can be mutually exclusive: This new module extends the idea of named scratchpads such that you can define "families of scratchpads" that are exclusive on the same screen. It also allows to remove this constraint of being mutually exclusive with another scratchpad. * `XMonad.Actions.Prefix` A module that allows the user to use an Emacs-style prefix argument (raw or numeric). ### Bug Fixes and Minor Changes * `XMonad.Layout.Tabbed` tabbedLeft and tabbedRight will set their tabs' height and width according to decoHeight/decoWidth * `XMonad.Prompt` Added `sorter` to `XPConfig` used to sort the possible completions by how well they match the search string (example: `XMonad.Prompt.FuzzyMatch`). Fixes a potential bug where an error during prompt execution would leave the window open and keep the keyboard grabbed. See issue [#180](https://github.com/xmonad/xmonad-contrib/issues/180). Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where using tab to wrap around the completion rows would fail when maxComplRows is restricting the number of rows of output. * `XMonad.Prompt.Pass` Added 'passOTPPrompt' to support getting OTP type password. This require pass-otp (https://github.com/tadfisher/pass-otp) has been setup in the running machine. Added 'passGenerateAndCopyPrompt', which both generates a new password and copies it to the clipboard. These two actions are commonly desirable to take together, e.g. when establishing a new account. Made password prompts traverse symlinks when gathering password names for autocomplete. * `XMonad.Actions.DynamicProjects` Make the input directory read from the prompt in `DynamicProjects` absolute wrt the current directory. Before this, the directory set by the prompt was treated like a relative directory. This means that when you switch from a project with directory `foo` into a project with directory `bar`, xmonad actually tries to `cd` into `foo/bar`, instead of `~/bar` as expected. * `XMonad.Actions.DynamicWorkspaceOrder` Add a version of `withNthWorkspace` that takes a `[WorkspaceId] -> [WorkspaceId]` transformation to apply over the list of workspace tags resulting from the dynamic order. * `XMonad.Actions.GroupNavigation` Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy cycling between all windows on all visible workspaces. * `XMonad.Hooks.WallpaperSetter` Preserve the aspect ratio of wallpapers that xmonad sets. When previous versions would distort images to fit the screen size, it will now find a best fit by cropping instead. * `XMonad.Util.Themes` Add adwaitaTheme and adwaitaDarkTheme to match their respective GTK themes. * 'XMonad.Layout.BinarySpacePartition' Add a new `SplitShiftDirectional` message that allows moving windows by splitting its neighbours. * `XMonad.Prompt.FuzzyMatch` Make fuzzy sort show shorter strings first. ## 0.15 ### Breaking Changes * `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers` The layout will no longer perform refreshes inside of its message handling. If you have been relying on it to in your xmonad.hs, you will need to start sending its messages in a manner that properly handles refreshing, e.g. with `sendMessage`. ### New Modules * `XMonad.Util.Purex` Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from the `XConf` and modifications to the `XState` are fundamentally pure -- contrary to the current treatment of such actions in most xmonad code. Pure modifications to the `WindowSet` can be readily composed, but due to the need for those modifications to be properly handled by `windows`, other pure changes to the `XState` cannot be interleaved with those changes to the `WindowSet` without superfluous refreshes, hence breaking composability. This module aims to rectify that situation by drawing attention to it and providing `PureX`: a pure type with the same monadic interface to state as `X`. The `XLike` typeclass enables writing actions generic over the two monads; if pure, existing `X` actions can be generalised with only a change to the type signature. Various other utilities are provided, in particular the `defile` function which is needed by end-users. ### Bug Fixes and Minor Changes * Add support for GHC 8.6.1. * `XMonad.Actions.MessageHandling` Refresh-performing functions updated to better reflect the new `sendMessage`. ## 0.14 ### Breaking Changes * `XMonad.Layout.Spacing` Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed of four sides each with its own border width. The screen and window borders are now separate and can be independently toggled on/off. The screen border examines the window/rectangle list resulting from 'runLayout' rather than the stack, which makes it compatible with layouts such as the builtin `Full`. The child layout will always be called with the screen border. If only a single window is displayed (and `smartBorder` enabled), it will be expanded into the original layout rectangle. Windows that are displayed but not part of the stack, such as those created by 'XMonad.Layout.Decoration', will be shifted out of the way, but not scaled (not possible for windows created by XMonad). This isn't perfect, so you might want to disable `Spacing` on such layouts. * `XMonad.Util.SpawnOnce` - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks to shift spawned windows to a specific workspace. * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier * `XMonad.Actions.GridSelect` - Added field `gs_bordercolor` to `GSConfig` to specify border color. * `XMonad.Layout.Minimize` Though the interface it offers is quite similar, this module has been almost completely rewritten. The new `XMonad.Actions.Minimize` contains several functions that allow interaction with minimization window state. If you are using this module, you must upgrade your configuration to import `X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has been completely deprecated, and its functions have no effect. * `XMonad.Prompt.Unicode` - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a filepath to the `UnicodeData.txt` file containing unicode data. * `XMonad.Actions.PhysicalScreens` `getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default value are: - `def`(same as verticalScreenOrderer) will keep previous behavior - `verticalScreenOrderer` - `horizontalScreenOrderer` One can build his custom ScreenOrderer using: - `screenComparatorById` (allow to order by Xinerama id) - `screenComparatorByRectangle` (allow to order by screen coordonate) - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id) * `XMonad.Util.WorkspaceCompare` `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information) * `XMonad.Hooks.EwmhDesktops` - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific remapping of all visible windows to the active workspace (#216). - Handle workspace renames that might be occuring in the custom function that is provided to ewmhDesktopsLogHookCustom. * `XMonad.Hooks.DynamicLog` - Support xmobar's \ and \ tags; see `xmobarAction` and `xmobarRaw`. * `XMonad.Layout.NoBorders` The layout now maintains a list of windows that never have borders, and a list of windows that always have borders. Use `BorderMessage` to manage these lists and the accompanying event hook (`borderEventHook`) to remove destroyed windows from them. Also provides the `hasBorder` manage hook. Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`. See the documentation for more information. The type signature of `hiddens` was changed to accept a new `Rectangle` parameter representing the bounds of the parent layout, placed after the `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous` will need to update their configuration. For example, replace "`hiddens amb wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make use of the new parameter with "`hiddens amb wset lr mst wrs =`". * `XMonad.Actions.MessageFeedback` - Follow the naming conventions of `XMonad.Operations`. Functions returning `X ()` are named regularly (previously these ended in underscore) while those returning `X Bool` are suffixed with an uppercase 'B'. - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent` (renamed from `send`). - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of type `SomeMessage -> X Bool`, which means you are no longer constrained to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher. - The `send*Messages*` family of funtions allows for sequencing arbitrary sets of messages with minimal refresh. It makes little sense for these functions to support custom message dispatchers. - Remain backwards compatible. Maintain deprecated aliases of all renamed functions: - `send` -> `sendMessageWithNoRefreshToCurrentB` - `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB` - `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent` - `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB` - `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent` - `tryMessage` -> `tryMessageWithNoRefreshToCurrentB` - `tryMessage_` -> `tryMessageWithNoRefreshToCurrent` ### New Modules * `XMonad.Layout.MultiToggle.TabBarDecoration` Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to dynamically toggle `XMonad.Layout.TabBarDecoration`. * `XMonad.Hooks.RefocusLast` Provides hooks and actions that keep track of recently focused windows on a per workspace basis and automatically refocus the last window on loss of the current (if appropriate as determined by user specified criteria). * `XMonad.Layout.StateFull` Provides `StateFull`: a stateful form of `Full` that does not misbehave when floats are focused, and the `FocusTracking` layout transformer by means of which `StateFull` is implemented. `FocusTracking` simply holds onto the last true focus it was given and continues to use it as the focus for the transformed layout until it sees another. It can be used to improve the behaviour of a child layout that has not been given the focused window. * `XMonad.Actions.SwapPromote` Module for tracking master window history per workspace, and associated functions for manipulating the stack using such history. * `XMonad.Actions.CycleWorkspaceByScreen` A new module that allows cycling through previously viewed workspaces in the order they were viewed most recently on the screen where cycling is taking place. Also provides the `repeatableAction` helper function which can be used to build actions that can be repeated while a modifier key is held down. * `XMonad.Prompt.FuzzyMatch` Provides a predicate `fuzzyMatch` that is much more lenient in matching completions in `XMonad.Prompt` than the default prefix match. Also provides a function `fuzzySort` that allows sorting the fuzzy matches by "how well" they match. * `XMonad.Utils.SessionStart` A new module that allows to query if this is the first time xmonad is started of the session, or a xmonad restart. Currently needs manual setting of the session start flag. This could be automated when this moves to the core repository. * `XMonad.Layout.MultiDishes` A new layout based on Dishes, however it accepts additional configuration to allow multiple windows within a single stack. * `XMonad.Util.Rectangle` A new module for handling pixel rectangles. * `XMonad.Layout.BinaryColumn` A new module which provides a simple grid layout, halving the window sizes of each window after master. This is similar to Column, but splits the window in a way that maintains window sizes upon adding & removing windows as well as the option to specify a minimum window size. ### Bug Fixes and Minor Changes * `XMonad.Layout.Grid` Fix as per issue #223; Grid will no longer calculate more columns than there are windows. * `XMonad.Hooks.FadeWindows` Added support for GHC version 8.4.x by adding a Semigroup instance for Monoids * `XMonad.Hooks.WallpaperSetter` Added support for GHC version 8.4.x by adding a Semigroup instance for Monoids * `XMonad.Hooks.Mosaic` Added support for GHC version 8.4.x by adding a Semigroup instance for Monoids * `XMonad.Actions.Navigation2D` Added `sideNavigation` and a parameterised variant, providing a navigation strategy with fewer quirks for tiled layouts using X.L.Spacing. * `XMonad.Layout.Fullscreen` The fullscreen layouts will now not render any window that is totally obscured by fullscreen windows. * `XMonad.Layout.Gaps` Extended the sendMessage interface with `ModifyGaps` to allow arbitrary modifications to the `GapSpec`. * `XMonad.Layout.Groups` Added a new `ModifyX` message type that allows the modifying function to return values in the `X` monad. * `XMonad.Actions.Navigation2D` Generalised (and hence deprecated) hybridNavigation to hybridOf. * `XMonad.Layout.LayoutHints` Preserve the window order of the modified layout, except for the focused window that is placed on top. This fixes an issue where the border of the focused window in certain situations could be rendered below borders of unfocused windows. It also has a lower risk of interfering with the modified layout. * `XMonad.Layout.MultiColumns` The focused window is placed above the other windows if they would be made to overlap due to a layout modifier. (As long as it preserves the window order.) * `XMonad.Actions.GridSelect` - The vertical centring of text in each cell has been improved. * `XMonad.Actions.SpawnOn` - Bind windows spawns by child processes of the original window to the same workspace as the original window. * `XMonad.Util.WindowProperties` - Added the ability to test if a window has a tag from `XMonad.Actions.TagWindows` * `XMonad.Layout.Magnifier` - Handle `IncMasterN` messages. * `XMonad.Util.EZConfig` - Can now parse Latin1 keys, to better accommodate users with non-US keyboards. * `XMonad.Actions.Submap` Establish pointer grab to avoid freezing X, when button press occurs after submap key press. And terminate submap at button press in the same way, as we do for wrong key press. * `XMonad.Hooks.SetWMName` Add function `getWMName`. * `XMonad.Hooks.ManageHelpers` - Make type of ManageHook combinators more general. - New manage hook `doSink` for sinking windows (as upposed to the `doFloat` manage hook) * `XMonad.Prompt` Export `insertString`. * `XMonad.Prompt.Window` - New function: `windowMultiPrompt` for using `mkXPromptWithModes` with window prompts. * `XMonad.Hooks.WorkspaceHistory` - Now supports per screen history. * `XMonad.Layout.ComboP` - New `PartitionWins` message to re-partition all windows into the configured sub-layouts. Useful when window properties have changed and you want to re-sort windows into the appropriate sub-layout. * `XMonad.Actions.Minimize` - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform actions with both the last and first minimized windows easily. * `XMonad.Config.Gnome` - Update logout key combination (modm+shift+Q) to work with modern * `XMonad.Prompt.Pass` - New function `passTypePrompt` which uses `xdotool` to type in a password from the store, bypassing the clipboard. - New function `passEditPrompt` for editing a password from the store. - Now handles password labels with spaces and special characters inside them. * `XMonad.Prompt.Unicode` - Persist unicode data cache across XMonad instances due to `ExtensibleState` now used instead of `unsafePerformIO`. - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the Unicode character via `xdotool` instead of copying it to the paste buffer. - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()` acts as a generic function to pass the selected Unicode character to any program. * `XMonad.Prompt.AppendFile` - New function `appendFilePrompt'` which allows for transformation of the string passed by a user before writing to a file. * `XMonad.Hooks.DynamicLog` - Added a new function `dzenWithFlags` which allows specifying the arguments passed to `dzen2` invocation. The behaviour of current `dzen` function is unchanged. * `XMonad.Util.Dzen` - Now provides functions `fgColor` and `bgColor` to specify foreground and background color, `align` and `slaveAlign` to set text alignment, and `lineCount` to enable a second (slave) window that displays lines beyond the initial (title) one. * `XMonad.Hooks.DynamicLog` - Added optional `ppVisibleNoWindows` to differentiate between empty and non-empty visible workspaces in pretty printing. * `XMonad.Actions.DynamicWorkspaceOrder` - Added `updateName` and `removeName` to better control ordering when workspace names are changed or workspaces are removed. * `XMonad.Config.Azerty` * Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY keyboards, which are slightly different from the French ones in the top row. ## 0.13 (February 10, 2017) ### Breaking Changes * The type of `completionKey` (of `XPConfig` record) has been changed from `KeySym` to `(KeyMask, KeySym)`. The default value for this is still bound to the `Tab` key. * New constructor `CenteredAt Rational Rational` added for `XMonad.Prompt.XPPosition`. * `XMonad.Prompt` now stores its history file in the XMonad cache directory in a file named `prompt-history`. * `XMonad.Hooks.ManageDocks` now requires an additional startup hook to be added to configuration in addition to the other 3 hooks, otherwise docks started before xmonad are covered by windows. It's recommended to use the newly introduced `docks` function to add all necessary hooks to xmonad config. ### New Modules * `XMonad.Layout.SortedLayout` A new LayoutModifier that sorts a given layout by a list of properties. The order of properties in the list determines the order of windows in the final layout. Any unmatched windows go to the end of the order. * `XMonad.Prompt.Unicode` A prompt to search a unicode character by its name, and put it into the clipboard. * `XMonad.Util.Ungrab` Release xmonad's keyboard and pointer grabs immediately, so screen grabbers and lock utilities, etc. will work. Replaces the short sleep hackaround. * `XMonad.Util.Loggers.NamedScratchpad` A collection of Loggers (see `XMonad.Util.Loggers`) for NamedScratchpads (see `XMonad.Util.NamedScratchpad`). * `XMonad.Util.NoTaskbar` Utility function and `ManageHook` to mark a window to be ignored by EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since you will usually be taken to the `NSP` workspace by them. ### Bug Fixes and Minor Changes * `XMonad.Hooks.ManageDocks` - Fix a very annoying bug where taskbars/docs would be covered by windows. - Also fix a bug that caused certain Gtk and Qt application to have issues displaying menus and popups. * `XMonad.Layout.LayoutBuilder` Merge all functionality from `XMonad.Layout.LayoutBuilderP` into `XMonad.Layout.LayoutBuilder`. * `XMonad.Actions.WindowGo` - Fix `raiseNextMaybe` cycling between 2 workspaces only. * `XMonad.Actions.UpdatePointer` - Fix bug when cursor gets stuck in one of the corners. * `XMonad.Actions.DynamicProjects` - Switching away from a dynamic project that contains no windows automatically deletes that project's workspace. The project itself was already being deleted, this just deletes the workspace created for it as well. - Added function to change the working directory (`changeProjectDirPrompt`) - All of the prompts are now multiple mode prompts. Try using the `changeModeKey` in a prompt and see what happens! ## 0.12 (December 14, 2015) ### Breaking Changes * `XMonad.Actions.UpdatePointer.updatePointer` arguments were changed. This allows including aspects of both of the `TowardsCentre` and `Relative` methods. To keep the same behavior, replace the entry in the left column with the entry on the right: | < 0.12 | >= 0.12 | |-------------------------------------|----------------------------------| | `updatePointer Nearest` | `updatePointer (0.5, 0.5) (1,1)` | | `updatePointer (Relative x y)` | `updatePointer (x,y) (0,0)` | | `updatePointer (TowardsCentre x y)` | `updatePointer (0.5,0.5) (x,y)` | ### New Modules * `XMonad.Actions.AfterDrag` Perform an action after the current mouse drag is completed. * `XMonad.Actions.DynamicProjects` Imbues workspaces with additional features so they can be treated as individual project areas. * `XMonad.Actions.LinkWorkspaces` Provides bindings to add and delete links between workspaces. It is aimed at providing useful links between workspaces in a multihead setup. Linked workspaces are viewed at the same time. * `XMonad.Config.Bepo` This module fixes some of the keybindings for the francophone among you who use a BEPO keyboard layout. Based on `XMonad.Config.Azerty` * `XMonad.Config.Dmwit` Daniel Wagner's configuration. * `XMonad.Config.Mate` This module provides a config suitable for use with the MATE desktop environment. * `XMonad.Config.Prime` A draft of a brand new config syntax for xmonad. * `XMonad.Hooks.DynamicProperty` Module to apply a `ManageHook` to an already-mapped window when a property changes. This would commonly be used to match browser windows by title, since the final title will only be set after (a) the window is mapped, (b) its document has been loaded, (c) all load-time scripts have run. * `XMonad.Hooks.ManageDebug` A `manageHook` and associated `logHook` for debugging `ManageHook`s. Simplest usage: wrap your xmonad config in the `debugManageHook` combinator. Or use `debugManageHookOn` for a triggerable version, specifying the triggering key sequence in `XMonad.Util.EZConfig` syntax. Or use the individual hooks in whatever way you see fit. * `XMonad.Hooks.WallpaperSetter` Log hook which changes the wallpapers depending on visible workspaces. * `XMonad.Hooks.WorkspaceHistory` Keeps track of workspace viewing order. * `XMonad.Layout.AvoidFloats` Find a maximum empty rectangle around floating windows and use that area to display non-floating windows. * `XMonad.Layout.BinarySpacePartition` Layout where new windows will split the focused window in half, based off of BSPWM. * `XMonad.Layout.Dwindle` Three layouts: The first, `Spiral`, is a reimplementation of `XMonad.Layout.Spiral.spiral` with, at least to me, more intuitive semantics. The second, `Dwindle`, is inspired by a similar layout in awesome and produces the same sequence of decreasing window sizes as Spiral but pushes the smallest windows into a screen corner rather than the centre. The third, `Squeeze` arranges all windows in one row or in one column, with geometrically decreasing sizes. * `XMonad.Layout.Hidden` Similar to `XMonad.Layout.Minimize` but completely removes windows from the window set so `XMonad.Layout.BoringWindows` isn't necessary. Perfect companion to `XMonad.Layout.BinarySpacePartition` since it can be used to move windows to another part of the BSP tree. * `XMonad.Layout.IfMax` Provides `IfMax` layout, which will run one layout if there are maximum `N` windows on workspace, and another layout, when number of windows is greater than `N`. * `XMonad.Layout.PerScreen` Configure layouts based on the width of your screen; use your favorite multi-column layout for wide screens and a full-screen layout for small ones. * `XMonad.Layout.Stoppable` This module implements a special kind of layout modifier, which when applied to a layout, causes xmonad to stop all non-visible processes. In a way, this is a sledge-hammer for applications that drain power. For example, given a web browser on a stoppable workspace, once the workspace is hidden the web browser will be stopped. * `XMonad.Prompt.ConfirmPrompt` A module for setting up simple confirmation prompts for keybindings. * `XMonad.Prompt.Pass` This module provides 3 `XMonad.Prompt`s to ease passwords manipulation (generate, read, remove) via [pass][]. * `XMonad.Util.RemoteWindows` This module implements a proper way of finding out whether the window is remote or local. * `XMonad.Util.SpawnNamedPipe` A module for spawning a pipe whose `Handle` lives in the xmonad state. * `XMonad.Util.WindowState` Functions for saving per-window data. ### Miscellaneous Changes * Fix issue #9: `XMonad.Prompt.Shell` `searchPredicate` is ignored, defaults to `isPrefixOf` * Fix moveHistory when alwaysHighlight is enabled * `XMonad.Actions.DynamicWorkspaceGroups` now exports `addRawWSGroup` * Side tabs were added to the tabbed layout * `XMonad/Layout/IndependentScreens` now exports `marshallSort` * `XMonad/Hooks/UrgencyHook` now exports `clearUrgency` * Exceptions are now caught when finding commands on `PATH` in `Prompt.Shell` * Switched to `Data.Default` wherever possible * `XMonad.Layout.IndependentScreens` now exports `whenCurrentOn` * `XMonad.Util.NamedActions` now exports `addDescrKeys'` * EWMH `DEMANDS_ATTENTION` support added to `UrgencyHook` * New `useTransientFor` modifier in `XMonad.Layout.TrackFloating` * Added the ability to remove arbitrary workspaces ## 0.9 (October 26, 2009) ### Updates that Require Changes in `xmonad.hs` * `XMonad.Hooks.EwmhDesktops` no longer uses `layoutHook`, the `ewmhDesktopsLayout` modifier has been removed from xmonad-contrib. It uses `logHook`, `handleEventHook`, and `startupHook` instead and provides a convenient function `ewmh` to add EWMH support to a `defaultConfig`. * Most `DynamicLog` users can continue with configs unchanged, but users of the quickbar functions `xmobar` or `dzen` will need to change `xmonad.hs`: their types have changed to allow easier composition with other `XConfig` modifiers. The `dynamicLogDzen` and `dynamicLogXmobar` functions have been removed. * `WindowGo` or `safeSpawn` users may need to change command lines due to `safeSpawn` changes. * People explicitly referencing the "SP" scratchpad workspace should change it to "NSP" which is also used by the new `Util.NamedScratchpad` module. * (Optional) People who explicitly use `swapMaster` in key or mouse bindings should change it to `shiftMaster`. It's the current default used where `swapMaster` had been used previously. It works better than `swapMaster` when using floating and tiled windows together on the same workspace. ## See Also [pass]: http://www.passwordstore.org/ xmonad-contrib-0.18.0/LICENSE0000644000000000000000000000271607346545000013730 0ustar0000000000000000Copyright (c) The Xmonad Community. All rights reserved. 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 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 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. xmonad-contrib-0.18.0/README.md0000644000000000000000000001143607346545000014201 0ustar0000000000000000

XMonad logo

Hackage License Made in Haskell
Stack Cabal Nix
GitHub Sponsors Open Collective
Chat on #xmonad@irc.libera.chat Chat on #xmonad:matrix.org

# xmonad-contrib **Community-maintained extensions for the [XMonad][web:xmonad] window manager.** [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. ## Installation For installation and configuration instructions, please see: * [downloading and installing xmonad][web:download] * [installing latest xmonad snapshot from git][web:install] * [configuring xmonad][web:tutorial] If you run into any trouble, consult our [documentation][web:documentation] or ask the [community][web:community] for help. ## Contributing We welcome all forms of contributions: * [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] 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 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-contrib-0.18.0/Setup.lhs0000644000000000000000000000011407346545000014521 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain xmonad-contrib-0.18.0/XMonad/Actions/0000755000000000000000000000000007346545000015503 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Actions/AfterDrag.hs0000644000000000000000000000543207346545000017702 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.AfterDrag -- Description : Allows you to add actions dependent on the current mouse drag. -- Copyright : (c) 2014 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- Perform an action after the current mouse drag is completed. ----------------------------------------------------------------------------- module XMonad.Actions.AfterDrag ( -- * Usage -- $usage afterDrag, ifClick, ifClick') where import XMonad import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.AfterDrag -- -- Then add appropriate mouse bindings, for example: -- -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1))) -- -- This will allow you to resize windows as usual, but if you instead of -- draging click the mouse button the window will be automatically resized to -- fill the whole screen. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- -- More practical examples are available in "XMonad.Actions.FloatSnap". -- | Schedule a task to take place after the current dragging is completed. afterDrag :: X () -- ^ The task to schedule. -> X () afterDrag task = do drag <- gets dragging case drag of Nothing -> return () -- Not dragging Just (motion, cleanup) -> modify $ \s -> s { dragging = Just(motion, cleanup >> task) } -- | Take an action if the current dragging can be considered a click, -- supposing the drag just started before this function is called. -- 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 () ifClick action = ifClick' 300 action (return ()) -- | Take an action if the current dragging is completed within a certain time (in milliseconds.) ifClick' :: 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 () ifClick' ms click drag = do start <- io getCurrentTime afterDrag $ do stop <- io getCurrentTime if diffUTCTime stop start <= (fromIntegral ms / 10^(3 :: Integer) :: NominalDiffTime) then click else drag xmonad-contrib-0.18.0/XMonad/Actions/BluetileCommands.hs0000644000000000000000000000673507346545000021301 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This is a list of selected commands that can be made available using -- "XMonad.Hooks.ServerMode" to allow external programs to control -- the window manager. Bluetile () -- uses this to enable its dock application to do things like changing -- workspaces and layouts. -- ----------------------------------------------------------------------------- module XMonad.Actions.BluetileCommands ( -- * Usage -- $usage bluetileCommands ) where import XMonad import qualified XMonad.StackSet as W import System.Exit -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode -- > import XMonad.Actions.BluetileCommands -- -- Then edit your @handleEventHook@: -- -- > main = xmonad def { handleEventHook = serverModeEventHook' bluetileCommands } -- -- See the documentation of "XMonad.Hooks.ServerMode" for details on -- how to actually invoke the commands from external programs. workspaceCommands :: Int -> X [(String, X ())] workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return [( "greedyView" ++ show i, activateScreen sid >> windows (W.greedyView i)) | i <- spaces ] layoutCommands :: Int -> [(String, X ())] layoutCommands sid = [ ("layout floating" , activateScreen sid >> sendMessage (JumpToLayout "Floating")) , ("layout tiled1" , activateScreen sid >> sendMessage (JumpToLayout "Tiled1")) , ("layout tiled2" , activateScreen sid >> sendMessage (JumpToLayout "Tiled2")) , ("layout fullscreen" , activateScreen sid >> sendMessage (JumpToLayout "Fullscreen")) ] masterAreaCommands :: Int -> [(String, X ())] masterAreaCommands sid = [ ("increase master n", activateScreen sid >> sendMessage (IncMasterN 1)) , ("decrease master n", activateScreen sid >> sendMessage (IncMasterN (-1))) ] quitCommands :: [(String, X ())] quitCommands = [ ("quit bluetile", io exitSuccess) , ("quit bluetile and start metacity", restart "metacity" False) ] bluetileCommands :: X [(String, X ())] bluetileCommands = do let restartCommand = [ ("restart bluetile", restart "bluetile" True) ] wscmds0 <- workspaceCommands 0 wscmds1 <- workspaceCommands 1 return $ restartCommand ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands activateScreen :: Int -> X () activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view) xmonad-contrib-0.18.0/XMonad/Actions/Commands.hs0000644000000000000000000001260207346545000017601 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Commands -- Description : Run internal xmonad commands using a dmenu menu. -- Copyright : (c) David Glasser 2007 -- License : BSD3 -- -- Maintainer : glasser@mit.edu -- Stability : stable -- Portability : portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.Commands ( -- * Usage -- $usage commandMap, runCommand, runCommandConfig, runCommand', workspaceCommands, screenCommands, defaultCommands ) where import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Dmenu (dmenu) import qualified Data.Map as M import System.Exit import XMonad.Prelude -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Commands -- -- Then add a keybinding to the runCommand action: -- -- > , ((modm .|. controlMask, xK_y), commands >>= runCommand) -- -- and define the list of commands you want to use: -- -- > commands :: X [(String, X ())] -- > commands = defaultCommands -- -- Whatever key you bound to will now cause a popup menu of internal -- xmonad commands to appear. You can change the commands by changing -- the contents of the list returned by 'commands'. (If you like it -- enough, you may even want to get rid of many of your other key -- bindings!) -- -- For detailed instructions on editing your key bindings, see -- . -- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a -- list of pairs. commandMap :: [(String, X ())] -> M.Map String (X ()) 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) | 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)) | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes , (f, m) <- [(view, "screen"), (shift, "screen-to-")] ] -- | A nice pre-defined list of commands. defaultCommands :: X [(String, X ())] defaultCommands = do wscmds <- workspaceCommands return $ wscmds ++ screenCommands ++ otherCommands where otherCommands = [ ("shrink" , sendMessage Shrink ) , ("expand" , sendMessage Expand ) , ("next-layout" , sendMessage NextLayout ) , ("default-layout" , asks (layoutHook . config) >>= setLayout ) , ("restart-wm" , restart "xmonad" True ) , ("restart-wm-no-resume", restart "xmonad" False ) , ("xterm" , spawn =<< asks (terminal . config) ) , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) , ("kill" , kill ) , ("refresh" , refresh ) , ("focus-up" , windows focusUp ) , ("focus-down" , windows focusDown ) , ("swap-up" , windows swapUp ) , ("swap-down" , windows swapDown ) , ("swap-master" , windows swapMaster ) , ("sink" , withFocused $ windows . sink ) , ("quit-wm" , io exitSuccess ) ] -- | Given a list of command\/action pairs, prompt the user to choose a -- command using dmenu and return the corresponding action. runCommand :: [(String, X ())] -> X () runCommand = runCommandConfig dmenu -- | Given a list of command\/action pairs, prompt the user to choose a -- command using dmenu-compatible launcher and return the corresponding action. -- See X.U.Dmenu for compatible launchers. runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X() runCommandConfig f cl = do let m = commandMap cl choice <- f (M.keys m) fromMaybe (return ()) (M.lookup choice m) -- | Given the name of a command from 'defaultCommands', return the -- corresponding action (or the null action if the command is not -- found). runCommand' :: String -> X () runCommand' c = do m <- fmap commandMap defaultCommands fromMaybe (return ()) (M.lookup c m) xmonad-contrib-0.18.0/XMonad/Actions/ConstrainedResize.hs0000644000000000000000000000416407346545000021477 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.ConstrainedResize -- Description : Constrain the aspect ratio of a floating window. -- Copyright : (c) Dougal Stanton -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.ConstrainedResize ( -- * Usage -- $usage XMonad.Actions.ConstrainedResize.mouseResizeWindow ) where import XMonad -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import qualified XMonad.Actions.ConstrainedResize as Sqr -- -- Then add something like the following to your mouse bindings: -- -- > , ((modm, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) -- > , ((modm .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) -- -- The line without the shiftMask replaces the standard mouse resize -- function call, so it's not completely necessary but seems neater -- this way. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- | Resize (floating) window with optional aspect ratio constraints. mouseResizeWindow :: Window -> Bool -> X () mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do sh <- io $ getWMNormalHints d w io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) mouseDrag (\ex ey -> do let x = ex - fromIntegral (wa_x wa) 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 float w) (float w) xmonad-contrib-0.18.0/XMonad/Actions/CopyWindow.hs0000644000000000000000000001704407346545000020147 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CopyWindow -- Description : Duplicate a window on multiple workspaces. -- Copyright : (c) David Roundy , Ivan Veselov , Lanny Ripple -- License : BSD3-style (see LICENSE) -- -- Maintainer : ??? -- Stability : unstable -- Portability : unportable -- -- Provides bindings to duplicate a window on multiple workspaces, -- providing dwm-like tagging functionality. -- ----------------------------------------------------------------------------- module XMonad.Actions.CopyWindow ( -- * Usage -- $usage copy, copyToAll, copyWindow, runOrCopy , killAllOtherCopies, kill1, taggedWindows, copiesOfOn -- * Highlight workspaces containing copies in logHook -- $logHook , wsContainingCopies, copiesPP ) where import XMonad import XMonad.Prelude import Control.Arrow ((&&&)) import qualified Data.List as L import XMonad.Actions.WindowGo import XMonad.Hooks.StatusBar.PP (PP(..), WS(..), isHidden) import qualified XMonad.StackSet as W -- $usage -- -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CopyWindow -- -- Then add something like this to your keybindings: -- -- > -- mod-[1..9] @@ Switch to workspace N -- > -- mod-shift-[1..9] @@ Move client to workspace N -- > -- mod-control-shift-[1..9] @@ Copy client to workspace N -- > [((m .|. modm, k), windows $ f i) -- > | (i, k) <- zip (workspaces x) [xK_1 ..] -- > , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]] -- -- To use the above key bindings you need also to import -- "XMonad.StackSet": -- -- > import qualified XMonad.StackSet as W -- -- You may also wish to redefine the binding to kill a window so it only -- removes it from the current workspace, if it's present elsewhere: -- -- > , ((modm .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window -- -- Instead of copying a window from one workspace to another maybe you don't -- want to have to remember where you placed it. For that consider: -- -- > , ((modm, xK_b ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox -- -- Another possibility which this extension provides is 'making window -- always visible' (i.e. always on current workspace), similar to corresponding -- metacity functionality. This behaviour is emulated through copying given -- window to all the workspaces and then removing it when it's unneeded on -- all workspaces any more. -- -- Here is the example of keybindings which provide these actions: -- -- > , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible -- > , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back -- -- For detailed instructions on editing your key bindings, see -- . -- $logHook -- -- 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 | otherwise = s -- | 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 . 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 copyWindow w n = copy' where copy' s = if n `W.tagMember` s then W.view (W.currentTag s) $ insertUp' w $ W.view n s else s insertUp' a = W.modify (Just $ W.Stack a [] []) (\(W.Stack t l r) -> if a `elem` t:l++r then Just $ W.Stack t l r else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) -- | runOrCopy will run the provided shell command unless it can -- find a specified window in which case it will copy the window to -- the current workspace. Similar to (i.e., stolen from) "XMonad.Actions.WindowGo". runOrCopy :: String -> Query Bool -> X () runOrCopy = copyMaybe . spawn -- | Copy a window if it exists, run the first argument otherwise. copyMaybe :: X () -> Query Bool -> X () copyMaybe f qry = ifWindow qry copyWin f where copyWin = ask >>= \w -> doF (\ws -> copyWindow w (W.currentTag ws) ws) -- | Remove the focused window from this workspace. If it's present in no -- other workspace, then kill it instead. If we do kill it, we'll get a -- delete notify back from X. -- -- There are two ways to delete a window. Either just kill it, or if it -- supports the delete protocol, send a delete event (e.g. firefox). kill1 :: X () kill1 = do ss <- gets windowset whenJust (W.peek ss) $ \w -> if W.member w $ delete'' w ss then windows $ delete'' w else kill where delete'' w = W.modify Nothing (W.filter (/= w)) -- | Kill all other copies of focused window (if they're present). -- 'All other' means here 'copies which are not on the current workspace'. killAllOtherCopies :: X () killAllOtherCopies = do ss <- gets windowset whenJust (W.peek ss) $ \w -> windows $ W.view (W.currentTag ss) . delFromAllButCurrent w where 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 -- | A list of hidden workspaces containing a copy of the focused window. wsContainingCopies :: X [WorkspaceId] wsContainingCopies = do ws <- gets windowset return $ copiesOfOn (W.peek ws) (taggedWindows $ W.hidden ws) -- | Get a list of tuples (tag, [Window]) for each workspace. taggedWindows :: [W.Workspace i l a] -> [(i, [a])] taggedWindows = map $ W.tag &&& W.integrate' . W.stack -- | Get tags with copies of the focused window (if present.) copiesOfOn :: (Eq a) => Maybe a -> [(i, [a])] -> [i] copiesOfOn foc tw = maybe [] hasCopyOf foc where hasCopyOf f = map fst $ filter ((f `elem` ) . snd) tw xmonad-contrib-0.18.0/XMonad/Actions/CycleRecentWS.hs0000644000000000000000000001617507346545000020523 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS -- Description : Cycle through most recently used workspaces. -- Copyright : (c) Michal Janeczek -- License : BSD3-style (see LICENSE) -- -- Maintainer : Michal Janeczek -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleRecentWS ( -- * Usage -- $usage cycleRecentWS, cycleRecentNonEmptyWS, cycleWindowSets, toggleRecentWS, toggleRecentNonEmptyWS, toggleWindowSets, recentWS, #ifdef TESTING unView, #endif ) where import XMonad.Actions.Repeatable (repeatableSt) import XMonad hiding (workspaces) import XMonad.Prelude (void, when) import XMonad.StackSet hiding (filter, modify) import Control.Arrow ((&&&)) import Data.Function (on) import Control.Monad.State (lift) -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleRecentWS -- > -- > , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) -- -- For detailed instructions on editing your key bindings, see -- . -- | Cycle through most recent workspaces with repeated presses of a key, while -- a modifier key is held down. The recency of workspaces previewed while browsing -- to the target workspace is not affected. That way a stack of most recently used -- workspaces is maintained, similarly to how many window managers handle window -- switching. For best effects use the same modkey+key combination as the one used -- to invoke this action. cycleRecentWS :: [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 () cycleRecentWS = cycleWindowSets $ recentWS (const True) -- | Like 'cycleRecentWS', but restricted to non-empty workspaces. cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action. -- As soon as one of them is released, the final switch is made. -> KeySym -- ^ Key used to switch to next (less recent) workspace. -> KeySym -- ^ Key used to switch to previous (more recent) workspace. -- If it's the same as the nextWorkspace key, it is effectively ignored. -> X () cycleRecentNonEmptyWS = cycleWindowSets $ recentWS (not . null . stack) -- | Switch to the most recent workspace. The stack of most recently used workspaces -- is updated, so repeated use toggles between a pair of workspaces. toggleRecentWS :: X () toggleRecentWS = toggleWindowSets $ recentWS (const True) -- | Like 'toggleRecentWS', but restricted to non-empty workspaces. toggleRecentNonEmptyWS :: X () toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack) -- | Given a predicate @p@ and the current 'WindowSet' @w@, create a -- list of 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 -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from -> [KeySym] -- ^ A list of modifier keys used when invoking this action. -- As soon as one of them is released, the final workspace is chosen and the action exits. -> KeySym -- ^ Key used to preview next workspace from the list of generated options -> KeySym -- ^ Key used to preview previous workspace from the list of generated options. -- If it's the same as nextOption key, it is effectively ignored. -> X () cycleWindowSets genOptions mods keyNext keyPrev = do (options, unView') <- gets $ (genOptions &&& unView) . windowset let preview = do i <- get lift $ windows (view (options !! (i `mod` n)) . unView') where n = length options void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if | s == keyNext -> modify succ >> preview | s == keyPrev -> modify pred >> preview | otherwise -> pure () -- | Given an old and a new 'WindowSet', which is __exactly__ one -- 'view' away from the old one, restore the workspace order of the -- former inside of the latter. This respects any new state that the -- new 'WindowSet' may have accumulated. unView :: forall i l a s sd. (Eq i, Eq s) => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd unView w0 w1 = fixOrderH . fixOrderV . view' (currentTag w0) $ w1 where view' = if screen (current w0) == screen (current w1) then greedyView else view fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs } | otherwise = w fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs } | otherwise = w pfxV = commonPrefix `on` fmap (tag . workspace) pfxH = commonPrefix `on` fmap tag insertAt :: Int -> x -> [x] -> [x] insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r commonPrefix :: Eq x => [x] -> [x] -> Int commonPrefix a b = length $ takeWhile id $ zipWith (==) a b -- | Given some function that generates a list of workspaces from a -- given 'WindowSet', switch to the first generated workspace. toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X () toggleWindowSets genOptions = do options <- gets $ genOptions . windowset case options of [] -> return () o:_ -> windows (view o) xmonad-contrib-0.18.0/XMonad/Actions/CycleSelectedLayouts.hs0000644000000000000000000000307607346545000022136 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleSelectedLayouts -- Description : Cycle through the given subset of layouts. -- Copyright : (c) Roman Cheplyaka -- License : BSD3-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- This module allows to cycle through the given subset of layouts. -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleSelectedLayouts ( -- * Usage -- $usage cycleThroughLayouts) where import XMonad import XMonad.Prelude (elemIndex, fromMaybe) import qualified XMonad.StackSet as S -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.CycleSelectedLayouts -- -- > , ((modm, xK_t ), cycleThroughLayouts ["Tall", "Mirror Tall"]) cycleToNext :: (Eq a) => [a] -> a -> Maybe a cycleToNext lst a = do -- not beautiful but simple and readable ind <- elemIndex a lst return $ lst !! if ind == length lst - 1 then 0 else ind+1 -- | If the current layout is in the list, cycle to the next layout. Otherwise, -- apply the first layout from list. cycleThroughLayouts :: [String] -> X () cycleThroughLayouts [] = pure () cycleThroughLayouts lst@(x: _) = do winset <- gets windowset let ld = description . S.layout . S.workspace . S.current $ winset let newld = fromMaybe x (cycleToNext lst ld) sendMessage $ JumpToLayout newld xmonad-contrib-0.18.0/XMonad/Actions/CycleWS.hs0000644000000000000000000004151507346545000017356 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWS -- Description : Cycle through workspaces. -- Copyright : (c) Joachim Breitner , -- Nelson Elhage (`toggleWS' function) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Joachim Breitner -- Stability : unstable -- Portability : unportable -- -- Provides bindings to cycle forward or backward through the list of -- workspaces, to move windows between workspaces, and to cycle -- between screens. More general combinators provide ways to cycle -- through workspaces in various orders, to only cycle through some -- subset of workspaces, and to cycle by more than one workspace at a -- time. -- -- 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 (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) (Not emptyWS) 1 -- > windows . greedyView $ t -- > where bToDir True = Next -- > bToDir False = Prev -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleWS ( -- * Usage -- $usage -- * Moving between workspaces -- $moving nextWS , prevWS , shiftToNext , shiftToPrev -- * Toggling the previous workspace -- $toggling , toggleWS , toggleWS' , toggleOrView -- * Moving between screens (xinerama) , nextScreen , prevScreen , shiftNextScreen , shiftPrevScreen , swapNextScreen , swapPrevScreen -- * Moving between workspaces, take two! -- $taketwo , Direction1D(..) , WSType(..) , emptyWS , hiddenWS , anyWS , wsTagGroup , ignoringWSs , shiftTo , moveTo , doTo -- * The mother-combinator , findWorkspace , toggleOrDoSkip , skipTags , screenBy ) where import XMonad.Prelude (find, findIndex, isJust, isNothing, liftM2) import XMonad hiding (workspaces) import qualified XMonad.Hooks.WorkspaceHistory as WH import XMonad.StackSet hiding (filter) import XMonad.Util.Types import XMonad.Util.WorkspaceCompare -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWS -- > -- > -- a basic CycleWS setup -- > -- > , ((modm, xK_Down), nextWS) -- > , ((modm, xK_Up), prevWS) -- > , ((modm .|. shiftMask, xK_Down), shiftToNext) -- > , ((modm .|. shiftMask, xK_Up), shiftToPrev) -- > , ((modm, xK_Right), nextScreen) -- > , ((modm, xK_Left), prevScreen) -- > , ((modm .|. shiftMask, xK_Right), shiftNextScreen) -- > , ((modm .|. shiftMask, xK_Left), shiftPrevScreen) -- > , ((modm, xK_z), toggleWS) -- -- If you want to follow the moved window, you can use both actions: -- -- > , ((modm .|. shiftMask, xK_Down), shiftToNext >> nextWS) -- > , ((modm .|. shiftMask, xK_Up), shiftToPrev >> prevWS) -- -- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'. -- For example: -- -- > , ((modm , xK_f), moveTo Next emptyWS) -- find a free workspace -- > , ((modm .|. controlMask, xK_Right), -- a crazy keybinding! -- > do t <- findWorkspace getSortByXineramaRule Next (Not emptyWS) 2 -- > windows . view $ t ) -- -- For detailed instructions on editing your key bindings, see -- . -- -- When using the toggle functions, in order to ensure that the workspace -- to which you switch is the previously viewed workspace, use the -- 'logHook' in "XMonad.Hooks.WorkspaceHistory". {- $moving The following commands for moving the view and windows between workspaces are somewhat inflexible, but are very simple and probably Do The Right Thing for most users. All of the commands in this section cycle through workspaces in the order in which they are given in your config. -} -- | Switch to the next workspace. nextWS :: X () nextWS = switchWorkspace 1 -- | Switch to the previous workspace. prevWS :: X () prevWS = switchWorkspace (-1) -- | Move the focused window to the next workspace. shiftToNext :: X () shiftToNext = shiftBy 1 -- | Move the focused window to the previous workspace. shiftToPrev :: X () shiftToPrev = shiftBy (-1) -- $toggling -- | Toggle to the workspace displayed previously. toggleWS :: X () toggleWS = toggleWS' [] -- | Toggle to the previous workspace while excluding some workspaces. -- -- > -- Ignore the scratchpad workspace while toggling: -- > ("M-b", toggleWS' ["NSP"]) toggleWS' :: [WorkspaceId] -> X () toggleWS' skips = lastViewedHiddenExcept skips >>= flip whenJust (windows . view) -- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view -- the previously displayed workspace ala weechat. Change @greedyView@ to -- @toggleOrView@ in your workspace bindings as in the 'XMonad.StackSet.view' -- faq at . -- For more flexibility see 'toggleOrDoSkip'. toggleOrView :: WorkspaceId -> X () toggleOrView = toggleOrDoSkip [] greedyView -- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\"), and -- running other actions such as view, shift, etc. For example: -- -- > import qualified XMonad.StackSet as W -- > import XMonad.Actions.CycleWS -- > -- > -- toggleOrView for people who prefer view to greedyView -- > toggleOrView' = toggleOrDoSkip [] W.view -- > -- > -- toggleOrView ignoring scratchpad and named scratchpad workspace -- > toggleOrViewNoSP = toggleOrDoSkip ["NSP"] W.greedyView toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X () toggleOrDoSkip skips f toWS = do cur <- gets (currentTag . windowset) if toWS == cur then lastViewedHiddenExcept skips >>= flip whenJust (windows . f) else windows (f toWS) -- | List difference ('\\') for workspaces and tags. Removes workspaces -- matching listed tags from the given workspace list. skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a] skipTags wss ids = filter ((`notElem` ids) . tag) wss -- | Ignoring the skips, find the best candidate for the last viewed hidden -- workspace. lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId) lastViewedHiddenExcept skips = do hs <- gets $ map tag . flip skipTags skips . hidden . windowset choose hs . find (`elem` hs) <$> WH.workspaceHistory where choose [] _ = Nothing choose (h:_) Nothing = Just h choose _ vh@(Just _) = vh switchWorkspace :: Int -> X () switchWorkspace d = wsBy d >>= windows . greedyView shiftBy :: Int -> X () shiftBy d = wsBy d >>= windows . shift wsBy :: Int -> X WorkspaceId wsBy = findWorkspace getSortByIndex Next anyWS {- $taketwo A few more general commands are also provided, which allow cycling through subsets of workspaces. For example, > moveTo Next emptyWS will move to the first available workspace with no windows, and > shiftTo Prev (WSIs $ return (('p' `elem`) . tag)) will move the focused window backwards to the first workspace containing the letter 'p' in its name. =) -} {-# 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 | HiddenWS -- ^ cycle through non-visible workspaces | HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces | HiddenEmptyWS -- ^ cycle through empty non-visible workspaces | AnyWS -- ^ cycle through all workspaces | WSTagGroup Char -- ^ 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 | 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) wsTypeToPred EmptyWS = return (isNothing . stack) wsTypeToPred NonEmptyWS = return (isJust . stack) wsTypeToPred HiddenWS = do hs <- gets (map tag . hidden . windowset) return (\w -> tag w `elem` hs) wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS hi <- wsTypeToPred HiddenWS return (\w -> hi w && ne w) wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS hi <- wsTypeToPred HiddenWS return (\w -> hi w && ne w) wsTypeToPred AnyWS = return (const True) wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset return $ (cur ==).groupName where groupName = takeWhile (/=sep).tag 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 () moveTo dir t = doTo dir t getSortByIndex (windows . greedyView) -- | Move the currently focused window to the next workspace in the -- given direction that satisfies the given condition. shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByIndex (windows . shift) -- | Using the given sort, find the next workspace in the given -- direction of the given type, and perform the given action on it. doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X () doTo dir t srt act = findWorkspace srt dir t 1 >>= act -- | Given a function @s@ to sort workspaces, a direction @dir@, a -- predicate @p@ on workspaces, and an integer @n@, find the tag of -- the workspace which is @n@ away from the current workspace in -- direction @dir@ (wrapping around if necessary), among those -- workspaces, sorted by @s@, which satisfy @p@. -- -- For some useful workspace sorting functions, see -- "XMonad.Util.WorkspaceCompare". -- -- For ideas of what to do with a workspace tag once obtained, note -- that 'moveTo' and 'shiftTo' are implemented by applying @(>>= -- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively, -- to the output of 'findWorkspace'. findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n) where maybeNegate Next d = d maybeNegate Prev d = -d findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId findWorkspaceGen _ _ 0 = gets (currentTag . windowset) findWorkspaceGen sortX wsPredX d = do wsPred <- wsPredX sort <- sortX ws <- gets windowset let cur = workspace (current ws) sorted = sort (workspaces ws) 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 next = if null ws' then cur else case mCurIx of Nothing -> ws' !! (d' `mod` length ws') Just ix -> ws' !! ((ix + d) `mod` length ws') return $ tag next findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int findWsIndex ws = findIndex ((== tag ws) . tag) -- | View next screen nextScreen :: X () nextScreen = switchScreen 1 -- | View prev screen prevScreen :: X () prevScreen = switchScreen (-1) switchScreen :: Int -> X () switchScreen d = do s <- screenBy d mws <- screenWorkspace s case mws of Nothing -> return () Just ws -> windows (view ws) {- | Get the 'ScreenId' /d/ places over. Example usage is a variation of the the default screen keybindings: > -- mod-{w,e}, Switch to previous/next Xinerama screen > -- mod-shift-{w,e}, Move client to previous/next Xinerama screen > -- > [((m .|. modm, key), sc >>= screenWorkspace >>= flip whenJust (windows . f)) > | (key, sc) <- zip [xK_w, xK_e] [(screenBy (-1)),(screenBy 1)] > , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] -} screenBy :: Int -> X ScreenId screenBy d = do ws <- gets windowset --let ss = sortBy screen (screens ws) let now = screen (current ws) return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws)) -- | Swap current screen with next screen swapNextScreen :: X () swapNextScreen = swapScreen 1 -- | Swap current screen with previous screen swapPrevScreen :: X () swapPrevScreen = swapScreen (-1) swapScreen :: Int -> X () swapScreen d = do s <- screenBy d mws <- screenWorkspace s case mws of Nothing -> return () Just ws -> windows (greedyView ws) -- | Move focused window to workspace on next screen shiftNextScreen :: X () shiftNextScreen = shiftScreenBy 1 -- | Move focused window to workspace on prev screen shiftPrevScreen :: X () shiftPrevScreen = shiftScreenBy (-1) shiftScreenBy :: Int -> X () shiftScreenBy d = do s <- screenBy d mws <- screenWorkspace s case mws of Nothing -> return () Just ws -> windows (shift ws) xmonad-contrib-0.18.0/XMonad/Actions/CycleWindows.hs0000644000000000000000000002363007346545000020455 0ustar0000000000000000{-# LANGUAGE ViewPatterns, MultiWayIf #-} -------------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWindows -- Description : Cycle windows while maintaining focus in place. -- Copyright : (c) Wirt Wolff -- License : BSD3-style (see LICENSE) -- -- Maintainer : Wirt Wolff -- Stability : unstable -- Portability : unportable -- -- Provides bindings to cycle windows up or down on the current workspace -- stack while maintaining focus in place. -- -- Bindings are available to: -- -- * Cycle nearby or nth windows into the focused frame -- -- * Cycle a window halfway around the stack -- -- * Cycle windows through the focused position. -- -- * Cycle unfocused windows. -- -- These bindings are especially useful with layouts that hide some of -- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or -- when using "XMonad.Layout.LimitWindows" to only show three or four -- panes. See also "XMonad.Actions.RotSlaves" for related actions. ----------------------------------------------------------------------------- module XMonad.Actions.CycleWindows ( -- * Usage -- $usage -- * Cycling nearby or nth window into current frame -- $cycle cycleRecentWindows, cycleStacks', -- * Cycling half the stack to get rid of a boring window -- $opposite rotOpposite', rotOpposite, -- * Cycling windows through the current frame -- $focused rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus', -- * Cycling windows through other frames -- $unfocused rotUnfocused', rotUnfocusedUp, rotUnfocusedDown, -- * Updating the mouse pointer -- $pointer -- * Generic list rotations rotUp, rotDown ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import qualified Data.List.NonEmpty as NE import XMonad.Actions.RotSlaves import XMonad.Actions.Repeatable (repeatableSt) import Control.Arrow (second) import Control.Monad.Trans (lift) -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWindows -- > -- config -- > -- other key bindings with x here your config -- > -- > -- make sure mod matches keysym -- > , ((mod4Mask, xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w) -- > , ((modm, xK_z), rotOpposite) -- > , ((modm , xK_i), rotUnfocusedUp) -- > , ((modm , xK_u), rotUnfocusedDown) -- > , ((modm .|. controlMask, xK_i), rotFocusedUp) -- > , ((modm .|. controlMask, xK_u), rotFocusedDown) -- -- Also, if you use focus follows mouse, you will want to read the section -- on updating the mouse pointer below. For detailed instructions on -- editing your key bindings, see . {- $pointer With FocusFollowsMouse == True, the focus is updated after binding actions, possibly focusing a window you didn't intend to focus. Most people using TwoPane probably already have a logHook causing the mouse to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp") If you want this built into the key binding instead, use the appropriate action from one of those modules to also have your bindings move the pointer to the point of your choice on the current window: > import XMonad.Actions.UpdatePointer -- or Actions.Warp and either > -- modify the window rotation bindings > , ((modm .|. controlMask, xK_i ), rotFocusedUp > >> updatePointer (Relative 1 1)) > , ((modm .|. controlMask, xK_u ), rotFocusedDown > >> updatePointer (Relative 1 1)) > > -- or add to xmonad's logHook > , logHook = dynamicLogWithPP xmobarPP > >> updatePointer Nearest -- or your preference -} -- $cycle -- Cycle windows into focus from below or above the focused pane by pressing -- a key while one or more modifier keys is held down. The window order isn't -- changed until a modifier is released, leaving the previously focused window -- just below the new one, (or above if the window just above is chosen.) For -- best results use the same modifier + key combination as the one used to invoke -- the \"bring from below\" action. Also, once cycling, pressing a number key n -- will focus the nth window, with 0 being the one originally focused. cycleRecentWindows :: [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 shift windows from below the current choice into the current frame. -> KeySym -- ^ Key used to shift windows from above the current choice into the current frame. -- If it's the same as the first key, it is effectively ignored. -> X () cycleRecentWindows = cycleStacks' stacks where stacks s = map (`shiftToFocus'` s) (wins s) wins (W.Stack t l r) = t : r ++ reverse l -- | Cycle through a /finite/ list of window stacks with repeated presses -- of a key while a modifier key is held down. For best results use the same -- mod key + key combination as the one used to invoke the \"bring from below\" -- action. You could use cycleStacks' with a different stack permutations -- function to, for example, cycle from one below to one above to two below, -- etc. instead of in order. You are responsible for having it generate a -- finite list, though, or xmonad may hang seeking its length. cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack. -> [KeySym] -- ^ A list of modifier keys used to invoke 'cycleStacks''. -- As soon as any is released, we're no longer cycling on the [Stack Window] -> KeySym -- ^ Key used to select a \"next\" stack. -> KeySym -- ^ Key used to select a \"previous\" stack. -> X () cycleStacks' filteredPerms mods keyNext keyPrev = do stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset let preview = do i <- get lift . windows . W.modify' . const $ stacks !! (i `mod` n) where n = length stacks void $ repeatableSt 0 mods keyNext $ \t s -> if | t == keyPress && s == keyNext -> modify succ | t == keyPress && s == keyPrev -> modify pred | t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s) | otherwise -> preview where numKeyToN = subtract 48 . read . show -- | Given a stack element and a stack, shift or insert the element (window) -- at the currently focused position. shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a shiftToFocus' w s@(W.Stack _ ls _) = W.Stack w (reverse revls') rs' where (revls', rs') = splitAt (length ls) . filter (/= w) $ W.integrate s -- $opposite -- Shifts the focused window as far as possible from the current focus, -- i.e. halfway around the stack. Windows above the focus up to the \"opposite\" -- position remain in place, while those above the insertion shift toward -- the current focus. This is useful for people who use lots of windows in Full, -- TwoPane, etc., to get rid of boring windows while cycling and swapping -- near the focus. rotOpposite :: X() rotOpposite = windows $ W.modify' rotOpposite' -- | The opposite rotation on a Stack. rotOpposite' :: W.Stack a -> W.Stack a rotOpposite' (W.Stack t l r) = W.Stack t' l' r' where rrvl = r ++ reverse l part = (length rrvl + 1) `div` 2 (l', notEmpty -> t' :| r') = second reverse . splitAt (length l) $ reverse (take part rrvl ++ t : drop part rrvl) -- $focused -- Most people will want the @rotAllUp@ or @rotAllDown@ actions from -- "XMonad.Actions.RotSlaves" to cycle all windows in the stack. -- -- The following actions keep the \"next\" window stable, which is -- mostly useful in two window layouts, or when you have a log viewer or -- buffer window you want to keep next to the cycled window. -- | Rotate windows through the focused frame, excluding the \"next\" window. -- With, e.g. TwoPane, this allows cycling windows through either the -- master or slave pane, without changing the other frame. When the master -- is focused, the window below is skipped, when a non-master window is -- focused, the master is skipped. rotFocusedUp :: X () rotFocusedUp = windows . W.modify' $ rotFocused' rotUp rotFocusedDown :: X () rotFocusedDown = windows . W.modify' $ rotFocused' rotDown -- | The focused rotation on a stack. rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotFocused' _ s@(W.Stack _ [] []) = s rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus where (notEmpty -> t' :| rs') = f (t:rs) rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise -- $unfocused -- Rotate windows through the unfocused frames. This is similar to -- @rotSlaves@, from "XMonad.Actions.RotSlaves", but excludes the current -- frame rather than master. rotUnfocusedUp :: X () rotUnfocusedUp = windows . W.modify' $ rotUnfocused' rotUp rotUnfocusedDown :: X () rotUnfocusedDown = windows . W.modify' $ rotUnfocused' rotDown -- | The unfocused rotation on a stack. rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotUnfocused' _ s@(W.Stack _ [] []) = s rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll) (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) xmonad-contrib-0.18.0/XMonad/Actions/CycleWorkspaceByScreen.hs0000644000000000000000000000736307346545000022421 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWorkspaceByScreen -- Description : Cycle workspaces in a screen-aware fashion. -- Copyright : (c) 2017 Ivan Malison -- License : BSD3-style (see LICENSE) -- -- Maintainer : IvanMalison@gmail.com -- Stability : unstable -- Portability : unportable -- -- Cycle through previously viewed workspaces in the order they were viewed most -- recently on the screen where cycling is taking place. -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleWorkspaceByScreen ( -- * Usage -- $usage cycleWorkspaceOnScreen , cycleWorkspaceOnCurrentScreen , handleKeyEvent , repeatableAction ) where import Data.IORef import XMonad import XMonad.Prelude import XMonad.Hooks.WorkspaceHistory import XMonad.Actions.Repeatable (repeatable) import qualified XMonad.StackSet as W -- $usage -- -- To use this module, first import it as well as -- "XMonad.Hooks.WorkspaceHistory": -- -- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook) -- > import XMonad.Actions.CycleWorkspaceByScreen -- -- Then add 'workspaceHistoryHook' to your @logHook@ like this: -- -- > main :: IO () -- > main = xmonad $ def -- > { ... -- > , logHook = workspaceHistoryHook >> ... -- > } -- -- Finally, define a new keybinding for cycling (seen) workspaces per -- screen: -- -- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p) {-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-} repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X () repeatableAction = repeatable handleKeyEvent :: EventType -> KeySym -> X () -> EventType -> KeySym -> Maybe (X ()) handleKeyEvent eventType key action = helper where helper et k | et == eventType && k == key = Just action | otherwise = Nothing runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X () runFirst matchers eventType key = fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers -- | Like 'XMonad.Actions.CycleRecentWS.cycleRecentWS', but only cycle -- through the most recent workspaces on the given screen. cycleWorkspaceOnScreen :: ScreenId -- ^ The screen to cycle on. -> [KeySym] -- ^ A list of modifier keys used when invoking this -- action; as soon as one of them is released, the final -- switch is made. -> KeySym -- ^ Key used to switch to next workspace. -> KeySym -- ^ Key used to switch to previous workspace. -> X () cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do startingHistory <- workspaceHistoryByScreen currentWSIndex <- io $ newIORef 1 let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory getAndIncrementWS increment = do current <- readIORef currentWSIndex modifyIORef currentWSIndex ((`mod` length cycleWorkspaces) . (+ increment)) return $ cycleWorkspaces !! current focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView) repeatable mods nextKey $ runFirst [ handleKeyEvent keyPress nextKey $ focusIncrement 1 , handleKeyEvent keyPress prevKey $ focusIncrement (-1) ] return () -- | Like 'cycleWorkspaceOnScreen', but supply the currently focused -- screen as the @screenId@. cycleWorkspaceOnCurrentScreen :: [KeySym] -> KeySym -> KeySym -> X () cycleWorkspaceOnCurrentScreen mods n p = withWindowSet $ \ws -> cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p xmonad-contrib-0.18.0/XMonad/Actions/DeManage.hs0000644000000000000000000000373407346545000017507 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DeManage -- Description : Cease management of a window without unmapping it. -- Copyright : (c) Spencer Janssen -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : stable -- Portability : unportable -- -- This module provides a method to cease management of a window -- without unmapping it. This is especially useful for applications -- like kicker and gnome-panel. See also "XMonad.Hooks.ManageDocks" for -- more a more automated solution. -- -- To make a panel display correctly with xmonad: -- -- * Determine the pixel size of the panel, add that value to -- 'XMonad.Core.XConfig.defaultGaps' -- -- * Launch the panel -- -- * Give the panel window focus, then press @mod-d@ (or whatever key -- you have bound 'demanage' to) -- -- * Convince the panel to move\/resize to the correct location. Changing the -- panel's position setting several times seems to work. -- ----------------------------------------------------------------------------- module XMonad.Actions.DeManage ( -- * Usage -- $usage demanage ) where import qualified XMonad.StackSet as W import XMonad -- $usage -- To use demanage, add this import to your @xmonad.hs@: -- -- > import XMonad.Actions.DeManage -- -- And add a keybinding, such as: -- -- > , ((modm, xK_d ), withFocused demanage) -- -- For detailed instructions on editing your key bindings, see -- . -- | Stop managing the currently focused window. demanage :: Window -> X () demanage w = do -- use modify to defeat automatic 'unmanage' calls. modify (\s -> s { windowset = W.delete w (windowset s) }) refresh xmonad-contrib-0.18.0/XMonad/Actions/DwmPromote.hs0000644000000000000000000000340707346545000020140 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DwmPromote -- Description : DWM-like swap function for xmonad. -- Copyright : (c) Miikka Koskinen 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : arcatan@kapsi.fi -- Stability : stable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.DwmPromote ( -- * Usage -- $usage dwmpromote ) where import XMonad import XMonad.StackSet import XMonad.Prelude import qualified Data.List.NonEmpty as NE -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.DwmPromote -- -- then add a keybinding or substitute 'dwmpromote' in place of promote: -- -- > , ((modm, xK_Return), dwmpromote) -- -- For detailed instructions on editing your key bindings, see -- . -- | Swap the 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. dwmpromote :: X () dwmpromote = windows $ modify' $ \c -> case c of Stack _ [] [] -> c Stack t [] (r:rs) -> Stack r [] (t:rs) Stack t (l:ls) rs -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls) xmonad-contrib-0.18.0/XMonad/Actions/DynamicProjects.hs0000644000000000000000000003310407346545000021136 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicProjects -- Description : Treat workspaces as individual project areas. -- Copyright : (c) Peter J. Jones -- License : BSD3-style (see LICENSE) -- -- Maintainer : Peter Jones -- Stability : unstable -- Portability : not portable -- -- Imbues workspaces with additional features so they can be treated -- as individual project areas. -------------------------------------------------------------------------------- module XMonad.Actions.DynamicProjects ( -- * Overview -- $overview -- * Usage -- $usage -- * Types Project (..) , ProjectName -- * Hooks , dynamicProjects -- * Bindings , switchProjectPrompt , shiftToProjectPrompt , renameProjectPrompt , changeProjectDirPrompt -- * Helper Functions , switchProject , shiftToProject , lookupProject , currentProject , activateProject , modifyProject ) where -------------------------------------------------------------------------------- import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute) import XMonad.Prelude import XMonad import XMonad.Actions.DynamicWorkspaces import XMonad.Prompt import XMonad.Prompt.Directory import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -------------------------------------------------------------------------------- -- $overview -- Inspired by @TopicSpace@, @DynamicWorkspaces@, and @WorkspaceDir@, -- @DynamicProjects@ treats workspaces as projects while maintaining -- compatibility with all existing workspace-related functionality in -- XMonad. -- -- Instead of using generic workspace names such as @3@ or @work@, -- @DynamicProjects@ allows you to dedicate workspaces to specific -- projects and then switch between projects easily. -- -- A project is made up of a name, working directory, and a start-up -- hook. When you switch to a workspace, @DynamicProjects@ changes -- the working directory to the one configured for the matching -- project. If the workspace doesn't have any windows, the project's -- start-up hook is executed. This allows you to launch applications -- or further configure the workspace/project. -- -- When using the @switchProjectPrompt@ function, workspaces are -- created as needed. This means you can create new project spaces -- (and therefore workspaces) on the fly. (These dynamic projects are -- not preserved across restarts.) -- -- Additionally, frequently used projects can be configured statically -- in your XMonad configuration. Doing so allows you to configure the -- per-project start-up hook. -------------------------------------------------------------------------------- -- $usage -- To use @DynamicProjects@ you need to add it to your XMonad -- configuration and then configure some optional key bindings. -- -- > import XMonad.Actions.DynamicProjects -- -- Start by defining some projects: -- -- > projects :: [Project] -- > projects = -- > [ Project { projectName = "scratch" -- > , projectDirectory = "~/" -- > , projectStartHook = Nothing -- > } -- > -- > , Project { projectName = "browser" -- > , projectDirectory = "~/download" -- > , projectStartHook = Just $ do spawn "conkeror" -- > spawn "chromium" -- > } -- > ] -- -- Then inject @DynamicProjects@ into your XMonad configuration: -- -- > main = xmonad $ dynamicProjects projects def -- -- And finally, configure some optional key bindings: -- -- > , ((modm, xK_space), switchProjectPrompt def) -- > , ((modm, xK_slash), shiftToProjectPrompt def) -- -- For detailed instructions on editing your key bindings, see -- . -------------------------------------------------------------------------------- type ProjectName = String type ProjectTable = Map ProjectName Project -------------------------------------------------------------------------------- -- | Details about a workspace that represents a project. data Project = Project { projectName :: !ProjectName -- ^ Workspace name. , projectDirectory :: !FilePath -- ^ Working directory. , projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook. } -------------------------------------------------------------------------------- -- | Internal project state. data ProjectState = ProjectState { projects :: !ProjectTable , previousProject :: !(Maybe WorkspaceId) } -------------------------------------------------------------------------------- instance ExtensionClass ProjectState where initialValue = ProjectState Map.empty Nothing -------------------------------------------------------------------------------- -- Internal types for working with XPrompt. data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName] data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode instance XPrompt ProjectPrompt where 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 c DirMode _) = let xpt = directoryMultipleModes' (complCaseSensitivity c) "" (const $ return ()) in completionFunction xpt completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns modeAction (ProjectPrompt _ SwitchMode _) buf auto = do let name = if null auto then buf else auto ps <- XS.gets projects case Map.lookup name ps of Just p -> switchProject p Nothing | null name -> return () | otherwise -> switchProject (defProject name) 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 _ = when (not (null name) && not (all isSpace name)) $ do renameWorkspaceByName name modifyProject (\p -> p { projectName = name }) modeAction (ProjectPrompt _ DirMode _) buf auto = do let dir' = if null auto then buf else auto dir <- io $ makeAbsolute dir' modifyProject (\p -> p { projectDirectory = dir }) -------------------------------------------------------------------------------- -- | Add dynamic projects support to the given config. dynamicProjects :: [Project] -> XConfig a -> XConfig a dynamicProjects ps c = c { startupHook = dynamicProjectsStartupHook ps <> startupHook c , logHook = dynamicProjectsLogHook <> logHook c } -------------------------------------------------------------------------------- -- | Log hook for tracking workspace changes. dynamicProjectsLogHook :: X () dynamicProjectsLogHook = do name <- gets (W.tag . W.workspace . W.current . windowset) xstate <- XS.get unless (Just name == previousProject xstate) $ do XS.put (xstate {previousProject = Just name}) activateProject . fromMaybe (defProject name) $ Map.lookup name (projects xstate) -------------------------------------------------------------------------------- -- | Start-up hook for recording configured projects. dynamicProjectsStartupHook :: [Project] -> X () dynamicProjectsStartupHook ps = XS.modify go where go :: ProjectState -> ProjectState go s = s {projects = update $ projects s} update :: ProjectTable -> ProjectTable update = Map.union (Map.fromList $ map entry ps) entry :: Project -> (ProjectName, Project) entry p = (projectName p, addDefaultHook p) -- Force the hook to be a @Just@ so that it doesn't automatically -- get deleted when switching away from a workspace with no -- windows. addDefaultHook :: Project -> Project addDefaultHook p = p { projectStartHook = projectStartHook p <|> Just (return ()) } -------------------------------------------------------------------------------- -- | Find a project based on its name. lookupProject :: ProjectName -> X (Maybe Project) lookupProject name = Map.lookup name <$> XS.gets projects -------------------------------------------------------------------------------- -- | Fetch the current project (the one being used for the currently -- active workspace). currentProject :: X Project currentProject = do name <- gets (W.tag . W.workspace . W.current . windowset) proj <- lookupProject name return $ fromMaybe (defProject name) proj -------------------------------------------------------------------------------- -- | Modify the current project using a pure function. modifyProject :: (Project -> Project) -> X () modifyProject f = do p <- currentProject ps <- XS.gets projects -- If a project is renamed to match another project, the old project -- will be removed and replaced with this one. let new = f p ps' = Map.insert (projectName new) new $ Map.delete (projectName p) ps XS.modify $ \s -> s {projects = ps'} activateProject new -------------------------------------------------------------------------------- -- | Switch to the given project. switchProject :: Project -> X () switchProject p = do oldws <- gets (W.workspace . W.current . windowset) oldp <- currentProject let name = W.tag oldws ws = W.integrate' (W.stack oldws) -- If the project we are switching away from has no windows, and -- it's a dynamic project, remove it from the configuration. when (null ws && isNothing (projectStartHook oldp)) $ do removeWorkspaceByTag name -- also remove the old workspace XS.modify (\s -> s {projects = Map.delete name $ projects s}) appendWorkspace (projectName p) -------------------------------------------------------------------------------- -- | Prompt for a project name and then switch to it. Automatically -- creates a project if a new name is returned from the prompt. switchProjectPrompt :: XPConfig -> X () switchProjectPrompt = projectPrompt [ SwitchMode , ShiftMode , RenameMode , DirMode ] -------------------------------------------------------------------------------- -- | Shift the currently focused window to the given project. shiftToProject :: Project -> X () shiftToProject p = do addHiddenWorkspace (projectName p) windows (W.shift $ projectName p) -------------------------------------------------------------------------------- -- | Prompts for a project name and then shifts the currently focused -- window to that project. shiftToProjectPrompt :: XPConfig -> X () shiftToProjectPrompt = projectPrompt [ ShiftMode , RenameMode , SwitchMode , DirMode ] -------------------------------------------------------------------------------- -- | Rename the current project. renameProjectPrompt :: XPConfig -> X () renameProjectPrompt = projectPrompt [ RenameMode , DirMode , SwitchMode , ShiftMode ] -------------------------------------------------------------------------------- -- | Change the working directory used for the current project. -- -- NOTE: This will only affect new processed started in this project. -- Existing processes will maintain the previous working directory. changeProjectDirPrompt :: XPConfig -> X () changeProjectDirPrompt = projectPrompt [ DirMode , SwitchMode , ShiftMode , RenameMode ] -------------------------------------------------------------------------------- -- | Prompt for a project name. projectPrompt :: [ProjectMode] -> XPConfig -> X () projectPrompt submodes c = do 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 c m names) submodes mkXPromptWithModes modes c -------------------------------------------------------------------------------- -- | Activate a project by updating the working directory and -- possibly running its start-up hook. This function is automatically -- invoked when the workspace changes. activateProject :: Project -> X () activateProject p = do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) home <- io getHomeDirectory -- Change to the project's directory. catchIO (setCurrentDirectory $ expandHome home $ projectDirectory p) -- Possibly run the project's startup hook. when (null ws) $ fromMaybe (return ()) (projectStartHook p) where -- Replace an initial @~@ character with the home directory. expandHome :: FilePath -> FilePath -> FilePath expandHome home dir = case stripPrefix "~" dir of Nothing -> dir Just xs -> home ++ xs -------------------------------------------------------------------------------- -- | Default project. defProject :: ProjectName -> Project defProject name = Project name "~/" Nothing xmonad-contrib-0.18.0/XMonad/Actions/DynamicWorkspaceGroups.hs0000644000000000000000000001413107346545000022502 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicWorkspaceGroups -- Description : Dynamically manage workspace groups in multi-head setups. -- Copyright : (c) Brent Yorgey 2009 -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : experimental -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.DynamicWorkspaceGroups ( -- * Usage -- $usage WSGroupId , addRawWSGroup , addWSGroup , addCurrentWSGroup , forgetWSGroup , viewWSGroup , promptWSGroupView , promptWSGroupAdd , promptWSGroupForget , WSGPrompt -- * TopicSpace Integration -- $topics , viewTopicGroup , promptTopicGroupView ) where 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.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaceGroups -- -- Then add keybindings like the following (this example uses -- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary): -- -- > , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ") -- > , ("M-y g", promptWSGroupView myXPConfig "Go to group: ") -- > , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ") -- type WSGroup = [(ScreenId,WorkspaceId)] type WSGroupId = String 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 extensionType = PersistentExtension -- | Add a new workspace group of the given name, mapping to an -- explicitly specified association between screen IDs and workspace -- names. This function could be useful for, say, creating some -- standard workspace groups in your startup hook. addRawWSGroup :: WSGroupId -> [(ScreenId, WorkspaceId)] -> X () addRawWSGroup name = XS.modify . withWSG . M.insert name -- | Add a new workspace group with the given name. addWSGroup :: WSGroupId -> [WorkspaceId] -> X () 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 for_ wmap (addRawWSGroup name) where strength (ma, b) = ma >>= \a -> return (a,b) -- | Give a name to the current workspace group. addCurrentWSGroup :: WSGroupId -> X () addCurrentWSGroup name = withWindowSet $ \w -> addWSGroup name $ map (W.tag . W.workspace) (reverse $ W.current w : W.visible w) -- | Delete the named workspace group from the list of workspace -- groups. Note that this has no effect on the workspaces involved; -- it simply forgets the given name. forgetWSGroup :: WSGroupId -> X () forgetWSGroup = XS.modify . withWSG . M.delete -- | View the workspace group with the given name. viewWSGroup :: WSGroupId -> X () viewWSGroup = viewGroup (windows . W.greedyView) -- | Internal function for viewing a group. viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X () viewGroup fview name = do WSG m <- XS.get for_ (M.lookup name m) $ mapM_ (uncurry (viewWS fview)) -- | 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 fview wid Nothing -> return () -- | Find the workspace which is currently on the given screen. findScreenWS :: ScreenId -> X (Maybe WorkspaceId) findScreenWS sid = withWindowSet $ return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens newtype WSGPrompt = WSGPrompt String instance XPrompt WSGPrompt where showXPrompt (WSGPrompt s) = s -- | Prompt for a workspace group to view. promptWSGroupView :: XPConfig -> String -> X () 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' xp gs) fview -- | Prompt for a name for the current workspace group. promptWSGroupAdd :: XPConfig -> String -> X () promptWSGroupAdd xp s = mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup -- | Prompt for a workspace group to forget. promptWSGroupForget :: XPConfig -> String -> X () promptWSGroupForget xp s = do gs <- fmap (M.keys . unWSG) XS.get 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-contrib-0.18.0/XMonad/Actions/DynamicWorkspaceOrder.hs0000644000000000000000000001651007346545000022301 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicWorkspaceOrder -- Description : Remember a dynamically updateable ordering on workspaces. -- Copyright : (c) Brent Yorgey 2009 -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : experimental -- Portability : unportable -- -- Remember a dynamically updateable ordering on workspaces, together -- with tools for using this ordering with "XMonad.Actions.CycleWS" -- and "XMonad.Hooks.StatusBar.PP". -- ----------------------------------------------------------------------------- module XMonad.Actions.DynamicWorkspaceOrder ( -- * Usage -- $usage getWsCompareByOrder , getSortByOrder , swapWith , swapWithCurrent , swapOrder , updateName , removeName , moveTo , moveToGreedy , shiftTo , withNthWorkspace' , withNthWorkspace ) where import XMonad import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort) import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo) import qualified Data.Map as M import qualified Data.Set as S import XMonad.Prelude (fromJust, fromMaybe) import Data.Ord (comparing) -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- -- Then add keybindings to swap the order of workspaces (these -- examples use "XMonad.Util.EZConfig" emacs-style keybindings): -- -- > , ("M-C-", DO.swapWith Next NonEmptyWS) -- > , ("M-C-", DO.swapWith Prev NonEmptyWS) -- -- See "XMonad.Actions.CycleWS" for information on the possible -- arguments to 'swapWith'. -- -- However, by itself this will do nothing; 'swapWith' does not change -- the actual workspaces in any way. It simply keeps track of an -- auxiliary ordering on workspaces. Anything which cares about the -- order of workspaces must be updated to use the auxiliary ordering. -- -- To change the order in which workspaces are displayed by -- "XMonad.Hooks.StatusBar.PP", use 'getSortByOrder' in your -- 'XMonad.Hooks.StatusBar.PP.ppSort' field, for example: -- -- > myPP = ... byorgeyPP { -- > ... -- > , ppSort = DO.getSortByOrder -- > ... -- > } -- -- To use workspace cycling commands like those from -- "XMonad.Actions.CycleWS", use the versions of 'moveTo', -- 'moveToGreedy', and 'shiftTo' exported by this module. For example: -- -- > , ("M-S-", DO.shiftTo Next HiddenNonEmptyWS) -- > , ("M-S-", DO.shiftTo Prev HiddenNonEmptyWS) -- > , ("M-", DO.moveTo Next HiddenNonEmptyWS) -- > , ("M-", DO.moveTo Prev HiddenNonEmptyWS) -- -- For slight variations on these, use the source for examples and -- tweak as desired. -- | Extensible state storage for the workspace order. newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) } deriving (Read, Show) instance ExtensionClass WSOrderStorage where initialValue = WSO Nothing extensionType = PersistentExtension -- | Lift a Map function to a function on WSOrderStorage. withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int) -> (WSOrderStorage -> WSOrderStorage) withWSO f = WSO . fmap f . unWSO -- | Update the ordering storage: initialize if it doesn't yet exist; -- add newly created workspaces at the end as necessary. updateOrder :: X () updateOrder = do WSO mm <- XS.get case mm of Nothing -> do -- initialize using ordering of workspaces from the user's config ws <- asks (workspaces . config) XS.put . WSO . Just . M.fromList $ zip ws [0..] Just m -> do -- check for new workspaces and add them at the end curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset) let mappedWs = M.keysSet m newWs = curWs `S.difference` mappedWs nextIndex = 1 + maximum (-1 : M.elems m) newWsIxs = zip (S.toAscList newWs) [nextIndex..] XS.modify . withWSO . M.union . M.fromList $ newWsIxs -- | A comparison function which orders workspaces according to the -- stored dynamic ordering. getWsCompareByOrder :: X WorkspaceCompare getWsCompareByOrder = do updateOrder -- after the call to updateOrder we are guaranteed that the dynamic -- workspace order is initialized and contains all existing -- workspaces. WSO (Just m) <- XS.get return $ comparing (fromMaybe 1000 . flip M.lookup m) -- | Sort workspaces according to the stored dynamic ordering. getSortByOrder :: X WorkspaceSort getSortByOrder = mkWsSort getWsCompareByOrder -- | Swap the current workspace with another workspace in the stored -- dynamic order. swapWith :: Direction1D -> WSType -> X () swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent -- | Swap the given workspace with the current one. swapWithCurrent :: WorkspaceId -> X () swapWithCurrent w = do cur <- gets (W.currentTag . windowset) swapOrder w cur -- | Swap the two given workspaces in the dynamic order. swapOrder :: WorkspaceId -> WorkspaceId -> X () swapOrder w1 w2 = do io $ print (w1,w2) WSO (Just m) <- XS.get let i1 = fromJust (w1 `M.lookup` m) let i2 = fromJust (w2 `M.lookup` m) XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) windows id -- force a status bar update -- | Update the name of a workspace in the stored order. updateName :: WorkspaceId -> WorkspaceId -> X () updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId -- | Remove a workspace from the stored order. removeName :: WorkspaceId -> X () removeName = XS.modify . withWSO . M.delete -- | Update a key in a Map. changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a changeKey oldKey newKey oldMap = case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of (Nothing, _) -> oldMap (Just val, newMap) -> M.insert newKey val newMap -- | View the next workspace of the given type in the given direction, -- where \"next\" is determined using the dynamic workspace order. moveTo :: Direction1D -> WSType -> X () moveTo dir t = doTo dir t getSortByOrder (windows . W.view) -- | Same as 'moveTo', but using 'greedyView' instead of 'view'. moveToGreedy :: Direction1D -> WSType -> X () moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView) -- | Shift the currently focused window to the next workspace of the -- given type in the given direction, using the dynamic workspace order. shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift) -- | Do something with the nth workspace in the dynamic order after -- transforming it. The callback is given the workspace's tag as well -- as the 'WindowSet' of the workspace itself. withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X () withNthWorkspace' tr job wnum = do sort <- getSortByOrder ws <- gets (tr . map W.tag . sort . W.workspaces . windowset) case drop wnum ws of (w:_) -> windows $ job w [] -> return () -- | Do something with the nth workspace in the dynamic order. The -- callback is given the workspace's tag as well as the 'WindowSet' -- of the workspace itself. withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () withNthWorkspace = withNthWorkspace' id xmonad-contrib-0.18.0/XMonad/Actions/DynamicWorkspaces.hs0000644000000000000000000002755607346545000021504 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicWorkspaces -- Description : Provides bindings to add and delete workspaces. -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Provides bindings to add and delete workspaces. -- ----------------------------------------------------------------------------- module XMonad.Actions.DynamicWorkspaces ( -- * Usage -- $usage addWorkspace, addWorkspacePrompt, appendWorkspace, appendWorkspacePrompt, addWorkspaceAt, removeWorkspace, removeWorkspaceByTag, removeEmptyWorkspace, removeEmptyWorkspaceByTag, removeEmptyWorkspaceAfter, removeEmptyWorkspaceAfterExcept, addHiddenWorkspace, addHiddenWorkspaceAt, withWorkspace, selectWorkspace, renameWorkspace, renameWorkspaceByName, toNthWorkspace, withNthWorkspace, setWorkspaceIndex, withWorkspaceIndex, 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, mkComplFunFromList', mkXPrompt ) import XMonad.Util.WorkspaceCompare ( getSortByIndex ) import qualified Data.Map.Strict as Map import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaces -- > import XMonad.Actions.CopyWindow(copy) -- -- Then add keybindings like the following: -- -- > , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace) -- > , ((modm .|. shiftMask, xK_v ), selectWorkspace def) -- > , ((modm, xK_m ), withWorkspace def (windows . W.shift)) -- > , ((modm .|. shiftMask, xK_m ), withWorkspace def (windows . copy)) -- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def) -- -- > -- mod-[1..9] %! Switch to workspace N in the list of workspaces -- > -- mod-shift-[1..9] %! Move client to workspace N in the list of workspaces -- > ++ -- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) -- > ++ -- > zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) -- -- Alternatively, you can associate indexes (which don't depend of the -- workspace list order) to workspaces by using following keybindings: -- -- > -- mod-[1..9] %! Switch to workspace of index N -- > -- mod-control-[1..9] %! Set index N to the current workspace -- > ++ -- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withWorkspaceIndex W.greedyView) [1..]) -- > ++ -- > zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..]) -- -- For detailed instructions on editing your key bindings, see -- . See also the documentation for -- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'. type WorkspaceTag = String -- | The workspace index is mapped to a workspace tag by the user and -- can be updated. type WorkspaceIndex = Int -- | Internal dynamic project state that stores a mapping between -- workspace indexes and workspace tags. newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag} deriving (Read, Show) instance ExtensionClass DynamicWorkspaceState where initialValue = DynamicWorkspaceState Map.empty extensionType = PersistentExtension -- | Set the index of the current workspace. setWorkspaceIndex :: WorkspaceIndex -> X () setWorkspaceIndex widx = do wtag <- gets (currentTag . windowset) wmap <- XS.gets workspaceIndexMap XS.modify $ \s -> s {workspaceIndexMap = Map.insert widx wtag wmap} withWorkspaceIndex :: (String -> WindowSet -> WindowSet) -> WorkspaceIndex -> X () withWorkspaceIndex job widx = do wtag <- ilookup widx maybe (return ()) (windows . job) wtag where ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag) ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap withWorkspace :: XPConfig -> (String -> X ()) -> X () withWorkspace c job = do ws <- gets (workspaces . windowset) sort <- getSortByIndex let ts = map tag $ sort ws job' t | t `elem` ts = job t | otherwise = addHiddenWorkspace t >> job t mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job' renameWorkspace :: XPConfig -> X () renameWorkspace conf = workspacePrompt conf renameWorkspaceByName renameWorkspaceByName :: String -> X () renameWorkspaceByName w = do old <- gets (currentTag . windowset) windows $ \s -> let sett wk = wk { tag = w } setscr scr = scr { workspace = sett $ workspace scr } sets q = q { current = setscr $ current q } in sets $ removeWorkspace' w s updateIndexMap old w where updateIndexMap oldIM newIM = do wmap <- XS.gets workspaceIndexMap 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 ws <- gets (map tag . sort . workspaces . windowset) case drop wnum ws of (w:_) -> job w [] -> return () withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () withNthWorkspace job wnum = do sort <- getSortByIndex ws <- gets (map tag . sort . workspaces . windowset) case drop wnum ws of (w:_) -> windows $ job w [] -> return () selectWorkspace :: XPConfig -> X () selectWorkspace conf = workspacePrompt conf $ \w -> do s <- gets windowset if tagMember w s then windows $ greedyView w else addWorkspace w -- | Add a new workspace with the given name, or do nothing if a -- workspace with the given name already exists; then switch to the -- newly created workspace. addWorkspace :: String -> X () addWorkspace = addWorkspaceAt (:) -- | Same as addWorkspace, but adds the workspace to the end of the list of workspaces appendWorkspace :: String -> X() appendWorkspace = addWorkspaceAt (flip (++) . return) -- | Adds a new workspace with the given name to the current list of workspaces. -- This function allows the user to pass a function that inserts an element -- into a list at an arbitrary spot. addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X () addWorkspaceAt add newtag = addHiddenWorkspaceAt add newtag >> windows (greedyView newtag) -- | Prompt for the name of a new workspace, add it if it does not -- already exist, and switch to it. addWorkspacePrompt :: XPConfig -> X () addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace -- | Prompt for the name of a new workspace, appending it to the end of the list of workspaces -- if it does not already exist, and switch to it. appendWorkspacePrompt :: XPConfig -> X () appendWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) appendWorkspace -- | Add a new hidden workspace with the given name, or do nothing if -- a workspace with the given name already exists. Takes a function to insert -- the workspace at an arbitrary spot in the list. addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X () addHiddenWorkspaceAt add newtag = whenX (gets (not . tagMember newtag . windowset)) $ do l <- asks (layoutHook . config) windows (addHiddenWorkspace' add newtag l) -- | Add a new hidden workspace with the given name, or do nothing if -- a workspace with the given name already exists. addHiddenWorkspace :: String -> X () addHiddenWorkspace = addHiddenWorkspaceAt (:) -- | Remove the current workspace if it contains no windows. removeEmptyWorkspace :: X () removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag -- | Remove the current workspace. removeWorkspace :: X () removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag -- | Remove workspace with specific tag if it contains no windows. removeEmptyWorkspaceByTag :: String -> X () removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t -- | Remove workspace with specific tag. removeWorkspaceByTag :: String -> X () removeWorkspaceByTag torem = do s <- gets windowset case s of StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do when (torem==tag cur) $ windows $ view $ tag w windows $ removeWorkspace' torem _ -> return () -- | Remove the current workspace after an operation if it is empty and hidden. -- Can be used to remove a workspace if it is empty when leaving it. The -- operation may only change workspace once, otherwise the workspace will not -- be removed. removeEmptyWorkspaceAfter :: X () -> X () removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept [] -- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces, -- whose entries will never be removed. removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X () removeEmptyWorkspaceAfterExcept sticky f = do before <- gets (currentTag . windowset) f after <- gets (currentTag . windowset) when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before isEmpty :: String -> X Bool isEmpty t = do wsl <- gets $ workspaces . windowset let mws = find (\ws -> tag ws == t) wsl 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 } -- | 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, 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 . 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-contrib-0.18.0/XMonad/Actions/EasyMotion.hs0000644000000000000000000004534407346545000020140 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.EasyMotion -- Description : Focus a visible window using a key chord. -- Copyright : (c) Matt Kingston -- 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 . -- Thanks to for some feature inspiration and window -- sorting code. -- ----------------------------------------------------------------------------- module XMonad.Actions.EasyMotion ( -- * Usage -- $usage selectWindow -- * Configuration , EasyMotionConfig(..) , ChordKeys(..) , def -- * Creating overlays , fullSize , fixedSize , textSize , proportional , bar ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Util.Font (releaseXMF, initXMF, Align(AlignCenter), XMonadFont(..), textExtentsXMF) import XMonad.Util.XUtils (createNewWindow, paintAndWrite, deleteWindow, showWindow) import Control.Arrow ((&&&)) import qualified Data.Map.Strict as M (Map, elems, map, mapWithKey) -- $usage -- -- You can use this module's basic functionality with the following in your -- @xmonad.hs@: -- -- > import XMonad.Actions.EasyMotion (selectWindow) -- -- To customise -- -- > import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..)) -- -- Then add a keybinding and an action to the 'selectWindow' function. -- In this case @M-f@ to focus the selected window: -- -- > , ((modm, xK_f), selectWindow def >>= (`whenJust` windows . W.focusWindow)) -- -- Similarly, to kill a window with @M-f@: -- -- > , ((modm, xK_f), selectWindow def >>= (`whenJust` killWindow)) -- -- See 'EasyMotionConfig' for all configuration options. A short summary follows. -- -- Default chord keys are @s,d,f,j,k,l@. To customise these and display options assign -- different values to 'def' (the default configuration): -- -- > , ((modm, xK_f), (selectWindow def{sKeys = AnyKeys [xK_f, xK_d]}) >>= (`whenJust` windows . W.focusWindow)) -- -- You must supply at least two different keys in the 'sKeys' list. Keys provided earlier in the list -- will be used preferentially—therefore, keys you would like to use more frequently should be -- earlier in the list. -- -- To map different sets of keys to different screens. The following configuration maps keys @fdsa@ -- to screen 0 and @hjkl@ to screen 1. Keys provided earlier in the list will be used preferentially. -- Providing the same key for multiple screens is possible but will break down in some scenarios. -- -- > import qualified Data.Map.Strict as StrictMap (fromList) -- > emConf :: EasyMotionConfig -- > emConf = def { sKeys = PerScreenKeys $ StrictMap.fromList [(0, [xK_f, xK_d, xK_s, xK_a]), (1, [xK_h, xK_j, xK_k, xK_l])] } -- > -- key bindings -- > , ((modm, xK_f), selectWindow emConf >>= (`whenJust` windows . W.focusWindow)) -- -- To customise the font: -- -- > , ((modm, xK_f), (selectWindow def{emFont = "xft: Sans-40"}) >>= (`whenJust` windows . W.focusWindow)) -- -- The 'emFont' field provided is supplied directly to the 'initXMF' function. The default is -- @"xft:Sans-100"@. Some example options: -- -- > "xft: Sans-40" -- > "xft: Arial-100" -- > "xft: Cambria-80" -- -- Customise the overlay by supplying a function to 'overlayF'. The signature is -- @'Position' -> 'Rectangle' -> 'Rectangle'@. The parameters are the height in pixels of -- the selection chord and the rectangle of the window to be overlaid. Some are provided: -- -- > import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..), proportional, bar, fullSize) -- > , ((modm, xK_f), (selectWindow def{ overlayF = proportional 0.3 }) >>= (`whenJust` windows . W.focusWindow)) -- > , ((modm, xK_f), (selectWindow def{ overlayF = bar 0.5 }) >>= (`whenJust` windows . W.focusWindow)) -- > , ((modm, xK_f), (selectWindow def{ overlayF = fullSize }) >>= (`whenJust` windows . W.focusWindow)) -- > , ((modm, xK_f), (selectWindow def{ overlayF = fixedSize 300 350 }) >>= (`whenJust` windows . W.focusWindow)) -- TODO: -- - An overlay function that creates an overlay a proportion of the width XOR height of the -- window it's over, and with a fixed w/h proportion? E.g. overlay-height = 0.3 * -- target-window-height; overlay-width = 0.5 * overlay-height. -- - An overlay function that creates an overlay of a fixed w,h, aligned mid,mid, or parametrised -- alignment? -- - Parametrise chord generation? -- - W.shift example; bring window from other screen to current screen? Only useful if we don't -- show chords on current workspace. -- - Use stringToKeysym, keysymToKeycode, keycodeToKeysym, keysymToString to take a string from -- the user? -- - Think a bit more about improving functionality with floating windows. -- - currently, floating window z-order is not respected -- - could ignore floating windows -- - may be able to calculate the visible section of a floating window, and display the chord in -- that space -- - Provide an option to prepend the screen key to the easymotion keys (i.e. w,e,r)? -- - overlay alpha -- - Delay after selection so the user can see what they've chosen? Min-delay: 0 seconds. If -- there's a delay, perhaps keep the other windows covered briefly to naturally draw the user's -- attention to the window they've selected? Or briefly highlight the border of the selected -- window? -- - Option to cover windows that will not be selected by the current chord, such that it's -- slightly more obvious where to maintain focus. -- - Something unpleasant happens when the user provides only two keys (let's say f, d) for -- chords. When they have five windows open, the following chords are generated: ddd, ddf, dfd, -- dff, fdd. When 'f' is pressed, all chords disappear unexpectedly because we know there are no -- other valid options. The user expects to press 'fdd'. This is an optimisation in software but -- pretty bad for usability, as the user continues firing keys into their -- now-unexpectedly-active window. And is of course only one concrete example of a more general -- problem. -- Short-term solution: -- - Keep displaying the chord until the user has fully entered it -- Fix: -- - Show the shortest possible chords -- | Associates a user window, an overlay window created by this module and a rectangle -- circumscribing these windows data OverlayWindow = OverlayWindow { win :: !Window -- ^ The window managed by xmonad , attrs :: !WindowAttributes -- ^ Window attributes for @win@ , overlay :: !Window -- ^ Our window used to display the overlay , rect :: !Rectangle -- ^ The rectangle of @overlay@ } -- | An overlay window and the chord used to select it data Overlay = Overlay { overlayWin :: !OverlayWindow -- ^ The window managed by xmonad , chord :: ![KeySym] -- ^ The chord we'll display in the overlay } -- | Maps keys to windows. 'AnyKeys' maps keys to windows regardless which screen they're on. -- 'PerScreenKeys' maps keys to screens to windows. See @Usage@ for more examples. data ChordKeys = AnyKeys ![KeySym] | PerScreenKeys !(M.Map ScreenId [KeySym]) -- | Configuration options for EasyMotion. -- -- All colors are hex strings, e.g. "#000000" -- -- If the number of windows for which chords are required exceeds 'maxChordLen', chords -- will simply not be generated for these windows. In this way, single-key selection may be -- preferred over the ability to select any window. -- -- 'cancelKey', @xK_BackSpace@ and any duplicates will be removed from 'sKeys' if included. -- See @Usage@ for examples of 'sKeys'. data EasyMotionConfig = EMConf { txtCol :: !String -- ^ Color of the text displayed , bgCol :: !String -- ^ Color of the window overlaid , overlayF :: !(Position -> Rectangle -> Rectangle) -- ^ Function to generate overlay rectangle , borderCol :: !String -- ^ Color of the overlay window borders , sKeys :: !ChordKeys -- ^ Keys to use for window selection , cancelKey :: !KeySym -- ^ Key to use to cancel selection , emFont :: !String -- ^ Font for selection characters (passed to 'initXMF') , borderPx :: !Int -- ^ Width of border in pixels , maxChordLen :: !Int -- ^ Maximum chord length. Use 0 for no maximum. } instance Default EasyMotionConfig where def = EMConf { txtCol = "#ffffff" , bgCol = "#000000" , overlayF = proportional (0.3::Double) , borderCol = "#ffffff" , sKeys = AnyKeys [xK_s, xK_d, xK_f, xK_j, xK_k, xK_l] , cancelKey = xK_q , borderPx = 1 , maxChordLen = 0 #ifdef XFT , emFont = "xft:Sans-100" #else , emFont = "-misc-fixed-*-*-*-*-200-*-*-*-*-*-*-*" #endif } -- | Create overlay windows of the same size as the window they select fullSize :: Position -> Rectangle -> Rectangle fullSize _ = id -- | Create overlay windows a proportion of the size of the window they select proportional :: RealFrac f => f -> Position -> Rectangle -> Rectangle proportional f th r = Rectangle { rect_width = newW , rect_height = newH , rect_x = rect_x r + fi (rect_width r - newW) `div` 2 , rect_y = rect_y r + fi (rect_height r - newH) `div` 2 } where newH = max (fi th) (round $ f * fi (rect_height r)) newW = newH -- | Create fixed-size overlay windows fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle fixedSize w h th r = Rectangle { rect_width = rw , rect_height = rh , rect_x = rect_x r + fi (rect_width r - rw) `div` 2 , rect_y = rect_y r + fi (rect_height r - rh) `div` 2 } where rw = max (fi w) (fi th) rh = max (fi h) (fi th) -- | Create overlay windows the minimum size to contain their key chord textSize :: Position -> Rectangle -> Rectangle textSize th r = Rectangle { rect_width = fi th , rect_height = fi th , rect_x = rect_x r + (fi (rect_width r) - fi th) `div` 2 , rect_y = rect_y r + (fi (rect_height r) - fi th) `div` 2 } -- | Create overlay windows the full width of the window they select, the minimum height to contain -- their chord, and a proportion of the distance from the top of the window they select bar :: RealFrac f => f -> Position -> Rectangle -> Rectangle bar f th r = Rectangle { rect_width = rect_width r , rect_height = fi th , rect_x = rect_x r , rect_y = rect_y r + round (f' * (fi (rect_height r) - fi th)) } where -- clamp f in [0,1] as other values will appear to lock up xmonad as the overlay will be -- displayed off-screen f' = min 0.0 $ max f 1.0 -- | Handles overlay display and window selection. Called after config has been sanitised. handleSelectWindow :: EasyMotionConfig -> X (Maybe Window) handleSelectWindow EMConf { sKeys = AnyKeys [] } = return Nothing handleSelectWindow c = do f <- initXMF $ emFont c th <- (\(asc, dsc) -> asc + dsc + 2) <$> textExtentsXMF f (concatMap keysymToString (allKeys . sKeys $ c)) XConf { theRoot = rw, display = dpy } <- ask XState { mapped = mappedWins, windowset = ws } <- get -- build overlays depending on key configuration overlays :: [Overlay] <- case sKeys c of AnyKeys ks -> buildOverlays ks <$> sortedOverlayWindows where visibleWindows :: [Window] visibleWindows = toList mappedWins sortedOverlayWindows :: X [OverlayWindow] sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows th visibleWindows PerScreenKeys m -> fmap concat $ sequence $ M.elems $ M.mapWithKey (\sid ks -> buildOverlays ks <$> sortedOverlayWindows sid) m where screenById :: ScreenId -> Maybe WindowScreen screenById sid = find ((== sid) . W.screen) (W.screens ws) visibleWindowsOnScreen :: ScreenId -> [Window] visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace sortedOverlayWindows :: ScreenId -> X [OverlayWindow] sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows th (visibleWindowsOnScreen sid) status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime if status == grabSuccess then do resultWin <- handleKeyboard dpy (displayOverlay f) (cancelKey c) overlays [] io $ ungrabKeyboard dpy currentTime mapM_ (deleteWindow . overlay . overlayWin) overlays io $ sync dpy False releaseXMF f case resultWin of -- focus the selected window Selected o -> return . Just . win . overlayWin $ o -- return focus correctly _ -> whenJust (W.peek ws) (windows . W.focusWindow) $> Nothing else releaseXMF f $> Nothing where allKeys :: ChordKeys -> [KeySym] allKeys (AnyKeys ks) = ks allKeys (PerScreenKeys m) = concat $ M.elems m buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay] buildOverlays = appendChords (maxChordLen c) buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow] buildOverlayWindows th = fmap (fromMaybe [] . sequenceA) . traverse (buildOverlayWin th) sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow] sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs) makeRect :: WindowAttributes -> Rectangle makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa)) buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow) buildOverlayWin th w = safeGetWindowAttributes w >>= \case Nothing -> pure Nothing Just wAttrs -> do let r = overlayF c th $ makeRect wAttrs o <- createNewWindow r Nothing "" True return . Just $ OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs } -- | Display an overlay with the provided formatting displayOverlay :: XMonadFont -> Overlay -> X () displayOverlay f Overlay { overlayWin = OverlayWindow { rect = r, overlay = o }, chord = ch } = do showWindow o paintAndWrite o f (fi (rect_width r)) (fi (rect_height r)) (fi (borderPx c)) (bgCol c) (borderCol c) (txtCol c) (bgCol c) [AlignCenter] [concatMap keysymToString ch] -- | Display overlay windows and chords for window selection selectWindow :: EasyMotionConfig -> X (Maybe Window) selectWindow conf = handleSelectWindow conf { sKeys = sanitiseKeys (sKeys conf) } where -- make sure the key lists don't contain: backspace, our cancel key, or duplicates sanitise :: [KeySym] -> [KeySym] sanitise = nub . filter (`notElem` [xK_BackSpace, cancelKey conf]) sanitiseKeys :: ChordKeys -> ChordKeys sanitiseKeys cKeys = case cKeys of AnyKeys ks -> AnyKeys . sanitise $ ks PerScreenKeys m -> PerScreenKeys $ M.map sanitise m -- | Take a list of overlays lacking chords, return a list of overlays with key chords appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay] appendChords _ [] _ = [] appendChords maxUserSelectedLen ks overlayWins = zipWith Overlay overlayWins chords where chords = replicateM chordLen ks -- the minimum necessary chord length to assign a unique chord to each visible window minCoverLen = -((-(length overlayWins)) `div` length ks) -- if the user has specified a max chord length we use this even if it will not cover all -- windows, as they may prefer to focus windows with fewer keys over the ability to focus any -- window chordLen = if maxUserSelectedLen <= 0 then minCoverLen else min minCoverLen maxUserSelectedLen -- | A three-state result for handling user-initiated selection cancellation, successful selection, -- or backspace. data HandleResult = Exit | Selected Overlay | Backspace -- | Handle key press events for window selection. handleKeyboard :: Display -> (Overlay -> X()) -> KeySym -> [Overlay] -> [Overlay] -> X HandleResult handleKeyboard _ _ _ [] _ = return Exit handleKeyboard dpy drawFn cancel selected deselected = do redraw ev <- io $ allocaXEvent $ \e -> do maskEvent dpy (keyPressMask .|. keyReleaseMask .|. buttonPressMask) e getEvent e if | ev_event_type ev == keyPress -> do s <- io $ keycodeToKeysym dpy (ev_keycode ev) 0 if | s == cancel -> return Exit | s == xK_BackSpace -> return Backspace | isNextOverlayKey s -> handleNextOverlayKey s | otherwise -> handleKeyboard dpy drawFn cancel selected deselected | ev_event_type ev == buttonPress -> do -- See XMonad.Prompt Note [Allow ButtonEvents] io $ allowEvents dpy replayPointer currentTime handleKeyboard dpy drawFn cancel selected deselected | otherwise -> handleKeyboard dpy drawFn cancel selected deselected where redraw = mapM (mapM_ drawFn) [selected, deselected] retryBackspace x = case x of Backspace -> redraw >> handleKeyboard dpy drawFn cancel selected deselected _ -> return x isNextOverlayKey keySym = isJust (find ((== Just keySym) . listToMaybe .chord) selected) handleNextOverlayKey keySym = case fg of [x] -> return $ Selected x _ -> handleKeyboard dpy drawFn cancel (trim fg) (clear bg) >>= retryBackspace where (fg, bg) = partition ((== Just keySym) . listToMaybe . chord) selected trim = map (\o -> o { chord = drop 1 $ chord o }) clear = map (\o -> o { chord = [] }) xmonad-contrib-0.18.0/XMonad/Actions/FindEmptyWorkspace.hs0000644000000000000000000000464407346545000021625 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FindEmptyWorkspace -- Description : Find an empty workspace. -- Copyright : (c) Miikka Koskinen 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : arcatan@kapsi.fi -- Stability : stable -- Portability : unportable -- -- Find an empty workspace. -- ----------------------------------------------------------------------------- module XMonad.Actions.FindEmptyWorkspace ( -- * Usage -- $usage viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace ) where import XMonad.Prelude import XMonad import XMonad.StackSet -- $usage -- -- To use, import this module into your @xmonad.hs@: -- -- > import XMonad.Actions.FindEmptyWorkspace -- -- and add the desired keybindings, for example: -- -- > , ((modm, xK_m ), viewEmptyWorkspace) -- > , ((modm .|. shiftMask, xK_m ), tagToEmptyWorkspace) -- -- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@ -- will tag the current window to an empty workspace and view it. -- -- For detailed instructions on editing your key bindings, see -- . -- | Find the first hidden empty workspace in a StackSet. Returns -- Nothing if all workspaces are in use. Function searches currently -- focused workspace, other visible workspaces (when in Xinerama) and -- hidden workspaces in this order. findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a) findEmptyWorkspace = find (isNothing . stack) . allWorkspaces where allWorkspaces ss = (workspace . current) ss : (map workspace . visible) ss ++ hidden ss withEmptyWorkspace :: (WorkspaceId -> X ()) -> X () withEmptyWorkspace f = do ws <- gets windowset whenJust (findEmptyWorkspace ws) (f . tag) -- | Find and view an empty workspace. Do nothing if all workspaces are -- in use. viewEmptyWorkspace :: X () viewEmptyWorkspace = withEmptyWorkspace (windows . view) -- | Tag current window to an empty workspace and view it. Do nothing if -- all workspaces are in use. tagToEmptyWorkspace :: X () tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w -- | Send current window to an empty workspace. Do nothing if -- all workspaces are in use. sendToEmptyWorkspace :: X () sendToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ shift w xmonad-contrib-0.18.0/XMonad/Actions/FlexibleManipulate.hs0000644000000000000000000001065007346545000021613 0ustar0000000000000000{-# 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) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- Move and resize floating windows without warping the mouse. -- ----------------------------------------------------------------------------- -- Based on the FlexibleResize code by Lukas Mai (mauke). module XMonad.Actions.FlexibleManipulate ( -- * Usage -- $usage mouseWindow, discrete, linear, resize, position ) where import XMonad import XMonad.Prelude ((<&>), fi) import qualified Prelude as P import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($)) -- $usage -- First, add this import to your @xmonad.hs@: -- -- > import qualified XMonad.Actions.FlexibleManipulate as Flex -- -- Now set up the desired mouse binding, for example: -- -- > , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) -- -- * Flex.'linear' indicates that positions between the edges and the -- middle indicate a combination scale\/position. -- -- * Flex.'discrete' indicates that there are discrete pick -- regions. (The window is divided by thirds for each axis.) -- -- * Flex.'resize' performs only a resize of the window, based on which -- quadrant the mouse is in. -- -- * Flex.'position' is similar to the built-in -- 'XMonad.Operations.mouseMoveWindow'. -- -- You can also write your own function for this parameter. It should take -- a value between 0 and 1 indicating position, and return a value indicating -- the corresponding position if plain Flex.'linear' was used. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". discrete, linear, resize, position :: Double -> Double -- | Manipulate the window based on discrete pick regions; the window -- is divided into regions by thirds along each axis. discrete x | x < 0.33 = 0 | x > 0.66 = 1 | otherwise = 0.5 -- | Scale\/reposition the window by factors obtained from the mouse -- position by linear interpolation. Dragging precisely on a corner -- resizes that corner; dragging precisely in the middle moves the -- window without resizing; anything else is an interpolation -- between the two. linear = id -- | Only resize the window, based on the window quadrant the mouse is in. resize x = if x < 0.5 then 0 else 1 -- | Only reposition the window. position = const 0.5 -- | Given an interpolation function, implement an appropriate window -- manipulation action. mouseWindow :: (Double -> Double) -> Window -> X () mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do let wpos = (fi (wa_x wa), fi (wa_y wa)) wsize = (fi (wa_width wa), fi (wa_height wa)) sh <- io $ getWMNormalHints d w pointer <- io $ queryPointer d w <&> 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 -> 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) io $ moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth float w) (float w) float w where pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt -- I'd rather I didn't have to do this, but I hate writing component 2d math type Pnt = (Double, Double) mapP :: (a -> b) -> (a, a) -> (b, b) mapP f (x, y) = (f x, f y) zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) zipP f (ax,ay) (bx,by) = (f ax bx, f ay by) minP :: Ord a => (a,a) -> (a,a) -> (a,a) minP = zipP min infixl 6 +, - infixl 7 *, / (+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a) (+) = zipP (P.+) (-) = zipP (P.-) (*) = zipP (P.*) (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a) (/) = zipP (P./) xmonad-contrib-0.18.0/XMonad/Actions/FlexibleResize.hs0000644000000000000000000000552307346545000020760 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FlexibleResize -- Description : Resize floating windows from any corner. -- Copyright : (c) Lukas Mai -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Resize floating windows from any corner. -- ----------------------------------------------------------------------------- module XMonad.Actions.FlexibleResize ( -- * Usage -- $usage XMonad.Actions.FlexibleResize.mouseResizeWindow, XMonad.Actions.FlexibleResize.mouseResizeEdgeWindow ) where import XMonad import XMonad.Prelude (fi) import Foreign.C.Types -- $usage -- To use, first import this module into your @xmonad.hs@ file: -- -- > import qualified XMonad.Actions.FlexibleResize as Flex -- -- Then add an appropriate mouse binding: -- -- > , ((modm, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- | Resize a floating window from whichever corner the mouse is -- closest to. mouseResizeWindow :: Window -- ^ The window to resize. -> X () mouseResizeWindow = mouseResizeEdgeWindow 0 -- | Resize a floating window from whichever corner or edge the mouse is -- closest to. mouseResizeEdgeWindow :: Rational -- ^ The size of the area where only one edge is resized. -> Window -- ^ The window to resize. -> X () mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do sh <- io $ getWMNormalHints d w (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w let pos_x = fi $ wa_x wa pos_y = fi $ wa_y wa width = fi $ wa_width wa height = fi $ wa_height wa west = findPos ix width north = findPos iy height (cx, fx, gx) = mkSel west width pos_x (cy, fy, gy) = mkSel north height pos_y io $ warpPointer d none w 0 0 0 0 cx cy mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey) io $ moveResizeWindow d w (fx nw) (fy nh) nw nh float w) (float w) where findPos :: CInt -> Position -> Maybe Bool 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) Nothing -> (k `div` 2, const p, const $ fi k) Just False -> (k, const p, subtract (fi p) . fi) xmonad-contrib-0.18.0/XMonad/Actions/FloatKeys.hs0000644000000000000000000001472307346545000017747 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FloatKeys -- Description : Move and resize floating windows. -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : stable -- Portability : unportable -- -- Move and resize floating windows. ----------------------------------------------------------------------------- module XMonad.Actions.FloatKeys ( -- * Usage -- $usage keysMoveWindow, keysMoveWindowTo, keysResizeWindow, keysAbsResizeWindow, directionMoveWindow, directionResizeWindow, Direction2D(..), P, G, ChangeDim ) where import XMonad import XMonad.Prelude (fi) import XMonad.Util.Types -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.FloatKeys -- -- Then add appropriate key bindings, for example: -- -- > , ((modm, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) -- > , ((modm, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) -- > , ((modm .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) -- > , ((modm .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) -- > , ((modm, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) -- -- Using "XMonad.Util.EZConfig" syntax, we can easily build keybindings -- where @M-\@ moves the currently focused window and -- @M-S-\@ resizes it using 'directionMoveWindow' and -- 'directionResizeWindow': -- -- > [ ("M-" <> m <> k, withFocused $ f i) -- > | (i, k) <- zip [U, D, R, L] ["", "", "", ""] -- > , (f, m) <- [(directionMoveWindow 10, ""), (directionResizeWindow 10, "S-")] -- > ] -- -- For detailed instructions on editing your key bindings, see -- . -- | @directionMoveWindow delta dir win@ moves the window @win@ by -- @delta@ pixels in direction @dir@. directionMoveWindow :: Int -> Direction2D -> Window -> X () directionMoveWindow delta dir win = case dir of U -> keysMoveWindow (0, -delta) win D -> keysMoveWindow (0, delta) win R -> keysMoveWindow (delta, 0) win L -> keysMoveWindow (-delta, 0) win -- | @directionResizeWindow delta dir win@ resizes the window @win@ by -- @delta@ pixels in direction @dir@. directionResizeWindow :: Int -> Direction2D -> Window -> X () directionResizeWindow delta dir win = case dir of U -> keysResizeWindow (0, -delta) (0, 0) win D -> keysResizeWindow (0, delta) (0, 0) win R -> keysResizeWindow (delta, 0) (0, 0) win L -> keysResizeWindow (-delta, 0) (0, 0) win -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the -- right and @dy@ pixels down. keysMoveWindow :: ChangeDim -> Window -> X () keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do io $ moveWindow d w (fi (fi (wa_x wa) + dx)) (fi (fi (wa_y wa) + dy)) float w -- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative -- point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a -- position relative to the window border, i.e. @gx = 0@ is the left -- border, @gx = 1@ is the right border, @gy = 0@ is the top border, and -- @gy = 1@ the bottom border. -- -- For example, on a 1024x768 screen: -- -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen -- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner keysMoveWindowTo :: P -> G -> Window -> X () keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do io $ moveWindow d w (x - round (gx * fi (wa_width wa))) (y - round (gy * fi (wa_height wa))) float w type G = (Rational, Rational) type P = (Position, Position) type ChangeDim = (Int, Int) -- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@ -- and the height by @dy@, leaving the window-relative point @(gx, -- gy)@ fixed. -- -- For example: -- -- > keysResizeWindow (10, 0) (0, 0) -- make the window 10 pixels larger to the right -- > 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 :: ChangeDim -> G -> Window -> X () keysResizeWindow = keysMoveResize keysResizeWindow' -- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@ -- and the height by @dy@, leaving the screen absolute point @(ax, -- ay)@ fixed. -- -- 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 :: ChangeDim -> D -> Window -> X () keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow' 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 -- 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 = fi (ax * w + nw * (fi x - ax)) / fi w ny :: Rational ny = fi (ay * h + nh * (fi y - ay)) / fi h 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 (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 -> withWindowAttributes d w $ \wa -> do sh <- io $ getWMNormalHints d w 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-contrib-0.18.0/XMonad/Actions/FloatSnap.hs0000644000000000000000000004072707346545000017740 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.FloatSnap -- Description : Snap to other windows or the edge of the screen while moving or resizing. -- Copyright : (c) 2009 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- Move and resize floating windows using other windows and the edge of the -- screen as guidelines. ----------------------------------------------------------------------------- module XMonad.Actions.FloatSnap ( -- * Usage -- $usage Direction2D(..), snapMove, snapGrow, snapShrink, snapMagicMove, snapMagicResize, snapMagicMouseResize, afterDrag, ifClick, ifClick') where import XMonad import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when) import qualified XMonad.StackSet as W import qualified Data.Set as S import XMonad.Hooks.ManageDocks (calcGap) import XMonad.Util.Types (Direction2D(..)) import XMonad.Actions.AfterDrag -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.FloatSnap -- -- Then add appropriate key bindings, for example: -- -- > , ((modm, xK_Left), withFocused $ snapMove L Nothing) -- > , ((modm, xK_Right), withFocused $ snapMove R Nothing) -- > , ((modm, xK_Up), withFocused $ snapMove U Nothing) -- > , ((modm, xK_Down), withFocused $ snapMove D Nothing) -- > , ((modm .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing) -- > , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing) -- > , ((modm .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing) -- > , ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing) -- -- For detailed instructions on editing your key bindings, see -- . -- -- And possibly add appropriate mouse bindings, for example: -- -- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicMove (Just 50) (Just 50) w))) -- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))) -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (snapMagicResize [R,D] (Just 50) (Just 50) w))) -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- -- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place. -- Note that the order in which the commands are applied in the mouse bindings are important. Snapping can also be used together with other window resizing -- functions, such as those from "XMonad.Actions.FlexibleResize" -- -- An alternative set of mouse bindings that will always snap after the drag is: -- -- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 50) (Just 50) w))) -- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))) -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R,D] (Just 50) (Just 50) w))) -- -- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap -- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against). -- -- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance. -- -- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which -- windows it should collide with. -- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the -- mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge -- will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or -- "XMonad.Actions.FlexibleManipulate". snapMagicMouseResize :: Rational -- ^ How big the middle snap area of each axis should be. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. -> X () snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do (_, _, _, px, py, _, _, _) <- io $ queryPointer d w let x = (fromIntegral px - wx wa)/ww wa y = (fromIntegral py - wy wa)/wh wa ml = [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 null mdir then [L,R,U,D] else mdir snapMagicResize dir collidedist snapdist w where wx = fromIntegral.wa_x wy = fromIntegral.wa_y ww = fromIntegral.wa_width wh = fromIntegral.wa_height -- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. snapMagicResize :: [Direction2D] -- ^ The edges to snap. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. -> X () snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do (xbegin,xend) <- handleAxis True d wa (ybegin,yend) <- handleAxis False d wa let xbegin' = if L `elem` dir then xbegin else wx wa xend' = if R `elem` dir then xend else wx wa + ww wa ybegin' = if U `elem` dir then ybegin else wy wa yend' = if D `elem` dir then yend else wy wa + wh wa io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin') io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin') float w where wx = fromIntegral.wa_x wy = fromIntegral.wa_y ww = fromIntegral.wa_width wh = fromIntegral.wa_height handleAxis horiz d wa = do ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w let begin = if bs then wpos wa else case (mbl,mbr) of (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br (Just bl,Nothing) -> bl (Nothing,Just br) -> br (Nothing,Nothing) -> wpos wa end = if fs then wpos wa + wdim wa 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 return (begin',end') where (wpos, wdim, _, _) = constructors horiz -- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen. snapMagicMove :: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move. -> X () snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do nx <- handleAxis True d wa ny <- handleAxis False d wa io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) float w where handleAxis horiz d wa = do ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w return $ if bs || fs then wpos wa else let b = case (mbl,mbr) of (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br (Just bl,Nothing) -> bl (Nothing,Just br) -> br (Nothing,Nothing) -> wpos wa f = case (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 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 -- | Move a window in the specified direction until it snaps against another window or the edge of the screen. snapMove :: Direction2D -- ^ What direction to move the window in. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to move. -> X () snapMove L = doSnapMove True True snapMove R = doSnapMove True False snapMove U = doSnapMove False True snapMove D = doSnapMove False False doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X () doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w let (mb,mf) = if rev then (bl,fl) else (br,fr) newpos = fromIntegral $ case (mb,mf) of (Just b,Nothing) -> b (Nothing,Just f) -> f - wdim wa (Just b,Just f) -> if rev /= (b < f - wdim wa) then b else f - wdim wa _ -> wpos wa if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa) else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos float w where (wpos, wdim, _, _) = constructors horiz -- | Grow the specified edge of a window until it snaps against another window or the edge of the screen. snapGrow :: Direction2D -- ^ What edge of the window to grow. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to grow. -> X () snapGrow = snapResize True -- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen. snapShrink :: Direction2D -- ^ What edge of the window to shrink. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to shrink. -> X () snapShrink = snapResize False snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X () snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> withWindowAttributes d w $ \wa -> do mr <- case dir of L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (v, wy wa, ww wa + wx wa - v, wh wa) _ -> Nothing R -> do ((_,_,_),(ms,mg,_)) <- getSnap True collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (wx wa, wy wa, v - wx wa, wh wa) _ -> Nothing U -> do ((mg,ms,_),(_,_,_)) <- getSnap False collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (wx wa, v, ww wa, wh wa + wy wa - v) _ -> Nothing D -> do ((_,_,_),(ms,mg,_)) <- getSnap False collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (wx wa, wy wa, ww wa, v - wy wa) _ -> Nothing case mr of Nothing -> 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 wy = fromIntegral.wa_y ww = fromIntegral.wa_width wh = fromIntegral.wa_height getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool)) getSnap horiz collidedist d w = do wa <- io $ getWindowAttributes d w screen <- W.current <$> gets windowset let sr = screenRect $ W.screenDetail screen wl = W.integrate' . W.stack $ W.workspace screen 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) ) where wborder = fromIntegral.wa_border_width (wpos, wdim, rpos, rdim) = constructors horiz (refwpos, refwdim, _, _) = constructors $ not horiz 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 front wa sr gr wla = dropWhile (<= rpos sr) $ takeWhile (<= rpos sr + rdim sr) $ sort $ (rpos gr - 2*wborder wa):(rpos gr + rdim gr - 2*wborder wa):(rpos sr + rdim sr - 2*wborder wa): foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l , listToMaybe $ dropWhile (<= v) l , v `elem` l ) 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 constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int) constructors True = ( fromIntegral.wa_x , fromIntegral.wa_width , fromIntegral.rect_x , fromIntegral.rect_width ) constructors False = ( fromIntegral.wa_y , fromIntegral.wa_height , fromIntegral.rect_y , fromIntegral.rect_height ) xmonad-contrib-0.18.0/XMonad/Actions/FocusNth.hs0000644000000000000000000000361307346545000017573 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FocusNth -- Description : Focus the nth window of the current workspace. -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : stable -- Portability : unportable -- -- Focus the nth window of the current workspace. ----------------------------------------------------------------------------- module XMonad.Actions.FocusNth ( -- * Usage -- $usage focusNth,focusNth', swapNth,swapNth') where import XMonad import XMonad.Prelude import XMonad.StackSet -- $usage -- Add the import to your @xmonad.hs@: -- -- > import XMonad.Actions.FocusNth -- -- Then add appropriate keybindings, for example: -- -- > -- mod4-[1..9] @@ Switch to window N -- > ++ [((modm, k), focusNth i) -- > | (i, k) <- zip [0 .. 8] [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see -- . -- | Give focus to the nth window of the current workspace. focusNth :: Int -> X () focusNth = windows . modify' . focusNth' focusNth' :: Int -> Stack a -> Stack a focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs | otherwise = s -- | Swap current window with nth. Focus stays in the same position swapNth :: Int -> X () swapNth = windows . modify' . swapNth' swapNth' :: Int -> Stack a -> Stack a swapNth' n s@(Stack c l r) | (n < 0) || (n > length l + length r) || (n == length l) = s | n < length l = let (nl, notEmpty -> nc :| nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r | otherwise = let (nl, notEmpty -> nc :| nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr) xmonad-contrib-0.18.0/XMonad/Actions/GridSelect.hs0000644000000000000000000007725007346545000020077 0ustar0000000000000000{-# 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 -- License : BSD-style (see LICENSE) -- -- Maintainer : Clemens Fruhwirth -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.GridSelect ( -- * Usage -- $usage -- ** Customizing -- *** Using a common GSConfig -- $commonGSConfig -- *** Custom keybindings -- $keybindings -- * Configuration GSConfig(..), def, TwoDPosition, buildDefaultGSConfig, -- * Variations on 'gridselect' gridselect, gridselectWindow, withSelectedWindow, bringSelected, goToSelected, gridselectWorkspace, gridselectWorkspace', spawnSelected, runSelectedAction, -- * Colorizers HasColorizer(defaultColorizer), fromClassName, stringColorizer, colorRangeFromClassName, stringToRatio, -- * Navigation Mode assembly TwoD, makeXEventhandler, shadowWithKeymap, -- * Built-in Navigation Mode defaultNavigation, substringSearch, navNSearch, -- * Navigation Components setPos, move, moveNext, movePrev, select, cancel, transformSearchString, -- * Rearrangers -- $rearrangers Rearranger, noRearranger, searchStringRearrangerGenerator, -- * Screenshots -- $screenshots -- * Types TwoDState, ) where import Control.Arrow ((***)) import Data.Bits import Data.Ord (comparing) import Control.Monad.State 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 import XMonad.Layout.Decoration import XMonad.Util.NamedWindows import XMonad.Actions.WindowBringer (bringWindow) import Text.Printf import System.Random (mkStdGen, randomR) import Data.Word (Word8) import qualified Data.List.NonEmpty as NE -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.GridSelect -- -- Then add a keybinding, e.g. -- -- > , ((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 def ["xterm","gmplayer","gvim"]) -- $commonGSConfig -- -- It is possible to bind a @gsconfig@ at top-level in your configuration. Like so: -- -- > -- the top of your config -- > {-# LANGUAGE NoMonomorphismRestriction #-} -- > import XMonad -- > ... -- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 } -- -- An example where 'buildDefaultGSConfig' is used instead of 'def' -- in order to specify a custom colorizer is @gsconfig2@ (found in -- "XMonad.Actions.GridSelect#Colorizers"): -- -- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 } -- -- > -- | A green monochrome colorizer based on window class -- > greenColorizer = colorRangeFromClassName -- > black -- lowest inactive bg -- > (0x70,0xFF,0x70) -- highest inactive bg -- > black -- active bg -- > white -- inactive fg -- > white -- active fg -- > where black = minBound -- > white = maxBound -- -- Then you can bind to: -- -- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer) -- > ,((modm, xK_p), spawnSelected (gsconfig2 defaultColorizer) ["xterm","gvim"]) -- $keybindings -- -- You can build you own navigation mode and submodes by combining the -- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'. -- -- > myNavigation :: TwoD a (Maybe a) -- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler -- > where navKeyMap = M.fromList [ -- > ((0,xK_Escape), cancel) -- > ,((0,xK_Return), select) -- > ,((0,xK_slash) , substringSearch myNavigation) -- > ,((0,xK_Left) , move (-1,0) >> myNavigation) -- > ,((0,xK_h) , move (-1,0) >> myNavigation) -- > ,((0,xK_Right) , move (1,0) >> myNavigation) -- > ,((0,xK_l) , move (1,0) >> myNavigation) -- > ,((0,xK_Down) , move (0,1) >> myNavigation) -- > ,((0,xK_j) , move (0,1) >> myNavigation) -- > ,((0,xK_Up) , move (0,-1) >> myNavigation) -- > ,((0,xK_y) , move (-1,-1) >> myNavigation) -- > ,((0,xK_i) , move (1,-1) >> myNavigation) -- > ,((0,xK_n) , move (-1,1) >> myNavigation) -- > ,((0,xK_m) , move (1,-1) >> myNavigation) -- > ,((0,xK_space) , setPos (0,0) >> myNavigation) -- > ] -- > -- The navigation handler ignores unknown key symbols -- > navDefaultHandler = const myNavigation -- -- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@: -- -- > gsconfig3 = def -- > { gs_cellheight = 30 -- > , gs_cellwidth = 100 -- > , gs_navigate = myNavigation -- > } -- $screenshots -- -- Selecting a workspace: -- -- <> -- -- Selecting a window by title: -- -- <> -- | The 'Default' instance gives a basic configuration for 'gridselect', with -- the colorizer chosen based on the type. -- -- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig' -- instead of 'def' to avoid ambiguous type variables. data GSConfig a = GSConfig { gs_cellheight :: Integer, gs_cellwidth :: Integer, gs_cellpadding :: Integer, gs_colorizer :: a -> Bool -> X (String, String), gs_font :: String, gs_navigate :: TwoD a (Maybe a), gs_rearranger :: Rearranger a, gs_originFractX :: Double, gs_originFractY :: Double, gs_bordercolor :: String } -- | That is 'fromClassName' if you are selecting a 'Window', or -- 'defaultColorizer' if you are selecting a 'String'. The catch-all instance -- @HasColorizer a@ uses the 'focusedBorderColor' and 'normalBorderColor' -- colors. class HasColorizer a where defaultColorizer :: a -> Bool -> X (String, String) instance HasColorizer Window where defaultColorizer = fromClassName instance HasColorizer String where defaultColorizer = stringColorizer instance {-# OVERLAPPABLE #-} HasColorizer a where defaultColorizer _ isFg = let getColor = if isFg then focusedBorderColor else normalBorderColor in asks $ (, "black") . getColor . config instance HasColorizer a => Default (GSConfig a) where def = buildDefaultGSConfig defaultColorizer type TwoDPosition = (Integer, Integer) type TwoDElementMap a = [(TwoDPosition,(String,a))] data TwoDState a = TwoDState { td_curpos :: TwoDPosition , td_availSlots :: [TwoDPosition] , td_elements :: [(String,a)] , td_gsconfig :: GSConfig a , td_font :: XMonadFont , td_paneX :: Integer , td_paneY :: Integer , td_drawingWin :: Window , td_searchString :: String , td_elementmap :: TwoDElementMap a } generateElementmap :: TwoDState a -> X (TwoDElementMap a) generateElementmap s = do rearrangedElements <- rearranger searchString sortedElements return $ zip positions rearrangedElements where TwoDState {td_availSlots = positions, td_gsconfig = gsconfig, td_searchString = searchString} = s GSConfig {gs_rearranger = rearranger} = gsconfig -- Filter out any elements that don't contain the searchString (case insensitive) filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s) -- Sorts the elementmap sortedElements = orderElementmap searchString filteredElements -- Case Insensitive version of isInfixOf needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack upper = map toUpper -- | We enforce an ordering such that we will always get the same result. If the -- elements position changes from call to call of gridselect, then the shown -- positions will also change when you search for the same string. This is -- especially the case when using gridselect for showing and switching between -- workspaces, as workspaces are usually shown in order of last visited. The -- chosen ordering is "how deep in the haystack the needle is" (number of -- characters from the beginning of the string and the needle). orderElementmap :: String -> [(String,a)] -> [(String,a)] orderElementmap searchString elements = if not $ null searchString then sortedElements else elements where upper = map toUpper -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle. calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element) , element) -- Use the score and then the string as the parameters for comparing, making -- it consistent even when two strings that score the same, as it will then be -- sorted by the strings, making it consistent. compareScore = comparing (\(score, (str,_)) -> (score, str)) sortedElements = map snd . sortBy compareScore $ map calcScore elements newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b } deriving (Functor, Applicative, Monad, MonadState (TwoDState a)) liftX :: X a1 -> TwoD a a1 liftX = TwoD . lift evalTwoD :: TwoD a1 a -> TwoDState a1 -> X a evalTwoD m s = flip evalStateT s $ unTwoD m diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)] diamondLayer 0 = [(0,0)] diamondLayer n = -- 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 diamond :: (Enum a, Num a, Eq a) => Stream (a, a) diamond = fromList $ concatMap diamondLayer [0..] diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)] diamondRestrict x y originX originY = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) . takeS 1000 $ diamond findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () drawWinBox win font (fg,bg) bc ch cw text x y cp = withDisplay $ \dpy -> do gc <- liftIO $ createGC dpy win bordergc <- liftIO $ createGC dpy win liftIO $ do Just fgcolor <- initColor dpy fg Just bgcolor <- initColor dpy bg Just bordercolor <- initColor dpy bc setForeground dpy gc fgcolor setBackground dpy gc bgcolor setForeground dpy bordergc bordercolor fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) 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))) text -- calculate the offset to vertically centre the text based on the ascender and descender (asc,desc) <- liftIO $ textExtentsXMF font stext let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext liftIO $ freeGC dpy gc liftIO $ freeGC dpy bordergc updateAllElements :: TwoD a () updateAllElements = do s <- get updateElements (td_elementmap s) grayoutElements :: Int -> TwoD a () grayoutElements skip = do s <- get updateElementsWithColorizer grayOnly $ drop skip (td_elementmap s) where grayOnly _ _ = return ("#808080", "#808080") updateElements :: TwoDElementMap a -> TwoD a () updateElements elementmap = do s <- get updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a () updateElementsWithColorizer colorizer elementmap = do TwoDState { td_curpos = curpos, td_drawingWin = win, td_gsconfig = gsconfig, td_font = font, td_paneX = paneX, td_paneY = paneY} <- get let cellwidth = gs_cellwidth gsconfig cellheight = gs_cellheight gsconfig paneX' = div (paneX-cellwidth) 2 paneY' = div (paneY-cellheight) 2 updateElement (pos@(x,y),(text, element)) = liftX $ do colors <- colorizer element (pos == curpos) drawWinBox win font colors (gs_bordercolor gsconfig) cellheight cellwidth text (paneX'+x*cellwidth) (paneY'+y*cellheight) (gs_cellpadding gsconfig) 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 | t == buttonRelease = do 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 case lookup (gridX,gridY) (td_elementmap s) of Just (_,el) -> return (Just el) Nothing -> contEventloop | otherwise = contEventloop stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop stdHandle _ contEventloop = contEventloop -- | Embeds a key handler into the X event handler that dispatches key -- events to the key handler, while non-key event go to the standard -- handler. makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a) makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e ev <- getEvent e if ev_event_type ev == keyPress then do (_, s) <- lookupString $ asKeyEvent e ks <- keycodeToKeysym d (ev_keycode ev) 0 return $ do mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) keyhandler (ks, s, mask) else return $ stdHandle ev me -- | When the map contains (KeySym,KeyMask) tuple for the given event, -- the associated action in the map associated shadows the default key -- handler shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap) -- Helper functions to use for key handler functions -- | Closes gridselect returning the element under the cursor select :: TwoD a (Maybe a) select = do s <- get return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s) -- | Closes gridselect returning no element. cancel :: TwoD a (Maybe a) cancel = return Nothing -- | Sets the absolute position of the cursor. setPos :: (Integer, Integer) -> TwoD a () setPos newPos = do s <- get let elmap = td_elementmap s newSelectedEl = findInElementMap newPos (td_elementmap s) oldPos = td_curpos s when (isJust newSelectedEl && newPos /= oldPos) $ do put s { td_curpos = newPos } updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl]) -- | Moves the cursor by the offsets specified move :: (Integer, Integer) -> TwoD a () move (dx,dy) = do s <- get let (x,y) = td_curpos s newPos = (x+dx,y+dy) setPos newPos moveNext :: TwoD a () moveNext = do position <- gets td_curpos elems <- gets td_elementmap let n = length elems m = case findIndex (\p -> fst p == position) elems of Nothing -> Nothing Just k | k == n-1 -> Just 0 | otherwise -> Just (k+1) whenJust m $ \i -> setPos (fst $ elems !! i) movePrev :: TwoD a () movePrev = do position <- gets td_curpos elems <- gets td_elementmap let n = length elems m = case findIndex (\p -> fst p == position) elems of Nothing -> Nothing Just 0 -> Just (n-1) Just k -> Just (k-1) whenJust m $ \i -> setPos (fst $ elems !! i) -- | Apply a transformation function the current search string transformSearchString :: (String -> String) -> TwoD a () transformSearchString f = do s <- get let oldSearchString = td_searchString s newSearchString = f oldSearchString when (newSearchString /= oldSearchString) $ do -- FIXME curpos might end up outside new bounds let s' = s { td_searchString = newSearchString } m <- liftX $ generateElementmap s' let s'' = s' { td_elementmap = m } oldLen = length $ td_elementmap s newLen = length $ td_elementmap s'' -- All the elements in the previous element map should be -- grayed out, except for those which will be covered by -- elements in the new element map. when (newLen < oldLen) $ grayoutElements newLen put s'' updateAllElements -- | By default gridselect used the defaultNavigation action, which -- binds left,right,up,down and vi-style h,l,j,k navigation. Return -- quits gridselect, returning the selected element, while Escape -- cancels the selection. Slash enters the substring search mode. In -- substring search mode, every string-associated keystroke is -- added to a search string, which narrows down the object -- selection. Substring search mode comes back to regular navigation -- via Return, while Escape cancels the search. If you want that -- navigation style, add 'defaultNavigation' as 'gs_navigate' to your -- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically. defaultNavigation :: TwoD a (Maybe a) defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler where navKeyMap = M.fromList [ ((0,xK_Escape) , cancel) ,((0,xK_Return) , select) ,((0,xK_slash) , substringSearch defaultNavigation) ,((0,xK_Left) , move (-1,0) >> defaultNavigation) ,((0,xK_h) , move (-1,0) >> defaultNavigation) ,((0,xK_Right) , move (1,0) >> defaultNavigation) ,((0,xK_l) , move (1,0) >> defaultNavigation) ,((0,xK_Down) , move (0,1) >> defaultNavigation) ,((0,xK_j) , move (0,1) >> defaultNavigation) ,((0,xK_Up) , move (0,-1) >> defaultNavigation) ,((0,xK_k) , move (0,-1) >> defaultNavigation) ,((0,xK_Tab) , moveNext >> defaultNavigation) ,((0,xK_n) , moveNext >> defaultNavigation) ,((shiftMask,xK_Tab), movePrev >> defaultNavigation) ,((0,xK_p) , movePrev >> defaultNavigation) ] -- The navigation handler ignores unknown key symbols, therefore we const navDefaultHandler = const defaultNavigation -- | This navigation style combines navigation and search into one mode at the cost of losing vi style -- navigation. With this style, there is no substring search submode, -- but every typed character is added to the substring search. navNSearch :: TwoD a (Maybe a) navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler where navNSearchKeyMap = M.fromList [ ((0,xK_Escape) , cancel) ,((0,xK_Return) , select) ,((0,xK_Left) , move (-1,0) >> navNSearch) ,((0,xK_Right) , move (1,0) >> navNSearch) ,((0,xK_Down) , move (0,1) >> navNSearch) ,((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) ] -- The navigation handler ignores unknown key symbols, therefore we const navNSearchDefaultHandler (_,s,_) = do transformSearchString (++ s) navNSearch -- | Navigation submode used for substring search. It returns to the -- first argument navigation style when the user hits Return. substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a) substringSearch returnNavigation = fix $ \me -> 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) ] searchDefaultHandler (_,s,_) = do transformSearchString (++ s) me in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler -- FIXME probably move that into Utils? -- 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 q = v * (1-f) p = v * (1-s) t = v * (1-(1-f)*s) in case hi of 0 -> (v,t,p) 1 -> (q,v,p) 2 -> (p,v,t) 3 -> (p,q,v) 4 -> (t,p,v) 5 -> (v,p,q) _ -> error "The world is ending. x mod a >= a." -- | Default colorizer for Strings 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) in if active then return ("#faff69", "black") 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 = printf "%02x" -- | A colorizer that picks a color inside a range, -- and depending on the window's class. colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range -> (Word8, Word8, Word8) -- ^ End of the color range -> (Word8, Word8, Word8) -- ^ Background of the active window -> (Word8, Word8, Word8) -- ^ Inactive text color -> (Word8, Word8, Word8) -- ^ Active text color -> Window -> Bool -> X (String, String) colorRangeFromClassName startC endC activeC inactiveT activeT w active = do classname <- runQuery className w if active then return (rgbToHex activeC, rgbToHex activeT) else return (rgbToHex $ mix startC endC $ stringToRatio classname, rgbToHex inactiveT) where rgbToHex :: (Word8, Word8, Word8) -> String rgbToHex (r, g, b) = '#':twodigitHex r ++twodigitHex g++twodigitHex b -- | Creates a mix of two colors according to a ratio -- (1 -> first color, 0 -> second color). mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8) mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2) where mix' a b = truncate $ (fi a * r) + (fi b * (1 - r)) -- | Generates a Double from a string, trying to -- achieve a random distribution. -- 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 $ 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. gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a) gridselect _ [] = return Nothing gridselect gsconfig elements = withDisplay $ \dpy -> do rootw <- asks theRoot scr <- gets $ screenRect . W.screenDetail . W.current . windowset win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw (rect_x scr) (rect_y scr) (rect_width scr) (rect_height scr) liftIO $ mapWindow dpy win liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask) status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime font <- initXMF (gs_font gsconfig) let screenWidth = toInteger $ rect_width scr screenHeight = toInteger $ rect_height scr 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 coords = diamondRestrict restrictX restrictY originPosX originPosY s = TwoDState { td_curpos = NE.head (notEmpty coords), td_availSlots = coords, td_elements = elements, td_gsconfig = gsconfig, td_font = font, td_paneX = screenWidth, td_paneY = screenHeight, td_drawingWin = win, td_searchString = "", td_elementmap = [] } m <- generateElementmap s evalTwoD (updateAllElements >> gs_navigate gsconfig) (s { td_elementmap = m }) else return Nothing liftIO $ do unmapWindow dpy win destroyWindow dpy win ungrabPointer dpy currentTime sync dpy False releaseXMF font return selectedElement -- | Like `gridSelect' but with the current windows and their titles as elements gridselectWindow :: GSConfig Window -> X (Maybe Window) gridselectWindow gsconf = windowMap >>= gridselect gsconf -- | Brings up a 2D grid of windows in the center of the screen, and one can -- select a window with cursors keys. The selected window is then passed to -- a callback function. withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X () withSelectedWindow callback conf = do mbWindow <- gridselectWindow conf for_ mbWindow callback windowMap :: X [(String,Window)] windowMap = do ws <- gets windowset mapM keyValuePair (W.allWindows ws) where keyValuePair w = (, w) <$> decorateName' w decorateName' :: Window -> X String decorateName' w = do show <$> getName w -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" -- | Brings selected window to the current workspace. bringSelected :: GSConfig Window -> X () bringSelected = withSelectedWindow $ \w -> do windows (bringWindow w) XMonad.focus w windows W.shiftMaster -- | Switches to selected window's workspace and focuses that window. goToSelected :: GSConfig Window -> X () goToSelected = withSelectedWindow $ windows . W.focusWindow -- | Select an application to spawn from a given list spawnSelected :: GSConfig String -> [String] -> X () spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn -- | Select an action and run it in the X monad runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X () runSelectedAction conf actions = do selectedActionM <- gridselect conf actions case selectedActionM of Just selectedAction -> selectedAction Nothing -> return () -- | Select a workspace and view it using the given function -- (normally 'W.view' or 'W.greedyView') -- -- Another option is to shift the current window to the selected workspace: -- -- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws) gridselectWorkspace :: GSConfig WorkspaceId -> (WorkspaceId -> WindowSet -> WindowSet) -> X () gridselectWorkspace conf viewFunc = gridselectWorkspace' conf (windows . viewFunc) -- | Select a workspace and run an arbitrary action on it. gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X () gridselectWorkspace' conf func = withWindowSet $ \ws -> do let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws) gridselect conf (zip wss wss) >>= flip whenJust func -- $rearrangers -- -- Rearrangers allow for arbitrary post-filter rearranging of the grid -- elements. -- -- For example, to be able to switch to a new dynamic workspace by typing -- in its name, you can use the following keybinding action: -- -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace) -- > -- > gridselectWorkspace' def -- > { gs_navigate = navNSearch -- > , gs_rearranger = searchStringRearrangerGenerator id -- > } -- > addWorkspace -- | A function taking the search string and a list of elements, and -- returning a potentially rearranged list of elements. type Rearranger a = String -> [(String, a)] -> X [(String, a)] -- | A rearranger that leaves the elements unmodified. noRearranger :: Rearranger a noRearranger _ = return -- | A generator for rearrangers that append a single element based on the -- search string, if doing so would not be redundant (empty string or value -- already present). searchStringRearrangerGenerator :: (String -> a) -> Rearranger a searchStringRearrangerGenerator f = let r "" xs = return xs r s xs | s `elem` map fst xs = return xs | otherwise = return $ xs ++ [(s, f s)] in r xmonad-contrib-0.18.0/XMonad/Actions/GroupNavigation.hs0000644000000000000000000002207507346545000021161 0ustar0000000000000000{-# language DeriveGeneric, DeriveAnyClass #-} ---------------------------------------------------------------------- -- | -- Module : XMonad.Actions.GroupNavigation -- Description : Cycle through groups of windows across workspaces. -- Copyright : (c) nzeh@cs.dal.ca -- License : BSD3-style (see LICENSE) -- -- Maintainer : nzeh@cs.dal.ca -- Stability : unstable -- Portability : unportable -- -- 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, and predefined groups. -- ---------------------------------------------------------------------- module XMonad.Actions.GroupNavigation ( -- * Usage -- $usage Direction (..) , nextMatch , nextMatchOrDo , nextMatchWithThis , historyHook -- * Utilities -- $utilities , isOnAnyVisibleWS ) where import Control.Monad.Reader (ask, asks) import Control.Monad.State (gets) import Control.DeepSeq import Data.Map ((!)) import qualified Data.Map as Map import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>)) import qualified Data.Sequence as Seq import qualified Data.Set as Set import Graphics.X11.Types import GHC.Generics import Prelude hiding (drop, elem, filter, null, reverse) import XMonad.Core import XMonad.ManageHook import XMonad.Operations (windows, withFocused) import XMonad.Prelude (elem, foldl', (>=>)) import qualified XMonad.StackSet as SS import qualified XMonad.Util.ExtensibleState as XS {- $usage Import the module into your @xmonad.hs@: > import XMonad.Actions.GroupNavigation To support cycling forward and backward through all xterm windows, add something like this to your keybindings: > , ((modm , xK_t), nextMatch Forward (className =? "XTerm")) > , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm")) These key combinations do nothing if there is no xterm window open. If you rather want to open a new xterm window if there is no open xterm window, use 'nextMatchOrDo' instead: > , ((modm , xK_t), nextMatchOrDo Forward (className =? "XTerm") (spawn "xterm")) > , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm")) You can use 'nextMatchWithThis' with an arbitrary query to cycle through all windows for which this query returns the same value as the current window. For example, to cycle through all windows in the same window class as the current window use: > , ((modm , xK_f), nextMatchWithThis Forward className) > , ((modm , xK_b), nextMatchWithThis Backward className) Finally, you can define keybindings to jump to the most recent window matching a certain Boolean query. To do this, you need to add 'historyHook' to your logHook: > main = xmonad $ def { logHook = historyHook } Then the following keybindings, for example, allow you to return to the most recent xterm or emacs window or to simply to the most recent window: > , ((modm .|. controlMask, xK_e), nextMatch History (className =? "Emacs")) > , ((modm .|. controlMask, xK_t), nextMatch History (className =? "XTerm")) > , ((modm , xK_BackSpace), nextMatch History (return True)) Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want to execute an action if no window matching the query exists. -} --- Basic cyclic navigation based on queries ------------------------- -- | The direction in which to look for the next match data Direction = Forward -- ^ Forward from current window or workspace | Backward -- ^ Backward from current window or workspace | History -- ^ Backward in history -- | Focuses the next window for which the given query produces the -- same result as the currently focused window. Does nothing if there -- is no focused window (i.e., the current workspace is empty). nextMatchWithThis :: Eq a => Direction -> Query a -> X () nextMatchWithThis dir qry = withFocused $ \win -> do prop <- runQuery qry win nextMatch dir (qry =? prop) -- | Focuses the next window that matches the given boolean query. -- Does nothing if there is no such window. This is the same as -- 'nextMatchOrDo' with alternate action @return ()@. nextMatch :: Direction -> Query Bool -> X () nextMatch dir qry = nextMatchOrDo dir qry (return ()) -- | Focuses the next window that matches the given boolean query. If -- there is no such window, perform the given action instead. nextMatchOrDo :: Direction -> Query Bool -> X () -> X () nextMatchOrDo dir qry act = orderedWindowList dir >>= focusNextMatchOrDo qry act -- Produces the action to perform depending on whether there's a -- matching window focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X () focusNextMatchOrDo qry act = findM (runQuery qry) >=> maybe act (windows . SS.focusWindow) -- Returns the list of windows ordered by workspace as specified in -- @xmonad.hs@. orderedWindowList :: Direction -> X (Seq Window) 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 $ foldl' (><) Seq.empty $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs cur = SS.peek ss return $ maybe wins (rotfun wins) cur where dirfun Backward = Seq.reverse dirfun _ = id rotfun wins x = rotate $ rotateTo (== x) wins -- Returns the ordered workspace list as specified in @xmonad.hs@. orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs' where wspcs = SS.workspaces ss wspcsMap = foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs wspcs' = fmap (wspcsMap !) wsids isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss) --- History navigation, requires a layout modifier ------------------- -- The state extension that holds the history information data HistoryDB = HistoryDB (Maybe Window) -- currently focused window (Seq Window) -- previously focused windows deriving (Read, Show, Generic, NFData) instance ExtensionClass HistoryDB where initialValue = HistoryDB Nothing Seq.empty extensionType = PersistentExtension -- | Action that needs to be executed as a logHook to maintain the -- focus history of all windows as the WindowSet changes. historyHook :: X () historyHook = (XS.put $!) . force =<< updateHistory =<< XS.get -- Updates the history in response to a WindowSet change updateHistory :: HistoryDB -> X HistoryDB updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> let newcur = SS.peek ss wins = Set.fromList $ SS.allWindows ss newhist = Seq.filter (`Set.member` wins) (ins oldcur oldhist) in pure $ HistoryDB newcur (del newcur newhist) where ins x xs = maybe xs (<| xs) x del x xs = maybe xs (\x' -> Seq.filter (/= x') xs) x --- Some sequence helpers -------------------------------------------- -- Rotates the sequence by one position rotate :: Seq a -> Seq a rotate xs = rotate' (viewl xs) where rotate' EmptyL = Seq.empty rotate' (x' :< xs') = xs' |> x' -- 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) = Seq.breakl cond xs in rxs >< lxs --- A monadic find --------------------------------------------------- -- Applies the given action to every sequence element in turn until -- the first element is found for which the action returns true. The -- remaining elements in the sequence are ignored. findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a) findM cond xs = findM' cond (viewl xs) where findM' _ EmptyL = return Nothing findM' qry (x' :< xs') = do isMatch <- qry x' if isMatch then return (Just x') else findM qry xs' -- $utilities -- #utilities# -- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo', -- and 'nextMatchWithThis'. -- | A query that matches all windows on visible workspaces. This is -- useful for configurations with multiple screens, and matches even -- invisible windows. isOnAnyVisibleWS :: Query Bool isOnAnyVisibleWS = do w <- ask ws <- liftX $ gets windowset let allVisible = concatMap (maybe [] SS.integrate . SS.stack . SS.workspace) (SS.current ws:SS.visible ws) visibleWs = w `elem` allVisible unfocused = Just w /= SS.peek ws return $ visibleWs && unfocused xmonad-contrib-0.18.0/XMonad/Actions/KeyRemap.hs0000644000000000000000000001346307346545000017563 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.KeyRemap -- Description : Remap Keybinding on the fly. -- Copyright : (c) Christian Dietrich -- License : BSD-style (as xmonad) -- -- Maintainer : stettberger@dokucde.de -- Stability : unstable -- Portability : unportable -- -- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift -- is left us Layout -- ----------------------------------------------------------------------------- module XMonad.Actions.KeyRemap ( -- * Usage -- $usage setKeyRemap, buildKeyRemapBindings, setDefaultKeyRemap, KeymapTable (KeymapTable), emptyKeyRemap, dvorakProgrammerKeyRemap ) where import XMonad import XMonad.Prelude import XMonad.Util.Paste import qualified XMonad.Util.ExtensibleState as XS newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Show) instance ExtensionClass KeymapTable where initialValue = KeymapTable [] -- $usage -- Provides the possibility to remap parts of the keymap to generate different keys -- -- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout -- after all -- -- First, you must add all possible keybindings for all layout you want to use: -- -- > keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap] -- -- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the -- empty keyremap (no remapping is done) as default after startup): -- -- > myStartupHook :: X() -- > myStartupHook = do -- > setWMName "LG3D" -- > setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap] -- -- Then you add keybindings for changing keyboard layouts; -- -- > , ((0 , xK_F1 ), setKeyRemap emptyKeyRemap) -- > , ((0 , xK_F2 ), setKeyRemap dvorakProgrammerKeyRemap) -- -- When defining your own keymappings, please be aware of: -- -- * If you want to emulate a key that is shifted on us you must emulate that keypress: -- -- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%' -- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5' -- -- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate -- the KeymapTable -- -- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap -- are nessesary doKeyRemap :: KeyMask -> KeySym -> X() doKeyRemap mask sym = do table <- XS.get let (insertMask, insertSym) = extractKeyMapping table mask sym sendKey insertMask insertSym -- | Using this in the keybindings to set the actual Key Translation table setKeyRemap :: KeymapTable -> X() setKeyRemap table = do let KeymapTable newtable = table KeymapTable oldtable <- XS.get XConf { display = dpy, theRoot = rootw } <- ask let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync let ungrab kc m = io $ ungrabKey dpy kc m rootw forM_ oldtable $ \((mask, sym), _) -> do kc <- io $ keysymToKeycode dpy sym -- "If the specified KeySym is not defined for any KeyCode, -- XKeysymToKeycode() returns zero." when (kc /= 0) $ ungrab kc mask forM_ newtable $ \((mask, sym), _) -> do kc <- io $ keysymToKeycode dpy sym -- "If the specified KeySym is not defined for any KeyCode, -- XKeysymToKeycode() returns zero." when (kc /= 0) $ grab kc mask XS.put table -- | Adding this to your startupHook, to select your default Key Translation table. -- You also must give it all the KeymapTables you are willing to use setDefaultKeyRemap :: KeymapTable -> [KeymapTable] -> X() setDefaultKeyRemap dflt keyremaps = do XS.put (KeymapTable mappings) setKeyRemap dflt where mappings = nub (keyremaps >>= \(KeymapTable table) -> table) extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym) extractKeyMapping (KeymapTable table) mask sym = insertKey filtered where filtered = filter (\((m, s),_) -> m == mask && s == sym) table insertKey [] = (mask, sym) insertKey ((_, to):_) = to -- | Append the output of this function to your keybindings with ++ buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())] buildKeyRemapBindings keyremaps = [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings] where mappings = concatMap (\(KeymapTable table) -> table) keyremaps bindings = nub (map fst mappings) -- Here come the Keymappings -- | The empty KeymapTable, does no translation emptyKeyRemap :: KeymapTable emptyKeyRemap = KeymapTable [] -- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers dvorakProgrammerKeyRemap :: KeymapTable dvorakProgrammerKeyRemap = KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) | (maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey] where layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym] layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./" :: [KeySym] layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111" layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym] layoutDvorakShift = map getShift layoutDvorak layoutDvorakKey = map getKey layoutDvorak getKey char = fromJust $ (layoutUsKey !?) =<< elemIndex char layoutUs getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs charToMask char = if [char] == "0" then 0 else shiftMask xmonad-contrib-0.18.0/XMonad/Actions/Launcher.hs0000644000000000000000000001102007346545000017572 0ustar0000000000000000{- | Module : XMonad.Actions.Launcher Description : A set of prompts for XMonad. Copyright : (C) 2012 Carlos López-Camey License : None; public domain Maintainer : Stability : unstable A set of prompts for XMonad -} module XMonad.Actions.Launcher( -- * Description and use -- $description defaultLauncherModes , ExtensionActions , LauncherConfig(..) , launcherPrompt ) where import qualified Data.Map as M import XMonad hiding (config) import XMonad.Prelude import XMonad.Prompt import XMonad.Util.Run {- $description This module exemplifies usage of `XMonad.Prompt.mkXPromptWithModes`. It includes two modes: * Hoogle mode: Search for functions using hoogle, choosing a function leads you to documentation in Haddock. * Calc: Uses the program calc to do calculations. To test it, modify your local .xmonad: > import XMonad.Prompt(def) > import XMonad.Actions.Launcher > ((modm .|. controlMask, xK_l), launcherPrompt def $ defaultLauncherModes launcherConfig) A LauncherConfig contains settings for the default modes, modify them accordingly. > launcherConfig = LauncherConfig { pathToHoogle = "/home/YOU/.cabal/bin/hoogle" , browser = "firefox"} Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up. If you used the default 'XPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'. -} data HoogleMode = HMode FilePath String --path to hoogle and browser data CalculatorMode = CalcMode data LauncherConfig = LauncherConfig { browser :: String , pathToHoogle :: String } type ExtensionActions = M.Map String (String -> X()) -- | Uses the command `calc` to compute arithmetic expressions instance XPrompt CalculatorMode where showXPrompt CalcMode = "calc %s> " commandToComplete CalcMode = id --send the whole string to `calc` completionFunction CalcMode s = if null s then return [] else lines <$> runProcessWithInput "calc" [s] "" modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard -- | Uses the program `hoogle` to search for functions instance XPrompt HoogleMode where showXPrompt _ = "hoogle %s> " commandToComplete _ = id completionFunction (HMode pathToHoogleBin' _) s = completionFunctionWith pathToHoogleBin' ["--count","8",s] -- This action calls hoogle again to find the URL corresponding to the autocompleted item modeAction (HMode pathToHoogleBin'' browser') query result = do completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query] let link = do s <- find (isJust . \complStr -> findSeqIndex complStr result) completionsWithLink i <- findSeqIndex s "http://" return $ drop i s case link of Just l -> spawn $ browser' ++ " " ++ l _ -> return () where -- | Receives a sublist and a list. It returns the index where the sublist appears in the list. findSeqIndex :: (Eq a) => [a] -> [a] -> Maybe Int findSeqIndex xs xss = findIndex (isPrefixOf xss) $ tails xs -- | 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 = lines <$> runProcessWithInput cmd args "" -- | Creates a prompt with the given modes launcherPrompt :: XPConfig -> [XPMode] -> X() launcherPrompt config modes = mkXPromptWithModes modes config -- | Create a list of modes based on : -- a list of extensions mapped to actions -- the path to hoogle defaultLauncherModes :: LauncherConfig -> [XPMode] defaultLauncherModes cnf = let ph = pathToHoogle cnf in [ hoogleMode ph $ browser cnf , calcMode] hoogleMode :: FilePath -> String -> XPMode hoogleMode pathToHoogleBin browser' = XPT $ HMode pathToHoogleBin browser' calcMode :: XPMode calcMode = XPT CalcMode {- -- ideas for XMonad.Prompt running on mode XPMultipleModes * Switch to mode by name of the prompt, 1. ':' at an empty(?) buffer, 2. autocomplete name in buffer should happen, 3. switch to mode with enter (cancel switch with C-g) * Support for actions of type String -> X a -- ideas for this module * Hoogle mode: add a setting in the action to either go to documentation or to the source code (needs hoogle change?) * Hoogle mode: add setting to query hoogle at haskell.org instead (with &mode=json) -} xmonad-contrib-0.18.0/XMonad/Actions/LinkWorkspaces.hs0000644000000000000000000001731707346545000021007 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.LinkWorkspaces -- Description : Bindings to add and delete links between workspaces. -- Copyright : (c) Jan-David Quesel -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.LinkWorkspaces ( -- * Usage -- $usage switchWS, removeAllMatchings, unMatch, toggleLinkWorkspaces, defaultMessageConf, MessageConfig(..) ) 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) import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen') import qualified Data.Map as M ( insert, delete, Map, lookup, empty, filter ) -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.LinkWorkspaces -- -- and add a function to print messages like -- -- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1) -- > message_color_func c1 c2 msg = dzenColor c1 c2 msg -- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen -- -- alternatively you can use the noMessages function as the argument -- -- Then add keybindings like the following: -- -- > ,((modm, xK_p), toggleLinkWorkspaces message) -- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message) -- -- > [ ((modm .|. m, k), a i) -- > | (a, m) <- [(switchWS (\y -> windows $ view y) message, 0),(switchWS (\x -> windows $ shift x . view x) message, shiftMask)] -- > , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] -- -- For detailed instructions on editing your key bindings, see -- . data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X() , foreground :: [Char] , alertedForeground :: [Char] , background :: [Char] } defaultMessageConf :: MessageConfig defaultMessageConf = MessageConfig { messageFunction = noMessageFn , background = "#000000" , alertedForeground = "#ff7701" , foreground = "#00ff00" } noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X() noMessageFn _ _ _ _ = return () :: X () -- | Stuff for linking workspaces newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show) instance ExtensionClass WorkspaceMap where initialValue = WorkspaceMap M.empty extensionType = PersistentExtension switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X () switchWS f m ws = switchWS' f m ws Nothing -- | 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' switchFn message workspace stopAtScreen = do ws <- gets windowset nScreens <- countScreens let now = W.screen (W.current ws) let next = (now + 1) `mod` nScreens switchFn workspace case stopAtScreen of Nothing -> sTM now next (Just now) Just sId -> if sId == next then return () else sTM now next (Just sId) where sTM = switchToMatching (switchWS' switchFn message) message workspace -- | 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 f message t now next stopAtScreen = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap case M.lookup t matchings of Nothing -> return () :: X() Just newWorkspace -> do 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 Nothing -> setMatching message t1 t2 matchings Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings return () -- | Insert a mapping between t1 and t2 and display a message setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X () setMatching message t1 t2 matchings = do ws <- gets windowset let now = W.screen (W.current ws) XS.put $ WorkspaceMap $ M.insert t1 t2 matchings messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2)) -- currently this function is called manually this means that if workspaces -- were deleted, some links stay in the RAM even though they are not used -- anymore... because of the small amount of memory used for those there is no -- special cleanup so far removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X () removeMatching' message t1 t2 matchings = do ws <- gets windowset let now = W.screen (W.current ws) XS.put $ WorkspaceMap $ M.delete t1 matchings messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2) -- | Remove all maps between workspaces removeAllMatchings :: MessageConfig -> X () removeAllMatchings message = do ws <- gets windowset let now = W.screen (W.current ws) XS.put $ WorkspaceMap M.empty messageFunction message now (alertedForeground message) (background message) "All links removed!" -- | remove all matching regarding a given workspace unMatch :: WorkspaceId -> X () unMatch workspace = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings) -- | Toggle the currently displayed workspaces as matching. Starting from the one with focus -- | a linked list of workspaces is created that will later be iterated by switchToMatching. toggleLinkWorkspaces :: MessageConfig -> X () toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X () toggleLinkWorkspaces' first message = do ws <- gets windowset nScreens <- countScreens 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 for_ (W.lookupWorkspace next ws) (toggleMatching message (W.currentTag ws)) onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next xmonad-contrib-0.18.0/XMonad/Actions/MessageFeedback.hs0000644000000000000000000002365607346545000021044 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MessageFeedback -- Description : An alternative @sendMessage@. -- Copyright : (c) -- Quentin Moser -- 2018 Yclept Nemo -- License : BSD3 -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge -- of whether the message was handled, and utility functions based on -- this facility. ----------------------------------------------------------------------------- module XMonad.Actions.MessageFeedback ( -- * Usage -- $usage -- * Messaging variants -- ** 'SomeMessage' sendSomeMessageB, sendSomeMessage , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent -- ** 'Message' , sendMessageB , sendMessageWithNoRefreshB , sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent -- * Utility Functions -- ** Send All , sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages -- ** Send Until , tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent , tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent -- ** Aliases , sm ) where import XMonad ( Window ) import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust ) import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet ) import XMonad.Prelude import XMonad.StackSet ( Workspace, current, workspace, layout, tag ) import Control.Monad.State ( gets ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.MessageFeedback -- -- You can then use this module's functions wherever an action is expected. All -- feedback variants are supported: -- -- * message to any workspace with no refresh -- * message to current workspace with no refresh -- * message to current workspace with refresh -- -- Except "message to any workspace with refresh" which makes little sense. -- -- Note that most functions in this module have a return type of @X Bool@ -- whereas configuration options will expect a @X ()@ action. For example, the -- key binding: -- -- > -- Shrink the master area of a tiled layout, or move the focused window -- > -- to the left in a WindowArranger-based layout -- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50)) -- -- is mis-typed. For this reason, this module provides alternatives (not ending -- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than -- 'sendMessageB') that discard their boolean result and return an @X ()@. For -- example, to correct the previous example: -- -- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50)) -- -- This module also provides 'SomeMessage' variants of each 'Message' function -- for when the messages are of differing types (but still instances of -- 'Message'). First box each message using 'SomeMessage' or the convenience -- alias 'sm'. Then, for example, to send each message: -- -- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB] -- -- This is /not/ equivalent to the following example, which will not refresh -- the workspace unless the last message is handled: -- -- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB -- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use -- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled, -- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB' -- for efficiency this is pretty much an exact copy of the -- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'. sendSomeMessageB :: SomeMessage -> X Bool sendSomeMessageB m = windowBracket id $ do w <- gets ((workspace . current) . windowset) ml <- handleMessage (layout w) m `catchX` return Nothing whenJust ml $ \l -> modifyWindowSet $ \ws -> ws { current = (current ws) { workspace = (workspace $ current ws) { layout = l }}} return $ isJust ml -- | Variant of 'sendSomeMessageB' that discards the result. sendSomeMessage :: SomeMessage -> X () sendSomeMessage = void . sendSomeMessageB -- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts -- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns -- @True@ if the message was handled, @False@ otherwise. sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool sendSomeMessageWithNoRefreshB m w = handleMessage (layout w) m `catchX` return Nothing >>= liftA2 (>>) (updateLayout $ tag w) (return . isJust) -- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result. sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X () sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m -- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the -- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see -- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was -- handled, @False@ otherwise. This function is somewhat of a cross between -- 'XMonad.Operations.sendMessage' (sends to the current layout) and -- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh). sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool sendSomeMessageWithNoRefreshToCurrentB m = gets (workspace . current . windowset) >>= sendSomeMessageWithNoRefreshB m -- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the -- result. sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X () sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB -- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage' -- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message -- was handled, @False@ otherwise. sendMessageB :: Message a => a -> X Bool sendMessageB = sendSomeMessageB . SomeMessage -- | Variant of 'sendSomeMessageWithNoRefreshB' which like -- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than -- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise. sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage -- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts -- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was -- handled, @False@ otherwise. sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage -- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result. sendMessageWithNoRefreshToCurrent :: Message a => a -> X () sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB -- | Send each 'SomeMessage' to the current layout without refresh (using -- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any -- message was handled, refresh. If you want to sequence a series of messages -- that would have otherwise used 'XMonad.Operations.sendMessage' while -- minimizing refreshes, use this. sendSomeMessagesB :: [SomeMessage] -> X [Bool] sendSomeMessagesB = windowBracket or . mapM sendSomeMessageWithNoRefreshToCurrentB -- | Variant of 'sendSomeMessagesB' that discards the results. sendSomeMessages :: [SomeMessage] -> X () sendSomeMessages = void . sendSomeMessagesB -- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than -- 'SomeMessage'. Use this if all the messages are of the same type. sendMessagesB :: Message a => [a] -> X [Bool] sendMessagesB = sendSomeMessagesB . map SomeMessage -- | Variant of 'sendMessagesB' that discards the results. sendMessages :: Message a => [a] -> X () sendMessages = void . sendMessagesB -- | Apply the dispatch function in order to each message of the list until one -- is handled. Returns @True@ if so, @False@ otherwise. tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool tryInOrderB _ [] = return False tryInOrderB f (m:ms) = do b <- f m if b then return True else tryInOrderB f ms -- | Variant of 'tryInOrderB' that sends messages to the current layout without -- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'. tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB -- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results. tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X () tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB -- | Apply the dispatch function to the first message, and if it was not -- handled, apply it to the second. Returns @True@ if either message was -- handled, @False@ otherwise. tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2] -- | Variant of 'tryMessageB' that sends messages to the current layout without -- refresh using 'sendMessageWithNoRefreshToCurrentB'. tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB -- | Variant of 'tryMessage' that discards the results. tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X () tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m -- | Convenience shorthand for 'SomeMessage'. sm :: Message a => a -> SomeMessage sm = SomeMessage xmonad-contrib-0.18.0/XMonad/Actions/Minimize.hs0000644000000000000000000001265507346545000017631 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Minimize -- Description : Actions for minimizing and maximizing windows. -- Copyright : (c) Bogdan Sinitsyn (2016) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Bogdan Sinitsyn -- Stability : unstable -- Portability : not portable -- -- Adds actions for minimizing and maximizing windows -- -- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your -- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from -- this module -- -- Possible keybindings: -- -- > , ((modm, xK_m ), withFocused minimizeWindow) -- > , ((modm .|. shiftMask, xK_m ), withLastMinimized maximizeWindowAndFocus) -- ----------------------------------------------------------------------------- module XMonad.Actions.Minimize ( -- * Usage -- $usage minimizeWindow , maximizeWindow , maximizeWindowAndFocus , withLastMinimized , withLastMinimized' , withFirstMinimized , withFirstMinimized' , withMinimized ) where import XMonad import XMonad.Prelude (fromMaybe, join, listToMaybe) import qualified XMonad.StackSet as W import qualified XMonad.Layout.BoringWindows as BW import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Minimize import XMonad.Util.WindowProperties (getProp32) import Foreign.C.Types (CLong) import qualified Data.List as L import qualified Data.Map as M -- $usage -- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows": -- -- > import XMonad.Actions.Minimize -- > import XMonad.Layout.Minimize -- > import qualified XMonad.Layout.BoringWindows as BW -- -- Then apply 'minimize' and 'boringWindows' to your layout hook and use some -- actions from this module: -- -- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever } -- -- Example keybindings: -- -- > , ((modm, xK_m ), withFocused minimizeWindow ) -- > , ((modm .|. shiftMask, xK_m ), withLastMinimized maximizeWindow) setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X () setMinimizedState win st f = do setWMState win st withDisplay $ \dpy -> do wm_state <- getAtom "_NET_WM_STATE" hidden <- fromIntegral <$> getAtom "_NET_WM_STATE_HIDDEN" wstate <- fromMaybe [] <$> getProp32 wm_state win io $ changeProperty32 dpy win wm_state aTOM propModeReplace (f hidden wstate) setMinimized :: Window -> X () setMinimized win = setMinimizedState win iconicState (:) setNotMinimized :: Window -> X () setNotMinimized win = setMinimizedState win normalState L.delete -- It does not just set minimizedStack to newWindows because it should save -- order in which elements were added (newer first) modified :: (RectMap -> RectMap) -> X Bool modified f = XS.modified $ \Minimized { rectMap = oldRectMap, minimizedStack = oldStack } -> let newRectMap = f oldRectMap newWindows = M.keys newRectMap in Minimized { rectMap = newRectMap , minimizedStack = (newWindows L.\\ oldStack) ++ (oldStack `L.intersect` newWindows) } -- | Minimize a window minimizeWindow :: Window -> X () minimizeWindow w = withWindowSet $ \ws -> whenX (modified $ M.insert w (M.lookup w $ W.floating ws)) $ do setMinimized w windows $ W.sink w BW.focusDown -- | Maximize window and apply a function to maximized window and 'WindowSet' maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X () maximizeWindowAndChangeWSet f w = do mrect <- XS.gets (join . M.lookup w . rectMap) whenX (modified $ M.delete w) $ do setNotMinimized w broadcastMessage BW.UpdateBoring windows $ f w . maybe id (W.float w) mrect -- | Just maximize a window without focusing maximizeWindow :: Window -> X () maximizeWindow = maximizeWindowAndChangeWSet $ const id -- | Maximize a window and then focus it maximizeWindowAndFocus :: Window -> X () maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow -- | Perform an action with first minimized window on current workspace -- or do nothing if there is no minimized windows on current workspace withFirstMinimized :: (Window -> X ()) -> X () withFirstMinimized action = withFirstMinimized' (`whenJust` action) -- | Like withFirstMinimized but the provided action is always invoked with a -- 'Maybe Window', that will be nothing if there is no first minimized window. withFirstMinimized' :: (Maybe Window -> X ()) -> X () withFirstMinimized' action = withMinimized (action . listToMaybe . reverse) -- | Perform an action with last minimized window on current workspace -- or do nothing if there is no minimized windows on current workspace withLastMinimized :: (Window -> X ()) -> X () 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. withLastMinimized' :: (Maybe Window -> X ()) -> X () withLastMinimized' action = withMinimized (action . listToMaybe) withMinimized :: ([Window] -> X a) -> X a withMinimized action = do minimized <- XS.gets minimizedStack currentStack <- withWindowSet $ return . W.index action $ minimized `L.intersect` currentStack xmonad-contrib-0.18.0/XMonad/Actions/MostRecentlyUsed.hs0000644000000000000000000001437407346545000021321 0ustar0000000000000000{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MostRecentlyUsed -- Description : Tab through windows by recency of use. -- Copyright : (c) 2022 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Maintainer : @LSLeary (on github) -- Stability : unstable -- Portability : unportable -- -- Based on the Alt+Tab behaviour common outside of xmonad. -- ----------------------------------------------------------------------------- -- --< Imports & Exports >-- {{{ module XMonad.Actions.MostRecentlyUsed ( -- * Usage -- $usage -- * Interface configureMRU, mostRecentlyUsed, withMostRecentlyUsed, Location(..), ) where -- base import Data.List.NonEmpty (nonEmpty) import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef) import Control.Monad.IO.Class (MonadIO) -- mtl import Control.Monad.Trans (lift) import Control.Monad.State (get, put, gets) -- containers import qualified Data.Map.Strict as M -- xmonad import XMonad ( Window, KeySym, keyPress, io , Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window) ) import XMonad.Core ( X, XConfig(..), windowset, WorkspaceId, ScreenId , ExtensionClass(..), StateExtension(..) , waitingUnmap ) import XMonad.Operations (screenWorkspace) import qualified XMonad.StackSet as W -- xmonad-contrib import qualified XMonad.Util.ExtensibleConf as XC import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.PureX (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow) import XMonad.Util.History (History, origin, event, erase, ledger) import XMonad.Actions.Repeatable (repeatableSt) import XMonad.Prelude -- }}} -- --< Core Data Types: WindowHistory & Location >-- {{{ data WindowHistory = WinHist { busy :: !Bool , hist :: !(History Window Location) } deriving (Show, Read) instance ExtensionClass WindowHistory where initialValue = WinHist { busy = False , hist = origin } extensionType = PersistentExtension data Location = Location { workspace :: !WorkspaceId , screen :: !ScreenId } deriving (Show, Read, Eq, Ord) -- }}} -- --< Interface >-- {{{ -- $usage -- -- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed' -- to work. -- -- > main :: IO () -- > main = xmonad . configureMRU . ... $ def -- > { ... -- > } -- -- Once that's done, it can be used normally in keybinds: -- -- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab) -- -- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not -- always the case, depending on how your system is configured. -- | Configure xmonad to support 'mostRecentlyUsed'. configureMRU :: XConfig l -> XConfig l configureMRU = XC.once f (MRU ()) where f cnf = cnf { logHook = logHook cnf <> logWinHist , handleEventHook = handleEventHook cnf <> winHistEH } newtype MRU = MRU () deriving Semigroup -- | An action to browse through the history of focused windows, taking -- another step back with each tap of the key. mostRecentlyUsed :: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the -- action is bound. -> KeySym -- ^ The 'KeySym' corresponding to the key to which the action -- is bound. -> X () mostRecentlyUsed mods key = do (toUndo, undo) <- undoer let undoably curThing withThing thing = curThing >>= \cur -> when (cur /= thing) $ withThing thing >> toUndo (withThing cur) withMostRecentlyUsed mods key $ \win Location{workspace,screen} -> handlingRefresh $ do undo undoably curScreenId viewScreen screen undoably curTag greedyView workspace mi <- gets (W.findTag win . windowset) for_ mi $ \i -> do undoably curTag greedyView i mfw <- peek for_ mfw $ \fw -> do undoably (pure fw) focusWindow win where undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a) undoer = do ref <- io . newIORef $ pure mempty let toUndo = io . modifyIORef ref . liftA2 (<>) undo = join (io $ readIORef ref) <* io (writeIORef ref $ pure mempty) pure (toUndo, undo) viewScreen :: ScreenId -> X Any viewScreen scr = screenWorkspace scr >>= foldMap view -- | A version of 'mostRecentlyUsed' that allows you to customise exactly what -- is done with each window you tab through (the default being to visit its -- previous 'Location' and give it focus). withMostRecentlyUsed :: [KeySym] -- ^ The 'KeySym's corresponding to the -- modifier to which the action is bound. -> KeySym -- ^ The 'KeySym' corresponding to the key to -- which the action is bound. -> (Window -> Location -> X ()) -- ^ The function applied to each window. -> X () withMostRecentlyUsed mods tab preview = do wh@WinHist{busy,hist} <- XS.get unless busy $ do XS.put wh{ busy = True } for_ (nonEmpty $ ledger hist) $ \ne -> do mfw <- gets (W.peek . windowset) let iSt = case cycleS ne of (w, _) :~ s | mfw == Just w -> s s -> s repeatableSt iSt mods tab $ \t s -> when (t == keyPress && s == tab) (pop >>= lift . uncurry preview) XS.modify $ \ws@WinHist{} -> ws{ busy = False } logWinHist where pop = do h :~ t <- get put t $> h -- }}} -- --< Raw Config >-- {{{ logWinHist :: X () logWinHist = do wh@WinHist{busy,hist} <- XS.get unless busy $ do cs <- gets (W.current . windowset) let cws = W.workspace cs for_ (W.stack cws) $ \st -> do let location = Location{ workspace = W.tag cws, screen = W.screen cs } XS.put wh{ hist = event (W.focus st) location hist } winHistEH :: Event -> X All winHistEH ev = All True <$ case ev of UnmapEvent{ ev_send_event = synth, ev_window = w } -> do e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) when (synth || e == 0) (collect w) DestroyWindowEvent{ ev_window = w } -> collect w _ -> pure () where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist } -- }}} xmonad-contrib-0.18.0/XMonad/Actions/MouseGestures.hs0000644000000000000000000001031207346545000020646 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MouseGestures -- Description : Support for simple mouse gestures. -- Copyright : (c) Lukas Mai -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Support for simple mouse gestures. -- ----------------------------------------------------------------------------- module XMonad.Actions.MouseGestures ( -- * Usage -- $usage Direction2D(..), mouseGestureH, mouseGesture, 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) -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.MouseGestures -- > import qualified XMonad.StackSet as W -- -- then add an appropriate mouse binding: -- -- > , ((modm .|. shiftMask, button3), mouseGesture gestures) -- -- where @gestures@ is a 'Data.Map.Map' from gestures to actions on -- windows, for example: -- -- > gestures = M.fromList -- > [ ([], focus) -- > , ([U], \w -> focus w >> windows W.swapUp) -- > , ([D], \w -> focus w >> windows W.swapDown) -- > , ([R, D], \_ -> sendMessage NextLayout) -- > ] -- -- This is just an example, of course; you can use any mouse button and -- gesture definitions you want. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". type Pos = (Position, Position) delta :: Pos -> Pos -> Position delta (ax, ay) (bx, by) = max (d ax bx) (d ay by) where d a b = abs (a - b) dir :: Pos -> Pos -> Direction2D dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax) where trans :: Double -> Direction2D trans x | rg (-3/4) (-1/4) x = D | rg (-1/4) (1/4) x = R | rg (1/4) (3/4) x = U | otherwise = L rg a z x = a <= x && x < z gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X () gauge hook op st nx ny = do let np = (nx, ny) stx <- io $ readIORef st let pivot = maybe op snd stx when (significant np pivot) $ do let d' = dir pivot np when ((fst <$> stx) /= Just d') $ hook d' io $ writeIORef st (Just (d', np)) where significant a b = delta a b >= 10 -- | @'mouseGestureH' moveHook endHook@ is a mouse button -- event handler. It collects mouse movements, calling @moveHook@ for each -- update; when the button is released, it calls @endHook@. mouseGestureH :: (Direction2D -> X ()) -> X () -> X () mouseGestureH moveHook endHook = do dpy <- asks display root <- asks theRoot (pos, acc) <- io $ do (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root r <- newIORef Nothing return ((fromIntegral ix, fromIntegral iy), r) mouseDrag (gauge moveHook pos acc) endHook -- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to -- look up the mouse gesture, then executes the corresponding action (if any). mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X () mouseGesture tbl win = do (mov, end) <- mkCollect mouseGestureH (void . mov) $ end >>= \gest -> case M.lookup gest tbl of Nothing -> return () Just f -> f win -- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two -- callback functions for passing to 'mouseGestureH'. The move hook will -- collect mouse movements (and return the current gesture as a list); the end -- hook will return a list of the completed gesture, which you can access with -- 'Control.Monad.>>='. mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D]) mkCollect = liftIO $ do acc <- newIORef [] let mov d = liftIO $ do ds <- readIORef acc let ds' = d : ds writeIORef acc ds' return $ reverse ds' end = liftIO $ do ds <- readIORef acc writeIORef acc [] return $ reverse ds return (mov, end) xmonad-contrib-0.18.0/XMonad/Actions/MouseResize.hs0000644000000000000000000001231107346545000020307 0ustar0000000000000000{-# 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier to resize windows with the mouse by grabbing the -- window's lower right corner. -- -- This module must be used together with "XMonad.Layout.WindowArranger". ----------------------------------------------------------------------------- module XMonad.Actions.MouseResize ( -- * Usage: -- $usage mouseResize , MouseResize (..) ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils -- $usage -- Usually this module is used to create layouts, but you can also use -- it to resize windows in any layout, together with the -- "XMonad.Layout.WindowArranger". For usage example see -- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness". -- -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Actions.MouseResize -- > import XMonad.Layout.WindowArranger -- -- Then edit your @layoutHook@ by modifying a given layout: -- -- > myLayout = mouseResize $ windowArrange $ layoutHook def -- -- and then: -- -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". mouseResize :: l a -> ModifiedLayout MouseResize l a mouseResize = ModifiedLayout (MR []) newtype MouseResize a = MR [((a,Rectangle),Maybe a)] instance Show (MouseResize a) where show _ = "" instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)] instance LayoutModifier MouseResize Window where redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout (MR st) _ (Just s) wrs | [] <- st = initState >>= \nst -> return (wrs, Just $ MR nst) | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst) where wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs initState = 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 wrs_to_state rs ((w,r):xs) | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs | otherwise = ((w,r),Nothing) : wrs_to_state (r: rs) xs where ir = inputRectangle r wrs_to_state _ [] = [] handleMess (MR s) m | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing | Just Hide <- fromMessage m = releaseResources >> return (Just $ MR []) | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR []) where releaseResources = mapM_ (deleteInputWin . snd) s handleMess _ _ = return Nothing handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X () handleResize st ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress , Just (w,Rectangle wx wy _ _) <- getWin ew st = do focus w mouseDrag (\x y -> do let rect = Rectangle wx wy (max 1 . fi $ x - wx) (max 1 . fi $ y - wy) sendMessage (SetGeometry rect)) (return ()) where getWin w (((win,r),tw):xs) | Just w' <- tw , w == w' = Just (win,r) | otherwise = getWin w xs getWin _ [] = Nothing handleResize _ _ = return () createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window) createInputWindow ((w,r),mr) = case mr of Just tr -> withDisplay $ \d -> do tw <- mkInputWindow d tr io $ selectInput d tw (exposureMask .|. buttonPressMask) cursor <- io $ createFontCursor d xC_bottom_right_corner io $ defineCursor d tw cursor io $ freeCursor d cursor showWindow tw return ((w,r), Just tw) Nothing -> return ((w,r), Nothing) deleteInputWin :: Maybe Window -> X () deleteInputWin = maybe (return ()) deleteWindow mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do rw <- asks theRoot let screen = defaultScreenOfDisplay d visual = defaultVisualOfScreen screen attrmask = cWOverrideRedirect io $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes xmonad-contrib-0.18.0/XMonad/Actions/Navigation2D.hs0000644000000000000000000014013407346545000020327 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Navigation2D -- Description : Directional navigation of windows and screens. -- Copyright : (c) 2011 Norbert Zeh -- License : BSD3-style (see LICENSE) -- -- Maintainer : Norbert Zeh -- Stability : unstable -- Portability : unportable -- -- Navigation2D is an xmonad extension that allows easy directional -- navigation of windows and screens (in a multi-monitor setup). ----------------------------------------------------------------------------- module XMonad.Actions.Navigation2D ( -- * Usage -- $usage -- * Finer points -- $finer_points -- * Alternative directional navigation modules -- $alternatives -- * Incompatibilities -- $incompatibilities -- * Detailed technical discussion -- $technical -- * Exported functions and types -- #Exports# navigation2D , navigation2DP , additionalNav2DKeys , additionalNav2DKeysP , withNavigation2DConfig , Navigation2DConfig(..) , def , Navigation2D , lineNavigation , centerNavigation , sideNavigation , sideNavigationWithBias , hybridOf , fullScreenRect , singleWindowRect , switchLayer , windowGo , windowSwap , windowToScreen , screenGo , screenSwap , Direction2D(..) ) where import qualified Data.List as L import qualified Data.Map as M import Control.Arrow (second) import XMonad.Prelude import XMonad hiding (Screen) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.EZConfig (additionalKeys, additionalKeysP) import XMonad.Util.Types import qualified Data.List.NonEmpty as NE -- $usage -- #Usage# -- Navigation2D provides directional navigation (go left, right, up, down) for -- windows and screens. It treats floating and tiled windows as two separate -- layers and provides mechanisms to navigate within each layer and to switch -- between layers. Navigation2D provides three different navigation strategies -- (see <#Technical_Discussion> for details): /Line navigation/ and -- /Side navigation/ feel rather natural but may make it impossible to navigate -- to a given window from the current window, particularly in the floating -- layer. /Center navigation/ feels less natural in certain situations but -- ensures that all windows can be reached without the need to involve the -- mouse. Another option is to use a /Hybrid/ of the three strategies, -- automatically choosing whichever first provides a suitable target window. -- Navigation2D allows different navigation strategies to be used in the two -- layers and allows customization of the navigation strategy for the tiled -- layer based on the layout currently in effect. -- -- You can use this module with (a subset of) the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Navigation2D -- -- Then add the configuration of the module to your main function: -- -- > main = xmonad $ navigation2D def -- > (xK_Up, xK_Left, xK_Down, xK_Right) -- > [(mod4Mask, windowGo ), -- > (mod4Mask .|. shiftMask, windowSwap)] -- > False -- > $ def -- -- /NOTE/: the @def@ argument to 'navigation2D' contains the strategy -- that decides which windows actually get selected. While the default -- behaviour tries to keep them into account, if you use modules that -- influence tiling in some way, like "XMonad.Layout.Spacing" or -- "XMonad.Layout.Gaps", you should think about using a different -- strategy, if you find the default behaviour to be unnatural. Check -- out the [finer points](#g:Finer_Points) below for more information. -- -- Alternatively to 'navigation2D', you can use 'navigation2DP': -- -- > main = xmonad $ navigation2DP def -- > ("", "", "", "") -- > [("M-", windowGo ), -- > ("M-S-", windowSwap)] -- > False -- > $ def -- -- That's it. If instead you'd like more control, you can combine -- 'withNavigation2DConfig' and 'additionalNav2DKeys' or 'additionalNav2DKeysP': -- -- > main = xmonad $ withNavigation2DConfig def -- > $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right) -- > [(mod4Mask, windowGo ), -- > (mod4Mask .|. shiftMask, windowSwap)] -- > False -- > $ additionalNav2DKeys (xK_u, xK_l, xK_d, xK_r) -- > [(mod4Mask, screenGo ), -- > (mod4Mask .|. shiftMask, screenSwap)] -- > False -- > $ def -- -- Or you can add the configuration of the module to your main function: -- -- > main = xmonad $ withNavigation2DConfig def $ def -- -- And specify your keybindings normally: -- -- > -- Switch between layers -- > , ((modm, xK_space), switchLayer) -- > -- > -- Directional navigation of windows -- > , ((modm, xK_Right), windowGo R False) -- > , ((modm, xK_Left ), windowGo L False) -- > , ((modm, xK_Up ), windowGo U False) -- > , ((modm, xK_Down ), windowGo D False) -- > -- > -- Swap adjacent windows -- > , ((modm .|. controlMask, xK_Right), windowSwap R False) -- > , ((modm .|. controlMask, xK_Left ), windowSwap L False) -- > , ((modm .|. controlMask, xK_Up ), windowSwap U False) -- > , ((modm .|. controlMask, xK_Down ), windowSwap D False) -- > -- > -- Directional navigation of screens -- > , ((modm, xK_r ), screenGo R False) -- > , ((modm, xK_l ), screenGo L False) -- > , ((modm, xK_u ), screenGo U False) -- > , ((modm, xK_d ), screenGo D False) -- > -- > -- Swap workspaces on adjacent screens -- > , ((modm .|. controlMask, xK_r ), screenSwap R False) -- > , ((modm .|. controlMask, xK_l ), screenSwap L False) -- > , ((modm .|. controlMask, xK_u ), screenSwap U False) -- > , ((modm .|. controlMask, xK_d ), screenSwap D False) -- > -- > -- Send window to adjacent screen -- > , ((modm .|. mod1Mask, xK_r ), windowToScreen R False) -- > , ((modm .|. mod1Mask, xK_l ), windowToScreen L False) -- > , ((modm .|. mod1Mask, xK_u ), windowToScreen U False) -- > , ((modm .|. mod1Mask, xK_d ), windowToScreen D False) -- -- For detailed instruction on editing the key binding see: -- -- . -- $finer_points -- #Finer_Points# -- The above should get you started. Here are some finer points: -- -- Navigation2D has the ability to wrap around at screen edges. For example, if -- you navigated to the rightmost window on the rightmost screen and you -- continued to go right, this would get you to the leftmost window on the -- leftmost screen. This feature may be useful for switching between screens -- that are far apart but may be confusing at least to novice users. Therefore, -- it is disabled in the above example (e.g., navigation beyond the rightmost -- window on the rightmost screen is not possible and trying to do so will -- simply not do anything.) If you want this feature, change all the 'False' -- values in the above example to 'True'. You could also decide you want -- wrapping only for a subset of the operations and no wrapping for others. -- -- By default, all layouts use the 'defaultTiledNavigation' strategy -- specified in the 'Navigation2DConfig' (by default, line navigation is -- used). Many more navigation strategies are available; some may feel -- more natural, depending on the layout and user: -- -- * 'lineNavigation' -- * 'centerNavigation' -- * 'sideNavigation' -- * 'sideNavigationWithBias' -- -- There is also the ability to combine two strategies with 'hybridOf'. -- -- To override the default behaviour for some layouts, add a pair (\"layout name\", -- navigation strategy) to the 'layoutNavigation' list in the -- 'Navigation2DConfig', where \"layout name\" is the string reported by the -- layout's description method (normally what is shown as the layout name in -- your status bar). For example, all navigation strategies normally allow only -- navigation between mapped windows. The first step to overcome this, for -- example, for the Full layout, is to switch to center navigation for the Full -- layout: -- -- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig -- > $ def -- -- The navigation between windows is based on their screen rectangles, which are -- available /and meaningful/ only for mapped windows. Thus, as already said, -- the default is to allow navigation only between mapped windows. However, -- there are layouts that do not keep all windows mapped. One example is the -- Full layout, which unmaps all windows except the one that has the focus, -- thereby preventing navigation to any other window in the layout. To make -- navigation to unmapped windows possible, unmapped windows need to be assigned -- rectangles to pretend they are mapped, and a natural way to do this for the -- Full layout is to pretend all windows occupy the full screen and are stacked -- on top of each other so that only the frontmost one is visible. This can be -- done as follows: -- -- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] -- > , unmappedWindowRect = [("Full", singleWindowRect)] -- > } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig -- > $ def -- -- With this setup, Left/Up navigation behaves like standard -- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like -- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the -- layout. -- -- In general, each entry in the 'unmappedWindowRect' association list is a pair -- (\"layout description\", function), where the function computes a rectangle -- for each unmapped window from the screen it is on and the window ID. -- Currently, Navigation2D provides only two functions of this type: -- 'singleWindowRect' and 'fullScreenRect'. -- -- With per-layout navigation strategies, if different layouts are in effect on -- different screens in a multi-monitor setup, and different navigation -- strategies are defined for these active layouts, the most general of these -- navigation strategies is used across all screens (because Navigation2D does -- not distinguish between windows on different workspaces), where center -- navigation is more general than line navigation, as discussed formally under -- <#Technical_Discussion>. -- $alternatives -- #Alternatives# -- -- There exist two alternatives to Navigation2D: -- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation". -- X.L.WindowNavigation has the advantage of colouring windows to indicate the -- window that would receive the focus in each navigation direction, but it does -- not support navigation across multiple monitors, does not support directional -- navigation of floating windows, and has a very unintuitive definition of -- which window receives the focus next in each direction. X.A.WindowNavigation -- does support navigation across multiple monitors but does not provide window -- colouring while retaining the unintuitive navigational semantics of -- X.L.WindowNavigation. This makes it very difficult to predict which window -- receives the focus next. Neither X.A.WindowNavigation nor -- X.L.WindowNavigation supports directional navigation of screens. -- $technical -- #Technical_Discussion# -- An in-depth discussion of the navigational strategies implemented in -- Navigation2D, including formal proofs of their properties, can be found -- at . -- $incompatibilities -- #Incompatibilities# -- Currently Navigation2D is known not to play nicely with tabbed layouts, but -- it should work well with any other tiled layout. My hope is to address the -- incompatibility with tabbed layouts in a future version. The navigation to -- unmapped windows, for example in a Full layout, by assigning rectangles to -- unmapped windows is more a workaround than a clean solution. Figuring out -- how to deal with tabbed layouts may also lead to a more general and cleaner -- solution to query the layout for a window's rectangle that may make this -- workaround unnecessary. At that point, the 'unmappedWindowRect' field of the -- 'Navigation2DConfig' will disappear. -- | A rectangle paired with an object type Rect a = (a, Rectangle) -- | A shorthand for window-rectangle pairs. Reduces typing. type WinRect = Rect Window -- | A shorthand for workspace-rectangle pairs. Reduces typing. type WSRect = Rect WorkspaceId ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- -- -- PUBLIC INTERFACE -- -- -- ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- | Encapsulates the navigation strategy data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a) runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a) runNav (N _ nav) = nav -- | Score that indicates how general a navigation strategy is type Generality = Int instance Eq Navigation2D where (N x _) == (N y _) = x == y instance Ord Navigation2D where (N x _) <= (N y _) = x <= y -- | Line navigation. To illustrate this navigation strategy, consider -- navigating to the left from the current window. In this case, we draw a -- horizontal line through the center of the current window and consider all -- windows that intersect this horizontal line and whose right boundaries are to -- the left of the left boundary of the current window. From among these -- windows, we choose the one with the rightmost right boundary. lineNavigation :: Navigation2D lineNavigation = N 1 doLineNavigation -- | Center navigation. Again, consider navigating to the left. Then we -- consider the cone bounded by the two rays shot at 45-degree angles in -- north-west and south-west direction from the center of the current window. A -- window is a candidate to receive the focus if its center lies in this cone. -- We choose the window whose center has minimum L1-distance from the current -- window center. The tie breaking strategy for windows with the same distance -- is a bit complicated (see <#Technical_Discussion>) but ensures that all -- windows can be reached and that windows with the same center are traversed in -- their order in the window stack, that is, in the order -- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse -- them. centerNavigation :: Navigation2D centerNavigation = N 2 doCenterNavigation -- | Side navigation. Consider navigating to the right this time. The strategy -- is to take the line segment forming the right boundary of the current window, -- and push it to the right until it intersects with at least one other window. -- Of those windows, one with a point that is the closest to the centre of the -- line (+1) is selected. This is probably the most intuitive strategy for the -- tiled layer when using "XMonad.Layout.Spacing". sideNavigation :: Navigation2D sideNavigation = N 1 (doSideNavigationWithBias 1) -- | Side navigation with bias. Consider a case where the screen is divided -- up into three vertical panes; the side panes occupied by one window each and -- the central pane split across the middle by two windows. By the criteria -- of side navigation, the two central windows are equally good choices when -- navigating inwards from one of the side panes. Hence in order to be -- equitable, symmetric and pleasant to use, different windows are chosen when -- navigating from different sides. In particular, the lower is chosen when -- going left and the higher when going right, causing L, L, R, R, L, L, etc to -- cycle through the four windows clockwise. This is implemented by using a bias -- of 1. /Bias/ is how many pixels off centre the vertical split can be before -- this behaviour is lost and the same window chosen every time. A negative bias -- swaps the preferred window for each direction. A bias of zero disables the -- behaviour. sideNavigationWithBias :: Int -> Navigation2D sideNavigationWithBias b = N 1 (doSideNavigationWithBias b) -- | Hybrid of two modes of navigation, preferring the motions of the first. -- Use this if you want to fall back on a second strategy whenever the first -- does not find a candidate window. E.g. -- @hybridOf lineNavigation centerNavigation@ is a good strategy for the -- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable -- you to take advantage of some of the latter strategy's more interesting -- motions in the tiled layer. hybridOf :: Navigation2D -> Navigation2D -> Navigation2D hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2 where applyToBoth f g a b c = f a b c <|> g a b c -- | Stores the configuration of directional navigation. The 'Default' instance -- uses line navigation for the tiled layer and for navigation between screens, -- and center navigation for the float layer. No custom navigation strategies -- or rectangles for unmapped windows are defined for individual layouts. data Navigation2DConfig = Navigation2DConfig { defaultTiledNavigation :: Navigation2D -- ^ default navigation strategy for the tiled layer , floatNavigation :: Navigation2D -- ^ navigation strategy for the float layer , screenNavigation :: Navigation2D -- ^ strategy for navigation between screens , layoutNavigation :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies -- for different layouts in the tiled layer. Each pair -- is of the form (\"layout description\", navigation -- strategy). If there is no pair in this list whose first -- component is the name of the current layout, the -- 'defaultTiledNavigation' strategy is used. , unmappedWindowRect :: [(String, Screen -> Window -> X (Maybe Rectangle))] -- ^ list associating functions to calculate rectangles -- for unmapped windows with layouts to which they are -- to be applied. Each pair in this list is of -- the form (\"layout description\", function), where the -- 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. } -- | Shorthand for the tedious screen type type Screen = WindowScreen -- | Convenience function for enabling Navigation2D with typical keybindings. -- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from -- modifier key to action, and a bool to indicate if wrapping should occur, and -- returns a function from XConfig to XConfig. -- Example: -- -- > navigation2D def (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l navigation2D navConfig (u, l, d, r) modifiers wrap xconfig = additionalNav2DKeys (u, l, d, r) modifiers wrap $ withNavigation2DConfig navConfig xconfig -- | Convenience function for enabling Navigation2D with typical keybindings, -- using the syntax defined in 'XMonad.Util.EZConfig.mkKeymap'. Takes a -- Navigation2DConfig, an (up, left, down, right) tuple, a mapping from key -- prefix to action, and a bool to indicate if wrapping should occur, and -- returns a function from XConfig to XConfig. Example: -- -- > navigation2DP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l navigation2DP navConfig (u, l, d, r) modifiers wrap xconfig = additionalNav2DKeysP (u, l, d, r) modifiers wrap $ withNavigation2DConfig navConfig xconfig -- | Convenience function for adding keybindings. Takes an (up, left, down, -- right) tuple, a mapping from key prefix to action, and a bool to indicate if -- wrapping should occur, and returns a function from XConfig to XConfig. -- Example: -- -- > additionalNav2DKeys (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l additionalNav2DKeys (u, l, d, r) modifiers wrap = flip additionalKeys [((modif, k), func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys] where dirKeys = [(u, U), (l, L), (d, D), (r, R)] -- | Convenience function for adding keybindings, using the syntax defined in -- 'XMonad.Util.EZConfig.mkKeymap'. Takes an (up, left, down, right) tuple, a -- mapping from key prefix to action, and a bool to indicate if wrapping should -- occur, and returns a function from XConfig to XConfig. Example: -- -- > additionalNav2DKeysP ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l additionalNav2DKeysP (u, l, d, r) modifiers wrap = flip additionalKeysP [(modif ++ k, func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys] where dirKeys = [(u, U), (l, L), (d, D), (r, R)] -- So we can store the configuration in extensible state instance ExtensionClass Navigation2DConfig where initialValue = def -- | Modifies the xmonad configuration to store the Navigation2D configuration withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf >> XS.put conf2d } instance Default Navigation2DConfig where def = Navigation2DConfig { defaultTiledNavigation = hybridOf lineNavigation sideNavigation , floatNavigation = centerNavigation , screenNavigation = lineNavigation , layoutNavigation = [] , unmappedWindowRect = [] } -- | Switches focus to the closest window in the other layer (floating if the -- current window is tiled, tiled if the current window is floating). Closest -- means that the L1-distance between the centers of the windows is minimized. switchLayer :: X () switchLayer = actOnLayer otherLayer ( \ _ cur wins -> windows $ doFocusClosestWindow cur wins ) ( \ _ cur wins -> windows $ doFocusClosestWindow cur wins ) ( \ _ _ _ -> return () ) False -- | Moves the focus to the next window in the given direction and in the same -- layer as the current window. The second argument indicates whether -- 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 = actOnLayer thisLayer ( \ conf cur wins -> windows $ doTiledNavigation conf dir W.focusWindow cur wins ) ( \ conf cur wins -> windows $ doFloatNavigation conf dir W.focusWindow cur wins ) ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.view cur wspcs ) -- | 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 -- changes for the two windows is their stacking order if they're on the same -- screen. If they're on different screens, each window is moved to the other -- 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 = actOnLayer thisLayer ( \ conf cur wins -> windows $ doTiledNavigation conf dir swap cur wins ) ( \ conf cur wins -> windows $ doFloatNavigation conf dir swap cur wins ) ( \ _ _ _ -> return () ) -- | 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 = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.shift cur wspcs ) -- | Moves the focus to the next screen in the given direction. The second -- argument indicates wrapping (see 'windowGo'). screenGo :: Direction2D -> Bool -> X () screenGo dir = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.view cur wspcs ) -- | 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 = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.greedyView cur wspcs ) -- | 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 -- respects statusbar struts. In such cases, it may be better to use -- 'singleWindowRect'. fullScreenRect :: Screen -> Window -> X (Maybe Rectangle) fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr) -- | Maps each window to the rectangle it would receive if it was the only -- window in the layout. Useful, for example, for determining the default -- rectangle for unmapped windows in a Full layout that respects statusbar -- struts. singleWindowRect :: Screen -> Window -> X (Maybe Rectangle) singleWindowRect scr win = listToMaybe . map snd . fst <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] }) (screenRect . W.screenDetail $ scr) ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- -- -- PRIVATE X ACTIONS -- -- -- ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- | Acts on the appropriate layer using the given action functions actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect]) -- ^ Chooses which layer to operate on, relative -- to the current window (same or other layer) -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer -> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -- ^ The action if the current workspace is empty -> Bool -- ^ Should navigation wrap around screen edges? -> X () actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do conf <- XS.get (floating, tiled) <- navigableWindows conf wrap winset let cur = W.peek winset case cur of Nothing -> actOnScreens wsact wrap Just w | Just rect <- L.lookup w tiled -> tiledact conf (w, rect) (choice tiled floating) | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled) | otherwise -> return () -- | Returns the list of windows on the currently visible workspaces navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect]) navigableWindows conf wrap winset = L.partition (\(win, _) -> M.member win (W.floating winset)) . addWrapping winset wrap . catMaybes . concat <$> ( mapM ( \scr -> mapM (maybeWinRect scr) $ W.integrate' $ W.stack $ W.workspace scr ) . sortedScreens ) winset where maybeWinRect scr win = do winrect <- windowRect win rect <- case winrect of Just _ -> return winrect Nothing -> maybe (return Nothing) (\f -> f scr win) (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf)) return ((,) win <$> rect) -- | Returns the current rectangle of the given window, Nothing if the window isn't mapped windowRect :: Window -> X (Maybe Rectangle) windowRect win = withDisplay $ \dpy -> do mp <- isMapped win if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw) `catchX` return Nothing else return Nothing -- | Acts on the screens using the given action function actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -- ^ Should wrapping be used? -> X () actOnScreens act wrap = withWindowSet $ \winset -> do conf <- XS.get let wsrects = visibleWorkspaces winset wrap cur = W.tag . W.workspace . W.current $ winset rect = fromJust $ L.lookup cur wsrects act conf (cur, rect) wsrects -- | Determines whether a given window is mapped isMapped :: Window -> X Bool isMapped = fmap (maybe False ((waIsUnmapped /=) . wa_map_state)) . safeGetWindowAttributes ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- -- -- PRIVATE PURE FUNCTIONS -- -- -- ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- | Finds the window closest to the given window and focuses it. Ties are -- broken by choosing the first window in the window stack among the tied -- windows. (The stack order is the one produced by integrate'ing each visible -- workspace's window stack and concatenating these lists for all visible -- workspaces.) doFocusClosestWindow :: WinRect -> [WinRect] -> (WindowSet -> WindowSet) doFocusClosestWindow (cur, rect) winrects | null winctrs = id | otherwise = W.focusWindow . fst $ L.foldl1' closer winctrs where ctr = centerOf rect winctrs = filter ((cur /=) . fst) $ map (second centerOf) winrects closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2 | otherwise = wc1 -- | Implements navigation for the tiled layer doTiledNavigation :: Navigation2DConfig -> Direction2D -> (Window -> WindowSet -> WindowSet) -> WinRect -> [WinRect] -> (WindowSet -> WindowSet) doTiledNavigation conf dir act cur winrects winset | Just win <- runNav nav dir cur winrects = act win winset | otherwise = winset where layouts = map (description . W.layout . W.workspace) $ W.screens winset nav = maximum $ map ( fromMaybe (defaultTiledNavigation conf) . flip L.lookup (layoutNavigation conf) ) layouts -- | Implements navigation for the float layer doFloatNavigation :: Navigation2DConfig -> Direction2D -> (Window -> WindowSet -> WindowSet) -> WinRect -> [WinRect] -> (WindowSet -> WindowSet) doFloatNavigation conf dir act cur winrects | Just win <- runNav nav dir cur winrects = act win | otherwise = id where nav = floatNavigation conf -- | Implements navigation between screens doScreenNavigation :: Navigation2DConfig -> Direction2D -> (WorkspaceId -> WindowSet -> WindowSet) -> WSRect -> [WSRect] -> (WindowSet -> WindowSet) doScreenNavigation conf dir act cur wsrects | Just ws <- runNav nav dir cur wsrects = act ws | otherwise = id where nav = screenNavigation conf -- | Implements line navigation. For layouts without overlapping windows, there -- is no need to break ties between equidistant windows. When windows do -- overlap, even the best tie breaking rule cannot make line navigation feel -- natural. Thus, we fairly arbtitrarily break ties by preferring the window -- that comes first in the window stack. (The stack order is the one produced -- by integrate'ing each visible workspace's window stack and concatenating -- these lists for all visible workspaces.) doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a doLineNavigation dir (cur, rect) winrects | null winrects' = Nothing | otherwise = Just . fst $ L.foldl1' closer winrects' where -- The current window's center ctr@(xc, yc) = centerOf rect -- The list of windows that are candidates to receive focus. winrects' = filter dirFilter . filter ((cur /=) . fst) $ winrects -- Decides whether a given window matches the criteria to be a candidate to -- receive the focus. dirFilter (_, r) = (dir == L && leftOf r rect && intersectsY yc r) || (dir == R && leftOf rect r && intersectsY yc r) || (dir == U && above r rect && intersectsX xc r) || (dir == D && above rect r && intersectsX xc r) -- Decide whether r1 is left of/above r2. leftOf r1 r2 = rect_x r1 + fi (rect_width r1) <= rect_x r2 above r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2 -- Check whether r's x-/y-range contains the given x-/y-coordinate. intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width r) >= x intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y -- Decides whether r1 is closer to the current window's center than r2 closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2 | otherwise = wr1 -- Returns the distance of r from the point (x, y) dist (x, y) r | dir == L = x - rect_x r - fi (rect_width r) | dir == R = rect_x r - x | dir == U = y - rect_y r - fi (rect_height r) | otherwise = rect_y r - y -- | Implements center navigation doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a doCenterNavigation dir (cur, rect) winrects | ((w, _):_) <- onCtr' = Just w | otherwise = closestOffCtr where -- The center of the current window (xc, yc) = centerOf rect -- All the windows with their center points relative to the current -- 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 (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 -- is the one produced by integrate'ing each visible workspace's window -- stack and concatenating these lists for all visible workspaces.) stackTransform | dir == L || dir == U = reverse | otherwise = id -- Transform a point into a difference to the current window center and -- rotate it so that the relevant cone becomes the right cone. dirTransform (x, y) | dir == R = ( x - xc , y - yc ) | dir == L = (-(x - xc), -(y - yc)) | dir == D = ( y - yc , x - xc ) | otherwise = (-(y - yc), -(x - xc)) -- Partition the points into points that coincide with the center -- and points that do not. (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs -- All the points that coincide with the current center and succeed it -- in the (appropriately ordered) window stack. onCtr' = L.drop 1 $ L.dropWhile ((cur /=) . fst) onCtr -- All the points that do not coincide with the current center and which -- lie in the (rotated) right cone. offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr -- The off-center point closest to the center and -- closest to the bottom ray of the cone. Nothing if no off-center -- point is in the cone closestOffCtr = if null offCtr' then Nothing else Just $ fst $ L.foldl1' closest offCtr' closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq)) | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p | yq < yp = wq -- q is closer to the bottom ray than p | otherwise = wp -- q is farther away from the bottom ray than p -- or it has the same distance but comes later -- in the window stack -- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and -- y1 <= y2, and make the assumption valid by initialising SideRects with the -- property and carefully preserving it over any individual transformation. data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int } deriving Show -- Conversion from Rectangle format to SideRect. toSR :: Rectangle -> SideRect toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y) -- Implements side navigation with bias. doSideNavigationWithBias :: Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a doSideNavigationWithBias bias dir (cur, rect) = fmap fst . listToMaybe . L.sortOn dist . foldr acClosest [] . filter (`toRightOf` (cur, transform rect)) . map (fmap transform) where -- Getting the center of the current window so we can make it the new origin. cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2) (x0, y0) = cOf . toSR $ rect -- Translate the given SideRect by (-x0, -y0). translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0) -- Rotate the given SideRect 90 degrees counter-clockwise about the origin. rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r) -- Apply the above function until d becomes synonymous with R (wolog). rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC transform = rotateToR dir . translate . toSR -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't -- below or above c, i.e. iff: -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c) toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c) -- Greedily accumulate the windows tied for the leftmost left side. acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l | x1 r > x1 r' = l acClosest (w, r) _ = [(w, r)] -- Given a (_, SideRect), calculate how far it is from the y=bias line. dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0 | otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias) -- | Swaps the current window with the window given as argument swap :: Window -> WindowSet -> WindowSet swap win winset = W.focusWindow cur $ L.foldl' (flip W.focusWindow) newwinset newfocused where -- The current window cur = fromJust $ W.peek winset -- All screens scrs = W.screens winset -- All visible workspaces visws = map W.workspace scrs -- The focused windows of the visible workspaces focused = mapMaybe (fmap W.focus . W.stack) visws -- The window lists of the visible workspaces wins = map (W.integrate' . W.stack) visws -- Update focused windows and window lists to reflect swap of windows. newfocused = map swapWins focused newwins = map (map swapWins) wins -- Replaces the current window with the argument window and vice versa. swapWins x | x == cur = win | x == win = cur | otherwise = x -- Reconstruct the workspaces' window stacks to reflect the swap. newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen. , W.visible = drop 1 newscrs } -- | Calculates the center of a rectangle centerOf :: Rectangle -> (Position, Position) centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2) -- | Functions to choose the subset of windows to operate on thisLayer, otherLayer :: a -> a -> a thisLayer = const otherLayer _ x = x -- | Returns the list of visible workspaces and their screen rects visibleWorkspaces :: WindowSet -> Bool -> [WSRect] visibleWorkspaces winset wrap = addWrapping winset wrap $ map ( \scr -> ( W.tag . W.workspace $ scr , screenRect . W.screenDetail $ scr ) ) $ sortedScreens winset -- | Creates five copies of each (window/workspace, rect) pair in the input: the -- original and four offset one desktop size (desktop = collection of all -- screens) to the left, to the right, up, and down. Wrap-around at desktop -- edges is implemented by navigating into these displaced copies. addWrapping :: WindowSet -- ^ The window set, used to get the desktop size -> Bool -- ^ Should wrapping be used? Do nothing if not. -> [Rect a] -- ^ Input set of (window/workspace, rect) pairs -> [Rect a] addWrapping _ False wrects = wrects addWrapping winset True wrects = [ (w, r { rect_x = rect_x r + fi x , rect_y = rect_y r + fi y } ) | (w, r) <- wrects , (x, y) <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)] ] where (xoff, yoff) = wrapOffsets winset -- | Calculates the offsets for window/screen coordinates for the duplication -- of windows/workspaces that implements wrap-around. wrapOffsets :: WindowSet -> (Integer, Integer) wrapOffsets winset = (max_x - min_x, max_y - min_y) 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 rects = map snd $ visibleWorkspaces winset False -- | Returns the list of screens sorted primarily by their centers' -- x-coordinates and secondarily by their y-coordinates. sortedScreens :: WindowSet -> [Screen] sortedScreens winset = L.sortBy cmp $ W.screens winset where cmp s1 s2 | x < x' = LT | x > x' = GT | y < x' = LT | y > y' = GT | otherwise = EQ where (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 (x, y) (x', y') = abs (fi $ x - x') + abs (fi $ y - y') xmonad-contrib-0.18.0/XMonad/Actions/NoBorders.hs0000644000000000000000000000201107346545000017726 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.NoBorders -- Description : Helper functions for dealing with window borders. -- Copyright : (c) Lukas Mai -- License : BSD3-style (see LICENSE) -- -- Maintainer : Lukas Mai -- Stability : stable -- Portability : unportable -- -- This module provides helper functions for dealing with window borders. -- ----------------------------------------------------------------------------- module XMonad.Actions.NoBorders ( toggleBorder ) where import XMonad -- | Toggle the border of the currently focused window. To use it, add a -- keybinding like so: -- -- > , ((modm, xK_g ), withFocused toggleBorder) -- toggleBorder :: Window -> X () toggleBorder w = do bw <- asks (borderWidth . config) withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $ if wa_border_width wa == 0 then setWindowBorderWidth d w bw else setWindowBorderWidth d w 0 xmonad-contrib-0.18.0/XMonad/Actions/OnScreen.hs0000644000000000000000000001503207346545000017554 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.OnScreen -- Description : Control workspaces on different screens (in xinerama mode). -- Copyright : (c) 2009 Nils Schweinsberg -- License : BSD3-style (see LICENSE) -- -- Maintainer : Nils Schweinsberg -- Stability : unstable -- Portability : unportable -- -- Control workspaces on different screens (in xinerama mode). -- ----------------------------------------------------------------------------- module XMonad.Actions.OnScreen ( -- * Usage -- $usage onScreen , onScreen' , Focus(..) , viewOnScreen , greedyViewOnScreen , onlyOnScreen , toggleOnScreen , toggleGreedyOnScreen ) where import XMonad import XMonad.Prelude (fromMaybe, guard, empty) import XMonad.StackSet hiding (new) -- | Focus data definitions data Focus = FocusNew -- ^ always focus the new screen | FocusCurrent -- ^ always keep the focus on the current screen | FocusTag WorkspaceId -- ^ always focus tag i on the new stack | FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack -- | Run any function that modifies the stack on a given screen. This function -- will also need to know which Screen to focus after the function has been -- run. onScreen :: (WindowSet -> WindowSet) -- ^ function to run -> Focus -- ^ what to do with the focus -> ScreenId -- ^ screen id -> WindowSet -- ^ current stack -> WindowSet onScreen f foc sc st = fromMaybe st $ do ws <- lookupWorkspace sc st let fStack = f $ view ws st return $ setFocus foc st fStack -- set focus for new stack setFocus :: Focus -> WindowSet -- ^ old stack -> WindowSet -- ^ new stack -> WindowSet setFocus FocusNew _ new = new setFocus FocusCurrent old new = case lookupWorkspace (screen $ current old) new of Nothing -> new Just i -> view i new setFocus (FocusTag i) _ new = view i new setFocus (FocusTagVisible i) old new = if i `elem` map (tag . workspace) (visible old) then setFocus (FocusTag i) old new else setFocus FocusCurrent old new -- | A variation of @onScreen@ which will take any @X ()@ function and run it -- on the given screen. -- Warning: This function will change focus even if the function it's supposed -- to run doesn't succeed. onScreen' :: X () -- ^ X function to run -> Focus -- ^ focus -> ScreenId -- ^ screen id -> X () onScreen' x foc sc = do st <- gets windowset case lookupWorkspace sc st of Nothing -> return () Just ws -> do windows $ view ws x windows $ setFocus foc st -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to -- switch focus to the workspace @i@. viewOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet viewOnScreen sid i = onScreen (view i) (FocusTag i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@ -- to switch the current workspace with workspace @i@. greedyViewOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet greedyViewOnScreen sid i = onScreen (greedyView i) (FocusTagVisible i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing. onlyOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet onlyOnScreen sid i = onScreen (view i) FocusCurrent sid -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view toggleOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet toggleOnScreen sid i = onScreen (toggleOrView' view i) FocusCurrent sid -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView toggleGreedyOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet toggleGreedyOnScreen sid i = onScreen (toggleOrView' greedyView i) FocusCurrent sid -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run -> WorkspaceId -- ^ tag to look for -> WindowSet -- ^ current stackset -> WindowSet toggleOrView' f i st = fromMaybe (f i st) $ do let st' = hidden st -- make sure we actually have to do something guard $ i == (tag . workspace $ current st) case st' of [] -> empty (h : _) -> return $ f (tag h) st -- finally, toggle! -- $usage -- -- This module provides an easy way to control, what you see on other screens in -- xinerama mode without having to focus them. Put this into your -- @xmonad.hs@: -- -- > import XMonad.Actions.OnScreen -- -- Then add the appropriate keybindings, for example replace your current keys -- to switch the workspaces with this at the bottom of your keybindings: -- -- > ++ -- > [ ((m .|. modm, k), windows (f i)) -- > | (i, k) <- zip (workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) -- > , (f, m) <- [ (viewOnScreen 0, 0) -- > , (viewOnScreen 1, controlMask) -- > , (greedyView, controlMask .|. shiftMask) ] -- > ] -- -- This will provide you with the following keybindings: -- -- * modkey + 1-0: -- Switch to workspace 1-0 on screen 0 -- -- * modkey + control + 1-0: -- Switch to workspace 1-0 on screen 1 -- -- * modkey + control + shift + 1-0: -- Default greedyView behaviour -- -- -- A more basic version inside the default keybindings would be: -- -- > , ((modm .|. controlMask, xK_1), windows (viewOnScreen 0 "1")) -- -- where 0 is the first screen and \"1\" the workspace with the tag \"1\". -- -- For detailed instructions on editing your key bindings, see -- . xmonad-contrib-0.18.0/XMonad/Actions/PerLayoutKeys.hs0000644000000000000000000000367407346545000020631 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PerLayoutKeys -- Description : Define key-bindings on per-layout basis. -- Copyright : (c) brandon s allbery kf8nh 2022, Roman Cheplyaka, 2008 -- License : BSD3-style (see LICENSE) -- -- Maintainer : brandon s allbery kf8ng -- Stability : unstable -- Portability : unportable -- -- Define key-bindings on per-layout basis. -- ----------------------------------------------------------------------------- module XMonad.Actions.PerLayoutKeys ( -- * Usage -- $usage chooseActionByLayout, bindByLayout ) where import XMonad import XMonad.StackSet as S -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.PerLayoutKeys -- -- > ,((0, xK_F2), bindByLayout [("Tall", spawn "rxvt"), ("Mirror Tall", spawn "xeyes"), ("", spawn "xmessage hello")]) -- -- For detailed instructions on editing your key bindings, see -- . -- | Uses supplied function to decide which action to run depending on current layout name. chooseActionByLayout :: (String->X()) -> X() chooseActionByLayout f = withWindowSet (f . description . S.layout. S.workspace . S.current) -- | If current layout is listed, run appropriate action (only the first match counts!) -- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied. bindByLayout :: [(String, X())] -> X() bindByLayout bindings = chooseActionByLayout chooser where chooser l = case lookup l bindings of Just action -> action Nothing -> case lookup "" bindings of Just action -> action Nothing -> return () xmonad-contrib-0.18.0/XMonad/Actions/PerWindowKeys.hs0000644000000000000000000000424407346545000020615 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 -- Stability : unstable -- Portability : unportable -- -- Define key-bindings on a per-window basis. -- ----------------------------------------------------------------------------- module XMonad.Actions.PerWindowKeys ( -- * Usage -- $usage bindAll, bindFirst ) where import XMonad -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.PerWindowKeys -- -- > ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)]) -- -- > ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)]) -- -- If you want an action that will always run, but also want to do something for -- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True, -- alwaysDoThisAction)]@. -- -- Similarly, if you want a default action to be run if all the others failed, -- you can use @'bindFirst' [(query1, action1), ..., (pure True, -- doThisIfTheOthersFail)]@. -- -- For detailed instructions on editing your key bindings, see -- . -- | 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-contrib-0.18.0/XMonad/Actions/PerWorkspaceKeys.hs0000644000000000000000000000350207346545000021300 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PerWorkspaceKeys -- Description : Define key-bindings on per-workspace basis. -- Copyright : (c) Roman Cheplyaka, 2008 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- Define key-bindings on per-workspace basis. -- ----------------------------------------------------------------------------- module XMonad.Actions.PerWorkspaceKeys ( -- * Usage -- $usage chooseAction, bindOn ) where import XMonad import XMonad.StackSet as S -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.PerWorkspaceKeys -- -- > ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")]) -- -- For detailed instructions on editing your key bindings, see -- . -- | Uses supplied function to decide which action to run depending on current workspace name. chooseAction :: (String->X()) -> X() chooseAction f = withWindowSet (f . S.currentTag) -- | If current workspace is listed, run appropriate action (only the first match counts!) -- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied. bindOn :: [(String, X())] -> X() bindOn bindings = chooseAction chooser where chooser ws = case lookup ws bindings of Just action -> action Nothing -> case lookup "" bindings of Just action -> action Nothing -> return () xmonad-contrib-0.18.0/XMonad/Actions/PhysicalScreens.hs0000644000000000000000000001570507346545000021146 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PhysicalScreens -- Description : Manipulate screens ordered by physical location instead of ID. -- Copyright : (c) Nelson Elhage -- License : BSD -- -- Maintainer : Nelson Elhage -- Stability : unstable -- Portability : unportable -- -- Manipulate screens ordered by physical location instead of ID ----------------------------------------------------------------------------- module XMonad.Actions.PhysicalScreens ( -- * Usage -- $usage PhysicalScreen(..) , getScreen , viewScreen , sendToScreen , onNextNeighbour , onPrevNeighbour , horizontalScreenOrderer , verticalScreenOrderer , ScreenComparator(ScreenComparator) , getScreenIdAndRectangle , screenComparatorById , screenComparatorByRectangle ) where import XMonad import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy) import qualified XMonad.StackSet as W {- $usage This module allows you name Xinerama screens from XMonad using their physical location relative to each other (as reported by Xinerama), rather than their @ScreenID@ s, which are arbitrarily determined by your X server and graphics hardware. You can specify how to order the screen by giving a ScreenComparator. To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId. The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom and then left-to-right. Example usage in your @xmonad.hs@ file: > import XMonad.Actions.PhysicalScreens > import Data.Default > , ((modMask, xK_a), onPrevNeighbour def W.view) > , ((modMask, xK_o), onNextNeighbour def W.view) > , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift) > , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift) > -- > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3 > -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3 > -- > [((modm .|. mask, key), f sc) > | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] > , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]] For detailed instructions on editing your key bindings, see . -} -- | The type of the index of a screen by location newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle) getScreenIdAndRectangle screen = (W.screen screen, rect) where rect = screenRect $ W.screenDetail screen -- | Translate a physical screen index to a 'ScreenId' getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId) getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset let screens = W.current w : W.visible w if i<0 || i >= length screens then return Nothing else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens in return $ Just $ W.screen $ ss !! i -- | Switch to a given physical screen viewScreen :: ScreenComparator -> PhysicalScreen -> X () viewScreen sc p = do i <- getScreen sc p whenJust i $ \s -> do w <- screenWorkspace s whenJust w $ windows . W.view -- | Send the active window to a given physical screen sendToScreen :: ScreenComparator -> PhysicalScreen -> X () sendToScreen sc p = do i <- getScreen sc p whenJust i $ \s -> do w <- screenWorkspace s whenJust w $ windows . W.shift -- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering) -- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom instance Default ScreenComparator where def= verticalScreenOrderer -- | Compare screen only by their coordonate screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator screenComparatorByRectangle rectComparator = ScreenComparator comparator where comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2 -- | Compare screen only by their Xinerama id screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator screenComparatorById idComparator = ScreenComparator comparator where comparator (id1, _) (id2, _) = idComparator id1 id2 -- | orders screens by the upper-left-most corner, from top-to-bottom verticalScreenOrderer :: ScreenComparator verticalScreenOrderer = screenComparatorByRectangle comparator where comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2) -- | orders screens by the upper-left-most corner, from left-to-right horizontalScreenOrderer :: ScreenComparator horizontalScreenOrderer = screenComparatorByRectangle comparator where comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2) -- | Get ScreenId for neighbours of the current screen based on position offset. getNeighbour :: ScreenComparator -> Int -> X ScreenId getNeighbour (ScreenComparator cmpScreen) d = do w <- gets windowset let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss pos = (curPos + d) `mod` length ss return $ ss !! pos neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X () neighbourWindows sc d f = do s <- getNeighbour sc d w <- screenWorkspace s whenJust w $ windows . f -- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter. onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X () onNextNeighbour sc = neighbourWindows sc 1 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X () onPrevNeighbour sc = neighbourWindows sc (-1) xmonad-contrib-0.18.0/XMonad/Actions/Plane.hs0000644000000000000000000001732207346545000017103 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Plane -- Description : Navigate through workspaces in a bidimensional manner. -- Copyright : (c) Marco Túlio Gontijo e Silva , -- Leonardo Serra -- License : BSD3-style (see LICENSE) -- -- Maintainer : Marco Túlio Gontijo e Silva -- Stability : unstable -- Portability : unportable -- -- This module has functions to navigate through workspaces in a bidimensional -- manner. It allows the organization of workspaces in lines, and provides -- functions to move and shift windows in all four directions (left, up, right -- and down) possible in a surface. -- -- This functionality was inspired by GNOME (finite) and KDE (infinite) -- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for -- the idea of applying this approach to XMonad. ----------------------------------------------------------------------------- module XMonad.Actions.Plane ( -- * Usage -- $usage -- * Data types Direction (..) , Limits (..) , Lines (..) -- * Key bindings , planeKeys -- * Navigating through workspaces , planeShift , planeMove ) where import Data.Map (Map, fromList) import XMonad.Prelude hiding (fromList) import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Run -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.Plane -- > import Data.Map (union) -- > -- > main = xmonad def {keys = myKeys} -- > -- > myKeys conf = union (keys def conf) $ myNewKeys conf -- > -- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite -- -- For detailed instructions on editing your key bindings, see -- . -- | Direction to go in the plane. data Direction = ToLeft | ToUp | ToRight | ToDown deriving Enum -- | Defines the behaviour when you're trying to move out of the limits. data Limits = Finite -- ^ Ignore the function call, and keep in the same workspace. | Circular -- ^ Get on the other side, like in the Snake game. | Linear -- ^ The plan comes as a row, so it goes to the next or prev if -- the workspaces were numbered. deriving Eq -- | The number of lines in which the workspaces will be arranged. It's -- possible to use a number of lines that is not a divisor of the number of -- workspaces, but the results are better when using a divisor. If it's not a -- divisor, the last line will have the remaining workspaces. data Lines = GConf -- ^ Use @gconftool-2@ to find out the number of lines. | Lines Int -- ^ Specify the number of lines explicitly. -- | This is the way most people would like to use this module. It attaches the -- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and -- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'. -- It also associates these bindings with 'shiftMask' to 'planeShift'. planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ()) planeKeys modm ln limits = fromList $ [ ((keyMask, keySym), function ln limits direction) | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft , (keyMask, function) <- [(modm, planeMove), (shiftMask .|. modm, planeShift)] ] -- | Shift a window to the next workspace in 'Direction'. Note that this will -- also move to the next workspace. It's a good idea to use the same 'Lines' -- and 'Limits' for all the bindings. planeShift :: Lines -> Limits -> Direction -> X () planeShift = plane shift' shift' :: (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd shift' area = greedyView area . shift area -- | Move to the next workspace in 'Direction'. planeMove :: Lines -> Limits -> Direction -> X () planeMove = plane greedyView plane :: (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction -> X () plane function numberLines_ limits direction = do st <- get xconf <- ask numberLines <- liftIO $ case numberLines_ of Lines numberLines__ -> return numberLines__ GConf -> do numberLines__ <- runProcessWithInput gconftool parameters "" case reads numberLines__ of [(numberRead, _)] -> return numberRead _ -> do trace $ "XMonad.Actions.Plane: Could not parse the output of " ++ gconftool ++ unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1." return 1 let notBorder :: Bool notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction circular_ :: Int circular_ = circular currentWS circular :: Int -> Int circular = [ onLine pred , onColumn pred , onLine succ , onColumn succ ] !! fromEnum direction linear :: Int -> Int linear = [ onLine pred . onColumn pred , onColumn pred . onLine pred , onLine succ . onColumn succ , onColumn succ . onLine succ ] !! fromEnum direction onLine :: (Int -> Int) -> Int -> Int onLine f currentWS_ | line < areasLine = mod_ columns | otherwise = mod_ areasColumn where line, column :: Int (line, column) = split currentWS_ mod_ :: Int -> Int mod_ columns_ = compose line $ mod (f column) columns_ onColumn :: (Int -> Int) -> Int -> Int onColumn f currentWS_ | column < areasColumn || areasColumn == 0 = mod_ numberLines | otherwise = mod_ $ pred numberLines where line, column :: Int (line, column) = split currentWS_ mod_ :: Int -> Int mod_ lines_ = compose (mod (f line) lines_) column compose :: Int -> Int -> Int compose line column = line * columns + column split :: Int -> (Int, Int) split currentWS_ = (operation div, operation mod) where operation :: (Int -> Int -> Int) -> Int operation f = f currentWS_ columns areasLine :: Int areasLine = div areas columns areasColumn :: Int areasColumn = mod areas columns columns :: Int columns = if mod areas numberLines == 0 then preColumns else preColumns + 1 currentWS :: Int currentWS = fromJust mCurrentWS preColumns :: Int preColumns = div areas numberLines mCurrentWS :: Maybe Int mCurrentWS = elemIndex (currentTag $ windowset st) areaNames areas :: Int areas = length areaNames run :: (Int -> Int) -> X () run f = windows $ function $ areaNames !! f currentWS areaNames :: [String] areaNames = workspaces $ config xconf when (isJust mCurrentWS) $ case limits of Finite -> when notBorder $ run circular Circular -> run circular Linear -> if notBorder then run circular else run linear gconftool :: String gconftool = "gconftool-2" parameters :: [String] parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"] xmonad-contrib-0.18.0/XMonad/Actions/Prefix.hs0000644000000000000000000001651107346545000017300 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Prefix -- Description : Use an Emacs-style prefix argument for commands. -- Copyright : (c) Matus Goljer -- License : BSD3-style (see LICENSE) -- -- Maintainer : Matus Goljer -- Stability : unstable -- Portability : unportable -- -- A module that allows the user to use a prefix argument (raw or numeric). -- ----------------------------------------------------------------------------- module XMonad.Actions.Prefix ( -- * Usage -- $usage -- * Installation -- $installation PrefixArgument(..) , usePrefixArgument , useDefaultPrefixArgument , withPrefixArgument , isPrefixRaw , isPrefixNumeric , orIfPrefixed , ppFormatPrefix ) where import qualified Data.Map as M import XMonad.Prelude import XMonad import XMonad.Util.ExtensibleState as XS import XMonad.Util.Paste (sendKey) import XMonad.Actions.Submap (submapDefaultWithKey) import XMonad.Util.EZConfig (readKeySequence) import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ((<|)) {- $usage This module implements Emacs-style prefix argument. The argument comes in two flavours, 'Raw' and 'Numeric'. To initiate the "prefix mode" you hit the prefix keybinding (default C-u). This sets the Raw argument value to 1. Repeatedly hitting this key increments the raw value by 1. The Raw argument is usually used as a toggle, changing the behaviour of the function called in some way. An example might be calling "mpc add" to add new song to the playlist, but with C-u we also clean up the playlist beforehand. When in the "Raw mode", you can hit numeric keys 0..9 (with no modifier) to enter a "Numeric argument". Numeric argument represents a natural number. Hitting numeric keys in sequence produces the decimal number that would result from typing them. That is, the sequence C-u 4 2 sets the Numeric argument value to the number 42. If you have a function which understands the prefix argument, for example: > addMaybeClean :: PrefixArgument -> X () > addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add " > addMaybeClean _ = spawn "mpc add " 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 @\@ to the playlist while C-u MOD-a will clear the playlist and then add the file. You can of course use an anonymous action, like so: > ((modm, xK_a), withPrefixArgument $ \prefix -> do > case prefix of ... > ) If the prefix key is followed by a binding which is unknown to XMonad, the prefix along with that binding is sent to the active window. There is one caveat: when you use an application which has a nested C-u binding, for example C-c C-u in Emacs org-mode, you have to hit C-g (or any other non-recognized key really) to get out of the "xmonad grab" and let the C-c C-u be sent to the application. -} {- $installation The simplest way to enable this is to use 'useDefaultPrefixArgument' > xmonad $ useDefaultPrefixArgument $ def { .. } The default prefix argument is C-u. If you want to customize the prefix argument, 'usePrefixArgument' can be used: > xmonad $ usePrefixArgument "M-u" $ def { .. } where the key is entered in Emacs style (or "XMonad.Util.EZConfig" style) notation. The letter `M` stands for your chosen modifier. The function defaults to C-u if the argument could not be parsed. -} data PrefixArgument = Raw Int | Numeric Int | None deriving (Read, Show) instance ExtensionClass PrefixArgument where initialValue = None extensionType = PersistentExtension -- | Run 'job' in the 'X' monad and then execute 'cleanup'. In case -- of exception, 'cleanup' is executed anyway. -- -- Return the return value of 'job'. finallyX :: X a -> X a -> X a finallyX job cleanup = catchX (job >>= \r -> cleanup >> return r) cleanup -- | Set up Prefix. Defaults to C-u when given an invalid key. -- -- See usage section. usePrefixArgument :: LayoutClass l Window => String -> XConfig l -> XConfig l usePrefixArgument prefix conf = conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf } where binding = case readKeySequence conf prefix of Just (key :| []) -> key _ -> (controlMask, xK_u) -- | Set Prefix up with default prefix key (C-u). useDefaultPrefixArgument :: LayoutClass l Window => XConfig l -> XConfig l useDefaultPrefixArgument = usePrefixArgument "C-u" handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X () handlePrefixArg events = do ks <- asks keyActions logger <- asks (logHook . config) flip finallyX (XS.put None >> logger) $ do prefix <- XS.get case prefix of Raw a -> XS.put $ Raw (a + 1) None -> XS.put $ Raw 1 _ -> return () logger submapDefaultWithKey defaultKey ks where defaultKey key@(m, k) = if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask then do prefix <- XS.get let x = fromJust (Prelude.lookup k keyToNum) case prefix of Raw _ -> XS.put $ Numeric x Numeric a -> XS.put $ Numeric $ a * 10 + x None -> return () -- should never happen handlePrefixArg (key <| events) else do prefix <- XS.get mapM_ (uncurry sendKey) $ case prefix of Raw a -> replicate a (NE.head events) ++ [key] _ -> reverse (key : toList events) keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9] -- | Turn a prefix-aware X action into an X-action. -- -- First, fetch the current prefix, then pass it as argument to the -- original function. You should use this to "run" your commands. withPrefixArgument :: (PrefixArgument -> X a) -> X a withPrefixArgument = (>>=) XS.get -- | Test if 'PrefixArgument' is 'Raw' or not. isPrefixRaw :: PrefixArgument -> Bool isPrefixRaw (Raw _) = True isPrefixRaw _ = False -- | Test if 'PrefixArgument' is 'Numeric' or not. isPrefixNumeric :: PrefixArgument -> Bool isPrefixNumeric (Numeric _) = True isPrefixNumeric _ = False -- | Execute the first action, unless any prefix argument is given, -- in which case the second action is chosen instead. -- -- > action1 `orIfPrefixed` action2 orIfPrefixed :: X a -> X a -> X a orIfPrefixed xa xb = withPrefixArgument $ bool xa xb . isPrefixRaw -- | Format the prefix using the Emacs convetion for use in a -- statusbar, like xmobar. -- -- To add this formatted prefix to printer output, you can set it up -- like so -- -- > myPrinter :: PP -- > myPrinter = def { ppExtras = [ppFormatPrefix] } -- -- And then add to your status bar using "XMonad.Hooks.StatusBar": -- -- > mySB = statusBarProp "xmobar" myPrinter -- > main = xmonad $ withEasySB mySB defToggleStrutsKey def -- -- Or, directly in your 'logHook' configuration -- -- > logHook = dynamicLogWithPP myPrinter ppFormatPrefix :: X (Maybe String) ppFormatPrefix = do prefix <- XS.get return $ case prefix of Raw n -> Just $ foldr1 (\a b -> a ++ " " ++ b) $ replicate n "C-u" Numeric n -> Just $ "C-u " ++ show n None -> Nothing xmonad-contrib-0.18.0/XMonad/Actions/Promote.hs0000644000000000000000000000331607346545000017467 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Promote -- Description : Alternate promote function for xmonad. -- Copyright : (c) Miikka Koskinen 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : xmonad@s001.ethrael.com -- Stability : unstable -- Portability : unportable -- -- Alternate promote function for xmonad. -- -- Moves the focused window to the master pane. All other windows -- retain their order. If focus is in the master, swap it with the -- next window in the stack. Focus stays in the master. -- ----------------------------------------------------------------------------- module XMonad.Actions.Promote ( -- * Usage -- $usage promote ) where import XMonad import XMonad.StackSet -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Promote -- -- then add a keybinding or substitute 'promote' in place of swapMaster: -- -- > , ((modm, xK_Return), promote) -- -- For detailed instructions on editing your key bindings, see -- . -- | Move the focused window to the master pane. All other windows -- retain their order. If focus is in the master, swap it with the -- next windo in the stack. Focus stays in the master. promote :: X () promote = windows $ modify' $ \c -> case c of Stack _ [] [] -> c Stack t [] (x:rs) -> Stack x [] (t:rs) Stack t ls rs -> Stack t [] (reverse ls ++ rs) xmonad-contrib-0.18.0/XMonad/Actions/RandomBackground.hs0000644000000000000000000000477007346545000021267 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- An action to start terminals with a random background color -- ----------------------------------------------------------------------------- module XMonad.Actions.RandomBackground ( -- * Usage -- $usage randomBg', randomBg, RandomColor(HSV,RGB) ) where import XMonad(X, XConf(config), XConfig(terminal), io, spawn, MonadIO, asks) import System.Random import Numeric(showHex) -- $usage -- -- Add to your keybindings something like: -- -- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20 -- | RandomColor fixes constraints when generating random colors. All -- parameters should be in the range 0 -- 0xff data RandomColor = RGB { _colorMin :: Int , _colorMax :: Int } -- ^ specify the minimum and maximum lowest values for each color channel. | HSV { _colorSaturation :: Double , _colorValue :: Double } -- ^ specify the saturation and value, leaving the hue random. toHex :: [Int] -> String toHex = ("'#"++) . (++"'") . concatMap (ensure 2 . ($ "") . showHex) where ensure x = reverse . take x . (++repeat '0') . reverse randPermutation :: (RandomGen g) => [a] -> g -> [a] randPermutation xs g = swap $ zip (randoms g) xs where swap ((True,x):(c,y):ys) = y:swap ((c,x):ys) swap ((False,x):ys) = x:swap ys swap x = map snd x -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@ randomBg' :: (MonadIO m) => RandomColor -> m String 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 return $ toHex $ map round $ randPermutation [v,(v-s)*x + s,s] g -- | @randomBg@ starts a terminal with the background color taken from 'randomBg'' -- -- This depends on the your 'terminal' configuration field accepting an -- argument like @-bg '#ff0023'@ randomBg :: RandomColor -> X () randomBg x = do t <- asks (terminal . config) c <- randomBg' x spawn $ t ++ " -bg " ++ c xmonad-contrib-0.18.0/XMonad/Actions/RepeatAction.hs0000644000000000000000000000477207346545000020427 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RepeatAction -- Description : Repeat the last performed action. -- Copyright : (c) 2022 Martin Kozlovsky -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : not portable -- -- Ability to repeat the last action. -- ----------------------------------------------------------------------------- module XMonad.Actions.RepeatAction ( -- * Usage -- $usage rememberAction, rememberActions, repeatLast, ) where import XMonad import qualified XMonad.Util.ExtensibleState as XS -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.RepeatAction -- -- Then join a dedicated key to run the last action with the rest of your -- key bindings using the 'rememberActions': -- -- > rememberActions (modm, xK_period) [((modm, xK_c), kill), …] -- -- It can be also used in the same way for "XMonad.Util.EZConfig": -- -- > rememberActions "M-." [("M-c", kill), …] -- -- For example, if you use 'XMonad.Util.EZConfig.additionalKeysP', -- -- > main = xmonad $ … $ def -- > { -- > … -- > } -- > `additionalKeysP` myKeys -- -- you would adjust the call to 'XMonad.Util.EZConfig.additionalKeysP' -- like so: -- -- > `additionalKeysP` (rememberActions "M-." myKeys) -- -- For more detailed instructions on editing your key bindings, see -- . newtype LastAction = LastAction { runLastAction :: X () } instance ExtensionClass LastAction where initialValue = LastAction $ pure () -- | Transforms an action into an action that can be remembered and repeated. rememberAction :: X () -> X () rememberAction x = userCode x >>= \case Nothing -> pure () Just () -> XS.put (LastAction x) -- Only remember action if nothing went wrong. -- | Maps 'rememberAction' over a list of key bindings. rememberActions' :: [(a, X ())] -> [(a, X ())] rememberActions' = map (fmap rememberAction) infixl 4 `rememberActions` -- | Maps 'rememberAction' over a list of key bindings and adds a dedicated -- key to repeat the last action. rememberActions :: a -> [(a, X ())] -> [(a, X ())] rememberActions key keyList = (key, repeatLast) : rememberActions' keyList -- | Runs the last remembered action. -- / Be careful not to include this action in the remembered actions! / repeatLast :: X () repeatLast = XS.get >>= runLastAction xmonad-contrib-0.18.0/XMonad/Actions/Repeatable.hs0000644000000000000000000000662607346545000020115 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Repeatable -- Description : Actions you'd like to repeat. -- Copyright : (c) 2022 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Maintainer : @LSLeary (on github) -- Stability : unstable -- Portability : unportable -- -- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS", -- "XMonad.Actions.CycleWorkspaceByScreen", "XMonad.Actions.CycleWindows" and -- "XMonad.Actions.MostRecentlyUsed". -- -- See the source of these modules for usage examples. -- ----------------------------------------------------------------------------- module XMonad.Actions.Repeatable ( repeatable , repeatableSt , repeatableM ) where -- mtl import Control.Monad.State (StateT(..)) -- X11 import Graphics.X11.Xlib.Extras -- xmonad import XMonad -- | An action that temporarily usurps and responds to key press/release events, -- concluding when one of the modifier keys is released. repeatable :: [KeySym] -- ^ The list of 'KeySym's under the -- modifiers used to invoke the action. -> KeySym -- ^ The keypress that invokes the action. -> (EventType -> KeySym -> X ()) -- ^ The keypress handler. -> X () repeatable = repeatableM id -- | A more general variant of 'repeatable' with a stateful handler, -- accumulating a monoidal return value throughout the events. repeatableSt :: Monoid a => s -- ^ Initial state. -> [KeySym] -- ^ The list of 'KeySym's under the -- modifiers used to invoke the -- action. -> KeySym -- ^ The keypress that invokes the -- action. -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler. -> X (a, s) repeatableSt iSt = repeatableM $ \m -> runStateT m iSt -- | A more general variant of 'repeatable' with an arbitrary monadic handler, -- accumulating a monoidal return value throughout the events. repeatableM :: (MonadIO m, Monoid a) => (m a -> X b) -- ^ How to run the monad in 'X'. -> [KeySym] -- ^ The list of 'KeySym's under the -- modifiers used to invoke the action. -> KeySym -- ^ The keypress that invokes the action. -> (EventType -> KeySym -> m a) -- ^ The keypress handler. -> X b repeatableM run mods key pressHandler = do XConf{ theRoot = root, display = d } <- ask run (repeatableRaw d root mods key pressHandler) repeatableRaw :: (MonadIO m, Monoid a) => Display -> Window -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a repeatableRaw d root mods key pressHandler = do io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime) handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime) where getNextEvent = io $ allocaXEvent $ \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p s <- keycodeToKeysym d c 0 return (t, s) handleEvent (t, s) | t == keyRelease && s `elem` mods = pure mempty | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent) xmonad-contrib-0.18.0/XMonad/Actions/RotSlaves.hs0000644000000000000000000000547407346545000017773 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotSlaves -- Description : Rotate all windows except the master window and keep the focus in place. -- Copyright : (c) Hans Philipp Annen , Mischa Dieterle -- License : BSD3-style (see LICENSE) -- -- Maintainer : Hans Philipp Annen -- Stability : stable -- Portability : unportable -- -- Rotate all windows except the master window and keep the focus in -- place. ----------------------------------------------------------------------------- module XMonad.Actions.RotSlaves ( -- $usage rotSlaves', rotSlavesUp, rotSlavesDown, rotAll', rotAllUp, rotAllDown, -- * Generic list rotations -- $generic rotUp, rotDown ) where import XMonad import XMonad.StackSet import XMonad.Prelude -- $usage -- -- To use this module, import it with: -- -- > import XMonad.Actions.RotSlaves -- -- and add whatever keybindings you would like, for example: -- -- > , ((modm .|. shiftMask, xK_Tab ), rotSlavesUp) -- -- This operation will rotate all windows except the master window, -- while the focus stays where it is. It is useful together with the -- TwoPane layout (see "XMonad.Layout.TwoPane"). -- -- For detailed instructions on editing your key bindings, see -- . -- | Rotate the windows in the current stack, excluding the first one -- (master). rotSlavesUp,rotSlavesDown :: X () rotSlavesUp = windows $ modify' (rotSlaves' rotUp) rotSlavesDown = windows $ modify' (rotSlaves' rotDown) -- | The actual rotation, as a pure function on the window stack. rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a rotSlaves' _ s@(Stack _ [] []) = s rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise where (notEmpty -> master :| ws) = integrate s (revls', notEmpty -> t' :| rs') = splitAt (length ls) (master:f ws) -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X () rotAllUp = windows $ modify' (rotAll' rotUp) rotAllDown = windows $ modify' (rotAll' rotDown) -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a rotAll' f s = Stack r (reverse revls) rs where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s)) -- $generic -- Generic list rotations such that @rotUp [1..4]@ is equivalent to -- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are -- @id@ for null or singleton lists. rotUp :: [a] -> [a] rotUp l = drop 1 l ++ take 1 l rotDown :: [a] -> [a] rotDown = reverse . rotUp . reverse xmonad-contrib-0.18.0/XMonad/Actions/RotateSome.hs0000644000000000000000000001334307346545000020125 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotateSome -- Description : Rotate some elements around the stack. -- Copyright : (c) 2020 Ivan Brennan -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ivan Brennan -- Stability : stable -- Portability : unportable -- -- Functions for rotating some elements around the stack while keeping others -- anchored in place. Useful in combination with layouts that dictate window -- visibility based on stack position, such as "XMonad.Layout.LimitWindows". -- ----------------------------------------------------------------------------- module XMonad.Actions.RotateSome ( -- * Usage -- $usage -- * Example -- $example surfaceNext, surfacePrev, rotateSome, ) where import Control.Arrow ((***)) import XMonad.Prelude (NonEmpty(..), notEmpty, partition, sortOn, (\\)) import qualified Data.Map as M import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet) import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack) import XMonad.Util.Stack (reverseS) {- $usage You can use this module with the following in your @xmonad.hs@: > import XMonad.Actions.RotateSome and add keybindings such as the following: > , ((modMask .|. controlMask, xK_n), surfaceNext) > , ((modMask .|. controlMask, xK_p), surfacePrev) -} {- $example #Example# Consider a workspace whose stack contains five windows A B C D E but whose layout limits how many will actually be shown, showing only the first plus two additional windows, starting with the third: > ┌─────┬─────┐ > │ │ C │ > │ A ├─────┤ > │ │ D │ > └─────┴─────┘ > > A B C D E > _ ____ If C has focus and we'd like to replace it with one of the unshown windows, 'surfaceNext' will move the next unshown window, E, into the focused position: > ┌─────┬─────┐ ┌─────┬─────┐ > │ │ *C* │ │ │ *E* │ > │ A ├─────┤ surfaceNext -> │ A ├─────┤ > │ │ D │ │ │ D │ > └─────┴─────┘ └─────┴─────┘ > > A B *C* D E A C *E* D B > _ ____ _ ____ This repositioned windows B C E by treating them as a sequence that can be rotated through the focused stack position. Windows A and D remain anchored to their original (visible) positions. A second call to 'surfaceNext' moves B into focus: > ┌─────┬─────┐ ┌─────┬─────┐ > │ │ *E* │ │ │ *B* │ > │ A ├─────┤ surfaceNext -> │ A ├─────┤ > │ │ D │ │ │ D │ > └─────┴─────┘ └─────┴─────┘ > > A C *E* D B A E *B* D C > _ ____ _ ____ A third call would complete the cycle, bringing C back into focus. -} -- | -- Treating the focused window and any unshown windows as a ring that can be -- rotated through the focused position, surface the next element in the ring. surfaceNext :: X () surfaceNext = do ring <- surfaceRing windows . modify' $ rotateSome (`elem` ring) -- | Like 'surfaceNext' in reverse. surfacePrev :: X () surfacePrev = do ring <- surfaceRing windows . modify' $ reverseS . rotateSome (`elem` ring) . reverseS -- | -- Return a list containing the current focus plus any unshown windows. Note -- that windows are shown if 'runLayout' provides them with a rectangle or if -- they are floating. surfaceRing :: X [Window] surfaceRing = withWindowSet $ \wset -> do let Screen wsp _ sd = current wset case stack wsp >>= filter' (`M.notMember` floating wset) of Nothing -> pure [] Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd) where go :: Stack Window -> [Window] -> [Window] go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown) layoutWindows :: WindowSpace -> Rectangle -> X [Window] layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect -- | Like "XMonad.StackSet.filter" but won't move focus. filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a) filter' p (Stack f ls rs) | p f = Just $ Stack f (filter p ls) (filter p rs) | otherwise = Nothing -- | -- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate -- @p@ as a ring that can be rotated, while all other elements remain anchored -- in place. rotateSome :: (a -> Bool) -> Stack a -> Stack a rotateSome p (Stack t ls rs) = let -- Flatten the stack, index each element relative to the focused position, -- then partition into movable and anchored elements. (movables, anchors) = partition (p . snd) $ zip [negate (length ls)..] (reverse ls ++ t : rs) -- Pair each movable element with the index of its next movable neighbor. -- Append anchored elements, along with their unchanged indices, and sort -- by index. Separate lefts (negative indices) from the rest, and grab the -- new focus from the head of the remaining elements. (ls', notEmpty -> t' :| rs') = (map snd *** map snd) . span ((< 0) . fst) . sortOn fst . (++) anchors $ zipWith (curry (fst *** snd)) movables (rotate movables) in Stack t' (reverse ls') rs' rotate :: [a] -> [a] rotate = uncurry (flip (++)) . splitAt 1 xmonad-contrib-0.18.0/XMonad/Actions/Search.hs0000644000000000000000000005245307346545000017255 0ustar0000000000000000{- | Module : XMonad.Actions.Search Description : Easily run Internet searches on web sites through xmonad. Copyright : (C) 2007 Gwern Branwen License : None; public domain Maintainer : Stability : unstable Portability : unportable; depends on XSelection, XPrompt A module for easily running Internet searches on web sites through xmonad. Modeled after the handy Surfraw CLI search tools at . Additional sites welcomed. -} module XMonad.Actions.Search ( -- * Usage -- $usage search, SearchEngine(..), searchEngine, searchEngineF, promptSearch, promptSearchBrowser, promptSearchBrowser', selectSearch, selectSearchBrowser, isPrefixOf, escape, use, intelligent, (!>), prefixAware, namedEngine, alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb, rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, zbmath, multi, -- * Use case: searching with a submap -- $tip -- * Types Browser, Site, Query, Name, Search ) where import Codec.Binary.UTF8.String (encode) 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) {- $usage This module is intended to allow easy access to databases on the Internet through xmonad's interface. The idea is that one wants to run a search but the query string and the browser to use must come from somewhere. There are two places the query string can come from - the user can type it into a prompt which pops up, or the query could be available already in the X Windows copy\/paste buffer (perhaps you just highlighted the string of interest). Thus, there are two main functions: 'promptSearch', and 'selectSearch' (implemented using the more primitive 'search'). To each of these is passed an engine function; this is a function that knows how to search a particular site. For example, the 'google' function knows how to search Google, and so on. You pass 'promptSearch' and 'selectSearch' the engine you want, the browser you want, and anything special they might need; this whole line is then bound to a key of you choosing in your xmonad.hs. For specific examples, see each function. This module is easily extended to new sites by using 'searchEngine'. The currently available search engines are: * 'alpha' -- Wolfram|Alpha query. * 'amazon' -- Amazon keyword search. * 'arXiv' -- Open-access preprint archive. * 'aur' -- Arch User Repository. * 'clojureDocs' -- Documentation and examples repository for Clojure. * 'codesearch' -- Google Labs Code Search search. * 'cratesIo' -- Rust crate registry. * 'deb' -- Debian package search. * 'debbts' -- Debian Bug Tracking System. * 'debpts' -- Debian Package Tracking System. * 'dictionary' -- dictionary.reference.com search. * 'duckduckgo' -- DuckDuckGo search engine. * 'ebay' -- Ebay keyword search. * 'flora' -- Prettier Haskell package database. * 'github' -- GitHub keyword search. * 'google' -- basic Google search. * 'hackage' -- Hackage, the Haskell package database. * 'homeManager' -- Search Nix's home-manager's options. * 'hoogle' -- Hoogle, the Haskell libraries API search engine. * 'images' -- Google images. * 'imdb' -- the Internet Movie Database. * 'lucky' -- Google "I'm feeling lucky" search. * 'maps' -- Google maps. * 'mathworld' -- Wolfram MathWorld search. * 'ncatlab' -- Higer Algebra, Homotopy and Category Theory Wiki. * 'nixos' -- Search NixOS packages and options. * 'noogle' -- 'hoogle'-like Nix API search engine. * 'openstreetmap' -- OpenStreetMap free wiki world map. * 'protondb' -- Steam Proton Game Database. * 'rosettacode' -- Programming chrestomathy wiki. * 'rustStd' -- Rust standard library documentation. * 'scholar' -- Google scholar academic search. * 'sourcehut' -- Sourcehut projects search. * 'stackage' -- Stackage, An alternative Haskell libraries API search engine. * 'steam' -- Steam games search. * 'thesaurus' -- thesaurus.com search. * 'vocabulary' -- Dictionary search. * 'voidpgks_x86_64' -- Void Linux packages search for @x86_64@. * 'voidpgks_x86_64_musl' -- Void Linux packages search for @x86_64-musl@. * 'wayback' -- the Wayback Machine. * 'wikipedia' -- basic Wikipedia search. * 'wiktionary' -- Wiktionary search. * 'youtube' -- Youtube video search. * 'zbmath' -- Open alternative to MathSciNet. * 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google. Feel free to add more! -} {- $tip In combination with "XMonad.Actions.Submap" you can create a powerful and easy way to search without adding a whole bunch of bindings. First import the necessary modules: > import qualified XMonad.Prompt as P > import qualified XMonad.Actions.Submap as SM > import qualified XMonad.Actions.Search as S Then add the following to your key bindings: > ... > -- Search commands > , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.def) > , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) > > ... > > searchEngineMap method = M.fromList $ > [ ((0, xK_g), method S.google) > , ((0, xK_h), method S.hoogle) > , ((0, xK_w), method S.wikipedia) > ] Or in combination with XMonad.Util.EZConfig: > ... > ] -- end of regular keybindings > -- Search commands > ++ [("M-s " ++ k, S.promptSearch P.def f) | (k,f) <- searchList ] > ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ] > > ... > > searchList :: [(String, S.SearchEngine)] > searchList = [ ("g", S.google) > , ("h", S.hoogle) > , ("w", S.wikipedia) > ] Make sure to set firefox to open new pages in a new window instead of in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages should be opened in...@ Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then opens a new firefox window that performs the search on Google, Hoogle or Wikipedia respectively. If you select something in whatever application and hit /mod-shift-s/ + /g/\//h/\//w/ it will search the selected string with the specified engine. Happy searching! -} -- | A customized prompt indicating we are searching, and the name of the site. newtype Search = Search Name instance XPrompt Search where showXPrompt (Search name)= "Search [" ++ name ++ "]: " nextCompletion _ = getNextCompletion commandToComplete _ c = c -- | Escape the search string so search engines understand it. Only -- digits and ASCII letters are not encoded. All non ASCII characters -- which are encoded as UTF8 escape :: String -> String escape = concatMap escapeURIChar escapeURIChar :: Char -> String escapeURIChar c | isAscii c && isAlphaNum c = [c] | otherwise = concatMap (printf "%%%02X") $ encode [c] type Browser = FilePath type Query = String type Site = String -> String type Name = String data SearchEngine = SearchEngine Name Site -- | Given an already defined search engine, extracts its transformation -- function, making it easy to create compound search engines. -- For an instance you can use @use google@ to get a function which -- makes the same transformation as the google search engine would. use :: SearchEngine -> Site use (SearchEngine _ engine) = engine -- | Given a browser, a search engine's transformation function, and a search term, perform the -- requested search in the browser. search :: Browser -> Site -> Query -> X () search browser site query = safeSpawn browser [site query] {- | Given a base URL, create the 'SearchEngine' that escapes the query and 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" "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 from site to site, often considerably, so there\'s no general way to cover this. 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) {- | 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 = "https://en.wikipedia.org/wiki/" ++ (escape $ drop 1 $ snd $ break (==':') s) > | "https://" `isPrefixOf` s = s > | otherwise = (use google) s > myNewEngine = searchEngineF "mymulti" searchFunc @searchFunc@ here searches for a word in wikipedia if it has a prefix of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address directly if it starts with \"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. The user input will be automatically escaped in search engines created with 'searchEngine', 'searchEngineF', however, completely depends on the transformation function passed to it. -} searchEngineF :: Name -> Site -> SearchEngine searchEngineF = SearchEngine -- The engines. alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb, rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, zbmath :: SearchEngine alpha = searchEngine "alpha" "https://www.wolframalpha.com/input/?i=" amazon = searchEngine "amazon" "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords=" arXiv = searchEngineF "arXiv" (\s -> "https://arxiv.org/search/?query=" <> s <> "&searchtype=all") aur = searchEngine "aur" "https://aur.archlinux.org/packages?&K=" clojureDocs = searchEngine "clojureDocs" "https://clojuredocs.org/search?q=" codesearch = searchEngine "codesearch" "https://developers.google.com/s/results/code-search?q=" cratesIo = searchEngine "cratesIo" "https://crates.io/search?q=" deb = searchEngine "deb" "https://packages.debian.org/" debbts = searchEngine "debbts" "https://bugs.debian.org/" debpts = searchEngine "debpts" "https://packages.qa.debian.org/" dictionary = searchEngine "dict" "https://dictionary.reference.com/browse/" duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" ebay = searchEngine "ebay" "https://www.ebay.com/sch/i.html?_nkw=" flora = searchEngine "flora" "https://flora.pm/search?q=" github = searchEngine "github" "https://github.com/search?q=" google = searchEngine "google" "https://www.google.com/search?q=" hackage = searchEngine "hackage" "https://hackage.haskell.org/package/" homeManager = searchEngine "homeManager" "https://mipmip.github.io/home-manager-option-search/?query=" hoogle = searchEngine "hoogle" "https://hoogle.haskell.org/?hoogle=" images = searchEngine "images" "https://images.google.fr/images?q=" imdb = searchEngine "imdb" "https://www.imdb.com/find?s=all&q=" lucky = searchEngine "lucky" "https://www.google.com/search?btnI&q=" maps = searchEngine "maps" "https://maps.google.com/maps?q=" mathworld = searchEngine "mathworld" "https://mathworld.wolfram.com/search/?query=" ncatlab = searchEngine "ncatlab" "https://ncatlab.org/nlab/search?query=" nixos = searchEngine "nixos" "https://search.nixos.org/packages?channel=unstable&from=0&size=200&sort=relevance&type=packages&query=" noogle = searchEngineF "noogle" (\s -> "https://noogle.dev/?search=" <> s <> "&page=1&to=any&from=any") openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query=" protondb = searchEngine "protondb" "https://www.protondb.com/search?q=" rosettacode = searchEngine "rosettacode" "https://rosettacode.org/w/index.php?search=" rustStd = searchEngine "rustStd" "https://doc.rust-lang.org/std/index.html?search=" scholar = searchEngine "scholar" "https://scholar.google.com/scholar?q=" sourcehut = searchEngine "sourcehut" "https://sr.ht/projects?search=" stackage = searchEngine "stackage" "https://www.stackage.org/lts/hoogle?q=" steam = searchEngine "steam" "https://store.steampowered.com/search/?term=" thesaurus = searchEngine "thesaurus" "https://thesaurus.com/browse/" vocabulary = searchEngine "vocabulary" "https://www.vocabulary.com/search?q=" voidpgks_x86_64 = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64&q=" voidpgks_x86_64_musl = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64-musl&q=" wayback = searchEngineF "wayback" ("https://web.archive.org/web/*/"++) wikipedia = searchEngine "wiki" "https://en.wikipedia.org/wiki/Special:Search?go=Go&search=" wiktionary = searchEngine "wikt" "https://en.wiktionary.org/wiki/Special:Search?go=Go&search=" youtube = searchEngine "youtube" "https://www.youtube.com/results?search_type=search_videos&search_query=" zbmath = searchEngine "zbmath" "https://zbmath.org/?q=" multi :: SearchEngine multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google] {- | This function wraps up a search engine and creates a new one, which works like the argument, but goes directly to a URL if one is given rather than searching. > myIntelligentGoogleEngine = intelligent google 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 takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s) -- | > removeColonPrefix "foo://bar" ~> "//bar" -- > removeColonPrefix "foo//bar" ~> "foo//bar" removeColonPrefix :: String -> String removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s {- | Connects a few search engines into one. If the search engines\' names are \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases. Example: > multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google)) Now if you type \"wiki:Haskell\" it will search for \"Haskell\" in Wikipedia, \"mathworld:integral\" will search mathworld, and everything else will fall back to google. The use of intelligent will make sure that URLs are opened directly. -} (!>) :: SearchEngine -> SearchEngine -> SearchEngine (SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s) 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 up searching for google:xmonad if google is your fallback engine and you explicitly add the prefix. -} prefixAware :: SearchEngine -> SearchEngine prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s) {- | Changes search engine's name -} namedEngine :: Name -> SearchEngine -> SearchEngine namedEngine name (SearchEngine _ site) = searchEngineF name site {- | Like 'search', but for use with the output from a Prompt; it grabs the 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) = 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: > , ((modm, xK_g), promptSearch greenXPConfig google) This specializes "promptSearchBrowser" by supplying the browser argument as supplied by 'getBrowser' from "XMonad.Prompt.Shell". -} promptSearch :: XPConfig -> SearchEngine -> X () promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine -- | Like 'search', but for use with the X selection; it grabs the selection, -- passes it to a given searchEngine and opens it in a given browser. selectSearchBrowser :: Browser -> SearchEngine -> X () selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection {- | Like 'search', but for use with the X selection; it grabs the selection, passes it to a given searchEngine and opens it in the default browser . Example: > , ((modm .|. shiftMask, xK_g), selectSearch google) This specializes "selectSearchBrowser" by supplying the browser argument as supplied by 'getBrowser' from "XMonad.Prompt.Shell". -} selectSearch :: SearchEngine -> X () selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine xmonad-contrib-0.18.0/XMonad/Actions/ShowText.hs0000644000000000000000000000740407346545000017631 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.ShowText -- Description : Display text on the screen. -- Copyright : (c) Mario Pastorelli (2012) -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : pastorelli.mario@gmail.com -- Stability : unstable -- Portability : unportable -- -- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen" -- which offers more features (currently) ----------------------------------------------------------------------------- module XMonad.Actions.ShowText ( -- * Usage -- $usage def , handleTimerEvent , flashText , ShowTextConfig(..) ) where import Data.Map (Map,empty,insert,lookup) import Prelude hiding (lookup) import XMonad import XMonad.Prelude (All, fi, listToMaybe) import XMonad.StackSet (current,screen) import XMonad.Util.Font (Align(AlignCenter) , initXMF , releaseXMF , textExtentsXMF , textWidthXMF) import XMonad.Util.Timer (startTimer) import XMonad.Util.XUtils (createNewWindow , deleteWindow , showWindow , paintAndWrite) import qualified XMonad.Util.ExtensibleState as ES -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.ShowText -- -- Then add the event hook handler: -- -- > xmonad { handleEventHook = myHandleEventHooks <> handleTimerEvent } -- -- You can then use flashText in your keybindings: -- -- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS) -- -- | ShowText contains the map with timers as keys and created windows as values newtype ShowText = ShowText (Map Atom Window) deriving (Read,Show) instance ExtensionClass ShowText where initialValue = ShowText empty -- | Utility to modify a ShowText modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText modShowText f (ShowText m) = ShowText $ f m data ShowTextConfig = STC { st_font :: String -- ^ Font name , st_bg :: String -- ^ Background color , st_fg :: String -- ^ Foreground color } 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" } -- | 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 if | mtyp == a, Just dh <- listToMaybe d -> whenJust (lookup (fromIntegral dh) m) deleteWindow | otherwise -> pure () mempty handleTimerEvent _ = mempty -- | Shows a window in the center of the screen with the given text flashText :: ShowTextConfig -> Rational -- ^ number of seconds -> String -- ^ text to display -> X () flashText c i s = do f <- initXMF (st_font c) d <- asks display sc <- gets $ fi . screen . current . windowset width <- textWidthXMF d f s (as,ds) <- textExtentsXMF f s let hight = as + ds ht = displayHeight d sc wh = displayWidth d sc y = (fi ht - hight + 2) `div` 2 x = (fi wh - width + 2) `div` 2 w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True showWindow w paintAndWrite w f (fi width) (fi hight) 0 (st_bg c) "" (st_fg c) (st_bg c) [AlignCenter] [s] releaseXMF f io $ sync d False t <- startTimer i ES.modify $ modShowText (insert (fromIntegral t) w) xmonad-contrib-0.18.0/XMonad/Actions/Sift.hs0000644000000000000000000000354107346545000016747 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Sift -- Description : Functions for sifting windows up and down. -- Copyright : (c) 2020 Ivan Brennan -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ivan Brennan -- Stability : stable -- Portability : unportable -- -- Functions for sifting windows up and down. Sifts behave identically to -- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in -- the wrapping case: rather than rotating the entire stack by one position -- like a swap would, a sift causes the windows at either end of the stack -- to trade positions. -- ----------------------------------------------------------------------------- module XMonad.Actions.Sift ( -- * Usage -- $usage siftUp, siftDown, ) where import XMonad.StackSet (Stack (Stack), StackSet, modify') import XMonad.Util.Stack (reverseS) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Sift -- -- and add keybindings such as the following: -- -- > , ((modMask .|. shiftMask, xK_j ), windows siftDown) -- > , ((modMask .|. shiftMask, xK_k ), windows siftUp ) -- -- | -- siftUp, siftDown. Exchange the focused window with its neighbour in -- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and -- 'swapDown', wrapping is handled by trading positions with the window -- at the other end of the stack. -- siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd siftUp = modify' siftUp' siftDown = modify' (reverseS . siftUp' . reverseS) siftUp' :: Stack a -> Stack a siftUp' (Stack t (l:ls) rs) = Stack t ls (l:rs) siftUp' (Stack t [] rs) = case reverse rs of (x:xs) -> Stack t (xs ++ [x]) [] [] -> Stack t [] [] xmonad-contrib-0.18.0/XMonad/Actions/SimpleDate.hs0000644000000000000000000000240507346545000020067 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SimpleDate -- Description : An example external contrib module for XMonad. -- Copyright : (c) Don Stewart 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : stable -- Portability : portable -- -- An example external contrib module for XMonad. -- Provides a simple binding to dzen2 to print the date as a popup menu. -- ----------------------------------------------------------------------------- module XMonad.Actions.SimpleDate ( -- * Usage -- $usage date ) where import XMonad.Core import XMonad.Util.Run -- $usage -- To use, import this module into @xmonad.hs@: -- -- > import XMonad.Actions.SimpleDate -- -- and add a keybinding, for example: -- -- > , ((modm, xK_d ), date) -- -- In this example, a popup date menu will now be bound to @mod-d@. -- -- For detailed instructions on editing your key bindings, see -- . date :: X () date = unsafeSpawn "(date; sleep 10) | dzen2" xmonad-contrib-0.18.0/XMonad/Actions/SinkAll.hs0000644000000000000000000000227107346545000017376 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SinkAll -- Description : (DEPRECATED) Push floating windows back into tiling. -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable -- -- Provides a simple binding that pushes all floating windows on the -- current workspace back into tiling. Note that the functionality of -- this module has been folded into the more general -- "XMonad.Actions.WithAll"; this module simply re-exports the -- 'sinkAll' function for backwards compatibility. ----------------------------------------------------------------------------- module XMonad.Actions.SinkAll {-# DEPRECATED "Use XMonad.Actions.WithAll instead" #-} ( -- * Usage -- $usage sinkAll) where import XMonad.Actions.WithAll (sinkAll) -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.SinkAll -- -- then add a keybinding; for example: -- -- > , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see -- . xmonad-contrib-0.18.0/XMonad/Actions/SpawnOn.hs0000644000000000000000000001052407346545000017426 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SpawnOn -- Description : Modify a window spawned by a command. -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- 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. -- Hence this module won't work on applications that don't set this property. -- ----------------------------------------------------------------------------- module XMonad.Actions.SpawnOn ( -- * Usage -- $usage Spawner, manageSpawn, manageSpawnWithGC, spawnHere, spawnOn, spawnAndDo, shellPromptHere, shellPromptOn ) where import System.Posix.Types (ProcessID) import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Process (getPPIDChain) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.SpawnOn -- -- > main = do -- > xmonad def { -- > ... -- > manageHook = manageSpawn <> manageHook def -- > ... -- > } -- -- To ensure that application appears on a workspace it was launched at, add keybindings like: -- -- > , ((mod1Mask,xK_o), spawnHere "urxvt") -- > , ((mod1Mask,xK_s), shellPromptHere def) -- -- The module can also be used to apply other manage hooks to the window of -- the spawned application(e.g. float or resize it). -- -- For detailed instructions on editing your key bindings, see -- . newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} instance ExtensionClass Spawner where initialValue = Spawner [] -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner f = XS.modify (Spawner . f . pidsRef) modifySpawnerM :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> X () modifySpawnerM f = XS.modifyM (fmap Spawner . f . pidsRef) -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. manageSpawn :: ManageHook manageSpawn = manageSpawnWithGC (return . take 20) manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@ -> ManageHook manageSpawnWithGC garbageCollect = pid >>= \case Nothing -> mempty Just p -> do Spawner pids <- liftX XS.get ppid_chain <- io $ getPPIDChain p case mapMaybe (`lookup` pids) ppid_chain of [] -> mempty mh : _ -> liftX (gc p) >> mh where gc p = modifySpawnerM $ garbageCollect . filter ((/= p) . fst) mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt cb c = do cmds <- io getCommands mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on current workspace. shellPromptHere :: XPConfig -> X () shellPromptHere = mkPrompt spawnHere -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on given workspace. shellPromptOn :: WorkspaceId -> XPConfig -> X () shellPromptOn ws = mkPrompt (spawnOn ws) -- | Replacement for 'spawn' which launches -- application on current workspace. spawnHere :: String -> X () spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd -- | Replacement for 'spawn' which launches -- application on given workspace. spawnOn :: WorkspaceId -> String -> X () 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) :) where -- TODO this is silly, search for a better solution mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs | otherwise = "exec " ++ xs metaChars = "&|;" xmonad-contrib-0.18.0/XMonad/Actions/Submap.hs0000644000000000000000000001242307346545000017270 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Submap -- Description : Create a sub-mapping of key bindings. -- Copyright : (c) Jason Creighton -- License : BSD3-style (see LICENSE) -- -- Maintainer : Jason Creighton -- Stability : unstable -- Portability : unportable -- -- A module that allows the user to create a sub-mapping of key bindings. -- ----------------------------------------------------------------------------- module XMonad.Actions.Submap ( -- * Usage -- $usage submap, visualSubmap, submapDefault, submapDefaultWithKey, -- * Utilities subName, ) where import Data.Bits import qualified Data.Map as M import XMonad hiding (keys) import XMonad.Prelude (fix, fromMaybe, keyToString, cleanKeyMask) import XMonad.Util.XUtils {- $usage First, import this module into your @xmonad.hs@: > import XMonad.Actions.Submap Allows you to create a sub-mapping of keys. Example: > , ((modm, xK_a), submap . M.fromList $ > [ ((0, xK_n), spawn "mpc next") > , ((0, xK_p), spawn "mpc prev") > , ((0, xK_z), spawn "mpc random") > , ((0, xK_space), spawn "mpc toggle") > ]) So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are, of course, free to use any combination of modifiers in the submapping. However, anyModifier will not work, because that is a special value passed to XGrabKey() and not an actual modifier. For detailed instructions on editing your key bindings, see . -} -- | Given a 'Data.Map.Map' from key bindings to X () actions, return -- an action which waits for a user keypress and executes the -- corresponding action, or does nothing if the key is not found in -- the map. submap :: M.Map (KeyMask, KeySym) (X ()) -> X () submap = submapDefault (return ()) -- | Like 'submap', but visualise the relevant options. -- -- ==== __Example__ -- -- > import qualified Data.Map as Map -- > import XMonad.Actions.Submap -- > -- > gotoLayout :: [(String, X ())] -- for use with EZConfig -- > gotoLayout = -- assumes you have a layout named "Tall" and one named "Full". -- > [("M-l", visualSubmap def $ Map.fromList $ map (\(k, s, a) -> ((0, k), (s, a))) -- > [ (xK_t, "Tall", switchToLayout "Tall") -- "M-l t" switches to "Tall" -- > , (xK_r, "Full", switchToLayout "Full") -- "M-l r" switches to "full" -- > ])] -- -- One could alternatively also write @gotoLayout@ as -- -- > gotoLayout = [("M-l", visualSubmap def $ Map.fromList $ -- > [ ((0, xK_t), subName "Tall" $ switchToLayout "Tall") -- > , ((0, xK_r), subName "Full" $ switchToLayout "Full") -- > ])] visualSubmap :: WindowConfig -- ^ The config for the spawned window. -> M.Map (KeyMask, KeySym) (String, X ()) -- ^ A map @keybinding -> (description, action)@. -> X () visualSubmap wc keys = withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) -> maybe (pure ()) snd (M.lookup (m', s) keys) where descriptions :: [String] descriptions = zipWith (\key desc -> keyToString key <> ": " <> desc) (M.keys keys) (map fst (M.elems keys)) -- | Give a name to an action. subName :: String -> X () -> (String, X ()) subName = (,) -- | Like 'submap', but executes a default action if the key did not match. submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X () submapDefault = submapDefaultWithKey . const -- | Like 'submapDefault', but sends the unmatched key to the default -- action as argument. submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> M.Map (KeyMask, KeySym) (X ()) -> X () submapDefaultWithKey defAction keys = waitForKeyPress >>= \(m', s) -> fromMaybe (defAction (m', s)) (M.lookup (m', s) keys) ----------------------------------------------------------------------- -- Internal stuff waitForKeyPress :: X (KeyMask, KeySym) waitForKeyPress = do XConf{ theRoot = root, display = dpy } <- ask io $ do grabKeyboard dpy root False grabModeAsync grabModeAsync currentTime grabPointer dpy root False buttonPressMask grabModeAsync grabModeAsync none none currentTime (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do maskEvent dpy (keyPressMask .|. buttonPressMask) p ev <- getEvent p case ev of KeyEvent { ev_keycode = code, ev_state = m } -> do keysym <- keycodeToKeysym dpy code 0 if isModifierKey keysym then nextkey else return (m, keysym) _ -> return (0, 0) m' <- cleanKeyMask <*> pure m io $ do ungrabPointer dpy currentTime ungrabKeyboard dpy currentTime sync dpy False pure (m', s) xmonad-contrib-0.18.0/XMonad/Actions/SwapPromote.hs0000644000000000000000000003774707346545000020341 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SwapPromote -- Description : Track the master window history per workspace. -- Copyright : (c) 2018 Yclept Nemo -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Module for tracking master window history per workspace, and associated -- functions for manipulating the stack using such history. -- ----------------------------------------------------------------------------- module XMonad.Actions.SwapPromote ( -- * Usage -- $usage MasterHistory (..) -- * State Accessors , getMasterHistoryMap , getMasterHistoryFromTag , getMasterHistoryCurrent , getMasterHistoryFromWindow , modifyMasterHistoryFromTag , modifyMasterHistoryCurrent -- * Log Hook , masterHistoryHook -- * Log Hook Building Blocks , masterHistoryHook' , updateMasterHistory -- * Actions , swapPromote , swapPromote' , swapIn , swapIn' , swapHybrid , swapHybrid' -- * Action Building Blocks , swapApply , swapPromoteStack , swapInStack , swapHybridStack -- * List Utilities , cycleN , split , split' , merge , merge' -- * Stack Utilities , stackSplit , stackMerge ) where import XMonad import 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 Control.Arrow import qualified Data.List.NonEmpty as NE -- $usage -- Given your configuration file, import this module: -- -- > import XMonad.Actions.SwapPromote -- -- First add 'masterHistoryHook' to your 'logHook' to track master windows per -- workspace: -- -- > myLogHook = otherHook >> masterHistoryHook -- -- Then replace xmonad's default promote keybinding with 'swapPromote'': -- -- > , ((mod1Mask, xK_Return), swapPromote' False) -- -- Depending on your xmonad configuration or window actions the master history -- may be empty. If this is the case you can still chain another promotion -- function: -- -- > import XMonad.Actions.DwmPromote -- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote) -- -- To be clear, this is only called when the lack of master history hindered -- the swap and not other conditions, such as having a only a single window. -- -- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus -- position - effectively "swapping" new windows into focus without moving the -- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows -- while swapping windows into the focused master. This works well on layouts -- with large masters. Both come with chainable variants, see 'swapIn'' and -- 'swapHybrid''. -- -- So far floating windows have been treated no differently than tiled windows -- even though their positions are independent of the stack. Often, yanking -- floating windows in and out of the workspace will obliterate the stack -- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is -- toggled so frequenty and always replaces the master window. That's why the -- swap functions accept a boolean argument; when @True@ non-focused floating -- windows will be ignored. -- -- All together: -- -- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote) -- | Mapping from workspace tag to master history list. The current master is -- the head of the list, the previous master the second element, and so on. -- Without history, the list is empty. newtype MasterHistory = MasterHistory { getMasterHistory :: M.Map WorkspaceId [Window] } deriving (Read,Show) instance ExtensionClass MasterHistory where initialValue = MasterHistory M.empty -- | Return the master history map from the state. getMasterHistoryMap :: X (M.Map WorkspaceId [Window]) getMasterHistoryMap = XS.gets getMasterHistory -- | Return the master history list of a given tag. The master history list may -- be empty. An invalid tag will also result in an empty list. getMasterHistoryFromTag :: WorkspaceId -> X [Window] getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap -- | Return the master history list of the current workspace. getMasterHistoryCurrent :: X [Window] getMasterHistoryCurrent = gets (W.currentTag . windowset) >>= getMasterHistoryFromTag -- | Return the master history list of the workspace containing the given -- window. Return an empty list if the window is not in the stackset. getMasterHistoryFromWindow :: Window -> X [Window] getMasterHistoryFromWindow w = gets (W.findTag w . windowset) >>= maybe (return []) getMasterHistoryFromTag -- | Modify the master history list of a given workspace, or the empty list of -- no such workspace is mapped. The result is then re-inserted into the master -- history map. modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X () modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) -> let l = M.findWithDefault [] t m in MasterHistory $ M.insert t (f l) m -- | Modify the master history list of the current workspace. While the current -- workspace is guaranteed to exist; its master history may not. For more -- information see 'modifyMasterHistoryFromTag'. modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X () modifyMasterHistoryCurrent f = gets (W.currentTag . windowset) >>= flip modifyMasterHistoryFromTag f -- | A 'logHook' to update the master history mapping. Non-existent workspaces -- are removed, and the master history list for the current workspaces is -- updated. See 'masterHistoryHook''. masterHistoryHook :: X () masterHistoryHook = masterHistoryHook' True updateMasterHistory -- | Backend for 'masterHistoryHook'. masterHistoryHook' :: Bool -- ^ If @True@, remove non-existent workspaces. -> ([Window] -> [Window] -> [Window]) -- ^ Function used to update the master history list of -- the current workspace. First argument is the master -- history, second is the integrated stack. See -- 'updateMasterHistory' for more details. -> X () masterHistoryHook' removeWorkspaces historyModifier = do wset <- gets windowset let W.Workspace wid _ mst = W.workspace . W.current $ wset tags = map W.tag $ W.workspaces wset st = W.integrate' mst XS.modify $ \(MasterHistory mm) -> let mm' = if removeWorkspaces then restrictKeys mm $ S.fromList tags else mm ms = M.findWithDefault [] wid mm' ms' = historyModifier ms st in MasterHistory $ M.insert wid ms' mm' -- | Less efficient version of 'M.restrictKeys'. Given broader eventual -- adoption, replace this with 'M.restrictKeys'. restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m -- | Given the current master history list and an integrated stack, return the -- new master history list. The current master is either moved (if it exists -- within the history) or added to the head of the list, and all missing (i.e. -- closed) windows are removed. updateMasterHistory :: [Window] -- ^ The master history list. -> [Window] -- ^ The integrated stack. -> [Window] updateMasterHistory _ [] = [] updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws -- | Wrap 'swapPromoteStack'; see also 'swapApply'. swapPromote :: Bool -> X Bool swapPromote = flip swapApply swapPromoteStack -- | Like 'swapPromote'' but discard the result. swapPromote' :: Bool -> X () swapPromote' = void . swapPromote -- | Wrap 'swapInStack'; see also 'swapApply'. swapIn :: Bool -> X Bool swapIn = flip swapApply swapInStack -- | Like 'swapIn'' but discard the result. swapIn' :: Bool -> X () swapIn' = void . swapIn -- | Wrap 'swapHybridStack'; see also 'swapApply'. swapHybrid :: Bool -> X Bool swapHybrid = flip swapApply swapHybridStack -- | Like 'swapHybrid'' but discard the result. swapHybrid' :: Bool -> X () swapHybrid' = void . swapHybrid -- | Apply the given master history stack modifier to the current stack. If -- given @True@, all non-focused floating windows will be ignored. Return -- @True@ if insufficient history; if so use 'whenX' to sequence a backup -- promotion function. swapApply :: Bool -> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)) -> X Bool swapApply ignoreFloats swapFunction = do fl <- gets $ W.floating . windowset st <- gets $ W.stack . W.workspace . W.current . windowset ch <- getMasterHistoryCurrent let swapApply' s1 = let fl' = if ignoreFloats then M.keysSet fl else S.empty ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1) fh = filter ff ch pm = listToMaybe . drop 1 $ fh (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window) (b,s3) = swapFunction pm s2 s4 = stackMerge s3 r mh = let w = NE.head . notEmpty . W.integrate $ s3 in const $ w : delete w ch in (b,Just s4,mh) (x,y,z) = maybe (False,Nothing,id) swapApply' st -- Any floating master windows will be added to the history when 'windows' -- calls the log hook. modifyMasterHistoryCurrent z windows $ W.modify Nothing . const $ y return x -- | If the focused window is the master window and there is no previous -- master, do nothing. Otherwise swap the master with the previous master. If -- the focused window is not the master window, swap it with the master window. -- In either case focus follows the original window, i.e. the focused window -- does not change, only its position. -- -- The first argument is the previous master (which may not exist), the second -- a window stack. Return @True@ if the master history hindered the swap; the -- history is either empty or out-of-sync. Though the latter shouldn't happen -- this function never changes the stack under such circumstances. swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window) swapPromoteStack _ st@(W.Stack _x [] []) = (False,st) swapPromoteStack Nothing st@(W.Stack _x [] _r) = (True,st) swapPromoteStack (Just pm) (W.Stack x [] r) = let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r st' = W.Stack x l' r' b = null l' in (b,st') swapPromoteStack _ (W.Stack x l r) = let r' = (++ r) . cycleN 1 . reverse $ l st' = W.Stack x [] r' in (False,st') -- | Perform the same swap as 'swapPromoteStack'. However the new window -- receives the focus; it appears to "swap into" the position of the original -- window. Under this model focus follows stack position and the zipper does -- not move. -- -- See 'swapPromoteStack' for more details regarding the parameters. swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window) swapInStack _ st@(W.Stack _x [] []) = (False,st) swapInStack Nothing st@(W.Stack _x [] _r) = (True,st) swapInStack (Just pm) (W.Stack x [] r) = let (x',r') = case span (/= pm) r of (__,[]) -> (x,r) (sl,sr) -> (pm,sl ++ x : drop 1 sr) st' = W.Stack x' [] r' b = x' == x in (b,st') swapInStack _ (W.Stack x l r) = let l' = init l ++ [x] x' = last l st' = W.Stack x' l' r in (False,st') -- | If the focused window is the master window, use 'swapInStack'. Otherwise use -- 'swapPromoteStack'. -- -- See 'swapPromoteStack' for more details regarding the parameters. swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window) swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st swapHybridStack m st = swapPromoteStack m st -- | Cycle a list by the given count. If positive, cycle to the left. If -- negative, cycle to the right: -- -- >>> cycleN 2 [1,2,3,4,5] -- [3,4,5,1,2] -- >>> cycleN (-2) [1,2,3,4,5] -- [4,5,1,2,3] cycleN :: Int -> [a] -> [a] cycleN n ls = let l = length ls in take l $ drop (n `mod` l) $ cycle ls -- | Wrap 'split'' with an initial index of @0@, discarding the list's length. split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b]) split p l = let (_,ys,ns) = split' p 0 l in (ys,ns) -- | Given a predicate, an initial index and a list, return a tuple containing: -- -- * List length. -- * Indexed list of elements which satisfy the predicate. An indexed element -- is a tuple containing the element index (offset by the initial index) and -- the element. -- * List of elements which do not satisfy the predicate. -- -- The initial index and length of the list simplify chaining calls to this -- function, such as for zippers of lists. split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b]) split' p i l = let accumulate e (c,ys,ns) = if p (snd e) then (c+1,e:ys,ns) else (c+1,ys,e:ns) (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l in (c',ys',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. merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b] merge il ul = let (_,il',ul') = merge' 0 il ul in ul' ++ map snd il' -- | Inverse of 'split'. Merge an indexed list with an unindexed list (see -- 'split''). Given a virtual index, an indexed list and an unindexed list, -- return a tuple containing: -- -- * Virtual index /after/ the unindexed list -- * Remainder of the indexed list -- * Merged unindexed list -- -- If the indexed list is empty, this functions consumes the entire unindexed -- list. If the unindexed list is empty, this function consumes only adjacent -- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing -- unindexed elements and so once @(10,"ten")@ is consumed this function -- concludes. -- -- The indexed list is assumed to have been created by 'split'' and not checked -- for correctness. Indices are assumed to be ascending, i.e. -- > [(1,"one"),(2,"two"),(4,"four")] -- -- The initial and final virtual indices simplify chaining calls to the this -- function, as as for zippers of lists. Positive values shift the unindexed -- list towards the tail, as if preceded by that many elements. merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b]) merge' i il@((j,a):ps) ul@(b:bs) = if j <= i then let (x,y,z) = merge' (i+1) ps ul in (x,y,a:z) else let (x,y,z) = merge' (i+1) il bs in (x,y,b:z) merge' i [] (b:bs) = let (x,y,z) = merge' (i+1) [] bs in (x,y,b:z) merge' i il@((j,a):ps) [] = if j <= i then let (x,y,z) = merge' (i+1) ps [] in (x,y,a:z) else (i,il,[]) merge' i [] [] = (i,[],[]) -- | Remove all elements of the set from the stack. Skip the currently focused -- member. Return an indexed list of excluded elements and the modified stack. -- Use 'stackMerge' to re-insert the elements using this list. stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b) stackSplit (W.Stack x l r) s = let (c,fl,tl) = split' (`S.member` s) 0 (reverse l) (_,fr,tr) = split' (`S.member` s) (c+1) r in (fl++fr,W.Stack x (reverse tl) tr) -- | Inverse of 'stackSplit'. Given a list of elements and their original -- indices, re-insert the elements into these same positions within the stack. -- Skip the currently focused member. Works best if the stack's length hasn't -- changed, though if shorter any leftover elements will be tacked on. stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b stackMerge (W.Stack x l r) il = let (i,il1,l') = merge' 0 il (reverse l) (_,il2,r') = merge' (i+1) il1 r in W.Stack x (reverse l') (r' ++ map snd il2) xmonad-contrib-0.18.0/XMonad/Actions/SwapWorkspaces.hs0000644000000000000000000000476207346545000021024 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SwapWorkspaces -- Description : Swap workspace tags without having to move individual windows. -- Copyright : (c) Devin Mullins -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- Lets you swap workspace tags, so you can keep related ones next to -- each other, without having to move individual windows. -- ----------------------------------------------------------------------------- module XMonad.Actions.SwapWorkspaces ( -- * Usage -- $usage swapWithCurrent, swapTo, swapWorkspaces, Direction1D(..) ) where import XMonad (windows, X()) import XMonad.StackSet import XMonad.Actions.CycleWS import XMonad.Util.WorkspaceCompare -- $usage -- Add this import to your @xmonad.hs@: -- -- > import XMonad.Actions.SwapWorkspaces -- -- Then throw something like this in your keys definition: -- -- > ++ -- > [((modm .|. controlMask, k), windows $ swapWithCurrent i) -- > | (i, k) <- zip workspaces [xK_1 ..]] -- -- After installing this update, if you're on workspace 1, hitting mod-ctrl-5 -- will swap workspaces 1 and 5. -- -- For detailed instructions on editing your key bindings, see -- . -- | Swaps the currently focused workspace with the given workspace tag, via -- @swapWorkspaces@. swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd swapWithCurrent t s = swapWorkspaces t (currentTag s) s -- | 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 -- | 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 | tag w == t1 = w { tag = t2 } | tag w == t2 = w { tag = t1 } | otherwise = w xmonad-contrib-0.18.0/XMonad/Actions/TagWindows.hs0000644000000000000000000001647207346545000020137 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.TagWindows -- Description : Functions for tagging windows and selecting them by tags. -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : unstable -- Portability : unportable -- -- Functions for tagging windows and selecting them by tags. ----------------------------------------------------------------------------- module XMonad.Actions.TagWindows ( -- * Usage -- $usage addTag, delTag, unTag, setTags, getTags, hasTag, withTaggedP, withTaggedGlobalP, withFocusedP, withTagged , withTaggedGlobal , focusUpTagged, focusUpTaggedGlobal, focusDownTagged, focusDownTaggedGlobal, shiftHere, shiftToScreen, tagPrompt, tagDelPrompt, TagPrompt, ) where import Control.Exception as E import XMonad hiding (workspaces) import XMonad.Prelude import XMonad.Prompt import XMonad.StackSet hiding (filter) econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- -- To use window tags, import this module into your @xmonad.hs@: -- -- > import XMonad.Actions.TagWindows -- > import XMonad.Prompt -- to use tagPrompt -- -- and add keybindings such as the following: -- -- > , ((modm, xK_f ), withFocused (addTag "abc")) -- > , ((modm .|. controlMask, xK_f ), withFocused (delTag "abc")) -- > , ((modm .|. shiftMask, xK_f ), withTaggedGlobalP "abc" W.sink) -- > , ((modm, xK_d ), withTaggedP "abc" (W.shiftWin "2")) -- > , ((modm .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) -- > , ((modm .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") -- > , ((modm, xK_g ), tagPrompt def (\s -> withFocused (addTag s))) -- > , ((modm .|. controlMask, xK_g ), tagDelPrompt def) -- > , ((modm .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobal s float)) -- > , ((modWinMask, xK_g ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2"))) -- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere)) -- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s)) -- -- NOTE: Tags are saved as space separated strings and split with -- 'unwords'. Thus if you add a tag \"a b\" the window will have -- the tags \"a\" and \"b\" but not \"a b\". -- -- For detailed instructions on editing your key bindings, see -- . -- | set multiple tags for a window at once (overriding any previous tags) setTags :: [String] -> Window -> X () setTags = setTag . unwords -- | set a tag for a window (overriding any previous tags) -- writes it to the \"_XMONAD_TAGS\" window property setTag :: String -> Window -> X () setTag s w = withDisplay $ \d -> io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s -- | read all tags of a window -- reads from the \"_XMONAD_TAGS\" window property getTags :: Window -> X [String] getTags w = withDisplay $ \d -> io $ E.catch (internAtom d "_XMONAD_TAGS" False >>= getTextProperty d w >>= wcTextPropertyToTextList d) (econst [[]]) <&> (words . unwords) -- | check a window for the given tag hasTag :: String -> Window -> X Bool 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 when (s `notElem` tags) $ setTags (s:tags) w -- | remove a tag from a window, if it exists delTag :: String -> Window -> X () delTag s w = do tags <- getTags w setTags (filter (/= s) tags) w -- | remove all tags unTag :: Window -> X () unTag = setTag "" -- | Move the focus in a group of windows, which share the same given tag. -- The Global variants move through all workspaces, whereas the other -- ones operate only on the current workspace focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X () focusUpTagged = focusTagged' (reverse . wsToList) focusDownTagged = focusTagged' wsToList focusUpTaggedGlobal = focusTagged' (reverse . wsToListGlobal) focusDownTaggedGlobal = focusTagged' wsToListGlobal wsToList :: (Ord i) => StackSet i l a s sd -> [a] wsToList ws = crs ++ cls where (crs, cls) = (cms down, cms (reverse . up)) cms f = maybe [] f (stack . workspace . current $ ws) wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a] wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls]) where curtag = currentTag ws (crs, cls) = (cms down, cms (reverse . up)) cms f = maybe [] f (stack . workspace . current $ ws) (lws, rws) = (mws (<), mws (>)) mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws sortByTag = sortBy (\x y -> compare (tag x) (tag y)) focusTagged' :: (WindowSet -> [Window]) -> String -> X () focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>= maybe (return ()) (windows . focusWindow) -- | apply a pure function to windows with a tag withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X () withTaggedP t f = withTagged' t (winMap f) withTaggedGlobalP t f = withTaggedGlobal' t (winMap f) winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X () winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw)) withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X () withTagged t f = withTagged' t (mapM_ f) withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f) withTagged' :: String -> ([Window] -> X ()) -> X () withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m withTaggedGlobal' :: String -> ([Window] -> X ()) -> X () withTaggedGlobal' t m = gets windowset >>= filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m withFocusedP :: (Window -> WindowSet -> WindowSet) -> X () withFocusedP f = withFocused $ windows . f shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd 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 [] -> s (t:_) -> shiftWin (tag . workspace $ t) w s data TagPrompt = TagPrompt instance XPrompt TagPrompt where showXPrompt TagPrompt = "Select Tag: " tagPrompt :: XPConfig -> (String -> X ()) -> X () tagPrompt c f = do sc <- tagComplList mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f tagComplList :: X [String] tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset) >>= mapM getTags <&> nub . concat tagDelPrompt :: XPConfig -> X () tagDelPrompt c = do sc <- tagDelComplList when (sc /= []) $ mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag) tagDelComplList :: X [String] tagDelComplList = gets windowset >>= maybe (return []) getTags . peek xmonad-contrib-0.18.0/XMonad/Actions/TiledWindowDragging.hs0000644000000000000000000000656507346545000021747 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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. -- Stability : unstable -- Portability : unportable -- -- Provides an action that allows you to change the position of windows by dragging them around. -- ----------------------------------------------------------------------------- module XMonad.Actions.TiledWindowDragging ( -- * Usage -- $usage dragWindow ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.DraggingVisualizer -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.TiledWindowDragging -- > import XMonad.Layout.DraggingVisualizer -- -- then edit your 'layoutHook' by adding the draggingVisualizer to your layout: -- -- > myLayout = draggingVisualizer $ layoutHook def -- -- Then add a mouse binding for 'dragWindow': -- -- > , ((modMask .|. shiftMask, button1), dragWindow) -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- | Create a mouse binding for this to be able to drag your windows around. -- You need "XMonad.Layout.DraggingVisualizer" for this to look good. dragWindow :: Window -> X () dragWindow window = whenX (isClient window) $ withDisplay $ \dpy -> withWindowAttributes dpy window $ \wa -> do focus window (offsetX, offsetY) <- getPointerOffset window let (winX, winY, winWidth, winHeight) = getWindowPlacement wa mouseDrag (\posX posY -> let rect = Rectangle (fi (fi winX + (posX - fi offsetX))) (fi (fi winY + (posY - fi offsetY))) (fi winWidth) (fi winHeight) in sendMessage $ DraggingWindow window rect ) (sendMessage DraggingStopped >> performWindowSwitching window) -- | get the pointer offset relative to the given windows root coordinates getPointerOffset :: Window -> X (Int, Int) getPointerOffset win = do (_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win) return (fi oX, fi oY) -- | return a tuple of windowX, windowY, windowWidth, windowHeight getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int) getWindowPlacement wa = (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa) performWindowSwitching :: Window -> X () performWindowSwitching win = do root <- asks theRoot (_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root) ws <- gets windowset let allWindows = W.index ws when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows (ls, t : rs) <- pure $ break (== win) allWindowsSwitched let newStack = W.Stack t (reverse ls) rs windows $ W.modify' $ const newStack where switchEntries a b x | x == a = b | x == b = a | otherwise = x xmonad-contrib-0.18.0/XMonad/Actions/ToggleFullFloat.hs0000644000000000000000000001101507346545000021067 0ustar0000000000000000-- | -- Module : XMonad.Actions.ToggleFullFloat -- Description : Fullscreen (float) a window while remembering its original state. -- Copyright : (c) 2022 Tomáš Janoušek -- License : BSD3 -- Maintainer : Tomáš Janoušek -- module XMonad.Actions.ToggleFullFloat ( -- * Usage -- $usage toggleFullFloatEwmhFullscreen, toggleFullFloat, fullFloat, unFullFloat, gcToggleFullFloat, ) where import qualified Data.Map.Strict as M import XMonad import XMonad.Prelude import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks) import XMonad.Hooks.ManageHelpers import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -- --------------------------------------------------------------------- -- $usage -- -- The main use-case is to make 'ewmhFullscreen' (re)store the size and -- position of floating windows instead of just unconditionally sinking them -- into the floating layer. To enable this, you'll need this in your -- @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.ToggleFullFloat -- > import XMonad.Hooks.EwmhDesktops -- > -- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…} -- -- Additionally, this "smart" fullscreening can be bound to a key and invoked -- manually whenever one needs a larger window temporarily: -- -- > , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat) newtype ToggleFullFloat = ToggleFullFloat{ fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) } deriving (Show, Read) instance ExtensionClass ToggleFullFloat where extensionType = PersistentExtension initialValue = ToggleFullFloat mempty -- | Full-float a window, remembering its state (tiled/floating and -- position/size). fullFloat :: Window -> X () fullFloat = windows . appEndo <=< runQuery doFullFloatSave -- | Restore window to its remembered state. unFullFloat :: Window -> X () unFullFloat = windows . appEndo <=< runQuery doFullFloatRestore -- | Full-float a window, if it's not already full-floating. Otherwise, -- restore its original state. toggleFullFloat :: Window -> X () toggleFullFloat w = ifM (isFullFloat w) (unFullFloat w) (fullFloat w) isFullFloat :: Window -> X Bool isFullFloat w = gets $ (Just fullRect ==) . M.lookup w . W.floating . windowset where fullRect = W.RationalRect 0 0 1 1 doFullFloatSave :: ManageHook doFullFloatSave = do w <- ask liftX $ do f <- gets $ M.lookup w . W.floating . windowset -- @M.insertWith const@ = don't overwrite stored original state XS.modify' $ ToggleFullFloat . M.insertWith const w f . fromToggleFullFloat doFullFloat doFullFloatRestore :: ManageHook doFullFloatRestore = do w <- ask mf <- liftX $ do mf <- XS.gets $ M.lookup w . fromToggleFullFloat XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat pure mf doF $ case mf of Just (Just f) -> W.float w f -- was floating before Just Nothing -> W.sink w -- was tiled before Nothing -> W.sink w -- fallback when not found in ToggleFullFloat -- | Install ToggleFullFloat garbage collection hooks. -- -- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if -- using the 'toggleFullFloat' separately from the EWMH hook. gcToggleFullFloat :: XConfig a -> XConfig a gcToggleFullFloat c = c { startupHook = startupHook c <> gcToggleFullFloatStartupHook , handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook } -- | ToggleFullFloat garbage collection: drop windows when they're destroyed. gcToggleFullFloatEventHook :: Event -> X All gcToggleFullFloatEventHook DestroyWindowEvent{ev_window = w} = do XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat mempty gcToggleFullFloatEventHook _ = mempty -- | ToggleFullFloat garbage collection: restrict to existing windows at -- startup. gcToggleFullFloatStartupHook :: X () gcToggleFullFloatStartupHook = withWindowSet $ \ws -> XS.modify' $ ToggleFullFloat . M.filterWithKey (\w _ -> w `W.member` ws) . fromToggleFullFloat -- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This -- makes windows restore their original state (size and position if floating) -- instead of unconditionally sinking into the tiling layer. -- -- ('gcToggleFullFloat' is included here.) toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a toggleFullFloatEwmhFullscreen = setEwmhFullscreenHooks doFullFloatSave doFullFloatRestore . gcToggleFullFloat xmonad-contrib-0.18.0/XMonad/Actions/TopicSpace.hs0000644000000000000000000003701707346545000020101 0ustar0000000000000000{-# 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) -- -- Maintainer : Nicolas Pouillard -- Stability : unstable -- Portability : unportable -- -- Turns your workspaces into a more topic oriented system. ----------------------------------------------------------------------------- module XMonad.Actions.TopicSpace ( -- * Overview -- $overview -- * Usage -- $usage -- * Types for Building Topics Topic , Dir , TopicConfig(..) , 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 -- * Utility , currentTopicDir , checkTopicConfig , (>*>) ) where import XMonad import XMonad.Prelude import qualified Data.Map.Strict as M import qualified XMonad.Hooks.StatusBar.PP as SBPP import qualified XMonad.StackSet as W import Data.Map (Map) import XMonad.Prompt (XPConfig) import XMonad.Prompt.Workspace (workspacePrompt) 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 -- instead of having a workspace called `work' you can setup one workspace per -- task. Here we call these workspaces, topics. The great thing with -- topics is that one can attach a directory that makes sense to each -- particular topic. One can also attach an action which will be triggered -- when switching to a topic that does not have any windows in it. So you can -- attach your mail client to the mail topic, some terminals in the right -- directory to the xmonad topic... This package also provides a nice way to -- display your topics in an historical way using a custom `pprWindowSet' -- function. You can also easily switch to recent topics using this history -- of last focused topics. -- -- A blog post highlighting some features of this module can be found -- . -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > 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 = tiDirs topicItems -- > , topicActions = tiActions topicItems -- > , defaultTopicAction = const (pure ()) -- by default, do nothing -- > , defaultTopic = "1:WEB" -- fallback -- > } -- -- 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 $ "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 def goto -- > -- > promptedShift :: X () -- > 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-", 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 $ def -- > { workspaces = topicNames topicItems -- > } -- > `additionalKeysP` myKeys -- | An alias for @flip replicateM_@ (>*>) :: Monad m => m a -> Int -> m () (>*>) = flip replicateM_ infix >*> -- | 'Topic' is just an alias for 'WorkspaceId' type Topic = WorkspaceId -- | '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 :: 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 (= fallback) topic. , maxTopicHistory :: Int -- ^ 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 } -- | 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', 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 = workspaceHistoryModify reverse -- | 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 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, trigger the action associated with -- the topic given in prompt. topicActionWithPrompt :: XPConfig -> TopicConfig -> X () topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg)) -- | 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 -- | Trigger the action associated with the current topic. currentTopicAction :: TopicConfig -> X () currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset) -- | Switch to the given topic. switchTopic :: TopicConfig -> Topic -> X () 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 tc topic -- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'. switchNthLastFocused :: TopicConfig -> Int -> X () switchNthLastFocused = switchNthLastFocusedExclude [] -- | 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) workspaceHistory whenJust ws $ windows . W.shift -- | 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 duplicate or undefined topics. checkTopicConfig :: [Topic] -> TopicConfig -> IO () checkTopicConfig tags tg = do -- 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 check diffTopic "Seen but missing topics/workspaces" check dups "Duplicate topics/workspaces" -- | 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-contrib-0.18.0/XMonad/Actions/TreeSelect.hs0000644000000000000000000006277507346545000020117 0ustar0000000000000000{-# 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 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tom Smeets -- Stability : unstable -- Portability : unportable -- -- -- 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. -- -- Only the nodes up to the currently selected are displayed. -- This will be configurable in the near future by changing 'ts_hidechildren' to @False@, this is not yet implemented. -- -- <> -- ----------------------------------------------------------------------------- module XMonad.Actions.TreeSelect ( -- * Usage -- $usage treeselectWorkspace , toWorkspaces , treeselectAction -- * Configuring -- $config , Pixel -- $pixel , TSConfig(..) , tsDefaultConfig , def -- * Navigation -- $navigation , defaultNavigation , select , cancel , moveParent , moveChild , moveNext , movePrev , moveHistBack , moveHistForward , moveTo -- * Advanced usage -- $advusage , TSNode(..) , treeselect , treeselectAt ) where import Control.Monad.Reader import Control.Monad.State import Data.Tree import Foreign (shiftL, shiftR, (.&.)) import System.IO import XMonad hiding (liftX) import XMonad.Prelude import XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.NamedWindows import XMonad.Util.TreeZipper import XMonad.Hooks.WorkspaceHistory import qualified Data.Map as M #ifdef XFT import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender import Graphics.X11.Xft #endif -- $usage -- -- These imports are used in the following example -- -- > import Data.Tree -- > import XMonad.Actions.TreeSelect -- > import XMonad.Hooks.WorkspaceHistory -- > import qualified XMonad.StackSet as W -- -- For selecting Workspaces, you need to define them in a tree structure using 'Data.Tree.Node' instead of just a standard list -- -- Here is an example workspace-tree -- -- > myWorkspaces :: Forest String -- > myWorkspaces = [ Node "Browser" [] -- a workspace for your browser -- > , Node "Home" -- for everyday activity's -- > [ Node "1" [] -- with 4 extra sub-workspaces, for even more activity's -- > , Node "2" [] -- > , Node "3" [] -- > , Node "4" [] -- > ] -- > , Node "Programming" -- for all your programming needs -- > [ Node "Haskell" [] -- > , Node "Docs" [] -- documentation -- > ] -- > ] -- -- Then add it to your 'XMonad.Core.workspaces' using the 'toWorkspaces' function. -- -- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces -- -- > 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 -- -- you could bind @Mod-f@ to switch workspace -- -- > , ((modMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.greedyView) -- -- and bind @Mod-Shift-f@ to moving the focused windows to a workspace -- -- > , ((modMask .|. shiftMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.shift) -- $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 'def' -- -- > 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 -- -- The 'Pixel' Color format is in the form of @0xaarrggbb@ -- -- Note that transparency is only supported if you have a window compositor running like -- -- Some Examples: -- -- @ -- white = 0xffffffff -- black = 0xff000000 -- red = 0xffff0000 -- green = 0xff00ff00 -- blue = 0xff0000ff -- transparent = 0x00000000 -- @ -- $navigation -- -- Keybindings for navigations can also be modified -- -- This is the definition of 'defaultNavigation' -- -- > defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a)) -- > defaultNavigation = M.fromList -- > [ ((0, xK_Escape), cancel) -- > , ((0, xK_Return), select) -- > , ((0, xK_space), select) -- > , ((0, xK_Up), movePrev) -- > , ((0, xK_Down), moveNext) -- > , ((0, xK_Left), moveParent) -- > , ((0, xK_Right), moveChild) -- > , ((0, xK_k), movePrev) -- > , ((0, xK_j), moveNext) -- > , ((0, xK_h), moveParent) -- > , ((0, xK_l), moveChild) -- > , ((0, xK_o), moveHistBack) -- > , ((0, xK_i), moveHistForward) -- > ] -- $advusage -- This module can also be used to select any other action -- | Extensive configuration for displaying the tree. -- -- This class also has a 'Default' instance data TSConfig a = TSConfig { ts_hidechildren :: Bool -- ^ when enabled, only the parents (and their first children) of the current node will be shown (This feature is not yet implemented!) , ts_background :: Pixel -- ^ background color filling the entire screen. , ts_font :: String -- ^ XMF font for drawing the node name extra text , ts_node :: (Pixel, Pixel) -- ^ node foreground (text) and background color when not selected , ts_nodealt :: (Pixel, Pixel) -- ^ every other node will use this color instead of 'ts_node' , ts_highlight :: (Pixel, Pixel) -- ^ node foreground (text) and background color when selected , ts_extra :: Pixel -- ^ extra text color , ts_node_width :: Int -- ^ node width in pixels , ts_node_height :: Int -- ^ node height in pixels , ts_originX :: Int -- ^ tree X position on the screen in pixels , ts_originY :: Int -- ^ tree Y position on the screen in pixels , ts_indent :: Int -- ^ indentation amount for each level in pixels , ts_navigate :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a)) -- ^ key bindings for navigating the tree } instance Default (TSConfig a) where 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 } -- | Default navigation -- -- * navigation using either arrow key or vi style hjkl -- * Return or Space to confirm -- * Escape or Backspace to cancel to defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a)) defaultNavigation = M.fromList [ ((0, xK_Escape), cancel) , ((0, xK_Return), select) , ((0, xK_space), select) , ((0, xK_Up), movePrev) , ((0, xK_Down), moveNext) , ((0, xK_Left), moveParent) , ((0, xK_Right), moveChild) , ((0, xK_k), movePrev) , ((0, xK_j), moveNext) , ((0, xK_h), moveParent) , ((0, xK_l), moveChild) , ((0, xK_o), moveHistBack) , ((0, xK_i), moveHistForward) ] -- | Default configuration. -- -- 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 , tsn_extra :: String -- ^ extra text, displayed next to the node name , tsn_value :: a -- ^ value to return when this node is selected } -- | State used by TreeSelect. -- -- Contains all needed information such as the window, font and a zipper over the tree. data TSState a = TSState { tss_tree :: TreeZipper (TSNode a) , tss_window :: Window , tss_display :: Display , tss_size :: (Int, Int) -- ^ size of 'tz_window' , tss_xfont :: XMonadFont , tss_gc :: GC , tss_visual :: Visual , tss_colormap :: Colormap , tss_history :: ([[String]], [[String]]) -- ^ history zipper, navigated with 'moveHistBack' and 'moveHistForward' } -- | State monad transformer using 'TSState' newtype TreeSelect a b = TreeSelect { runTreeSelect :: ReaderT (TSConfig a) (StateT (TSState a) X) b } deriving (Monad, Applicative, Functor, MonadState (TSState a), MonadReader (TSConfig a), MonadIO) -- | Lift the 'X' action into the 'XMonad.Actions.TreeSelect.TreeSelect' monad liftX :: X a -> TreeSelect b a liftX = TreeSelect . lift . lift -- | Run Treeselect with a given config and tree. -- This can be used for selectiong anything -- -- * for switching workspaces and moving windows use 'treeselectWorkspace' -- * for selecting actions use 'treeselectAction' treeselect :: TSConfig a -- ^ config file -> Forest (TSNode a) -- ^ a list of 'Data.Tree.Tree's to select from. -> X (Maybe a) treeselect c t = treeselectAt c (fromForest t) [] -- | Same as 'treeselect' but ad a specific starting position treeselectAt :: TSConfig a -- ^ config file -> TreeZipper (TSNode a) -- ^ tree structure with a cursor position (starting node) -> [[String]] -- ^ list of paths that can be navigated with 'moveHistBack' and 'moveHistForward' (bound to the 'o' and 'i' keys) -> X (Maybe a) treeselectAt conf@TSConfig{..} zipper hist = withDisplay $ \display -> do -- create a window on the currently focused screen rootw <- asks theRoot Rectangle{..} <- gets $ screenRect . W.screenDetail . W.current . windowset Just vinfo <- liftIO $ matchVisualInfo display (defaultScreen display) 32 4 colormap <- liftIO $ createColormap display rootw (visualInfo_visual vinfo) allocNone win <- liftIO $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True set_colormap attributes colormap set_background_pixel attributes ts_background set_border_pixel attributes 0 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? -- make the window visible mapWindow display win -- listen to key and mouse button events selectInput display win (exposureMask .|. keyPressMask .|. buttonReleaseMask) -- TODO: enable mouse select? -- and mouse button 1 grabButton display button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none -- grab the keyboard status <- liftIO $ grabKeyboard display win True grabModeAsync grabModeAsync currentTime r <- if status == grabSuccess then do -- load the XMF font gc <- liftIO $ createGC display win xfont <- initXMF ts_font -- run the treeselect Monad ret <- evalStateT (runReaderT (runTreeSelect (redraw >> navigate)) conf) TSState{ tss_tree = zipper , tss_window = win , tss_display = display , tss_xfont = xfont , tss_size = (fromIntegral rect_width, fromIntegral rect_height) , tss_gc = gc , tss_visual = visualInfo_visual vinfo , tss_colormap = colormap , tss_history = ([], hist) } -- release the XMF font releaseXMF xfont liftIO $ freeGC display gc return ret else return Nothing -- destroy the window liftIO $ do unmapWindow display win destroyWindow display win freeColormap display colormap -- Flush the output buffer and wait for all the events to be processed -- TODO: is this needed? sync display False return r -- | Select a workspace and execute a \"view\" function from "XMonad.StackSet" on it. treeselectWorkspace :: TSConfig WorkspaceId -> Forest String -- ^ your tree of workspace-names -> (WorkspaceId -> WindowSet -> WindowSet) -- ^ the \"view\" function. -- Instances can be 'W.greedyView' for switching to a workspace -- and/or 'W.shift' for moving the focused window to a selected workspace. -- -- These actions can also be combined by doing -- -- > \i -> W.greedyView i . W.shift i -> X () treeselectWorkspace c xs f = do -- get all defined workspaces -- They have to be set with 'toWorkspaces'! ws <- gets (W.workspaces . windowset) -- check the 'XConfig.workspaces' if all (`elem` map tag ws) (toWorkspaces xs) then do -- convert the 'Forest WorkspaceId' to 'Forest (TSNode WorkspaceId)' wsf <- forMForest (mkPaths xs) $ \(n, i) -> maybe (return (TSNode n "Does not exist!" "")) (mkNode n) (find (\w -> i == tag w) ws) -- get the current workspace path me <- gets (W.tag . W.workspace . W.current . windowset) hist <- workspaceHistory treeselectAt c (fromJust $ followPath tsn_name (splitPath me) $ fromForest wsf) (map splitPath hist) >>= maybe (return ()) (windows . f) else liftIO $ do -- error! let msg = unlines $ [ "Please add:" , " workspaces = toWorkspaces myWorkspaces" , "to your XMonad config!" , "" , "XConfig.workspaces: " ] ++ map tag ws hPutStrLn stderr msg xmessage msg return () where mkNode n w = do -- find the focused window's name on this workspace name <- maybe (return "") (fmap show . getName . W.focus) $ stack w return $ TSNode n name (tag w) -- | Convert the workspace-tree to a flat list of paths such that XMonad can use them -- -- The Nodes will be separated by a dot (\'.\') character toWorkspaces :: Forest String -> [WorkspaceId] toWorkspaces = map snd . concatMap flatten . mkPaths mkPaths :: Forest String -> Forest (String, WorkspaceId) mkPaths = map (\(Node n ns) -> Node (n, n) (map (f n) ns)) where f pth (Node x xs) = let pth' = pth ++ '.' : x in Node (x, pth') (map (f pth') xs) splitPath :: WorkspaceId -> [String] splitPath i = case break (== '.') i of (x, []) -> [x] (x, _:xs) -> x : splitPath xs -- | Select from a Tree of 'X' actions -- -- <> -- -- Each of these actions have to be specified inside a 'TSNode' -- -- Example -- -- > treeselectAction myTreeConf -- > [ Node (TSNode "Hello" "displays hello" (spawn "xmessage hello!")) [] -- > , Node (TSNode "Shutdown" "Poweroff the system" (spawn "shutdown")) [] -- > , Node (TSNode "Brightness" "Sets screen brightness using xbacklight" (return ())) -- > [ Node (TSNode "Bright" "FULL POWER!!" (spawn "xbacklight -set 100")) [] -- > , Node (TSNode "Normal" "Normal Brightness (50%)" (spawn "xbacklight -set 50")) [] -- > , Node (TSNode "Dim" "Quite dark" (spawn "xbacklight -set 10")) [] -- > ] -- > ] treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X () 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] forMForest x g = mapM (mapMTree g) x mapMTree :: (Functor m, Applicative m, Monad m) => (a -> m b) -> Tree a -> m (Tree b) mapMTree f (Node x xs) = Node <$> f x <*> mapM (mapMTree f) xs -- | Quit returning the currently selected node select :: TreeSelect a (Maybe a) select = gets (Just . (tsn_value . cursor . tss_tree)) -- | Quit without returning anything cancel :: TreeSelect a (Maybe a) cancel = return Nothing -- TODO: redraw only what is necessary. -- Examples: redrawAboveCursor, redrawBelowCursor and redrawCursor -- | Move the cursor to its parent node moveParent :: TreeSelect a (Maybe a) moveParent = moveWith parent >> redraw >> navigate -- | Move the cursor one level down, highlighting its first child-node moveChild :: TreeSelect a (Maybe a) moveChild = moveWith children >> redraw >> navigate -- | Move the cursor to the next child-node moveNext :: TreeSelect a (Maybe a) moveNext = moveWith nextChild >> redraw >> navigate -- | Move the cursor to the previous child-node movePrev :: TreeSelect a (Maybe a) movePrev = moveWith previousChild >> redraw >> navigate -- | Move backwards in history moveHistBack :: TreeSelect a (Maybe a) moveHistBack = do s <- get case tss_history s of (xs, a:y:ys) -> do put s{tss_history = (a:xs, y:ys)} moveTo y _ -> navigate -- | Move forward in history moveHistForward :: TreeSelect a (Maybe a) moveHistForward = do s <- get case tss_history s of (x:xs, ys) -> do put s{tss_history = (xs, x:ys)} moveTo x _ -> navigate -- | Move to a specific node moveTo :: [String] -- ^ path, always starting from the top -> TreeSelect a (Maybe a) moveTo i = moveWith (followPath tsn_name i . rootNode) >> redraw >> navigate -- | Apply a transformation on the internal 'XMonad.Util.TreeZipper.TreeZipper'. moveWith :: (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))) -> TreeSelect a () moveWith f = do s <- get case f (tss_tree s) of -- TODO: redraw cursor only? Just t -> put s{ tss_tree = t } Nothing -> return () -- | 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 .|. buttonPressMask) e ev <- getEvent e if | ev_event_type ev == keyPress -> do ks <- keycodeToKeysym d (ev_keycode ev) 0 return $ do mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) f <- asks ts_navigate fromMaybe navigate $ M.lookup (mask, ks) f | ev_event_type ev == buttonPress -> do -- See XMonad.Prompt Note [Allow ButtonEvents] allowEvents d replayPointer currentTime return navigate | otherwise -> return navigate -- | Request a full redraw redraw :: TreeSelect a () redraw = do win <- gets tss_window dpy <- gets tss_display -- clear window -- TODO: not always needed! liftIO $ clearWindow dpy win t <- gets tss_tree _ <- drawLayers 0 0 (reverse $ (tz_before t, cursor t, tz_after t) : tz_parents t) return () drawLayers :: Int -- ^ indentation level -> Int -- ^ height -> [(Forest (TSNode a), TSNode a, Forest (TSNode a))] -- ^ node layers (from top to bottom!) -> TreeSelect a Int drawLayers _ yl [] = return yl drawLayers xl yl ((bs, c, as):xs) = do TSConfig{..} <- ask let nodeColor y = if odd y then ts_node else ts_nodealt -- draw nodes above forM_ (zip [yl ..] (reverse bs)) $ \(y, Node n _) -> drawNode xl y n (nodeColor y) -- drawLayers (xl + 1) (y + 1) ns -- TODO: draw rest? if not ts_hidechildren -- drawLayers (xl + 1) (y + 1) ns -- draw the current / parent node -- if this is the last (currently focused) we use the 'ts_highlight' color let current_level = yl + length bs drawNode xl current_level c $ if null xs then ts_highlight else nodeColor current_level l2 <- drawLayers (xl + 1) (current_level + 1) xs -- draw nodes below forM_ (zip [l2 ..] as) $ \(y, Node n _) -> drawNode xl y n (nodeColor y) -- TODO: draw rest? if not ts_hidechildren -- drawLayers (xl + 1) (y + 1) ns return (l2 + length as) -- | Draw a node at a given indentation and height level drawNode :: Int -- ^ indentation level (not in pixels) -> Int -- ^ height level (not in pixels) -> TSNode a -- ^ node to draw -> (Pixel, Pixel) -- ^ node foreground (font) and background color -> TreeSelect a () drawNode ix iy TSNode{..} col = do TSConfig{..} <- ask window <- gets tss_window display <- gets tss_display font <- gets tss_xfont gc <- gets tss_gc 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 + ts_originX) (iy * ts_node_height + ts_originY) ts_node_width ts_node_height -- TODO: draw extra text (transparent background? or ts_background) -- drawWinBox window fnt col2 nodeH (scW-x) (mes) (x+nodeW) y 8 -- | Draw a simple box with text drawWinBox :: Window -> Display -> Visual -> Colormap -> GC -> XMonadFont -> (Pixel, Pixel) -> String -> Pixel -> String -> Int -> Int -> Int -> Int -> IO () drawWinBox win display visual colormap gc font (fg, bg) text fg2 text2 x y w h = do -- draw box setForeground display gc bg fillRectangle display win gc (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) -- dreaw text drawStringXMF display win visual colormap gc font fg (fromIntegral $ x + 8) (fromIntegral $ y + h - 8) text -- dreaw extra text drawStringXMF display win visual colormap gc font fg2 (fromIntegral $ x + w + 8) (fromIntegral $ y + h - 8) text2 -- | Modified version of 'XMonad.Util.Font.printStringXMF' that uses 'Pixel' as color format drawStringXMF :: Display -> Drawable -> Visual -> Colormap -> GC -> XMonadFont -- ^ XMF Font -> Pixel -- ^ font color -> Position -- ^ x-position -> Position -- ^ y-position -> String -- ^ string text -> IO () drawStringXMF display window visual colormap gc font col x y text = case font of Core fnt -> do setForeground display gc col setFont display gc $ fontFromFontStruct fnt drawImageString display window gc x y text Utf8 fnt -> do setForeground display gc col wcDrawImageString display window fnt gc x y text #ifdef XFT Xft fnts -> do withXftDraw display window visual colormap $ \ft_draw -> withXftColorValue display visual colormap (fromARGB col) $ #if MIN_VERSION_X11_xft(0, 3, 4) \ft_color -> xftDrawStringFallback ft_draw ft_color (NE.toList fnts) (fi x) (fi y) text #else \ft_color -> xftDrawString ft_draw ft_color (NE.head fnts) x y text #endif -- | Convert 'Pixel' to 'XRenderColor' -- -- Note that it uses short to represent its components fromARGB :: Pixel -> XRenderColor fromARGB x = #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-contrib-0.18.0/XMonad/Actions/UpdateFocus.hs0000644000000000000000000000631607346545000020267 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.UpdateFocus -- Description : Updates the focus on mouse move in unfocused windows. -- Copyright : (c) Daniel Schoepe -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- Updates the focus on mouse move in unfocused windows. -- ----------------------------------------------------------------------------- module XMonad.Actions.UpdateFocus ( -- * Usage -- $usage focusOnMouseMove, adjustEventInput, focusUnderPointer, ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- To make the focus update on mouse movement within an unfocused window, add the -- following to your @xmonad.hs@: -- -- > import XMonad.Actions.UpdateFocus -- > xmonad $ def { -- > .. -- > startupHook = adjustEventInput -- > handleEventHook = focusOnMouseMove -- > .. -- > } -- -- This module is probably only useful when focusFollowsMouse is set to True(default). -- | 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 -- check only every 15 px to avoid excessive calls to translateCoordinates when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do dpy <- asks display foc <- withWindowSet $ return . W.peek -- get the window under the pointer: (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y) when (foc /= Just w) $ focus w return (All True) focusOnMouseMove _ = return (All True) -- | Adjusts the event mask to pick up pointer movements. adjustEventInput :: X () adjustEventInput = withDisplay $ \dpy -> do rootw <- asks theRoot 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-contrib-0.18.0/XMonad/Actions/UpdatePointer.hs0000644000000000000000000001074707346545000020633 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonadContrib.UpdatePointer -- Description : Causes the pointer to follow whichever window focus changes to. -- Copyright : (c) Robert Marlow , 2015 Evgeny Kurnevsky -- License : BSD3-style (see LICENSE) -- -- Maintainer : Robert Marlow -- Stability : stable -- Portability : portable -- -- Causes the pointer to follow whichever window focus changes to. Compliments -- the idea of switching focus as the mouse crosses window boundaries to -- keep the mouse near the currently focused window -- ----------------------------------------------------------------------------- module XMonad.Actions.UpdatePointer ( -- * Usage -- $usage updatePointer ) where import XMonad import XMonad.Prelude import XMonad.StackSet (member, peek, screenDetail, current) import Control.Arrow ((&&&), (***)) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.UpdatePointer -- -- Enable it by including it in your logHook definition, e.g.: -- -- > logHook = updatePointer (0.5, 0.5) (1, 1) -- -- which will move the pointer to the nearest point of a newly focused -- window. The first argument establishes a reference point within the -- newly-focused window, while the second argument linearly interpolates -- between said reference point and the edges of the newly-focused window to -- obtain a bounding box for the pointer. -- -- > logHook = updatePointer (0.5, 0.5) (0, 0) -- exact centre of window -- > logHook = updatePointer (0.25, 0.25) (0.25, 0.25) -- near the top-left -- > logHook = updatePointer (0.5, 0.5) (1.1, 1.1) -- within 110% of the edge -- -- To use this with an existing logHook, use >> : -- -- > logHook = dynamicLog -- > >> updatePointer (1, 1) (0, 0) -- -- which moves the pointer to the bottom-right corner of the focused window. -- | 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 dpy <- asks display let defaultRect = screenRect $ screenDetail $ current ws rect <- case peek ws of Nothing -> return defaultRect Just w -> maybe defaultRect windowAttributesToRectangle <$> safeGetWindowAttributes w root <- asks theRoot mouseIsMoving <- asks mouseFocused (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root drag <- gets dragging unless (pointWithin (fi rootX) (fi rootY) rect || mouseIsMoving || isJust drag || not (currentWindow `member` ws || currentWindow == none)) $ let -- focused rectangle (rectX, rectY) = (rect_x &&& rect_y) rect (rectW, rectH) = (fi . rect_width &&& fi . rect_height) rect -- reference position, with (0,0) and (1,1) being top-left and bottom-right refX = lerp (fst refPos) rectX (rectX + rectW) refY = lerp (snd refPos) rectY (rectY + rectH) -- final pointer bounds, lerped *outwards* from reference position boundsX = join (***) (lerp (fst ratio) refX) (rectX, rectX + rectW) boundsY = join (***) (lerp (snd ratio) refY) (rectY, rectY + rectH) -- ideally we ought to move the pointer in a straight line towards the -- reference point until it is within the above bounds, but… in io $ warpPointer dpy none root 0 0 0 0 (round . clip boundsX $ fi rootX) (round . clip boundsY $ fi rootY) windowAttributesToRectangle :: WindowAttributes -> Rectangle windowAttributesToRectangle wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa + 2 * wa_border_width wa)) (fi (wa_height wa + 2 * wa_border_width wa)) lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r lerp r a b = (1 - r) * realToFrac a + r * realToFrac b clip :: Ord a => (a, a) -> a -> a clip (lower, upper) x | x < lower = lower | x > upper = upper | otherwise = x xmonad-contrib-0.18.0/XMonad/Actions/Warp.hs0000644000000000000000000000765507346545000016765 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : daniel@wagner-home.com -- Stability : unstable -- Portability : unportable -- -- Warp the pointer to a given window or screen. -- ----------------------------------------------------------------------------- module XMonad.Actions.Warp ( -- * Usage -- $usage banish, banishScreen, Corner(..), warpToScreen, warpToWindow ) where import XMonad.Prelude import XMonad import XMonad.StackSet as W {- $usage You can use this module with the following in your @xmonad.hs@: > import XMonad.Actions.Warp then add appropriate keybindings to warp the pointer; for example: > , ((modm, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window > >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 > > [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2)) > | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] Note that warping to a particular screen may change the focus. -} -- For detailed instructions on editing your key bindings, see -- . data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight {- | Move the mouse cursor to a corner of the focused window. Useful for uncluttering things. Internally, this uses numerical parameters. We parametrize on the 'Corner' type so the user need not see the violence inherent in the system. 'warpToScreen' and 'warpToWindow' can be used in a variety of ways. Suppose you wanted to emulate Ratpoison's \'banish\' command, which moves the mouse pointer to a corner? warpToWindow can do that! -} banish :: Corner -> X () banish direction = case direction of LowerRight -> warpToWindow 1 1 LowerLeft -> warpToWindow 0 1 UpperLeft -> warpToWindow 0 0 UpperRight -> warpToWindow 1 0 {- | Same as 'banish' but moves the mouse to the corner of the currently focused screen -} banishScreen :: Corner -> X () banishScreen direction = case direction of LowerRight -> warpToCurrentScreen 1 1 LowerLeft -> warpToCurrentScreen 0 1 UpperLeft -> warpToCurrentScreen 0 0 UpperRight -> warpToCurrentScreen 1 0 where warpToCurrentScreen h v = do ws <- gets windowset warpToScreen (W.screen $ current ws) h v windows (const ws) fraction :: (Integral a, Integral b) => Rational -> a -> b fraction f x = floor (f * fromIntegral x) warp :: Window -> Position -> Position -> X () warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y -- | Warp the pointer to a given position relative to the currently -- focused window. Top left = (0,0), bottom right = (1,1). warpToWindow :: Rational -> Rational -> X () warpToWindow h v = withDisplay $ \d -> withFocused $ \w -> withWindowAttributes d w $ \wa -> warp w (fraction h (wa_width wa)) (fraction v (wa_height wa)) -- | Warp the pointer to the given position (top left = (0,0), bottom -- right = (1,1)) on the given screen. warpToScreen :: ScreenId -> Rational -> Rational -> X () warpToScreen n h v = do root <- asks theRoot StackSet{current = x, visible = xs} <- gets windowset whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs) $ \r -> warp root (rect_x r + fraction h (rect_width r)) (rect_y r + fraction v (rect_height r)) xmonad-contrib-0.18.0/XMonad/Actions/WindowBringer.hs0000644000000000000000000001600307346545000020617 0ustar0000000000000000{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowBringer -- Description : Dmenu operations to bring windows to you, and bring you to windows. -- Copyright : Devin Mullins -- License : BSD-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : stable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.WindowBringer ( -- * Usage -- $usage WindowBringerConfig(..), gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs', bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs', windowMap, windowAppMap, windowMap', bringWindow, actionMenu ) where 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, getNameWMClass) -- $usage -- -- Import the module into your @xmonad.hs@: -- -- > import XMonad.Actions.WindowBringer -- -- and define appropriate key bindings: -- -- > , ((modm .|. shiftMask, xK_g ), gotoMenu) -- > , ((modm .|. shiftMask, xK_b ), bringMenu) -- -- For detailed instructions on editing your key bindings, see -- . data WindowBringerConfig = WindowBringerConfig { menuCommand :: String -- ^ The shell command that will handle window selection , menuArgs :: [String] -- ^ Arguments to be passed to menuCommand , windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window , windowFilter :: Window -> X Bool -- ^ Filter function to decide which windows to consider } instance Default WindowBringerConfig where def = WindowBringerConfig{ menuCommand = "dmenu" , menuArgs = ["-i"] , windowTitler = decorateName , windowFilter = \_ -> return True } -- | Pops open a dmenu with window titles. Choose one, and you will be -- taken to the corresponding workspace. gotoMenu :: X () gotoMenu = gotoMenuConfig def -- | Pops open a dmenu with window titles. Choose one, and you will be -- taken to the corresponding workspace. This version accepts a configuration -- object. gotoMenuConfig :: WindowBringerConfig -> X () gotoMenuConfig wbConfig = actionMenu wbConfig W.focusWindow -- | Pops open a dmenu with window titles. Choose one, and you will be -- taken to the corresponding workspace. This version takes a list of -- arguments to pass to dmenu. gotoMenuArgs :: [String] -> X () gotoMenuArgs args = gotoMenuConfig def { menuArgs = args } -- | Pops open an application with window titles given over stdin. Choose one, -- and you will be taken to the corresponding workspace. gotoMenu' :: String -> X () gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd } -- | Pops open an application with window titles given over stdin. Choose one, -- and you will be taken to the corresponding workspace. This version takes a -- list of arguments to pass to dmenu. gotoMenuArgs' :: String -> [String] -> X () gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args } -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. bringMenu :: X () bringMenu = bringMenuArgs def -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. This version -- accepts a configuration object. bringMenuConfig :: WindowBringerConfig -> X () bringMenuConfig wbConfig = actionMenu wbConfig bringWindow -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. This version -- takes a list of arguments to pass to dmenu. bringMenuArgs :: [String] -> X () bringMenuArgs args = bringMenuConfig def { menuArgs = args } -- | Pops open an application with window titles given over stdin. Choose one, -- and it will be dragged, kicking and screaming, into your current -- workspace. bringMenu' :: String -> X () bringMenu' cmd = bringMenuConfig def { menuArgs = [], menuCommand = cmd } -- | Pops open an application with window titles given over stdin. Choose one, -- and it will be dragged, kicking and screaming, into your current -- workspace. This version allows arguments to the chooser to be specified. bringMenuArgs' :: String -> [String] -> X () bringMenuArgs' cmd args = bringMenuConfig def { menuArgs = args, menuCommand = cmd } -- | Brings the specified window into the current workspace. bringWindow :: Window -> X.WindowSet -> X.WindowSet bringWindow w ws = W.shiftWin (W.currentTag ws) w ws -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action -- if found. actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X () 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 -- | A map from window names to Windows. windowMap :: X (M.Map String Window) 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' :: 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 -- know where he's going. 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-contrib-0.18.0/XMonad/Actions/WindowGo.hs0000644000000000000000000002262407346545000017602 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} {- | Module : XMonad.Actions.WindowGo Description : Operations for raising (traveling to) windows. License : Public domain Maintainer : Stability : unstable Portability : unportable Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query monad, such as 'runOrRaise'. runOrRaise will run a shell command unless it can find a specified window; you would use this to automatically travel to your Firefox or Emacs session, or start a new one (for example), instead of trying to remember where you left it or whether you still have one running. -} module XMonad.Actions.WindowGo ( -- * Usage -- $usage raise, raiseNext, runOrRaise, runOrRaiseNext, raiseMaybe, raiseNextMaybe, raiseNextMaybeCustomFocus, raiseBrowser, raiseEditor, runOrRaiseAndDo, runOrRaiseMaster, raiseAndDo, raiseMaster, ifWindows, ifWindow, raiseHook, module XMonad.ManageHook ) where import qualified Data.List as L (nub,sortBy) import XMonad.Prelude import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask) import Graphics.X11 (Window) import XMonad.ManageHook import XMonad.Operations (windows) import XMonad.Prompt.Shell (getBrowser, getEditor) import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack) import XMonad.Util.Run (safeSpawnProg) import qualified Data.List.NonEmpty as NE {- $usage Import the module into your @xmonad.hs@: > import XMonad.Actions.WindowGo and define appropriate key bindings: > , ((modm .|. shiftMask, xK_g), raise (className =? "Firefox")) > , ((modm .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox")) (Note that Firefox v3 and up have a class-name of \"Firefox\" and \"Navigator\"; lower versions use other classnames such as \"Firefox-bin\". Either choose the appropriate one, or cover your bases by using instead something like: > (className =? "Firefox" <||> className =? "Firefox-bin") For detailed instructions on editing your key bindings, see . -} -- | Get the list of workspaces sorted by their tag workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a] workspacesSorted s = L.sortBy (\u t -> W.tag u `compare` W.tag t) $ W.workspaces s -- | Get a list of all windows in the 'StackSet' with an absolute ordering of workspaces allWindowsSorted :: Ord i => Eq a => W.StackSet i l a s sd -> [a] allWindowsSorted = L.nub . concatMap (W.integrate' . W.stack) . workspacesSorted -- | If windows that satisfy the query exist, apply the supplied -- function to them, otherwise run the action given as -- second parameter. ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X () ifWindows qry f el = withWindowSet $ \wins -> do matches <- filterM (runQuery qry) $ allWindowsSorted wins case matches of [] -> el ws -> f ws -- | The same as ifWindows, but applies a ManageHook to the first match -- instead and discards the other matches ifWindow :: Query Bool -> ManageHook -> X () -> X () ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty) -- ifWindows guarantees that the list given to the function is -- non-empty. This should really use Data.List.NonEmpty, but, alas, -- that would be a breaking change. {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found. Presumably this executable is the same one that you were looking for. Note that this does not go through the shell. If you wish to run an arbitrary IO action (such as 'spawn', which will run its String argument through the shell), then you will want to use 'raiseMaybe' directly. -} runOrRaise :: String -> Query Bool -> X () runOrRaise = raiseMaybe . safeSpawnProg -- | See 'raiseMaybe'. If the Window can't be found, quietly give up and do nothing. raise :: Query Bool -> X () raise = raiseMaybe $ return () {- | 'raiseMaybe' queries all Windows based on a boolean provided by the user. Currently, there are 3 such useful booleans defined in "XMonad.ManageHook": 'title', 'resource', 'className'. Each one tests based pretty much as you would think. ManageHook also defines several operators, the most useful of which is (=?). So a useful test might be finding a @Window@ whose class is Firefox. Firefox 3 declares the class \"Firefox\", so you'd want to pass in a boolean like @(className =? \"Firefox\")@. If the boolean returns @True@ on one or more windows, then XMonad will quickly make visible the first result. If no @Window@ meets the criteria, then the first argument comes into play. The first argument is an arbitrary IO function which will be executed if the tests fail. This is what enables 'runOrRaise' to use 'raiseMaybe': it simply runs the desired program if it isn't found. But you don't have to do that. Maybe you want to do nothing if the search fails (the definition of 'raise'), or maybe you want to write to a log file, or call some prompt function, or something crazy like that. This hook gives you that flexibility. You can do some cute things with this hook. Suppose you want to do the same thing for Mutt which you just did for Firefox - but Mutt runs inside a terminal window? No problem: you search for a terminal window calling itself \"mutt\", and if there isn't you run a terminal with a command to run Mutt! Here's an example (borrowing 'runInTerm' from "XMonad.Util.Run"): > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt")) -} raiseMaybe :: X () -> Query Bool -> X () raiseMaybe f qry = ifWindow qry raiseHook f -- | A manage hook that raises the window. raiseHook :: ManageHook raiseHook = ask >>= doF . W.focusWindow -- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches. runOrRaiseNext :: String -> Query Bool -> X () runOrRaiseNext = raiseNextMaybe . safeSpawnProg -- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches. raiseNext :: Query Bool -> X () raiseNext = raiseNextMaybe $ return () {- | See 'raiseMaybe'. 'raiseNextMaybe' is an alternative version that allows cycling through the matching windows. If the focused window matches the query the next matching window is raised. If no matches are found the function f is executed. -} raiseNextMaybe :: X () -> Query Bool -> X () raiseNextMaybe = raiseNextMaybeCustomFocus W.focusWindow {- | See 'raiseMaybe' and 'raiseNextMaybe'. In addition to all of the options offered by 'raiseNextMaybe' 'raiseNextMaybeCustomFocus' allows the user to supply the function that should be used to shift the focus to any window that is found. -} raiseNextMaybeCustomFocus :: (Window -> WindowSet -> WindowSet) -> X() -> Query Bool -> X() raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do foc <- withWindowSet $ return . W.peek case foc of Just w | w `elem` ws -> let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws -- cannot fail to match in windows $ focusFn y _ -> windows . focusFn . NE.head . notEmpty $ ws -- ws is non-empty by ifWindows's definition. -- | Given a function which gets us a String, we try to raise a window with that classname, -- or we then interpret that String as a executable name. raiseVar :: IO String -> X () raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) className =? var) {- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either take you to the specified program's window, or they try to run it. This is most useful if your variables are simple and look like \"firefox\" or \"emacs\". -} raiseBrowser, raiseEditor :: X () raiseBrowser = raiseVar getBrowser raiseEditor = raiseVar getEditor {- | If the window is found the window is focused and the third argument is called otherwise, the first argument is called See 'raiseMaster' for an example. -} raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X () raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f where afterRaise = ask >>= (>> idHook) . liftX . after {- | If a window matching the second argument is found, the window is focused and the third argument is called; otherwise, the first argument is called. -} runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X () runOrRaiseAndDo = raiseAndDo . safeSpawnProg {- | if the window is found the window is focused and set to master otherwise, the first argument is called. > raiseMaster (runInTerm "-title ghci" "zsh -c 'ghci'") (title =? "ghci") -} raiseMaster :: X () -> Query Bool -> X () raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> windows W.swapMaster) {- | If the window is found the window is focused and set to master otherwise, action is run. > runOrRaiseMaster "firefox" (className =? "Firefox")) -} runOrRaiseMaster :: String -> Query Bool -> X () runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster) xmonad-contrib-0.18.0/XMonad/Actions/WindowMenu.hs0000644000000000000000000000553207346545000020140 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Uses "XMonad.Actions.GridSelect" to display a number of actions related to -- window management in the center of the focused window. Actions include: Closing, -- maximizing, minimizing and shifting the window to another workspace. -- -- Note: For maximizing and minimizing to actually work, you will need -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your -- setup. See the documentation of those modules for more information. -- ----------------------------------------------------------------------------- module XMonad.Actions.WindowMenu ( -- * Usage -- $usage windowMenu ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Actions.GridSelect import XMonad.Layout.Maximize import XMonad.Actions.Minimize import XMonad.Prelude (fi) -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.WindowMenu -- -- Then add a keybinding, e.g. -- -- > , ((modm, xK_o ), windowMenu) colorizer :: a -> Bool -> X (String, String) colorizer _ isFg = do fBC <- asks (focusedBorderColor . config) nBC <- asks (normalBorderColor . config) return $ if isFg then (fBC, nBC) else (nBC, fBC) windowMenu :: X () windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do tags <- asks (workspaces . config) let Rectangle x y wh ht = getSize wa Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset let originFractX = (fi x - fi sx + fi wh / 2) / fi swh originFractY = (fi y - fi sy + fi ht / 2) / fi sht gsConfig = (buildDefaultGSConfig colorizer) { gs_originFractX = originFractX , gs_originFractY = originFractY } actions = [ ("Cancel menu", return ()) , ("Close" , kill) , ("Maximize" , sendMessage $ maximizeRestore w) , ("Minimize" , minimizeWindow w) ] ++ [ ("Move to " ++ tag, windows $ W.shift tag) | tag <- tags ] runSelectedAction gsConfig actions getSize :: WindowAttributes -> Rectangle getSize wa = let x = fi $ wa_x wa y = fi $ wa_y wa wh = fi $ wa_width wa ht = fi $ wa_height wa in Rectangle x y wh ht xmonad-contrib-0.18.0/XMonad/Actions/WindowNavigation.hs0000644000000000000000000002272707346545000021340 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowNavigation -- Description : Experimental rewrite of "XMonad.Layout.WindowNavigation". -- Copyright : (c) 2007 David Roundy , -- Devin Mullins -- Maintainer : Devin Mullins -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable -- -- This is a rewrite of "XMonad.Layout.WindowNavigation". WindowNavigation -- lets you assign keys to move up\/down\/left\/right, based on actual cartesian -- window coordinates, rather than just going j\/k on the stack. -- -- This module is experimental. You'll have better luck with the original. -- -- This module differs from the other in a few ways: -- -- (1) You can go up\/down\/left\/right across multiple screens. -- -- (2) It doesn't provide little border colors for your neighboring windows. -- -- (3) It doesn't provide the \'Move\' action, which seems to be related to -- the XMonad.Layout.Combo extension. -- -- (4) It tries to be slightly smarter about tracking your current position. -- -- (5) Configuration is different. -- ----------------------------------------------------------------------------- module XMonad.Actions.WindowNavigation ( -- * Usage -- $usage withWindowNavigation, withWindowNavigationKeys, WNAction(..), go, swap, Direction2D(..), WNState, ) where import XMonad import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn) import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Arrow (second) import Data.IORef import Data.Map (Map()) import qualified Data.Map as M import qualified Data.Set as S -- $usage -- -- To use it, you're going to apply the 'withWindowNavigation' function. -- 'withWindowNavigation' performs some IO operations, so the syntax you'll use -- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog". -- In particular: -- -- > main = do -- > config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d) -- > $ 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. -- -- If you want more flexibility over your keybindings, you can use -- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather -- than a tuple of the four directional keys. See the source code of -- 'withWindowNavigation' for an example. -- TODO: -- - monad for WNState? -- - cleanup (including inr) -- - more documentation -- - tests? (esp. for edge cases in currentPosition) -- - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2 -- - solve the 2+3, middle right to bottom left problem -- - command to iteratively swapUp/swapDown instead of directly swapping with target -- - manageHook to draw window decos? withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l) withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} = withWindowNavigationKeys [ ((modm , u), WNGo U), ((modm , l), WNGo L), ((modm , d), WNGo D), ((modm , r), WNGo R), ((modm .|. shiftMask, u), WNSwap U), ((modm .|. shiftMask, l), WNSwap L), ((modm .|. shiftMask, d), WNSwap D), ((modm .|. shiftMask, r), WNSwap R) ] conf withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) withWindowNavigationKeys wnKeys conf = do posRef <- newIORef M.empty return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys) `M.union` keys conf cnf, logHook = logHook conf >> trackMovement posRef } where fromWNAction posRef (WNGo dir) = go posRef dir fromWNAction posRef (WNSwap dir) = swap posRef dir data WNAction = WNGo Direction2D | WNSwap Direction2D type WNState = Map WorkspaceId Point -- go: -- 1. get current position, verifying it matches the current window -- 2. get target windowrect -- 3. focus window -- 4. set new position go :: IORef WNState -> Direction2D -> X () go = withTargetWindow W.focusWindow swap :: IORef WNState -> Direction2D -> X () swap = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = case W.peek winSet of Just currentWin -> W.focusWindow currentWin $ mapWindows (swapWin currentWin targetWin) winSet Nothing -> winSet mapWindows f = W.mapWorkspace (mapWindows' f) mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s } mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down) swapWin win1 win2 win | win == win1 = win2 | win == win2 = win1 | otherwise = win withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do targets <- filter ((/= win) . fst) <$> navigableTargets pos dir whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do windows (adj targetWin) setPosition posRef pos targetRect trackMovement :: IORef WNState -> X () 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 -> currentPosition posRef >>= f win -- Gets the current position from the IORef passed in, or if nothing (say, from -- a restart), derives the current position from the current window. Also, -- verifies that the position is congruent with the current window (say, if you -- used mod-j/k or mouse or something). currentPosition :: IORef WNState -> X Point currentPosition posRef = do root <- asks theRoot currentWindow <- gets (W.peek . windowset) currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) wsid <- gets (W.currentTag . windowset) mp <- M.lookup wsid <$> io (readIORef posRef) return $ maybe (middleOf currentRect) (`inside` currentRect) mp where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) setPosition :: IORef WNState -> Point -> Rectangle -> X () setPosition posRef oldPos newRect = do wsid <- gets (W.currentTag . windowset) io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect) inside :: Point -> Rectangle -> Point Point x y `inside` Rectangle rx ry rw rh = Point (x `within` (rx, rw)) (y `within` (ry, rh)) where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim then pos else midPoint lower dim midPoint :: Position -> Dimension -> Position midPoint pos dim = pos + fromIntegral dim `div` 2 navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)] navigableTargets point dir = navigable dir point <$> windowRects -- Filters and sorts the windows in terms of what is closest from the Point in -- the Direction2D. navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable d pt = sortby d . filter (inr d pt . snd) -- Produces a list of normal-state windows, on any screen. Rectangles are -- adjusted based on screen position relative to the current screen, because I'm -- bad like that. windowRects :: X [(Window, Rectangle)] windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped 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)) `catchX` return Nothing -- Modified from droundy's implementation of WindowNavigation: inr :: Direction2D -> Point -> Rectangle -> Bool inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && py < ry + fromIntegral h inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && py > ry inr R (Point px py) (Rectangle rx ry w h) = px < rx + fromIntegral w && py >= ry && py < ry + fromIntegral h inr L (Point px py) (Rectangle rx ry _ h) = px > rx && py >= ry && py < ry + fromIntegral h sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] sortby D = sortOn (rect_y . snd) sortby R = sortOn (rect_x . snd) sortby U = reverse . sortby D sortby L = reverse . sortby R xmonad-contrib-0.18.0/XMonad/Actions/WithAll.hs0000644000000000000000000000352207346545000017405 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 or certain -- groups of windows on the current workspace. ----------------------------------------------------------------------------- module XMonad.Actions.WithAll ( -- * Usage -- $usage sinkAll, withAll, withAll', killAll, killOthers) where import XMonad.Prelude hiding (foldr) import XMonad import XMonad.StackSet -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.WithAll -- -- then add a keybinding; for example: -- -- , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see -- . -- | Un-float all floating windows on the current workspace. sinkAll :: X () sinkAll = withAll' sink -- | Apply a function to all windows on the current workspace. withAll' :: (Window -> WindowSet -> WindowSet) -> X () withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws in foldr f ws all' -- | Execute an 'X' action for each window on the current workspace. withAll :: (Window -> X ()) -> X() withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws in forM_ all' f -- | 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-contrib-0.18.0/XMonad/Actions/Workscreen.hs0000644000000000000000000001075507346545000020171 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Workscreen -- Description: Display a set of workspaces on several screens. -- Copyright : (c) 2012 kedals0 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Dal -- Stability : unstable -- Portability: unportable -- -- 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. ----------------------------------------------------------------------------- module XMonad.Actions.Workscreen ( -- * Usage -- $usage configWorkscreen ,viewWorkscreen ,Workscreen(..) ,shiftToWorkscreen ,fromWorkspace ,expandWorkspace ,WorkscreenId ) where import XMonad hiding (workspaces) import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.OnScreen -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Workscreen -- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"] -- > in Workscreen.expandWorkspace 2 myOldWorkspaces -- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces) -- > return () -- -- Then, replace normal workspace view and shift keybinding: -- -- > [((m .|. modm, k), f i) -- > | (i, k) <- zip [0..] [1..12] -- > , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]] -- -- For detailed instructions on editing your key bindings, see -- . data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show) type WorkscreenId=Int 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 = 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 = zipWith Workscreen [0..] (fromWorkspace' n ws) fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]] fromWorkspace' _ [] = [] fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws) -- | Initial configuration of workscreens configWorkscreen :: [Workscreen] -> X () configWorkscreen wscrn = XS.put (WorkscreenStorage 0 wscrn) -- | View workscreen of index @WorkscreenId@. If current workscreen is asked -- workscreen, workscreen's workspaces are shifted. viewWorkscreen :: WorkscreenId -> X () viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get let wscr = if wscrId == c then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId) else a !! wscrId (x, notEmpty -> _ :| ys) = splitAt wscrId a newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys) windows (viewWorkscreen' wscr) XS.put newWorkscreenStorage viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet viewWorkscreen' (Workscreen _ ws) = \s -> foldl wsToSc' s (zip [0..] ws) where wsToSc' s (scr,wsId) = greedyViewOnScreen scr wsId s shiftWs :: [WorkspaceId] -> [WorkspaceId] shiftWs a = drop 1 a ++ take 1 a -- | Shift a window on the first workspace of workscreen -- @WorkscreenId@. shiftToWorkscreen :: WorkscreenId -> X () shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get case workspaces (a !! wscrId) of [] -> pure () (w : _) -> windows $ W.shift w xmonad-contrib-0.18.0/XMonad/Actions/WorkspaceCursors.hs0000644000000000000000000001731507346545000021365 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WorkspaceCursors -- Description : Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. -- Copyright : (c) 2009 Adam Vogt -- License : BSD -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. ----------------------------------------------------------------------------- module XMonad.Actions.WorkspaceCursors ( -- * Usage -- $usage focusDepth ,makeCursors ,toList ,workspaceCursors ,WorkspaceCursors ,getFocus -- * Modifying the focus ,modifyLayer ,modifyLayer' ,shiftModifyLayer,shiftLayer -- * Functions to pass to 'modifyLayer' ,focusNth' ,noWrapUp,noWrapDown, -- * Todo -- $todo -- * Types Cursors, ) where import qualified XMonad.StackSet as W import XMonad.Actions.FocusNth(focusNth') import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMess, redoLayout)) import XMonad(Message, WorkspaceId, X, XState(windowset), fromMessage, sendMessage, windows, gets) import XMonad.Util.Stack (reverseS) import XMonad.Prelude -- $usage -- -- Here is an example config: -- -- > import XMonad -- > import XMonad.Actions.WorkspaceCursors -- > import XMonad.Util.EZConfig -- > import qualified XMonad.StackSet as W -- > -- > main = xmonad conf -- > -- > conf = additionalKeysP def -- > { layoutHook = workspaceCursors myCursors $ layoutHook def -- > , workspaces = toList myCursors } $ -- > [("M-"++shift++control++[k], f direction depth) -- > | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"] -- > , (direction,control) <- zip [W.focusUp',W.focusDown'] ["C-",""] -- > , (depth,k) <- zip (reverse [1..focusDepth myCursors]) "asdf"] -- > ++ moreKeybindings -- > -- > moreKeybindings = [] -- > -- > myCursors = makeCursors $ map (map (\x -> [x])) [ "1234", "abc", "xyz"] -- > -- myCursors = makeCursors [["wsA","wsB","wsC"],["-alpha-","-beta-","-gamma-"],["x","y"]] -- $todo -- -- * Find and document how to raise the allowable length of arguments: -- restoring xmonad's state results in: @xmonad: executeFile: resource -- exhausted (Argument list too long)@ when you specify more than about 50 -- workspaces. Or change it such that workspaces are created when you try to -- view it. -- -- * 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 -- times for being able to show jumping to some n'th multiple workspace -- | makeCursors requires a nonempty string, and each sublist must be nonempty makeCursors :: [[String]] -> Cursors String makeCursors [] = error "Workspace Cursors cannot be empty" makeCursors (a : as) = concat . reverse <$> foldl addDim x xs where x = end $ map return a xs = map (map return) as -- this could probably be simplified, but this true: -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[])) -- the strange order is used because it makes the regular M-1..9 -- bindings change the prefixes first addDim :: (Monoid a) => Cursors a -> [a] -> Cursors a addDim prev prefixes = Cons . fromJust . W.differentiate $ map ((<$> prev) . mappend) prefixes end :: [a] -> Cursors a end = Cons . fromJust . W.differentiate . map End data Cursors a = Cons (W.Stack (Cursors a)) | End a deriving (Eq,Show,Read) instance Foldable Cursors where foldMap f (End x) = f x foldMap f (Cons (W.Stack x y z)) = foldMap f x `mappend` mconcat (map (foldMap f) $ reverse y ++ z) instance Functor Cursors where fmap f (End a) = End $ f a fmap f (Cons (W.Stack x y z)) = Cons $ W.Stack (fmap f x) (fmap (fmap f) y) (fmap (fmap f) z) changeFocus :: (Cursors t -> Bool) -> Cursors t -> [Cursors t] changeFocus p (Cons x) = do choose <- chFocus p x foc <- changeFocus p $ W.focus choose return . Cons $ choose { W.focus = foc } changeFocus p x = guard (p x) >> return x chFocus :: (a -> Bool) -> W.Stack a -> [W.Stack a] chFocus p st = filter (p . W.focus) $ zipWith const (iterate W.focusDown' st) (W.integrate st) getFocus :: Cursors b -> b getFocus (Cons x) = getFocus $ W.focus x getFocus (End x) = x -- 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 = find ((x==) . getFocus) . changeFocus (const True) -- | non-wrapping version of 'W.focusUp'' noWrapUp :: W.Stack t -> W.Stack t noWrapUp (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs) noWrapUp x@(W.Stack _ [] _ ) = x -- | non-wrapping version of 'W.focusDown'' noWrapDown :: W.Stack t -> W.Stack t 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 <$> 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}) <$> 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 () modifyLayer f depth = modifyCursors (descend (return . f) depth) -- | @shiftModifyLayer@ is the same as 'modifyLayer', but also shifts the -- currently focused window to the new workspace shiftModifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X () shiftModifyLayer f = modifyLayer' $ \st -> do let st' = f st windows $ W.shift $ getFocus (Cons st') return st' -- | @shiftLayer@ is the same as 'shiftModifyLayer', but the focus remains on -- the current workspace. shiftLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X () shiftLayer f = modifyLayer' $ \st -> do windows $ W.shift $ getFocus $ Cons $ f st return st -- | example usages are 'shiftLayer' and 'shiftModifyLayer' modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> Int -> X () modifyLayer' f depth = modifyCursors (descend f depth) modifyCursors :: (Cursors String -> X (Cursors String)) -> X () modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<) 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 -- times (using "XMonad.Layout.MultiToggle") workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a workspaceCursors = ModifiedLayout . WorkspaceCursors newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) } instance Message ChangeCursors updateXMD :: Cursors WorkspaceId -> X () updateXMD cs = do changed <- gets $ (getFocus cs /=) . W.currentTag . windowset when changed $ windows $ W.greedyView $ getFocus cs instance LayoutModifier WorkspaceCursors a where redoLayout (WorkspaceCursors cs) _ _ arrs = do cws <- gets $ W.currentTag . windowset return (arrs,WorkspaceCursors <$> focusTo cws cs) handleMess (WorkspaceCursors cs) m = traverse (fmap WorkspaceCursors . ($ cs) . unWrap) (fromMessage m) xmonad-contrib-0.18.0/XMonad/Actions/WorkspaceNames.hs0000644000000000000000000001550207346545000020764 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WorkspaceNames -- Description : Persistently rename workspace and swap them along with their names. -- Copyright : (c) Tomas Janousek -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tomas Janousek -- Stability : experimental -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Actions.WorkspaceNames ( -- * Usage -- $usage -- * Workspace naming renameWorkspace, getWorkspaceNames', getWorkspaceNames, getWorkspaceName, getCurrentWorkspaceName, setWorkspaceName, setCurrentWorkspaceName, -- * Workspace swapping swapTo, swapTo', swapWithCurrent, -- * Workspace prompt 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(..), anyWS) import qualified XMonad.Actions.SwapWorkspaces as Swap import XMonad.Hooks.StatusBar.PP (PP(..)) import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename) import XMonad.Prompt (mkXPrompt, XPConfig, historyCompletionP) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex) import qualified Data.Map as M -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.WorkspaceNames -- -- Then add keybindings like the following: -- -- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def) -- -- and apply workspaceNamesPP to your pretty-printer: -- -- > 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: -- -- > , ((modMask .|. shiftMask, xK_Left ), swapTo Prev) -- > , ((modMask .|. shiftMask, xK_Right ), swapTo Next) -- -- > [((modm .|. controlMask, k), swapWithCurrent i) -- > | (i, k) <- zip workspaces [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see -- . -- | Workspace names container. newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String) deriving (Read, Show) instance ExtensionClass WorkspaceNames where initialValue = WorkspaceNames M.empty extensionType = PersistentExtension -- | Returns a lookup function that maps workspace tags to workspace names. getWorkspaceNames' :: X (WorkspaceId -> Maybe String) getWorkspaceNames' = do WorkspaceNames m <- XS.get return (`M.lookup` m) -- | 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) <$> getWorkspaceNames' -- | Gets the name of the current workspace. See 'getWorkspaceName' getCurrentWorkspaceName :: X (Maybe String) getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset) -- | Sets the name of a workspace. Empty string makes the workspace unnamed -- again. setWorkspaceName :: WorkspaceId -> String -> X () setWorkspaceName w name = do WorkspaceNames m <- XS.get XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m refresh -- | Sets the name of the current workspace. See 'setWorkspaceName'. setCurrentWorkspaceName :: String -> X () setCurrentWorkspaceName name = do current <- gets (W.currentTag . windowset) setWorkspaceName current name -- | Prompt for a new name for the current workspace and set it. renameWorkspace :: XPConfig -> X () renameWorkspace conf = do completion <- historyCompletionP (prompt ==) mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName where prompt = "Workspace name: " -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. swapTo :: Direction1D -> X () swapTo dir = swapTo' dir anyWS -- | Swap with the previous or next workspace of the given type. swapTo' :: Direction1D -> WSType -> X () swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent -- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the -- same with names. swapWithCurrent :: WorkspaceId -> X () swapWithCurrent t = do current <- gets (W.currentTag . windowset) swapNames t current windows $ Swap.swapWorkspaces t current -- | Swap names of the two workspaces. swapNames :: WorkspaceId -> WorkspaceId -> X () swapNames w1 w2 = do 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 -- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module. workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X () workspaceNamePrompt conf job = do 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 = fromMaybe "" (lookup name pairs) contains completions input = 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-contrib-0.18.0/XMonad/Config/0000755000000000000000000000000007346545000015310 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Config/Arossato.hs0000644000000000000000000002054307346545000017443 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE NoMonomorphismRestriction #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Arossato -- Description : Andrea Rossato's xmonad configuration. -- Copyright : (c) Andrea Rossato 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : stable -- Portability : portable -- -- This module specifies my xmonad defaults. -- ------------------------------------------------------------------------ module XMonad.Config.Arossato {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( -- * Usage -- $usage arossatoConfig ) where import qualified Data.Map as M import XMonad import qualified XMonad.StackSet as W import XMonad.Actions.CycleWS import XMonad.Hooks.DynamicLog hiding (xmobar) import XMonad.Hooks.ManageDocks import XMonad.Hooks.ServerMode import XMonad.Layout.Accordion import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders import XMonad.Layout.SimpleFloat import XMonad.Layout.Tabbed import XMonad.Layout.WindowArranger import XMonad.Prompt.Shell import XMonad.Prompt.Ssh import XMonad.Prompt.Theme import XMonad.Prompt.Window import XMonad.Prompt.XMonad import XMonad.Util.Run import XMonad.Util.Themes -- $usage -- The simplest way to use this configuration module is to use an -- @xmonad.hs@ like this: -- -- > module Main (main) where -- > -- > import XMonad -- > import XMonad.Config.Arossato (arossatoConfig) -- > -- > main :: IO () -- > main = xmonad =<< arossatoConfig -- -- NOTE: that I'm using xmobar and, if you don't have xmobar in your -- PATH, this configuration will produce an error and xmonad will not -- start. If you don't want to install xmobar get rid of this line at -- the beginning of 'arossatoConfig'. -- -- You can use this module also as a starting point for writing your -- own configuration module from scratch. Save it as your -- @xmonad.hs@ and: -- -- 1. Change the module name from -- -- > module XMonad.Config.Arossato -- > ( -- * Usage -- > -- $usage -- > arossatoConfig -- > ) where -- -- to -- -- > module Main where -- -- 2. Add a line like: -- -- > main = xmonad =<< arossatoConfig -- -- 3. Start playing with the configuration options...;) arossatoConfig = do xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed! return $ def { workspaces = ["home","var","dev","mail","web","doc"] ++ map show [7 .. 9 :: Int] , logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed! , manageHook = newManageHook , layoutHook = avoidStruts $ decorated ||| noBorders mytabs ||| otherLays , terminal = "urxvt +sb" , normalBorderColor = "white" , focusedBorderColor = "black" , keys = newKeys , handleEventHook = serverModeEventHook , focusFollowsMouse = False } where -- layouts mytabs = tabbed shrinkText (theme smallClean) decorated = simpleFloat' shrinkText (theme smallClean) tiled = Tall 1 (3/100) (1/2) otherLays = windowArrange $ magnifier tiled ||| noBorders Full ||| Mirror tiled ||| Accordion -- manageHook myManageHook = composeAll [ resource =? "win" --> doF (W.shift "doc") -- xpdf , resource =? "firefox-bin" --> doF (W.shift "web") ] newManageHook = myManageHook -- xmobar myDynLog h = dynamicLogWithPP def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")" , ppOutput = hPutStrLn h } -- key bindings stuff 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 x = [ (modMask x , xK_j) , (modMask x , xK_k) , (modMask x , xK_p) , (modMask x .|. shiftMask, xK_p) , (modMask x .|. shiftMask, xK_q) , (modMask x , xK_q) ] ++ -- I want modMask .|. shiftMask 1-9 to be free! [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] -- These are my personal key bindings toAdd x = [ ((modMask x , xK_F12 ), xmonadPrompt def ) , ((modMask x , xK_F3 ), shellPrompt def ) , ((modMask x , xK_F4 ), sshPrompt def ) , ((modMask x , xK_F5 ), themePrompt 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 ) , ((modMask x , xK_Left ), windows W.focusUp ) -- other stuff: launch some useful utilities , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) , ((modMask x .|. shiftMask, xK_F4 ), spawn "~/bin/dict.sh" ) , ((modMask x .|. shiftMask, xK_F5 ), spawn "~/bin/urlOpen.sh" ) , ((modMask x .|. shiftMask, xK_t ), spawn "~/bin/teaTime.sh" ) , ((modMask x , xK_c ), kill ) , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) -- commands fo the Magnifier layout , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) -- windowArranger , ((modMask x .|. controlMask , xK_a ), sendMessage Arrange ) , ((modMask x .|. controlMask .|. shiftMask, xK_a ), sendMessage DeArrange ) , ((modMask x .|. controlMask , xK_Left ), sendMessage (DecreaseLeft 10)) , ((modMask x .|. controlMask , xK_Up ), sendMessage (DecreaseUp 10)) , ((modMask x .|. controlMask , xK_Right), sendMessage (IncreaseRight 10)) , ((modMask x .|. controlMask , xK_Down ), sendMessage (IncreaseDown 10)) , ((modMask x .|. shiftMask , xK_Left ), sendMessage (MoveLeft 10)) , ((modMask x .|. shiftMask , xK_Right), sendMessage (MoveRight 10)) , ((modMask x .|. shiftMask , xK_Down ), sendMessage (MoveDown 10)) , ((modMask x .|. shiftMask , xK_Up ), sendMessage (MoveUp 10)) -- gaps , ((modMask x , xK_b ), sendMessage ToggleStruts ) ] ++ -- Use modMask .|. shiftMask .|. controlMask 1-9 instead [( (m .|. modMask x, k), windows $ f i) | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] ] xmonad-contrib-0.18.0/XMonad/Config/Azerty.hs0000644000000000000000000000401007346545000017115 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Azerty -- Description : Fix some keybindings for users of French keyboard layouts. -- Copyright : (c) Devin Mullins -- License : BSD -- -- Maintainer : Devin Mullins -- Stability : stable -- Portability : unportable -- -- This module fixes some of the keybindings for the francophone among you who -- use an AZERTY keyboard layout. Config stolen from TeXitoi's config on the -- wiki. module XMonad.Config.Azerty ( -- * Usage -- $usage azertyConfig, azertyKeys, belgianConfig, belgianKeys ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Azerty -- > -- > main = xmonad azertyConfig -- -- If you prefer, an azertyKeys function is provided which you can use as so: -- -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> azertyKeys c <> keys someConfig c } azertyConfig = def { keys = azertyKeys <> keys def } belgianConfig = def { keys = belgianKeys <> keys def } azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0] belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0] azertyKeysTop topRow conf@XConfig{modMask = modm} = M.fromList $ [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] ++ [((m .|. modm, k), windows $ f i) | (i, k) <- zip (workspaces conf) topRow, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] ++ -- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 -- mod-shift-{z,e,r} %! Move client to screen 1, 2, or 3 [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) | (key, sc) <- zip [xK_z, xK_e, xK_r] [0..], (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] xmonad-contrib-0.18.0/XMonad/Config/Bepo.hs0000644000000000000000000000270307346545000016533 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Bepo -- Description : Fix keybindings for the BEPO keyboard layout. -- Copyright : (c) Yorick Laupa -- License : BSD -- -- Maintainer : Yorick Laupa -- Stability : stable -- Portability : unportable -- -- This module fixes some of the keybindings for the francophone among you who -- use a BEPO keyboard layout. Based on XMonad.Config.Azerty module XMonad.Config.Bepo ( -- * Usage -- $usage bepoConfig, bepoKeys ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bepo -- > -- > main = xmonad bepoConfig -- -- If you prefer, an bepoKeys function is provided which you can use as so: -- -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c } 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)]] xmonad-contrib-0.18.0/XMonad/Config/Bluetile.hs0000644000000000000000000002264507346545000017422 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS -fno-warn-missing-signatures #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Bluetile -- Description : Default configuration of [Bluetile](http://projects.haskell.org/bluetile/). -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This is the default configuration of 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. -- ----------------------------------------------------------------------------- module XMonad.Config.Bluetile ( -- * Usage -- $usage bluetileConfig ) where import XMonad import XMonad.Layout.BorderResize import XMonad.Layout.BoringWindows hiding (Replace) import XMonad.Layout.ButtonDecoration import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Layout.DraggingVisualizer import XMonad.Layout.Maximize import XMonad.Layout.Minimize import XMonad.Layout.MouseResizableTile import XMonad.Layout.Renamed import XMonad.Layout.NoBorders import XMonad.Layout.PositionStoreFloat import XMonad.Layout.WindowSwitcherDecoration import XMonad.Actions.BluetileCommands import XMonad.Actions.CycleWS import XMonad.Actions.Minimize import XMonad.Actions.WindowMenu import XMonad.Hooks.CurrentWorkspaceOnTop import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Hooks.PositionStoreHooks import XMonad.Hooks.Minimize import XMonad.Hooks.ServerMode import XMonad.Hooks.WorkspaceByPos import XMonad.Config.Gnome import qualified XMonad.StackSet as W import qualified Data.Map as M import System.Exit import XMonad.Prelude(when) -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bluetile -- > import XMonad.Util.Replace -- > -- > main = replace >> xmonad bluetileConfig -- -- The invocation of 'replace' will replace a currently running -- window manager. This is the default behaviour of Bluetile as well. -- See "XMonad.Util.Replace" for more information. bluetileWorkspaces :: [String] 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 $ -- launching and killing programs [ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal , ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog , ((modMask' .|. shiftMask, xK_c ), kill) -- %! Close the focused window , ((modMask', xK_F5 ), refresh) -- %! Resize viewed windows to the correct size , ((modMask' .|. shiftMask, xK_F5 ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default , ((modMask', xK_o ), windowMenu) -- move focus up or down the window stack , ((modMask', xK_Tab ), focusDown) -- %! Move focus to the next window , ((modMask' .|. shiftMask, xK_Tab ), focusUp) -- %! Move focus to the previous window , ((modMask', xK_j ), focusDown) -- %! Move focus to the next window , ((modMask', xK_k ), focusUp) -- %! Move focus to the previous window , ((modMask', xK_space ), focusMaster) -- %! Move focus to the master window -- modifying the window order , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window , ((modMask' .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window , ((modMask' .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window -- resizing the master/slave ratio , ((modMask', xK_h ), sendMessage Shrink) -- %! Shrink the master area , ((modMask', xK_l ), sendMessage Expand) -- %! Expand the master area , ((modMask', xK_u ), sendMessage ShrinkSlave) -- %! Shrink a slave area , ((modMask', xK_i ), sendMessage ExpandSlave) -- %! Expand a slave area -- floating layer support , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling , ((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 exitSuccess) -- %! Quit , ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart -- Metacity-like workspace switching , ((mod1Mask .|. controlMask, xK_Left), prevWS) , ((mod1Mask .|. controlMask, xK_Right), nextWS) , ((mod1Mask .|. controlMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) , ((mod1Mask .|. controlMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) -- more Metacity keys , ((mod1Mask , xK_F2), gnomeRun) , ((mod1Mask , xK_F4), kill) -- Switching to layouts , ((modMask' , xK_a), sendMessage $ JumpToLayout "Floating") , ((modMask' , xK_s), sendMessage $ JumpToLayout "Tiled1") , ((modMask' , xK_d), sendMessage $ JumpToLayout "Tiled2") , ((modMask' , xK_f), sendMessage $ JumpToLayout "Fullscreen") -- Maximizing , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) -- Minimizing , ((modMask', xK_m ), withFocused minimizeWindow) , ((modMask' .|. shiftMask, xK_m ), withLastMinimized maximizeWindow) ] ++ -- mod-[1..9] ++ [0] %! Switch to workspace N -- mod-shift-[1..9] ++ [0] %! Move client to workspace N [((m .|. modMask', k), windows $ f i) | (i, k) <- zip (XMonad.workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] ++ -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f)) | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) 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) -- mod-button2 %! Switch to next and first layout , ((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) ] isFloating :: Window -> X Bool isFloating w = do ws <- gets windowset return $ M.member w (W.floating ws) bluetileManageHook :: ManageHook bluetileManageHook = composeAll [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons) , className =? "MPlayer" --> doFloat , isFullscreen --> doFullFloat] bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ renamed [Replace "Floating"] floating ||| renamed [Replace "Tiled1"] tiled1 ||| renamed [Replace "Tiled2"] tiled2 ||| renamed [Replace "Fullscreen"] fullscreen where floating = floatingDeco $ maximize $ borderResize positionStoreFloat tiled1 = tilingDeco $ maximize mouseResizableTileMirrored tiled2 = tilingDeco $ maximize mouseResizableTile fullscreen = tilingDeco $ maximize $ smartBorders Full tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) floatingDeco = buttonDeco shrinkText defaultThemeWithButtons bluetileConfig = docks . ewmhFullscreen . ewmh $ def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook, logHook = currentWorkspaceOnTop, handleEventHook = minimizeEventHook `mappend` serverModeEventHook' bluetileCommands `mappend` positionStoreEventHook, workspaces = bluetileWorkspaces, keys = bluetileKeys, mouseBindings = bluetileMouseBindings, focusFollowsMouse = False, focusedBorderColor = "#000000", terminal = "gnome-terminal" } xmonad-contrib-0.18.0/XMonad/Config/Desktop.hs0000644000000000000000000001475007346545000017264 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Desktop -- Description : Core settings for interfacing with desktop environments. -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with a desktop -- environment such as KDE or GNOME. ----------------------------------------------------------------------------- module XMonad.Config.Desktop ( -- | Several basic integration settings are common to all of xmonad's -- desktop integration configurations. The specific desktop environment -- (DE) modules like "XMonad.Config.Gnome" use this module's -- @desktopConfig@ to set up basic communication between xmonad and -- the DE via a subset of the Extended Window Manager Hints (EWMH) -- specification. Extra xmonad settings unique to specific DE's are -- added by overriding or modifying @desktopConfig@ fields in the -- same way that the default configuration is customized in -- @xmonad.hs@. -- -- For more information about EWMH see: -- -- -- -- See also: "XMonad.Hooks.EwmhDesktops", "XMonad.Hooks.ManageDocks", -- "XMonad.Util.EZConfig". -- * Usage -- $usage desktopConfig, -- * Customizing a desktop config -- $customizing -- ** Modifying layouts, manageHook, or key bindings -- $layouts desktopLayoutModifiers -- ** Modifying the logHook -- $logHook -- ** Modifying the handleEventHook -- $eventHook -- ** Modifying the startupHook -- $startupHook ) where 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 -- $usage -- While this document describes how to configure xmonad, you also need -- to set up your Desktop Environment (DE) and display manager to use -- xmonad as its window manager. For DE and distro specific tips on -- how to do so, see the xmonad wiki: -- -- -- -- To configure xmonad for use with a DE or with DE tools like panels -- and pagers, in place of @def@ in your @xmonad.hs@, -- use @desktopConfig@ or one of the other desktop configs from the -- @XMonad.Config@ namespace. The following setup and customization examples -- work the same way for the other desktop configs as for @desktopConfig@. -- If you are using a specific DE config, import its module instead, and -- use its config in place of @desktopConfig@ in the following examples. -- -- > import XMonad -- > import XMonad.Config.Desktop -- > -- > main = xmonad desktopConfig -- -- @desktopConfig@ is an 'XConfig' that configures xmonad to -- ignore and leave room for dock type windows like panels and trays, adds -- the default key binding to toggle panel visibility, and activates basic -- EWMH support. It also sets a prettier root window mouse pointer. -- $customizing -- To customize a desktop config, modify its fields as is illustrated with -- the default configuration @def@ in . -- $layouts -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings. -- To add to layouts, manageHook or key bindings use something like the following -- to combine your modifications with the desktop config settings: -- -- > import XMonad -- > import XMonad.Config.Desktop -- > import XMonad.Layout.Tabbed -- > import XMonad.Util.EZConfig (additionalKeys) -- > -- > main = -- > xmonad $ desktopConfig { -- > -- add manage hooks while still ignoring panels and using default manageHooks -- > manageHook = myManageHook <> manageHook desktopConfig -- > -- > -- add a fullscreen tabbed layout that does not avoid covering -- > -- up desktop panels before the desktop layouts -- > , layoutHook = simpleTabbed ||| layoutHook desktopConfig -- > } -- > -- add a screenshot key to the default desktop bindings -- > `additionalKeys` [ ((mod4Mask, xK_F8), spawn "scrot") ] -- -- To replace the desktop layouts with your own choices, but still -- allow toggling panel visibility, use 'desktopLayoutModifiers' to -- modify your layouts: -- -- > , layoutHook = desktopLayoutModifiers $ simpleTabbed ||| Tall 1 0.03 0.5 -- -- @desktopLayoutModifiers@ modifies a layout to avoid covering docks, panels, -- etc. that set the @_NET_WM_STRUT_PARTIAL@ property. -- See also "XMonad.Hooks.ManageDocks". -- $logHook -- To add to the logHook while still sending workspace and window information -- to DE apps use something like: -- -- > , logHook = myLogHook <> logHook desktopConfig -- -- Or for more elaborate logHooks you can use @do@: -- -- > , logHook = do -- > dynamicLogWithPP xmobarPP -- > updatePointer (Relative 0.9 0.9) -- > logHook desktopConfig -- -- $eventHook -- To customize xmonad's event handling while still having it respond -- to EWMH events from pagers, task bars: -- -- > , handleEventHook = myEventHooks <> handleEventHook desktopConfig -- -- or 'mconcat' if you write a list event of event hooks -- -- > , handleEventHook = mconcat -- > [ myMouseHandler -- > , myMessageHandler -- > , handleEventHook desktopConfig ] -- -- Note that the event hooks are run left to right (in contrast to -- 'ManageHook'S which are right to left) -- $startupHook -- To run the desktop startupHook, plus add further actions to be run each -- time xmonad starts or restarts, use '<>' to combine actions as in the -- logHook example, or something like: -- -- > , startupHook = do -- > startupHook desktopConfig -- > spawn "xmonad-restart.sh" -- > 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 l -> M.Map (KeyMask, KeySym) (X ()) desktopKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_b), sendMessage ToggleStruts) ] desktopLayoutModifiers :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a desktopLayoutModifiers = avoidStruts xmonad-contrib-0.18.0/XMonad/Config/Dmwit.hs0000644000000000000000000003167207346545000016741 0ustar0000000000000000-- boilerplate {{{ {-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Dmwit -- Description : Daniel Wagner's xmonad configuration. -- ------------------------------------------------------------------------ module XMonad.Config.Dmwit {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} where -- system imports import Control.Monad.Trans import Data.Map (Map, fromList) import Data.Ratio import Data.Word import GHC.Real import System.Environment import System.Exit import System.IO import System.Process -- xmonad core import XMonad import XMonad.StackSet hiding (workspaces) -- xmonad contrib import XMonad.Actions.SpawnOn import XMonad.Actions.Warp import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Layout.Grid import XMonad.Layout.IndependentScreens hiding (withScreen) import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders import XMonad.Prelude hiding (fromList) import XMonad.Util.Dzen hiding (x, y) import XMonad.Util.SpawnOnce -- }}} -- volume {{{ outputOf :: String -> IO String outputOf s = do uninstallSignalHandlers (hIn, hOut, hErr, p) <- runInteractiveCommand s mapM_ hClose [hIn, hErr] hGetContents hOut <* waitForProcess p <* installSignalHandlers geomMean :: Floating a => [a] -> a geomMean xs = product xs ** (recip . fromIntegral . length $ xs) arithMean :: Floating a => [a] -> a arithMean xs = sum xs / fromIntegral (length xs) namedNumbers n s = do l <- lines s guard (sentinel `isPrefixOf` l) return (drop (length sentinel) l) where sentinel = n ++ " #" -- Data.List.Split.splitOn ":", but without involving an extra dependency splitColon xs = case break (==':') xs of (a, ':':b) -> a : splitColon b (a, _) -> [a] parse s = arithMean $ do l <- lines s guard ("\tVolume: " `isPrefixOf` l) part <- splitColon l (n,'%':_) <- reads part return n modVolume :: String -> Integer -> IO Double modVolume kind n = do is <- namedNumbers parseKind <$> outputOf listCommand forM_ is (outputOf . setCommand) parse <$> outputOf listCommand where sign | n > 0 = "+" | otherwise = "-" ctlKind = map (\c -> if c == ' ' then '-' else c) kind parseKind = unwords . map (\(notEmpty -> c :| cs) -> toUpper c : cs) . words $ kind setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%" listCommand = "pactl list " ++ ctlKind ++ "s" -- }}} -- convenient actions {{{ centerMouse = warpToWindow (1/2) (1/2) statusBarMouse = warpToScreen 0 (5/1600) (5/1200) withScreen s f = screenWorkspace s >>= flip whenJust (windows . f) makeLauncher yargs run exec close = concat ["exe=`yeganesh ", yargs, "` && ", run, " ", exec, "$exe", close] launcher = makeLauncher "" "eval" "\"exec " "\"" termLauncher = makeLauncher "-p withterm" "exec urxvt -e" "" "" viewShift i = view i . shift i floatAll = composeAll . map (\s -> className =? s --> doFloat) sinkFocus = peek >>= maybe id sink showMod k n = liftIO (modVolume k n) >>= volumeDzen . show . round volumeDzen = dzenConfig $ onCurr (center 170 66) >=> font "-*-helvetica-*-r-*-*-64-*-*-*-*-*-*-*,-*-terminus-*-*-*-*-64-*-*-*-*-*-*-*" -- }}} altMask = mod1Mask bright = "#80c0ff" dark = "#13294e" -- manage hooks for mplayer {{{ fullscreen43on169 = expand $ RationalRect 0 (-1/6) 1 (4/3) where expand (RationalRect x y w h) = RationalRect (x - bwx) (y - bwy) (w + 2 * bwx) (h + 2 * bwy) bwx = 2 / 1920 -- borderwidth bwy = 2 / 1080 fullscreenMPlayer = className =? "MPlayer" --> do dpy <- liftX $ asks display win <- ask hints <- liftIO $ getWMNormalHints dpy win case fmap (approx . fst) (sh_aspect hints) of Just ( 4 :% 3) -> viewFullOn 0 "5" win Just (16 :% 9) -> viewFullOn 1 "5" win _ -> doFloat where approx (n, d) = approxRational (fi n / fi d) (1/100) operationOn f s n w = do let ws = marshall s n currws <- liftX $ screenWorkspace s doF $ view ws . maybe id view currws . shiftWin ws w . f w viewFullOn = operationOn sink centerWineOn = operationOn (`XMonad.StackSet.float` RationalRect (79/960) (-1/540) (401/480) (271/270)) -- }}} -- debugging {{{ class Show a => PPrint a where pprint :: Int -> a -> String pprint _ = show data PPrintable = forall a. PPrint a => P a instance Show PPrintable where show (P x) = show x instance PPrint PPrintable where pprint n (P x) = pprint n x record :: String -> Int -> [(String, PPrintable)] -> String record s n xs = preamble ++ intercalate newline fields ++ postlude where indentation = '\n' : replicate n '\t' preamble = s ++ " {" ++ indentation postlude = indentation ++ "}" newline = ',' : indentation fields = map (\(name, value) -> name ++ " = " ++ pprint (n+1) value) xs instance PPrint a => PPrint (Maybe a) where pprint n (Just x) = "Just (" ++ pprint n x ++ ")" pprint _ x = show x instance PPrint a => PPrint [a] where pprint _ [] = "[]" pprint n xs = preamble ++ intercalate newline allLines ++ postlude where indentation = '\n' : replicate n '\t' preamble = "[" ++ indentation allLines = map (pprint (n+1)) xs newline = ',' : indentation postlude = indentation ++ "]" instance PPrint Rectangle where pprint n x = record "Rectangle" n [ ("rect_x", P (rect_x x)), ("rect_y", P (rect_y x)), ("rect_width", P (rect_width x)), ("rect_height", P (rect_height x)) ] instance PPrint a => PPrint (Stack a) where pprint n x = record "Stack" n [ ("focus", P (XMonad.StackSet.focus x)), ("up", P (up x)), ("down", P (down x)) ] instance (PPrint i, PPrint l, PPrint a) => PPrint (Workspace i l a) where pprint n x = record "Workspace" n [ ("tag", P (tag x)), ("layout", P (layout x)), ("stack", P (stack x)) ] instance PPrint ScreenDetail where pprint n x = record "SD" n [("screenRect", P (screenRect x))] instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (XMonad.StackSet.Screen i l a sid sd) where pprint n x = record "Screen" n [ ("workspace", P (workspace x)), ("screen", P (screen x)), ("screenDetail", P (screenDetail x)) ] instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (StackSet i l a sid sd) where pprint n x = record "StackSet" n [ ("current", P (current x)), ("visible", P (visible x)), ("hidden", P (hidden x)), ("floating", P (floating x)) ] instance PPrint (Layout a) instance PPrint Int instance PPrint XMonad.Screen instance PPrint Integer instance PPrint Position instance PPrint Dimension instance PPrint Char instance PPrint Word64 instance PPrint ScreenId instance (Show a, Show b) => PPrint (Map a b) -- }}} -- main {{{ dmwitConfig nScreens = docks $ def { borderWidth = 2, workspaces = withScreens nScreens (map show [1..5]), terminal = "urxvt", normalBorderColor = dark, focusedBorderColor = bright, modMask = mod4Mask, keys = keyBindings, layoutHook = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full, manageHook = (title =? "CGoban: Main Window" --> doF sinkFocus) <> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5") <> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5") <> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <> compared to) this one <> (appName =? "huludesktop" --> doRectFloat fullscreen43on169) <> fullscreenMPlayer <> floatAll ["Gimp", "Wine"] <> manageSpawn, logHook = allPPs nScreens, startupHook = refresh >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1] } main = countScreens >>= xmonad . dmwitConfig -- }}} -- keybindings {{{ keyBindings conf = let m = modMask conf in fromList . anyMask $ [ ((m , xK_BackSpace ), spawnHere "urxvt"), ((m , xK_p ), spawnHere launcher), ((m .|. shiftMask , xK_p ), spawnHere termLauncher), ((m .|. shiftMask , xK_c ), kill), ((m , xK_q ), restart "xmonad" True), ((m .|. shiftMask , xK_q ), io exitSuccess), ((m , xK_grave ), sendMessage NextLayout), ((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf), ((m , xK_o ), sendMessage Toggle), ((m , xK_x ), withFocused (windows . sink)), ((m , xK_Home ), windows focusUp), ((m .|. shiftMask , xK_Home ), windows swapUp), ((m , xK_End ), windows focusDown), ((m .|. shiftMask , xK_End ), windows swapDown), ((m , xK_a ), windows focusMaster), ((m .|. shiftMask , xK_a ), windows swapMaster), ((m , xK_Control_L ), withScreen 0 view), ((m .|. shiftMask , xK_Control_L ), withScreen 0 viewShift), ((m , xK_Alt_L ), withScreen 1 view), ((m .|. shiftMask , xK_Alt_L ), withScreen 1 viewShift), ((m , xK_u ), centerMouse), ((m .|. shiftMask , xK_u ), statusBarMouse), ((m , xK_s ), spawnHere "chromium --password-store=gnome"), ((m , xK_n ), spawnHere "gvim todo"), ((m , xK_t ), spawnHere "mpc toggle"), ((m , xK_h ), spawnHere "urxvt -e alsamixer"), ((m , xK_d ), spawnHere "wyvern"), ((m , xK_l ), spawnHere "urxvt -e sup"), ((m , xK_r ), spawnHere "urxvt -e ncmpcpp"), ((m , xK_c ), spawnHere "urxvt -e ghci"), ((m , xK_g ), spawnHere "slock" >> spawnHere "xscreensaver-command -lock"), ((m , xK_f ), spawnHere "gvim ~/.xmonad/xmonad.hs"), (( noModMask , xK_F8 ), showMod "sink input" (-4)), (( noModMask , xK_F9 ), showMod "sink input" 4 ), (( shiftMask , xK_F8 ), showMod "sink" (-4)), (( shiftMask , xK_F9 ), showMod "sink" 4 ), (( noModMask , xK_Super_L ), return ()) -- make VirtualBox ignore stray hits of the Windows key ] ++ [ ((m .|. e , key ), windows (onCurrentScreen f ws)) | (key, ws) <- zip [xK_1..xK_9] (workspaces' conf) , (e, f) <- [(0, view), (shiftMask, viewShift)] ] atSchool school home = do host <- liftIO (getEnv "HOST") return $ case host of "sorghum" -> home "buckwheat" -> home _ -> school anyMask xs = do ((mask, key), action) <- xs extraMask <- [0, controlMask, altMask, controlMask .|. altMask] return ((mask .|. extraMask, key), action) -- }}} -- logHook {{{ pipeName n s = "/home/dmwit/.xmonad/pipe-" ++ n ++ "-" ++ show s xmobarCommand (S s) = unwords ["xmobar", "-x", show s, "-t", template s, "-C", pipeReader ] where template 0 = "}%focus%{%workspaces%" template _ = "%date%}%focus%{%workspaces%" pipeReader = "'[\ \Run PipeReader \"" ++ pipeName "focus" s ++ "\" \"focus\",\ \Run PipeReader \"" ++ pipeName "workspaces" s ++ "\" \"workspaces\"\ \]'" allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp <- [ppFocus, ppWorkspaces]] color c = xmobarColor c "" ppFocus s@(S s_) = whenCurrentOn s def { ppOrder = \case{ _:_:windowTitle:_ -> [windowTitle]; _ -> [] }, ppOutput = appendFile (pipeName "focus" s_) . (++ "\n") } ppWorkspaces s@(S s_) = marshallPP s def { ppCurrent = color "white", ppVisible = color "white", ppHiddenNoWindows = color dark, ppUrgent = color "red", ppSep = "", ppOrder = \case{ wss:_layout:_title:_ -> [wss]; _ -> [] }, ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n") } -- }}} xmonad-contrib-0.18.0/XMonad/Config/Droundy.hs0000644000000000000000000002237707346545000017303 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Droundy -- Description : David Roundy's xmonad config. -- Copyright : (c) Spencer Janssen 2007 -- License : BSD3-style (see LICENSE) -- ------------------------------------------------------------------------ module XMonad.Config.Droundy {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( config, mytab ) where import XMonad hiding (keys, config) import qualified XMonad (keys) import qualified XMonad.StackSet as W import qualified Data.Map as M import System.Exit ( exitSuccess ) import XMonad.Layout.Tabbed ( tabbed, shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) import XMonad.Layout.Combo ( combineTwo ) import XMonad.Layout.Renamed ( Rename(Replace), renamed ) import XMonad.Layout.LayoutCombinators import XMonad.Layout.Square ( Square(Square) ) import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L), windowNavigation ) import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring, focusUp, focusDown ) import XMonad.Layout.NoBorders ( smartBorders ) import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir ) import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) ) import XMonad.Layout.ShowWName ( showWName ) import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) ) import XMonad.Prompt ( font, height, XPConfig ) import XMonad.Prompt.Layout ( layoutPrompt ) import XMonad.Prompt.Shell ( shellPrompt ) import XMonad.Actions.CopyWindow ( kill1, copy ) import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, selectWorkspace, renameWorkspace, removeWorkspace ) import XMonad.Actions.CycleWS ( moveTo, hiddenWS, emptyWS, Direction1D( Prev, Next), WSType ((:&:), Not) ) import XMonad.Hooks.ManageDocks ( avoidStruts, docks ) import XMonad.Hooks.EwmhDesktops ( ewmh ) myXPConfig :: XPConfig myXPConfig = def {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" ,height=22} ------------------------------------------------------------------------ -- Key bindings: -- | The xmonad key bindings. Add, modify or remove key bindings here. -- -- (The comment formatting character is used when generating the manpage) -- keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) keys x = M.fromList $ -- launching and killing programs [ ((modMask x .|. shiftMask, xK_c ), kill1) -- %! Close the focused window , ((modMask x .|. shiftMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms , ((modMask x .|. controlMask .|. shiftMask, xK_L ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default -- move focus up or down the window stack , ((modMask x, xK_Tab ), focusDown) -- %! Move focus to the next window , ((modMask x, xK_j ), focusDown) -- %! Move focus to the next window , ((modMask x, xK_k ), focusUp ) -- %! Move focus to the previous window , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window -- floating layer support , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling -- quit, or restart , ((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 $ 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) , ((modMask x, xK_Down), sendMessage $ Go D) , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R) , ((modMask x .|. controlMask, xK_Left), sendMessage $ Swap L) , ((modMask x .|. controlMask, xK_Up), sendMessage $ Swap U) , ((modMask x .|. controlMask, xK_Down), sendMessage $ Swap D) , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) , ((0, xK_F2 ), spawn "gnome-terminal") -- %! Launch gnome-terminal , ((0, xK_F3 ), shellPrompt myXPConfig) -- %! Launch program , ((0, xK_F11 ), spawn "ksnapshot") -- %! Take snapshot , ((modMask x .|. shiftMask, xK_b ), markBoring) , ((controlMask .|. modMask x .|. shiftMask, xK_b ), clearBoring) , ((modMask x .|. shiftMask, xK_x ), changeDir myXPConfig) , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) , ((modMask x .|. shiftMask, xK_v ), selectWorkspace myXPConfig) , ((modMask x, xK_m ), withWorkspace myXPConfig (windows . W.shift)) , ((modMask x .|. shiftMask, xK_m ), withWorkspace myXPConfig (windows . copy)) , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig) , ((modMask x, xK_l ), layoutPrompt myXPConfig) , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) , ((modMask x, xK_space), sendMessage Toggle) ] ++ zip (map (modMask x,) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) ++ zip (map (modMask x .|. shiftMask,) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) config = docks $ ewmh def { borderWidth = 1 -- Width of the window border in pixels. , XMonad.workspaces = ["mutt","iceweasel"] , layoutHook = showWName $ workspaceDir "~" $ boringWindows $ smartBorders $ windowNavigation $ maximizeVertical $ toggleLayouts Full $ avoidStruts $ renamed [Replace "tabbed"] mytab ||| renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) ||| renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| renamed [Replace "widescreen"] ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5 , terminal = "xterm" -- The preferred terminal program. , normalBorderColor = "#222222" -- Border color for unfocused windows. , focusedBorderColor = "#00ff00" -- Border color for focused windows. , XMonad.modMask = mod1Mask , XMonad.keys = keys } mytab = tabbed CustomShrink def instance Shrinker CustomShrink where shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s where n = length s halfn = n `div` 2 rs = reverse s cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs) shrinkIt _ s = shrinkIt shrinkText s dropFromTail :: String -> String -> Maybe String dropFromTail "" _ = Nothing dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s | otherwise = Nothing dropFromHead :: String -> String -> Maybe String dropFromHead "" _ = Nothing dropFromHead h s | take (length h) s == h = Just $ drop (length h) s | otherwise = Nothing {- data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show) instance UrgencyHook FocusUrgencyHook Window where urgencyHook _ w = modify copyAndFocus where copyAndFocus s | Just w == W.peek (windowset s) = s | has w $ W.stack $ W.workspace $ W.current $ windowset s = s { windowset = until ((Just w ==) . W.peek) W.focusUp $ windowset s } | otherwise = let t = W.currentTag $ windowset s in s { windowset = until ((Just w ==) . W.peek) W.focusUp $ copyWindow w t $ windowset s } has _ Nothing = False has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) -} xmonad-contrib-0.18.0/XMonad/Config/Example.hs0000644000000000000000000000566607346545000017254 0ustar0000000000000000-------------------------------------------------------------------------------- -- | Example.hs -- -- Example configuration file for xmonad using the latest recommended -- features (e.g., 'desktopConfig'). module Main (main) where -------------------------------------------------------------------------------- import System.Exit import XMonad import XMonad.Config.Desktop import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageHelpers import XMonad.Layout.BinarySpacePartition (emptyBSP) import XMonad.Layout.NoBorders (noBorders) import XMonad.Layout.ResizableTile (ResizableTall(..)) import XMonad.Layout.ToggleLayouts (ToggleLayout(..), toggleLayouts) import XMonad.Prompt import XMonad.Prompt.ConfirmPrompt import XMonad.Prompt.Shell import XMonad.Util.EZConfig -------------------------------------------------------------------------------- main = do spawn "xmobar" -- Start a task bar such as xmobar. -- Start xmonad using the main desktop configuration with a few -- simple overrides: xmonad $ desktopConfig { modMask = mod4Mask -- Use the "Win" key for the mod key , manageHook = myManageHook <> manageHook desktopConfig , layoutHook = desktopLayoutModifiers myLayouts , logHook = (dynamicLogString def >>= xmonadPropLog) <> logHook desktopConfig } `additionalKeysP` -- Add some extra key bindings: [ ("M-S-q", confirmPrompt myXPConfig "exit" (io exitSuccess)) , ("M-p", shellPrompt myXPConfig) , ("M-", sendMessage (Toggle "Full")) ] -------------------------------------------------------------------------------- -- | Customize layouts. -- -- This layout configuration uses two primary layouts, 'ResizableTall' -- and 'BinarySpacePartition'. You can also use the 'M-' key -- binding defined above to toggle between the current layout and a -- full screen layout. myLayouts = toggleLayouts (noBorders Full) others where others = ResizableTall 1 (1.5/100) (3/5) [] ||| emptyBSP -------------------------------------------------------------------------------- -- | Customize the way 'XMonad.Prompt' looks and behaves. It's a -- great replacement for dzen. myXPConfig = def { position = Top , alwaysHighlight = True , promptBorderWidth = 0 , font = "xft:monospace:size=9" } -------------------------------------------------------------------------------- -- | Manipulate windows as they are created. The list given to -- @composeOne@ is processed from top to bottom. The first matching -- rule wins. -- -- 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 -- Handle floating windows: [ transience -- move transient windows to their parent , isDialog -?> doCenterFloat ] <> composeAll [ className =? "Pidgin" --> doFloat , className =? "XCalc" --> doFloat , className =? "mpv" --> doFloat ] xmonad-contrib-0.18.0/XMonad/Config/Gnome.hs0000644000000000000000000000517607346545000016722 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Gnome -- Description : Config for integrating xmonad with GNOME. -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the GNOME desktop -- environment. module XMonad.Config.Gnome ( -- * Usage -- $usage gnomeConfig, gnomeRun, gnomeRegister, desktopLayoutModifiers ) where import XMonad import XMonad.Config.Desktop import XMonad.Util.Run (safeSpawn) import qualified Data.Map as M import System.Environment (getEnvironment) -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Gnome -- > -- > main = xmonad gnomeConfig -- -- For examples of how to further customize @gnomeConfig@ see "XMonad.Config.Desktop". gnomeConfig = desktopConfig { terminal = "gnome-terminal" , keys = gnomeKeys <> keys desktopConfig , startupHook = gnomeRegister >> startupHook desktopConfig } gnomeKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), gnomeRun) , ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ] -- | Launch the "Run Application" dialog. gnome-panel must be running for this -- to work. gnomeRun :: X () gnomeRun = withDisplay $ \dpy -> do rw <- asks theRoot gnome_panel <- getAtom "_GNOME_PANEL_ACTION" panel_run <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG" io $ allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw gnome_panel 32 panel_run 0 sendEvent dpy rw False structureNotifyMask e sync dpy False -- | Register xmonad with gnome. 'dbus-send' must be in the $PATH with which -- xmonad is started. -- -- This action reduces a delay on startup only only if you have configured -- gnome-session>=2.26: to start xmonad with a command as such: -- -- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string gnomeRegister :: MonadIO m => m () gnomeRegister = io $ do x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment whenJust x $ \sessionId -> safeSpawn "dbus-send" ["--session" ,"--print-reply=literal" ,"--dest=org.gnome.SessionManager" ,"/org/gnome/SessionManager" ,"org.gnome.SessionManager.RegisterClient" ,"string:xmonad" ,"string:"++sessionId] xmonad-contrib-0.18.0/XMonad/Config/Kde.hs0000644000000000000000000000326507346545000016355 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Kde -- Description : Config for integrating xmonad with KDE. -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the KDE desktop -- environment. module XMonad.Config.Kde ( -- * Usage -- $usage kdeConfig, kde4Config, desktopLayoutModifiers ) where import XMonad import XMonad.Config.Desktop import qualified Data.Map as M -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Kde -- > -- > main = xmonad kdeConfig -- -- For KDE 4, replace 'kdeConfig' with 'kde4Config' -- -- For examples of how to further customize @kdeConfig@ see "XMonad.Config.Desktop". kdeConfig = desktopConfig { terminal = "konsole" , keys = kdeKeys <> keys desktopConfig } kde4Config = desktopConfig { terminal = "konsole" , keys = kde4Keys <> keys desktopConfig } 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 [ ((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-contrib-0.18.0/XMonad/Config/Mate.hs0000644000000000000000000000731407346545000016537 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -- TODO: Remove when we depend on a version of xmonad that has unGrab. {-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Mate -- Description : Config for integrating xmonad with MATE. -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the MATE desktop -- environment. -- ----------------------------------------------------------------------------- module XMonad.Config.Mate ( -- * Usage -- $usage mateConfig, mateRun, matePanel, mateRegister, mateLogout, mateShutdown, desktopLayoutModifiers ) where import System.Environment (getEnvironment) import qualified Data.Map as M import XMonad hiding (unGrab) import XMonad.Config.Desktop import XMonad.Prelude (toUpper) import XMonad.Util.Run (safeSpawn) import XMonad.Util.Ungrab (unGrab) -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Mate -- > -- > main = xmonad mateConfig -- -- For examples of how to further customize @mateConfig@ see "XMonad.Config.Desktop". mateConfig = desktopConfig { terminal = "mate-terminal" , keys = mateKeys <> keys desktopConfig , startupHook = mateRegister >> startupHook desktopConfig } mateKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), mateRun) , ((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. partial application for existing keybinding compatibility. mateRun :: X () 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 panel panel_action <- getAtom (panel ++ "_" ++ map toUpper action) io $ allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw mate_panel 32 panel_action 0 sendEvent dpy rw False structureNotifyMask e sync dpy False -- | Register xmonad with mate. 'dbus-send' must be in the $PATH with which -- xmonad is started. -- -- This action reduces a delay on startup only if you have configured -- mate-session to start xmonad with a command such as (check local -- documentation): -- -- > dconf write /org/mate/desktop/session/required_components/windowmanager "'xmonad'" -- -- (the extra quotes are required by dconf) mateRegister :: MonadIO m => m () mateRegister = io $ do x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment whenJust x $ \sessionId -> safeSpawn "dbus-send" ["--session" ,"--print-reply=literal" ,"--dest=org.mate.SessionManager" ,"/org/mate/SessionManager" ,"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-contrib-0.18.0/XMonad/Config/Prime.hs0000644000000000000000000006237607346545000016736 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Prime -- Description : Draft of a brand new config syntax for xmonad. -- Copyright : Devin Mullins -- License : BSD-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- This is a draft of a brand new config syntax for xmonad. It aims to be: -- -- * easier to copy/paste snippets from the docs -- -- * 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. -- ----------------------------------------------------------------------------- module XMonad.Config.Prime {-# DEPRECATED "This module is a perpetual draft and will therefore be removed from xmonad-contrib in the near future." #-} ( -- Note: The identifiers here are listed in the order that makes the most sense -- for a user, while the definitions below are listed in the order that makes -- the most sense for a developer. -- * Start here -- $start_here xmonad, nothing, -- * Attributes you can set -- $settables normalBorderColor, focusedBorderColor, terminal, modMask, borderWidth, focusFollowsMouse, clickJustFocuses, SettableClass(..), UpdateableClass(..), -- * Attributes you can add to -- $summables manageHook, handleEventHook, workspaces, logHook, startupHook, clientMask, rootMask, SummableClass(..), -- * Attributes you can add to or remove from -- $removables keys, mouseBindings, RemovableClass(..), -- * Modifying the list of workspaces -- $workspaces withWorkspaces, wsNames, wsKeys, wsActions, wsSetName, -- * Modifying the screen keybindings -- $screens withScreens, sKeys, sActions, onScreens, -- * Modifying the layoutHook -- $layout addLayout, resetLayout, modifyLayout, -- * Updating the XConfig en masse -- $update startWith, apply, applyIO, -- * The rest of the world -- | Everything you know and love from the core "XMonad" module is available -- for use in your config file, too. module XMonad, -- | (Almost) everything you know and love from the Haskell "Prelude" is -- available for use in your config file. Note that '>>' has been overriden, so -- if you want to create do-blocks for normal monads, you'll need some let -- statements or a separate module. (See the Troubleshooting section.) module Prelude, -- * Core -- | These are the building blocks on which the config language is built. -- Regular people shouldn't need to know about these. Prime, Arr, (>>), ifThenElse, -- * Example config -- $example -- * Troubleshooting -- $troubleshooting ) where import Prelude hiding ((>>), mod) import qualified Prelude as P ((>>=), (>>)) import XMonad.Prelude (All) import XMonad hiding (xmonad, XConfig(..)) import XMonad (XConfig(XConfig)) import qualified XMonad.StackSet as W import qualified XMonad as X (xmonad, XConfig(..)) import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings) -- $start_here -- To start with, create a @xmonad.hs@ that looks like this: -- -- > {-# LANGUAGE RebindableSyntax #-} -- > import XMonad.Config.Prime -- > -- > -- Imports go here. -- > -- > main = xmonad $ do -- > nothing -- > -- Configs go here. -- -- This will give you a default xmonad install, with room to grow. The lines -- starting with double dashes are comments. You may delete them. Note that -- Haskell is a bit precise about indentation. Make sure all the statements in -- your do-block start at the same column, and make sure that any multi-line -- statements are formatted with a hanging indent. (For an example, see the -- 'keys =+' statement in the /Example config/ section, below.) -- -- After changing your config file, restart xmonad with mod-q (where, by -- default, "mod" == "alt"). -- -- The Prime "Monad" -- -- | A Prime is a function that transforms an XConfig. It's not a monad, but we -- turn on RebindableSyntax so we can abuse the pretty do notation. type Prime l l' = Arr (XConfig l) (XConfig l') -- | An Arr is a generalization of Prime. Don't reference the type, if you can -- avoid it. It might go away in the future. type Arr x y = x -> IO y -- | Composes two Arrs using 'Prelude.>>=' from "Prelude". (>>) :: Arr x y -> Arr y z -> Arr x z (>>) x y c = (P.>>=) (x c) y -- | Because of RebindableSyntax, this is necessary to enable you to use -- if-then-else expressions. No need to call it directly. ifThenElse :: Bool -> a -> a -> a ifThenElse True a _ = a ifThenElse False _ b = b -- | This is the xmonad main function. It passes 'XMonad.Config.def' (the -- default 'XConfig') into your do-block, takes the modified config out of your -- do-block, and then runs xmonad. -- -- The do-block is a 'Prime'. Advanced readers can skip right to that -- definition. xmonad :: (Default a, Read (l Window), LayoutClass l Window) => (a -> IO (XConfig l)) -> IO () xmonad prime = (P.>>=) (prime def) X.xmonad -- | This doesn't modify the config in any way. It's just here for your initial -- config because Haskell doesn't allow empty do-blocks. Feel free to delete it -- once you've added other stuff. nothing :: Prime l l nothing = return -- $settables -- These are a bunch of attributes that you can set. Syntax looks like this: -- -- > terminal =: "urxvt" -- -- Strings are double quoted, Dimensions are unquoted integers, booleans are -- 'True' or 'False' (case-sensitive), and 'modMask' is usually 'mod1Mask' or -- 'mod4Mask'. class UpdateableClass s x y | s -> x y where -- | This lets you apply a function to an attribute (i.e. read, modify, write). (=.) :: s c -> (x -> y) -> Arr c c class SettableClass s x y | s -> x y where -- | This lets you modify an attribute. (=:) :: s c -> y -> Arr c c -- Undecideable instance. But it's nice to leave open the possibility to write -- fields you can't read (e.g. `wmName =: ...`). instance UpdateableClass s x y => SettableClass s x y where s =: y = s =. const y data Settable x c = Settable (c -> x) -- getter (x -> c -> c) -- setter instance UpdateableClass (Settable x) x x where (Settable g s =. f) c = return $ s (f $ g c) c -- | Non-focused windows border color. Default: @\"#dddddd\"@ normalBorderColor :: Settable String (XConfig l) normalBorderColor = Settable X.normalBorderColor (\x c -> c { X.normalBorderColor = x }) -- | Focused windows border color. Default: @\"#ff0000\"@ focusedBorderColor :: Settable String (XConfig l) focusedBorderColor = Settable X.focusedBorderColor (\x c -> c { X.focusedBorderColor = x }) -- | The preferred terminal application. Default: @\"xterm\"@ terminal :: Settable String (XConfig l) terminal = Settable X.terminal (\x c -> c { X.terminal = x }) -- | The mod modifier, as used by key bindings. Default: @mod1Mask@ (which is -- probably alt on your computer). modMask :: Settable KeyMask (XConfig l) modMask = Settable X.modMask (\x c -> c { X.modMask = x }) -- | The border width (in pixels). Default: @1@ borderWidth :: Settable Dimension (XConfig l) borderWidth = Settable X.borderWidth (\x c -> c { X.borderWidth = x }) -- | Whether window focus follows the mouse cursor on move, or requires a mouse -- click. (Mouse? What's that?) Default: @True@ focusFollowsMouse :: Settable Bool (XConfig l) focusFollowsMouse = Settable X.focusFollowsMouse (\x c -> c { X.focusFollowsMouse = x }) -- | If True, a mouse click on an inactive window focuses it, but the click is -- not passed to the window. If False, the click is also passed to the window. -- Default @True@ clickJustFocuses :: Settable Bool (XConfig l) clickJustFocuses = Settable X.clickJustFocuses (\x c -> c { X.clickJustFocuses = x }) -- $summables -- In addition to being able to set these attributes, they have a special -- syntax for being able to add to them. The operator is @=+@ (the plus comes -- /after/ the equals), but each attribute has a different syntax for what -- comes after the operator. class SummableClass s y | s -> y where -- | This lets you add to an attribute. (=+) :: s c -> y -> Arr c c infix 0 =+ data Summable x y c = Summable (c -> x) -- getter (x -> c -> c) -- setter (x -> y -> x) -- accumulator instance UpdateableClass (Summable x y) x x where (Summable g s _ =. f) c = return $ s (f $ g c) c instance SummableClass (Summable x y) y where (Summable g s a =+ y) c = return $ s (g c `a` y) c -- | The action to run when a new window is opened. Default: -- -- > manageHook =: composeAll [className =? "MPlayer" --> doFloat, className =? "Gimp" --> doFloat] -- -- To add more rules to this list, you can say, for instance: -- -- > import XMonad.StackSet -- > ... -- > manageHook =+ (className =? "Emacs" --> doF kill) -- > manageHook =+ (className =? "Vim" --> doF shiftMaster) -- -- Note that operator precedence mandates the parentheses here. manageHook :: Summable ManageHook ManageHook (XConfig l) manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<>) -- | Custom X event handler. Return @All True@ if the default handler should -- also be run afterwards. Default does nothing. To add an event handler: -- -- > import XMonad.Hooks.ServerMode -- > ... -- > handleEventHook =+ serverModeEventHook handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l) handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<>) -- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding -- appends to the end: -- -- > workspaces =+ ["0"] -- -- This is useless unless you also create keybindings for this. workspaces :: Summable [String] [String] (XConfig l) workspaces = Summable X.workspaces (\x c -> c { X.workspaces = x }) (++) -- | The action to perform when the windows set is changed. This happens -- whenever focus change, a window is moved, etc. @logHook =+@ takes an @X ()@ -- and appends it via '(>>)'. For instance: -- -- > import XMonad.Hooks.ICCCMFocus -- > ... -- > logHook =+ takeTopFocus -- -- Note that if your expression is parametrically typed (e.g. of type -- @MonadIO m => m ()@), you'll need to explicitly annotate it, like so: -- -- > logHook =+ (io $ putStrLn "Hello, world!" :: X ()) logHook :: Summable (X ()) (X ()) (XConfig l) logHook = Summable X.logHook (\x c -> c { X.logHook = x }) (P.>>) -- | The action to perform on startup. @startupHook =+@ takes an @X ()@ and -- appends it via '(>>)'. For instance: -- -- > import XMonad.Hooks.SetWMName -- > ... -- > startupHook =+ setWMName "LG3D" -- -- Note that if your expression is parametrically typed (e.g. of type -- @MonadIO m => m ()@), you'll need to explicitly annotate it, as documented -- in 'logHook'. startupHook :: Summable (X ()) (X ()) (XConfig l) startupHook = Summable X.startupHook (\x c -> c { X.startupHook = x }) (P.>>) -- | The client events that xmonad is interested in. This is useful in -- combination with handleEventHook. Default: @structureNotifyMask .|. -- enterWindowMask .|. propertyChangeMask@ -- -- > clientMask =+ keyPressMask .|. keyReleaseMask clientMask :: Summable EventMask EventMask (XConfig l) clientMask = Summable X.clientMask (\x c -> c { X.clientMask = x }) (.|.) -- | The root events that xmonad is interested in. This is useful in -- combination with handleEventHook. Default: @substructureRedirectMask .|. -- substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|. -- structureNotifyMask .|. buttonPressMask@ rootMask :: Summable EventMask EventMask (XConfig l) rootMask = Summable X.rootMask (\x c -> c { X.rootMask = x }) (.|.) -- $removables -- The following support the the @=+@ for adding items and the @=-@ operator -- for removing items. class RemovableClass r y | r -> y where -- | This lets you remove from an attribute. (=-) :: r c -> y -> Arr c c infix 0 =- data Keys c = Keys { kAdd :: [(String, X ())] -> c -> c, kRemove :: [String] -> c -> c } instance SummableClass Keys [(String, X ())] where Keys { kAdd = a } =+ newKeys = return . a newKeys instance RemovableClass Keys [String] where Keys { kRemove = r } =- sadKeys = return . r sadKeys -- | Key bindings to 'X' actions. Default: see @`man xmonad`@. 'keys' -- takes a list of keybindings specified emacs-style, as documented in -- 'XMonad.Util.EZConfig.mkKeyMap'. For example, to change the "kill window" -- key: -- -- > keys =- ["M-S-c"] -- > keys =+ [("M-M1-x", kill)] keys :: Keys (XConfig l) keys = Keys { -- Note that since checkKeymap happens on newKeys, it doesn't check for -- duplicates between repeated applications. Probably OK. (Especially since -- overriding defaults is a common behavior.) Also note that there's no -- reference cycle here. Yay! kAdd = \newKeys c -> (c `additionalKeysP` newKeys) { X.startupHook = (P.>>) (X.startupHook c) (checkKeymap c newKeys) }, kRemove = flip removeKeysP } data MouseBindings c = MouseBindings { mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> c, mRemove :: [(ButtonMask, Button)] -> c -> c } instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where MouseBindings { mAdd = a } =+ newBindings = return . a newBindings instance RemovableClass MouseBindings [(ButtonMask, Button)] where MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings -- | Mouse button bindings to an 'X' actions on a window. Default: see @`man -- xmonad`@. To make @mod-\@ switch workspaces: -- -- > import XMonad.Actions.CycleWS (nextWS, prevWS) -- > ... -- > mouseBindings =+ [((mod4Mask, button4), const prevWS), -- > ((mod4Mask, button5), const nextWS)] -- -- Note that you need to specify the numbered mod-mask e.g. 'mod4Mask' instead -- of just 'modMask'. mouseBindings :: MouseBindings (XConfig l) mouseBindings = MouseBindings { mAdd = flip additionalMouseBindings, mRemove = flip removeMouseBindings } -- $workspaces -- Workspaces can be configured through 'workspaces', but then the 'keys' need -- to be set, and this can be a bit laborious. 'withWorkspaces' provides a -- convenient mechanism for common workspace updates. -- | Configure workspaces through a Prime-like interface. Example: -- -- > withWorkspaces $ do -- > wsKeys =+ ["0"] -- > wsActions =+ [("M-M1-", windows . swapWithCurrent)] -- > wsSetName 1 "mail" -- -- This will set 'workspaces' and add the necessary keybindings to 'keys'. Note -- that it won't remove old keybindings; it's just not that clever. withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l withWorkspaces wsarr xconf = (P.>>=) (wsarr def) $ \wsconf -> wsprime wsconf xconf where wsprime :: WorkspaceConfig -> Prime l l wsprime wsconf = (workspaces =: allNames) >> (keys =+ [(mod ++ key, action name) | (name, key) <- zip allNames (wsKeys_ wsconf), (mod, action) <- wsActions_ wsconf]) where allNames = zipWith chooseName (wsNames_ wsconf) (wsKeys_ wsconf) chooseName name keyspec = if not (null name) then name else keyspec data WorkspaceConfig = WorkspaceConfig { wsNames_ :: [String], wsKeys_ :: [String], wsActions_ :: [(String, String -> X ())] } instance Default WorkspaceConfig where def = WorkspaceConfig { wsNames_ = repeat "", wsKeys_ = map (:[]) ['1'..'9'], -- The hungry monkey eats dots and turns them into numbers. wsActions_ = [("M-", windows . W.greedyView), ("M-S-", windows . W.shift)] } -- | The list of workspace names, like 'workspaces' but with two differences: -- -- 1. If any entry is the empty string, it'll be replaced with the -- corresponding entry in 'wsKeys'. -- 2. The list is truncated to the size of 'wsKeys'. -- -- The default value is @'repeat' ""@. -- -- If you'd like to create workspaces without associated keyspecs, you can do -- that afterwards, outside the 'withWorkspaces' block, with @'workspaces' =+@. wsNames :: Settable [String] WorkspaceConfig wsNames = Settable wsNames_ (\x c -> c { wsNames_ = x }) -- | The list of workspace keys. These are combined with the modifiers in -- 'wsActions' to form the keybindings for navigating to workspaces. Default: -- @["1","2",...,"9"]@. wsKeys :: Summable [String] [String] WorkspaceConfig wsKeys = Summable wsKeys_ (\x c -> c { wsKeys_ = x }) (++) -- | Mapping from key prefix to command. Its type is @[(String, String -> -- X())]@. The key prefix may be a modifier such as @\"M-\"@, or a submap -- prefix such as @\"M-a \"@, or both, as in @\"M-a M-\"@. The command is a -- function that takes a workspace name and returns an @X ()@. 'withWorkspaces' -- creates keybindings for the cartesian product of 'wsKeys' and 'wsActions'. -- -- Default: -- -- > [("M-", windows . W.greedyView), -- > ("M-S-", windows . W.shift)] wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++) -- | A convenience for just modifying one entry in 'wsNames', in case you only -- want a few named workspaces. Example: -- -- > wsSetName 1 "mail" -- > wsSetName 2 "web" wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig wsSetName index newName = wsNames =. zipWith (curry maybeSet) [0..] where maybeSet (i, oldName) | i == (index - 1) = newName | otherwise = oldName -- $screens -- 'withScreens' provides a convenient mechanism to set keybindings for moving -- between screens, much like 'withWorkspaces'. -- | Configure screen keys through a Prime-like interface: -- -- > withScreens $ do -- > sKeys =: ["e", "r"] -- -- This will add the necessary keybindings to 'keys'. Note that it won't remove -- old keybindings; it's just not that clever. withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l 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] data ScreenConfig = ScreenConfig { sKeys_ :: [String], sActions_ :: [(String, ScreenId -> X ())] } instance Default ScreenConfig where def = ScreenConfig { sKeys_ = ["w", "e", "r"], sActions_ = [("M-", windows . onScreens W.view), ("M-S-", windows . onScreens W.shift)] } -- | The list of screen keys. These are combined with the modifiers in -- 'sActions' to form the keybindings for navigating to workspaces. Default: -- @["w","e","r"]@. sKeys :: Summable [String] [String] ScreenConfig sKeys = Summable sKeys_ (\x c -> c { sKeys_ = x }) (++) -- | Mapping from key prefix to command. Its type is @[(String, ScreenId -> -- X())]@. Works the same as 'wsActions' except for a different function type. -- -- Default: -- -- > [("M-", windows . onScreens W.view), -- > ("M-S-", windows . onScreens W.shift)] sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig sActions = Summable sActions_ (\x c -> c { sActions_ = x }) (++) -- | Converts a stackset transformer parameterized on the workspace type into one -- parameterized on the screen type. For example, you can use @onScreens W.view -- 0@ to navigate to the workspace on the 0th screen. If the screen id is not -- recognized, the returned transformer acts as an identity function. onScreens :: Eq s => (i -> W.StackSet i l a s sd -> W.StackSet i l a s sd) -> s -> W.StackSet i l a s sd -> W.StackSet i l a s sd onScreens f sc ws = maybe id f (W.lookupWorkspace sc ws) ws -- $layout -- Layouts are special. You can't modify them using the @=:@ or @=.@ operator. -- You need to use the following functions. -- | Add a layout to the list of layouts choosable with mod-space. For instance: -- -- > import XMonad.Layout.Tabbed -- > ... -- > addLayout simpleTabbed addLayout :: (LayoutClass l Window, LayoutClass r Window) => r Window -> Prime l (Choose l r) addLayout r c = return c { X.layoutHook = X.layoutHook c ||| r } -- | Reset the layoutHook from scratch. For instance, to get rid of the wide -- layout: -- -- > resetLayout $ Tall 1 (3/100) (1/2) ||| Full -- -- (The dollar is like an auto-closing parenthesis, so all the stuff to the -- right of it is treated like an argument to resetLayout.) resetLayout :: (LayoutClass r Window) => r Window -> Prime l r resetLayout r c = return c { X.layoutHook = r } -- | Modify your 'layoutHook' with some wrapper function. You probably want to call -- this after you're done calling 'addLayout'. Example: -- -- > import XMonad.Layout.NoBorders -- > ... -- > modifyLayout smartBorders modifyLayout :: (LayoutClass r Window) => (l Window -> r Window) -> Prime l r modifyLayout f c = return c { X.layoutHook = f $ X.layoutHook c } -- $update -- Finally, there are a few contrib modules that bundle multiple attribute -- updates together. There are three types: 1) wholesale replacements for the -- default config, 2) pure functions on the config, and 3) IO actions on the -- config. The syntax for each is different. Examples: -- -- 1) To start with a 'XMonad.Config.Gnome.gnomeConfig' instead of the default, -- we use 'startWith': -- -- > import XMonad.Config.Gnome -- > ... -- > startWith gnomeConfig -- -- 2) 'XMonad.Hooks.UrgencyHook.withUrgencyHook' is a pure function, so we need -- to use 'apply': -- -- > import XMonad.Hooks.UrgencyHook -- > ... -- > apply $ withUrgencyHook dzenUrgencyHook -- -- 3) 'XMonad.Hooks.DynamicLog.xmobar' returns an @IO (XConfig l)@, so we need -- to use 'applyIO': -- -- > import XMonad.Hooks.DynamicLog -- > ... -- > applyIO xmobar -- | Replace the current 'XConfig' with the given one. If you use this, you -- probably want it to be the first line of your config. startWith :: XConfig l' -> Prime l l' startWith = const . return -- | Turns a pure function on 'XConfig' into a 'Prime'. apply :: (XConfig l -> XConfig l') -> Prime l l' apply f = return . f -- | Turns an IO function on 'XConfig' into a 'Prime'. applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l' applyIO = id -- This is here in case we want to change the Prime type later. -- $example -- As an example, I've included below a subset of my current config. Note that -- my import statements specify individual identifiers in parentheticals. -- That's optional. The default is to import the entire module. I just find it -- helpful to remind me where things came from. -- -- > {-# LANGUAGE RebindableSyntax #-} -- > import XMonad.Config.Prime -- > -- > import XMonad.Actions.CycleWS (prevWS, nextWS) -- > import XMonad.Actions.SwapWorkspaces (swapWithCurrent) -- > import XMonad.Actions.WindowNavigation (withWindowNavigation) -- > import XMonad.Layout.Fullscreen (fullscreenSupport) -- > import XMonad.Layout.NoBorders (smartBorders) -- > import XMonad.Layout.Tabbed (simpleTabbed) -- > -- > main = xmonad $ do -- > modMask =: mod4Mask -- > normalBorderColor =: "#222222" -- > terminal =: "urxvt" -- > focusFollowsMouse =: False -- > resetLayout $ Tall 1 (3/100) (1/2) ||| simpleTabbed -- > modifyLayout smartBorders -- > apply fullscreenSupport -- > applyIO $ withWindowNavigation (xK_w, xK_a, xK_s, xK_d) -- > withWorkspaces $ do -- > wsKeys =+ ["0"] -- > wsActions =+ [("M-M1-", windows . swapWithCurrent)] -- > keys =+ [ -- > ("M-,", sendMessage $ IncMasterN (-1)), -- > ("M-.", sendMessage $ IncMasterN 1), -- > ("M-M1-d", spawn "date | dzen2 -fg '#eeeeee' -p 2"), -- > ("C-S-q", return ()), -- > ("", spawn "amixer set Master 5%-"), -- > ("", spawn "amixer set Master 5%+"), -- > ("M-M1-x", kill), -- > ("M-i", prevWS), -- > ("M-o", nextWS) -- > ] -- $troubleshooting -- === Only the last line of my config seems to take effect. What gives? -- You're missing the @{-\# LANGUAGE RebindableSyntax \#-}@ line at the top. -- -- === How do I do use normal monads like 'X' or 'IO'? -- Here are a couple of ways: -- -- > import qualified Prelude as P -- > ... -- > test1, test2 :: X () -- > test1 = spawn "echo Hi" P.>> spawn "echo Bye" -- > test2 = do spawn "echo Hi" -- > spawn "echo Bye" -- > where (>>) = (P.>>) -- -- === How do I use the old keyboard syntax? -- You can use 'apply' and supply your own Haskell function. For instance: -- -- > apply $ flip additionalKeys $ [((mod1Mask, xK_z), spawn "date | dzen2 -fg '#eeeeee' -p 2")] -- -- === How do I run a command before xmonad starts (like 'spawnPipe')? -- If you're using it for a status bar, see if 'XMonad.Hooks.DynamicLog.dzen' -- or 'XMonad.Hooks.DynamicLog.xmobar' does what you want. If so, you can apply -- it with 'applyIO'. -- -- If not, you can write your own @XConfig l -> IO (XConfig l)@ and apply it -- with 'applyIO'. When writing this function, see the above tip about using -- normal monads. -- -- Alternatively, you could do something like this this: -- -- > import qualified Prelude as P (>>) -- > -- > main = -- > openFile ".xmonad.log" AppendMode >>= \log -> -- > hSetBuffering log LineBuffering P.>> -- > (xmonad $ do -- > nothing -- Prime config here. -- > ) xmonad-contrib-0.18.0/XMonad/Config/Sjanssen.hs0000644000000000000000000000706007346545000017433 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Sjanssen -- Description : Spencer Janssen's xmonad config. -- ------------------------------------------------------------------------ module XMonad.Config.Sjanssen {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} (sjanssenConfig) where import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W import XMonad.Actions.CopyWindow import XMonad.Layout.Tabbed import XMonad.Layout.HintedTile import XMonad.Layout.NoBorders import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat) import XMonad.Hooks.EwmhDesktops import XMonad.Prompt import XMonad.Actions.SpawnOn import XMonad.Util.SpawnOnce import XMonad.Layout.LayoutScreens import XMonad.Layout.TwoPane import qualified Data.Map as M sjanssenConfig = 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) ] , keys = \c -> mykeys c `M.union` keys def c , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog , layoutHook = modifiers layouts , manageHook = composeAll [className =? x --> doShift w | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]] <> manageHook def <> manageSpawn <> (isFullscreen --> doFullFloat) , startupHook = mapM_ spawnOnce spawns } where tiled = HintedTile 1 0.03 0.5 TopLeft layouts = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme modifiers = avoidStruts . smartBorders spawns = [ "xmobar" , "xset -b", "xset s off", "xset dpms 0 600 1200" , "nitrogen --set-tiled wallpaper/wallpaper.jpg" , "trayer --transparent true --expand true --align right " ++ "--edge bottom --widthtype request" ] 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, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5) ,((modm .|. shiftMask, xK_z ), rescreen) , ((modm , xK_b ), sendMessage ToggleStruts) ] myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10" myTheme = def { fontName = myFont } myPromptConfig = def { position = Top , font = myFont , showCompletionOnTab = True , historyFilter = deleteConsecutive , promptBorderWidth = 0 } xmonad-contrib-0.18.0/XMonad/Config/Xfce.hs0000644000000000000000000000237007346545000016533 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Xfce -- Description : Config for integrating xmonad with Xfce. -- Copyright : (c) Ivan Miljenovic -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the Xfce desktop -- environment. module XMonad.Config.Xfce ( -- * Usage -- $usage xfceConfig, desktopLayoutModifiers ) where import XMonad import XMonad.Config.Desktop import qualified Data.Map as M -- $usage -- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Xfce -- > -- > main = xmonad xfceConfig -- -- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop". xfceConfig = desktopConfig { terminal = "xfce4-terminal" , keys = xfceKeys <> keys desktopConfig } 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-contrib-0.18.0/XMonad/Config/dmwit.xmobarrc0000644000000000000000000000047407346545000020200 0ustar0000000000000000Config { font = "xft:Monospace:pixelsize=14,-*-*-*-r-*-*-16-*-*-*-*-*-*-*", bgColor = "#000040", fgColor = "#80c0ff", position = TopSize C 100 26, lowerOnStart = True, commands = [ Run Com "date" ["+%H:%M"] "" 30 ], sepChar = "%", alignSep = "}{" } xmonad-contrib-0.18.0/XMonad/0000755000000000000000000000000007346545000014103 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Doc.hs0000644000000000000000000000475007346545000015152 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This is the main documentation module for the xmonad-contrib -- library. It provides a brief overview of xmonad and a link to -- documentation for configuring and extending xmonad. -- -- A link to documentation describing xmonad internals is also provided. -- This module is mainly intended for those wanting to contribute code, -- or for those who are curious to know what's going on behind the scenes. ----------------------------------------------------------------------------- module XMonad.Doc ( -- * Overview -- $overview -- * Configuring xmonad -- $configuring -- * Extending xmonad with the xmonad-contrib library -- $extending -- * Developing xmonad: a brief code commentary -- $developing ) where import XMonad.Doc.Configuring () import XMonad.Doc.Extending () import XMonad.Doc.Developing () -------------------------------------------------------------------------------- -- -- Overview -- -------------------------------------------------------------------------------- {- $overview #Overview# xmonad is a tiling window manager for X. The xmonad-contrib library collects third party tiling algorithms, hooks, configurations, scripts, and other extensions to xmonad. The source for this library is available from via git: > git clone https://github.com/xmonad/xmonad-contrib.git Each stable release of xmonad is accompanied by a stable release of the contrib library, which you should use if (and only if) you're using a stable release of xmonad. You can find the most recent tarball here: -} {- $configuring "XMonad.Doc.Configuring" documents the process of configuring xmonad. A brief tutorial will guide you through the basic configuration steps. -} {- $extending "XMonad.Doc.Extending" is dedicated to the xmonad-contrib library itself. You will find an overview of extensions available in the library and instructions for using them. -} {- $developing "XMonad.Doc.Developing" consists of a brief description of the xmonad internals. It is mainly intended for contributors and provides a brief code commentary with links to the source documentation. -} xmonad-contrib-0.18.0/XMonad/Doc/0000755000000000000000000000000007346545000014610 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Doc/Configuring.hs0000644000000000000000000001271707346545000017426 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc.Configuring -- Description : Brief xmonad tutorial. -- Copyright : (C) 2007 Don Stewart and Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This is a brief tutorial that will teach you how to create a basic -- xmonad configuration. For a more comprehensive tutorial, see the -- . -- -- For more detailed instructions on extending xmonad with the -- xmonad-contrib library, see -- -- and "XMonad.Doc.Extending". -- ----------------------------------------------------------------------------- module XMonad.Doc.Configuring ( -- * Configuring xmonad -- $configure -- * A simple example -- $example -- * Checking whether your xmonad.hs is correct -- $check -- * Loading your configuration -- $load ) where -------------------------------------------------------------------------------- -- -- Configuring Xmonad -- -------------------------------------------------------------------------------- {- $configure #Configuring_xmonad# xmonad can be configured by creating and editing the Haskell file: > ~/.xmonad/xmonad.hs If this file does not exist, xmonad will simply use default settings; if it does exist, xmonad will use whatever settings you specify. Note that this file can contain arbitrary Haskell code, which means that you have quite a lot of flexibility in configuring xmonad. HISTORICAL NOTE regarding upgrading from versions (< 0.5) of xmonad or using old documentation: xmonad-0.5 delivered a major change in the way xmonad is configured. Prior to version 0.5, configuring xmonad required editing a source file called Config.hs, manually recompiling xmonad, and then restarting. From version 0.5 onwards, however, you should NOT edit this file or manually compile with ghc --make. All you have to do is edit xmonad.hs and restart with @mod-q@; xmonad does the recompiling itself. The format of the configuration file also changed with version 0.5; enabling simpler and much shorter xmonad.hs files that only require listing those settings which are different from the defaults. While the complicated template.hs (man/xmonad.hs) files listing all default settings are still provided for reference, once you wish to make substantial changes to your configuration, the template.hs style configuration is not recommended. It is fine to use top-level definitions to organize your xmonad.hs, but wherever possible it is better to leave out settings that simply duplicate defaults. -} {- $example #A_simple_example# Here is a basic example, which starts with the default xmonad configuration and overrides the border width, default terminal, and some colours: > -- > -- An example, simple ~/.xmonad/xmonad.hs file. > -- It overrides a few basic settings, reusing all the other defaults. > -- > > import XMonad > > main = xmonad $ def > { borderWidth = 2 > , terminal = "urxvt" > , normalBorderColor = "#cccccc" > , focusedBorderColor = "#cd8b00" } This will run \'xmonad\', the window manager, with your settings passed as arguments. Overriding default settings like this (using \"record update syntax\"), will yield the shortest config file, as you only have to describe values that differ from the defaults. As an alternative, you can copy the template @xmonad.hs@ file (found either in the @man@ directory, if you have the xmonad source, or on the xmonad wiki config archive at ) into your @~\/.xmonad\/@ directory. This template file contains all the default settings spelled out, and you should be able to simply change the ones you would like to change. To see what fields can be customized beyond the ones in the example above, the definition of the 'XMonad.Core.XConfig' data structure can be found in "XMonad.Core". -} {- $check #Checking_whether_your_xmonad.hs_is_correct# After changing your configuration, it is a good idea to check that it is syntactically and type correct. You can do this easily by using an xmonad flag: > $ xmonad --recompile > $ If there is no output, your xmonad.hs has no errors. If there are errors, they will be printed to the console. Patch them up and try again. Note, however, that if you skip this step and try restarting xmonad with errors in your xmonad.hs, it's not the end of the world; xmonad will simply display a window showing the errors and continue with the previous configuration settings. (This assumes that you have the \'xmessage\' utility installed; you probably do.) -} {- $load #Loading_your_configuration# To get xmonad to use your new settings, type @mod-q@. (Remember, the mod key is \'alt\' by default, but you can configure it to be something else, such as your Windows key if you have one.) xmonad will attempt to compile this file, and run it. If everything goes well, xmonad will seamlessly restart itself with the new settings, keeping all your windows, layouts, etc. intact. (If you change anything related to your layouts, you may need to hit @mod-shift-space@ after restarting to see the changes take effect.) If something goes wrong, the previous (default) settings will be used. Note this requires that GHC and xmonad are in the @$PATH@ in the environment from which xmonad is started. -} xmonad-contrib-0.18.0/XMonad/Doc/Developing.hs0000644000000000000000000002621107346545000017242 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc.Developing -- Description : Brief overview of the xmonad internals. -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This module gives a brief overview of the xmonad internals. It is -- intended for advanced users who are curious about the xmonad source -- code and want an brief overview. This document may also be helpful -- for the beginner\/intermediate Haskell programmer who is motivated -- to write an xmonad extension as a way to deepen her understanding -- of this powerful functional language; however, there is not space -- here to go into much detail. For a more comprehensive document -- covering some of the same material in more depth, see the guided -- tour of the xmonad source on the xmonad wiki: -- . -- -- If you write an extension module and think it may be useful for -- others, consider releasing it. Coding guidelines and licensing -- policies are covered at the end of this document, and must be -- followed if you want your code to be included in the official -- repositories. For a basic tutorial on the nuts and bolts of -- developing a new extension for xmonad, see the tutorial on the -- wiki: -- . -- ----------------------------------------------------------------------------- module XMonad.Doc.Developing ( -- * Writing new extensions -- $writing -- * Libraries for writing window managers -- $xmonad-libs -- * xmonad internals -- $internals -- ** The @main@ entry point -- $main -- ** The X monad and the internal state -- $internalState -- ** Event handling and messages -- $events -- ** The 'LayoutClass' -- $layoutClass -- * Coding style -- $style -- * Licensing policy -- $license ) where -------------------------------------------------------------------------------- -- -- Writing Extensions -- -------------------------------------------------------------------------------- {- $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 Starting with version 0.5, xmonad and xmonad-contrib are packaged and distributed as libraries, instead of components which must be compiled by the user into a binary (as they were prior to version 0.5). This way of distributing xmonad has many advantages, since it allows packaging by GNU\/Linux distributions while still allowing the user to customize the window manager to fit her needs. Basically, xmonad and the xmonad-contrib libraries let users write their own window manager in just a few lines of code. While @xmonad.hs@ at first seems to be simply a configuration file, it is actually a complete Haskell program which uses the xmonad and xmonad-contrib libraries to create a custom window manager. This makes it possible not only to edit the default xmonad configuration, as we have seen in the "XMonad.Doc.Extending" document, but to use the Haskell programming language to extend the window manager you are writing in any way you see fit. -} {- $internals -} {- $main #The_main_entry_point# xmonad installs a binary, @xmonad@, which must be executed by the Xsession starting script. This binary, whose code can be read in @Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile' to run @ghc@ in order to build a binary from @xmonad.hs@. If this compilation process fails, for any reason, a default @main@ entry point will be used, which calls the 'XMonad.Main.xmonad' function with a default configuration. Thus, the real @main@ entry point, the one that even the users' custom window manager application in @xmonad.hs@ must call, is the 'XMonad.Main.xmonad' function. This function takes a configuration as its only argument, whose type ('XMonad.Core.XConfig') is defined in "XMonad.Core". 'XMonad.Main.xmonad' takes care of opening the connection with the X server, initializing the state (or deserializing it when restarted) and the configuration, and calling the event handler ('XMonad.Main.handle') that goes into an infinite loop (using 'Prelude.forever') waiting for events and acting accordingly. -} {- $internalState The event loop which calls 'XMonad.Main.handle' to react to events is run within the 'XMonad.Core.X' monad, which is a 'Control.Monad.State.StateT' transformer over 'IO', encapsulated within a 'Control.Monad.Reader.ReaderT' transformer. The 'Control.Monad.State.StateT' transformer encapsulates the (read\/writable) state of the window manager (of type 'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT' transformer encapsulates the (read-only) configuration (of type 'XMonad.Core.XConf'). Thanks to GHC's newtype deriving feature, the instance of the 'Control.Monad.State.MonadState' class parametrized over 'XMonad.Core.XState' and the instance of the 'Control.Monad.Reader.MonadReader' class parametrized over 'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X' monad. This way we can use 'Control.Monad.State.get', 'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the 'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and 'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'. 'XMonad.Core.XState' is where all the sensitive information about window management is stored. The most important field of the 'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type ('XMonad.Core.WindowSet') is a synonym for a 'XMonad.StackSet.StackSet' parametrized over a 'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside the 'XMonad.Layout.Layout' existential data type, the 'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the 'XMonad.Core.ScreenDetail's. What a 'XMonad.StackSet.StackSet' is and how it can be manipulated with pure functions is described in the Haddock documentation of the "XMonad.StackSet" module. The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four fields: * 'XMonad.StackSet.current', for the current, focused workspace. This is a 'XMonad.StackSet.Screen', which is composed of a 'XMonad.StackSet.Workspace' together with the screen information (for Xinerama support). * 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for the other visible (with Xinerama) workspaces. For non-Xinerama setups, this list is always empty. * 'XMonad.StackSet.hidden', the list of non-visible 'XMonad.StackSet.Workspace's. * 'XMonad.StackSet.floating', a map from floating 'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's specifying their geometry. The 'XMonad.StackSet.Workspace' type is made of a 'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and a (possibly empty) 'XMonad.StackSet.stack' of windows. "XMonad.StackSet" (which should usually be imported qualified, to avoid name clashes with Prelude functions such as 'Prelude.delete' and 'Prelude.filter') provides many pure functions to manipulate the 'XMonad.StackSet.StackSet'. These functions are most commonly used as an argument to 'XMonad.Operations.windows', which takes a pure function to manipulate the 'XMonad.Core.WindowSet' and does all the needed operations to refresh the screen and save the modified 'XMonad.Core.XState'. During each 'XMonad.Operations.windows' call, the 'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and 'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to physically arrange the 'XMonad.StackSet.stack' of windows on each workspace. The possibility of manipulating the 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') with pure functions makes it possible to test all the properties of those functions with QuickCheck, providing greater reliability of the core code. Every change to the "XMonad.StackSet" module must be accompanied by appropriate QuickCheck properties before being applied. -} {- $events Event handling is the core activity of xmonad. Events generated by the X server are most important, but there may also be events generated by layouts or the user. "XMonad.Core" defines a class that generalizes the concept of events, 'XMonad.Core.Message', constrained to types with a 'Data.Typeable.Typeable' instance definition (which can be automatically derived by GHC). 'XMonad.Core.Message's are wrapped within an existential type 'XMonad.Core.SomeMessage'. The 'Data.Typeable.Typeable' constraint allows for the definition of a 'XMonad.Core.fromMessage' function that can unwrap the message with 'Data.Typeable.cast'. X Events are instances of this class, along with any messages used by xmonad itself or by extension modules. Using the 'Data.Typeable.Typeable' class for any kind of 'XMonad.Core.Message's and events allows us to define polymorphic functions for processing messages or unhandled events. This is precisely what happens with X events: xmonad passes them to 'XMonad.Main.handle'. If the main event handling function doesn't have anything to do with the event, the event is sent to all visible layouts by 'XMonad.Operations.broadcastMessage'. This messaging system allows the user to create new message types, simply declare an instance of the 'Data.Typeable.Typeable' and use 'XMonad.Operations.sendMessage' to send commands to layouts. And, finally, layouts may handle X events and other messages within the same function... miracles of polymorphism. -} {- $layoutClass #The_LayoutClass# to do -} {- $style For coding style guidelines while contributing, please see the of xmonad's CONTRIBUTING.md. For examples of Haddock documentation syntax, have a look at 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. * Literal chunks of code can be written in comments using \"birdtrack\" notation (a greater-than symbol at the beginning of each line). Be sure to leave a blank line before and after each birdtrack-quoted section. * Link to functions by surrounding the names in single quotes, modules in double quotes. * Literal quote marks and slashes should be escaped with a backslash. To generate and view the Haddock documentation for your extension, run > stack haddock --no-haddock-deps 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: . For more information on the nuts and bolts of how to develop your own extension, see the tutorial on the wiki: . -} {- $license New modules should identify the author, and be submitted under the same license as xmonad (BSD3). -} xmonad-contrib-0.18.0/XMonad/Doc/Extending.hs0000644000000000000000000006201007346545000017070 0ustar0000000000000000{-# LANGUAGE CPP #-} -- We need to link to the current version of xmonad-docs, but both -- CURRENT_PACKAGE_VERSION and VERSION_xmonad_contrib contain quotation marks -- that we can't get rid of using CPP, so as a workaround we define the -- components separately in cpp-options and check that they're still in sync. #if !__HLINT__ && \ !( MIN_VERSION_xmonad_contrib(XMONAD_CONTRIB_VERSION_MAJOR, XMONAD_CONTRIB_VERSION_MINOR, XMONAD_CONTRIB_VERSION_PATCH) \ && !MIN_VERSION_xmonad_contrib(XMONAD_CONTRIB_VERSION_MAJOR, XMONAD_CONTRIB_VERSION_MINOR, XMONAD_CONTRIB_VERSION_PATCH + 1) \ ) #error "Please update XMONAD_CONTRIB_VERSION_* in xmonad-contrib.cabal" #endif ----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc.Extending -- Description : A module to document the xmonad-contrib library. -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This module documents the xmonad-contrib library and guides you -- through some more advanced parts of extending the capabilities of -- xmonad. If you're new to xmonad, you should first check out the -- and treat this document -- as supplemental reading. -- -- Knowing Haskell is by no means a prerequisite for configuring xmonad -- and the tutorial emphasizes this. This document, however, does -- assume a basic familiarity with the language. This is so that we can -- dive a bit deeper into what the different hooks do, or how to write -- our own little functions to configure xmonad. -- -- Those wishing to be totally hardcore and develop their own xmonad -- extensions (it's easier than it sounds, we promise!) should read the -- documentation in "XMonad.Doc.Developing". -- -- More configuration examples can be found -- . -- ----------------------------------------------------------------------------- module XMonad.Doc.Extending ( -- * The xmonad-contrib library -- $library -- ** Actions -- $actions -- ** Hooks -- $hooks -- ** Layouts -- $layouts -- ** Prompts -- $prompts -- ** Utilities -- $utils -- * Extending xmonad -- $extending -- ** Adding key bindings -- $keys -- *** Removing key bindings -- $keyDel -- ** Editing mouse bindings -- $mouse -- ** Editing the layout hook #LayoutHook# -- $layoutHook -- ** Editing the manage hook #ManageHook# -- $manageHook ) where -------------------------------------------------------------------------------- -- -- The XmonadContrib Library -- -------------------------------------------------------------------------------- {- $library The xmonad-contrib library is a set of extension modules contributed by xmonad hackers and users that provide additional features to xmonad. Examples include various layout modes (tabbed, spiral, three-column...), prompts, program launchers, the ability to manipulate windows and workspaces in various ways, alternate navigation modes, and much more. There are also \"meta-modules\" which make it easier to write new modules and extensions. This is a description of the different namespaces in xmonad-contrib. For more information about any particular module, go to the root of the documentation and just click on its name to view its Haddock documentation; each module should come with extensive documentation. If you find a module that could be better documented, or has incorrect documentation, please ! 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 -} {- $actions In the @XMonad.Actions@ namespace you can find modules exporting various functions that are usually intended to be bound to key combinations or mouse actions, in order to provide functionality beyond the standard keybindings offered by xmonad. -} {- $hooks In the @XMonad.Hooks@ namespace you can find modules exporting hooks—actions that xmonad performs when certain events occur. The three most important hooks are: * 'XMonad.Core.manageHook': this hook is called when a new window that xmonad must take care of is created. This is a very powerful hook, since it lets us examine the new window's properties and act accordingly. For instance, we can configure xmonad to put windows belonging to a given application in the float layer, not to manage dock applications, or open them in a given workspace. See [Editing the manage hook](#g:Editing_the_manage_hook) for more information on customizing 'XMonad.Core.manageHook'. * 'XMonad.Core.logHook': this hook is called when the stack of windows managed by xmonad changes; for example, this is invoked at the end of the 'XMonad.Operations.windows' function. A big application for this is to display some information about xmonad in a status bar. The aptly named "XMonad.Hooks.StatusBar" will produce a string (whose format can be configured) to be written, for example, to an X11 property. * 'XMonad.Core.handleEventHook': this hook is called on all events handled by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras" and xmonad source and development documentation for more details. -} {- $layouts In the @XMonad.Layout@ namespace you can find modules exporting contributed layout algorithms, such as a tabbed layout, a circle, a spiral, three columns, and so on. You will also find modules which provide facilities for combining different layouts, such as "XMonad.Layout.Combo", "XMonad.Layout.ComboP", "XMonad.Layout.LayoutBuilder", "XMonad.Layout.SubLayouts", or "XMonad.Layout.LayoutCombinators". Layouts can be also modified with layout modifiers. A general interface for writing layout modifiers is implemented in "XMonad.Layout.LayoutModifier". For more information on using those modules for customizing your 'XMonad.Core.layoutHook' see [Editing the layout hook](#g:LayoutHook). -} {- $prompts In the @XMonad.Prompt@ namespace you can find modules providing graphical prompts for getting user input and using it to perform various actions. The "XMonad.Prompt" module provides a library for easily writing new prompts. -} {- $utils In the @XMonad.Util@ namespace you can find modules exporting various utility functions that are used by the other modules of the @xmonad-contrib@ library. There are also utilities for helping in configuring xmonad or using external utilities. -} -------------------------------------------------------------------------------- -- -- Extending Xmonad -- -------------------------------------------------------------------------------- {- $extending #Extending_xmonad# Since the @xmonad.hs@ file is just another Haskell program, you may import and use any Haskell code or libraries you wish, such as extensions from the xmonad-contrib library, or other code you write yourself. -} {- $keys In the of the tutorial we have seen how to add new keys to xmonad with the help of the 'XMonad.Util.EZConfig.additionalKeysP' function. But how does that work? Assuming that library didn't exist yet, could we write it ourselves? Let's concentrate on the easier case of trying to write our own 'XMonad.Util.EZConfig.additionalKeys'. This works exactly like its almost-namesake, but requires you to specify the keys in the "default" style—that is: > main :: IO () > main = xmonad $ def > `additionalKeys` > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") > , ((mod1Mask, xK_BackSpace), spawn "xterm") > ] The extra work that 'XMonad.Util.EZConfig.additionalKeysP' does is only in parsing the input string (turning @"M1-m"@ into @(mod1Mask, xK_m)@). As we have seen in the tutorial, is also allows one to write @M@ and have xmonad pick up on the correct modifier key to use—something which 'XMonad.Util.EZConfig.additionalKeys' can't do. Editing key bindings means changing the 'XMonad.Core.keys' field of the 'XMonad.Core.XConfig' record used by xmonad. For example, to override /all/ of the default bindings with our own, we would write > import XMonad > import Data.Map (Map) > import qualified Data.Map as Map > > main :: IO () > main = xmonad $ def { keys = myKeys } > where > myKeys :: XConfig l -> Map (ButtonMask, KeySym) (X ()) > myKeys conf = Map.fromList > [ ((mod1Mask , xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") > , ((modMask conf, xK_BackSpace), spawn "xterm") > ] Now, obviously we don't want to do that; we only want to add to existing bindings (or, perhaps, override some of them with our own). Let's break @myKeys@ down a little. You can think of the type signature of @myKeys@ (and hence also of @keys@) like this: > myKeys :: UserConfig -> Map KeyPress Action It takes some user config and, from that, produces a map that associates certain keypresses with actions to execute. The reason why it might take the user config may seem a bit mysterious at first, but it is for the simple reason that some keybindings (like the workspace switching ones) need access to the user config. We have already seen this above when we queried @modMask conf@. If it helps, think of this as a @Reader@ monad with the config being the read-only state. This means that, as a first guess, the type signature of our version of 'XMonad.Util.EZConfig.additionalKeys' might look like > myAdditionalKeys :: XConfig l > -- ^ Base config with xmonad's default keybindings > -> (XConfig l -> Map (ButtonMask, KeySym) (X ())) > -- ^ User supplied keybindings > -> XConfig l > -- ^ Resulting config with everything merged together However, even assuming a correct implementation, using this is not very ergonomic: > main = xmonad $ def > `myAdditionalKeys` > (\conf -> Map.fromList > [ ((mod1Mask , xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") > , ((modMask conf, xK_BackSpace), spawn "xterm") > ]) Having to specify a lambda with parentheses and call 'Data.Map.Strict.fromList' does not make for a good user experience. Since one /always/ has to call that function anyways, we may well just accept a list from the user and transform it to a map ourselves. As an additional simplification, how about we don't care about the config argument at all and simply ask the user for a list? The resulting signature > myAdditionalKeys :: XConfig l > -> [(ButtonMask, KeySym), (X ())] > -> XConfig l looks exactly like what we want! Note that this is also the time we lose the ability to automagically fill in the correct modifier key, since the input to @myAdditionalKeys@ is already structured data (as opposed to just some strings that need to be parsed). Now that we know what kind of data structure—that is, maps—we are dealing with, the implementation of this function simply merges the two together, preferring the user config to xmonad's defaults in case of any conflicts. Thankfully, someone else has already done the hard work and written the merging function for us; it's called 'Data.Map.Strict.union'. What's left is essentially playing "type tetris": > myAdditionalKeys baseConf keyList = > let mergeKeylist conf = Map.fromList keyList `Map.union` (keys baseConf) conf > in baseConf { keys = mergeKeylist } The function @mergeKeyList@ take some user config, transforms the custom keybindings into a map (@Map.fromList keyList@), gets the keys from the base config (remember @keys baseConf@ is again a function, morally of type @UserConfig -> Map KeyPress Action@, and so we have to apply @conf@ to it in order to get a map!), and then merges these two maps together. Since @mergeKeylist@ now has exactly the right type signature, we can just set that as the keys. If you like operators, 'Data.Monoid.<>' (or xmonad's alias for it, 'XMonad.ManageHook.<+>') does exactly the same as the explicit usage of 'Data.Map.Strict.union' because that's the specified binary operation in the 'Data.Monoid.Monoid' instance for 'Data.Map.Strict.Map'. Note that the function works as expected (preferring user defined keys) because 'Data.Map.union' is /left biased/, which means that if the same key is present in both maps it will prefer the associated value of the left map. Our function now works as expected: > main :: IO () > main = xmonad $ def > `myAdditionalKeys` > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") > , ((mod1Mask, xK_BackSpace), spawn "xterm") > ] Lastly, if you want you can also emulate the automatic modifier detection by 'XMonad.Util.EZConfig.additionalKeysP' by defining the bulk of your config as a separate function > myConfig = def { modMask = mod4Mask } and then using that information > main :: IO () > main = xmonad $ myConfig > `myAdditionalKeys` > [ ((mod, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") > , ((mod, xK_BackSpace), spawn "xterm") > ] > where mod = modMask myConfig Hopefully you now feel well equipped to write some small functions that extend xmonad an scratch a particular itch! -} {- $keyDel #Removing_key_bindings# As we've learned, XMonad stores keybindings inside of a 'Data.Map.Strict.Map', which means that removing keybindings requires modifying it. This can be done with 'Data.Map.difference' or with 'Data.Map.Strict.delete'. For example, suppose you want to entirely rid yourself of @"M-q"@ and @"M-s-q"@ (you just want to leave xmonad running forever). To do this with bare @xmonad@, you need to define @newKeys@ as a 'Data.Map.Strict.difference' between the default map and the map of the key bindings you want to remove. Like so: > newKeys :: XConfig l -> Map (KeyMask, KeySym) (X ()) > newKeys x = keys def x `M.difference` keysToRemove x > > keysToRemove :: XConfig l -> Map (KeyMask, KeySym) (X ()) > keysToRemove x = M.fromList > [ ((modm , xK_q ), return ()) > , ((modm .|. shiftMask, xK_q ), return ()) > ] As you can see, it doesn't matter what actions we associate with the keys listed in @keysToRemove@, so we just use @return ()@ (the \"null\" action). Since @newKeys@ contains all of the default keys, you can simply pass it to 'XMonad.Core.XConfig' as your map of keybindings: > main :: IO () > main = xmonad $ def { keys = newKeys } However, having to manually type @return ()@ every time seems like a drag, doesn't it? And this approach isn't at all compatible with adding custom keybindings via 'XMonad.Util.EZConfig.additionalKeysP'! Well, good thing "XMonad.Util.EZConfig" also sports 'XMonad.Util.EZConfig.removeKeysP'. You can use it as you would expect. > main :: IO () > main = xmonad $ def > { … } > `removeKeysP` ["M-q", "M-S-q"] Can you guess how 'XMonad.Util.EZConfig.removeKeysP' works? It's almost the same code we wrote above, just accepting a list of keybindings. Try to see if you can come up with an implementation of > removeKeysP :: XConfig l -> [String] -> XConfig l If you're done, just click on @# Source@ when viewing the 'XMonad.Util.EZConfig.removeKeysP' documentation (did you know that Haddock lets you do that for every function?) and compare. By the way, one can conveniently combine 'XMonad.Util.EZConfig.additionalKeysP' and 'XMonad.Util.EZConfig.removeKeysP' by just intuitively chaining them: > main :: IO () > main = xmonad $ def > { … } > `additionalKeysP myKeys > `removeKeysP` ["M-q", "M-S-q"] If you don't use the @P@ alternatives of EZConfig, there is also an aptly named 'XMonad.Util.EZConfig.removeKeys'. Again, can you try to come up with an implementation yourself that has the correct signature? > removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a In addition to 'Data.Map.Strict.delete', you will probably need to use 'foldr'. -} {- $mouse #Editing_mouse_bindings# Most of the previous discussion of key bindings applies to mouse bindings as well. For example, you could configure button4 to close the window you click on like so: > import qualified Data.Map as M > > myMouse x = [ (0, button4), (\w -> focus w >> kill) ] > > newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x)) > > main = xmonad $ def { ..., mouseBindings = newMouse, ... } Overriding or deleting mouse bindings works similarly. You can also configure mouse bindings much more easily using the 'XMonad.Util.EZConfig.additionalMouseBindings' and 'XMonad.Util.EZConfig.removeMouseBindings' functions from the "XMonad.Util.EZConfig" module. -} {- $layoutHook #Editing_the_layout_hook# When you start an application that opens a new window, when you change the focused window, or move it to another workspace, or change that workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for reordering the visible windows on the visible workspace(s). Since different layouts may be attached to different workspaces, and you can change them, xmonad needs to know which one to use. In this sense the layoutHook may be thought as the list of layouts that xmonad will use for laying out windows on the screen(s). The problem is that the layout subsystem is implemented with an advanced feature of the Haskell programming language: type classes. This allows us to very easily write new layouts, combine or modify existing layouts, create layouts with internal state, etc. This means that we cannot simply have a list of layouts: a list requires every member to belong to the same type! Instead the combination of layouts to be used by xmonad is created with a specific layout combinator: 'XMonad.Layout.|||'. Suppose we want a list with the 'XMonad.Layout.Full', 'XMonad.Layout.Tabbed.tabbed' and 'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our @xmonad.hs@, all the needed modules: > import XMonad > > import XMonad.Layout.Tabbed > import XMonad.Layout.Accordion Then we create the combination of layouts we need: > mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion Now, all we need to do is change the 'XMonad.Core.layoutHook' field of the 'XMonad.Core.XConfig' record, like so: > main = xmonad $ def { layoutHook = mylayoutHook } Thanks to the new combinator, we can apply a layout modifier to a whole combination of layouts, instead of applying it to each one. For example, suppose we want to use the 'XMonad.Layout.NoBorders.noBorders' layout modifier, from the "XMonad.Layout.NoBorders" module (which must be imported): > mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion) If we want only the tabbed layout without borders, then we may write: > mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion Our @xmonad.hs@ will now look like this: > import XMonad > > import XMonad.Layout.Tabbed > import XMonad.Layout.Accordion > import XMonad.Layout.NoBorders > > mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion > > main = xmonad $ def { layoutHook = mylayoutHook } That's it! -} {- $manageHook #Editing_the_manage_hook# The 'XMonad.Core.manageHook' is a very powerful tool for customizing the behavior of xmonad with regard to new windows. Whenever a new window is created, xmonad calls the 'XMonad.Core.manageHook', which can thus be used to perform certain actions on the new window, such as placing it in a specific workspace, ignoring it, or placing it in the float layer. The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer and Gimp, and to ignore gnome-panel, desktop_window, kicker, and kdesktop. The "XMonad.ManageHook" module provides some simple combinators that can be used to alter the 'XMonad.Core.manageHook' by replacing or adding to the default actions. Let's start by analyzing the default 'XMonad.Config.manageHook', defined in "XMonad.Config": > manageHook :: ManageHook > manageHook = composeAll > [ className =? "MPlayer" --> doFloat > , className =? "Gimp" --> doFloat > , resource =? "desktop_window" --> doIgnore > , resource =? "kdesktop" --> doIgnore ] 'XMonad.ManageHook.composeAll' can be used to compose a list of different 'XMonad.Config.ManageHook's. In this example we have a list of 'XMonad.Config.ManageHook's formed by the following commands: the Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className' are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the float layer with the 'XMonad.ManageHook.doFloat' function; the windows whose resource names are respectively \"desktop_window\" and \kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore' function. This is another example of 'XMonad.Config.manageHook', taken from "XMonad.Config.Arossato": > myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat > , resource =? "win" --> doF (W.shift "doc") -- xpdf > , resource =? "firefox-bin" --> doF (W.shift "web") > ] > newManageHook = myManageHook <> manageHook def Again we use 'XMonad.ManageHook.composeAll' to compose a list of different 'XMonad.Config.ManageHook's. The first one will put RealPlayer on the float layer, the second one will put the xpdf windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift' functions, and the third one will put all firefox windows on the workspace called "web". Then we use the '<>' combinator to compose @myManageHook@ with the default 'XMonad.Config.manageHook' to form @newManageHook@. Each 'XMonad.Config.ManageHook' has the form: > property =? match --> action Where @property@ can be: * 'XMonad.ManageHook.title': the window's title * 'XMonad.ManageHook.resource': the resource name * 'XMonad.ManageHook.className': the resource class name. * 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the property @somestring@. (You can retrieve the needed information using the X utility named @xprop@; for example, to find the resource class name, you can type > xprop | grep WM_CLASS at a prompt, then click on the window whose resource class you want to know.) @match@ is the string that will match the property value (for instance the one you retrieved with @xprop@). An @action@ can be: * 'XMonad.ManageHook.doFloat': to place the window in the float layer; * 'XMonad.ManageHook.doIgnore': to ignore the window; * 'XMonad.ManageHook.doF': to execute a function with the window as argument. For example, suppose we want to add a 'XMonad.Config.manageHook' to float RealPlayer, which usually has a 'XMonad.ManageHook.resource' name of \"realplay.bin\". First we need to import "XMonad.ManageHook": > import XMonad.ManageHook Then we create our own 'XMonad.Config.manageHook': > myManageHook = resource =? "realplay.bin" --> doFloat We can now use the '<>' combinator to add our 'XMonad.Config.manageHook' to the default one: > newManageHook = myManageHook <> manageHook def (Of course, if we wanted to completely replace the default 'XMonad.Config.manageHook', this step would not be necessary.) Now, all we need to do is change the 'XMonad.Core.manageHook' field of the 'XMonad.Core.XConfig' record, like so: > main = xmonad def { ..., manageHook = newManageHook, ... } And we are done. Obviously, we may wish to add more then one 'XMonad.Config.manageHook'. In this case we can use a list of hooks, compose them all with 'XMonad.ManageHook.composeAll', and add the composed to the default one. For instance, if we want RealPlayer to float and thunderbird always opened in the workspace named "mail", we can do so like this: > myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat > , resource =? "thunderbird-bin" --> doF (W.shift "mail") > ] Remember to import the module that defines the 'XMonad.StackSet.shift' function, "XMonad.StackSet", like this: > import qualified XMonad.StackSet as W And then we can add @myManageHook@ to the default one to create @newManageHook@ as we did in the previous example. One more thing to note about this system is that if a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ of the corresponding actions will be run (in the order in which they are defined). An alternative version where only the first rule that matches is run is available as 'XMonad.Hooks.ManageHelpers.composeOne'. For additional rules and actions you can use in your manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers". -} xmonad-contrib-0.18.0/XMonad/Hooks/0000755000000000000000000000000007346545000015166 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Hooks/BorderPerWindow.hs0000644000000000000000000000507207346545000020602 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.BorderPerWindow -- Description : Set border width for a window in a ManageHook. -- Copyright : (c) 2021 Xiaokui Shu -- License : BSD-style (see LICENSE) -- -- Maintainer : subbyte@gmail.com -- Stability : unstable -- Portability : unportable -- -- Want to customize border width, for each window on all layouts? Want -- specific window have no border on all layouts? Try this. ----------------------------------------------------------------------------- module XMonad.Hooks.BorderPerWindow ( -- * Usage -- $usage defineBorderWidth , actionQueue -- * Design Considerations -- $design ) where import XMonad import XMonad.Util.ActionQueue (enqueue, actionQueue) -- $usage -- -- To use this module, first import it -- -- > import XMonad.Hooks.BorderPerWindow (defineBorderWidth, actionQueue) -- -- Then specify which window to customize the border of in your -- @manageHook@: -- -- > myManageHook :: ManageHook -- > myManageHook = composeAll -- > [ className =? "firefox" --> defineBorderWidth 0 -- > , className =? "Chromium" --> defineBorderWidth 0 -- > , isDialog --> defineBorderWidth 8 -- > ] -- -- Finally, add the 'actionQueue' combinator and @myManageHook@ to your -- config: -- -- > main = xmonad $ actionQueue $ def -- > { ... -- > , manageHook = myManageHook -- > , ... -- > } -- -- Note that this module is incompatible with other ways of changing -- borders, like "XMonad.Layout.NoBorders". This is because we are -- changing the border exactly /once/ (when the window first appears) -- and not every time some condition is satisfied. -- $design -- -- 1. Keep it simple. Since the extension does not aim to change border setting -- when layout changes, only execute the border setting function once to -- avoid potential window flashing/jumping/scaling. -- -- 2. The 'ManageHook' eDSL is a nice language for specifying windows. Let's -- build on top of it and use it to specify window to define border. defineBorderWidth :: Dimension -> ManageHook defineBorderWidth bw = do w <- ask liftX . enqueue $ updateBorderWidth w bw idHook updateBorderWidth :: Window -> Dimension -> X () updateBorderWidth w bw = do withDisplay $ \d -> io $ setWindowBorderWidth d w bw refresh xmonad-contrib-0.18.0/XMonad/Hooks/CurrentWorkspaceOnTop.hs0000644000000000000000000000525207346545000022007 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Hooks.CurrentWorkspaceOnTop ( -- * Usage -- $usage currentWorkspaceOnTop ) where import qualified Data.List.NonEmpty as NE (nonEmpty) import qualified Data.Map as M import XMonad import XMonad.Prelude (NonEmpty ((:|)), when) import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.CurrentWorkspaceOnTop -- > -- > main = xmonad $ def { -- > ... -- > logHook = currentWorkspaceOnTop -- > ... -- > } -- newtype CWOTState = CWOTS String instance ExtensionClass CWOTState where initialValue = CWOTS "" currentWorkspaceOnTop :: X () currentWorkspaceOnTop = withDisplay $ \d -> do ws <- gets windowset (CWOTS lastTag) <- XS.get let curTag = S.tag . S.workspace . S.current $ ws when (curTag /= lastTag) $ do -- the following is more or less a reimplementation of what's happening in "XMonad.Operation" 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) (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect updateLayout curTag ml' let this = S.view curTag ws 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 case NE.nonEmpty wins of Nothing -> pure () Just (w :| ws') -> do io $ raiseWindow d w -- raise first window of current workspace to the very top, io $ restackWindows d (w : ws') -- then use restackWindows to let all other windows from the workspace follow XS.put(CWOTS curTag) xmonad-contrib-0.18.0/XMonad/Hooks/DebugEvents.hs0000644000000000000000000016335607346545000017753 0ustar0000000000000000{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DebugEvents (debugEventsHook) where import Prelude 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 as E import Control.Monad.Fail import Control.Monad.State import Control.Monad.Reader import Codec.Binary.UTF8.String import Foreign hiding (void) import Foreign.C.Types import Numeric (showHex) import System.Exit import System.IO import System.Process import GHC.Stack (HasCallStack, prettyCallStack, callStack) -- | Event hook to dump all received events. You should probably not use this -- unconditionally; it will produce massive amounts of output. debugEventsHook :: Event -> X All debugEventsHook e = debugEventsHook' e >> return (All True) -- | 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 windowEvent "ConfigureRequest" w windowEvent " parent" p -- mask <- quickFormat msk $ dumpBits wmCRMask -- say " requested parameters" $ concat ['(':show wid -- ,'x':show ht -- ,')':if bw == 0 then "" else '+':show bw -- ,'@':'(':show x -- ,',':show y -- ,") mask " -- ,mask -- ] s <- quickFormat [x,y,wid,ht,bw,fromIntegral above,place] $ dumpListByMask' msk [("x" ,dump32 ,cARDINAL) ,("y" ,dump32 ,cARDINAL) ,("width" ,dump32 ,cARDINAL) ,("height" ,dump32 ,cARDINAL) ,("border_width",dump32 ,cARDINAL) ,("sibling" ,dumpWindow ,wINDOW ) ,("detail" ,dumpEnum wmPlacement,cARDINAL) ] say " requested" s 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 } = windowEvent "MapRequest" w >> windowEvent " parent" p 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 windowEvent "Button" w nl <- gets numberlockMask let msk | s == 0 = "" | otherwise = "modifiers " ++ keymaskToString nl s say " button" $ show b ++ msk debugEventsHook' DestroyWindowEvent {ev_window = w } = windowEvent "DestroyWindow" w debugEventsHook' UnmapEvent {ev_window = w } = windowEvent "Unmap" w debugEventsHook' MapNotifyEvent {ev_window = w } = windowEvent "MapNotify" w {- way too much output; suppressed. debugEventsHook' (CrossingEvent {ev_window = w ,ev_subwindow = s }) = windowEvent "Crossing" w >> windowEvent " subwindow" s -} debugEventsHook' CrossingEvent {} = return () 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 a' <- atomName a -- too many of these, and they're not real useful 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 } = 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 windowEvent "ClientMessage on" w n <- atomName a -- this is a sort of custom property -- @@@ this likely won't work as is; type information varies, I think (ta,b,l) <- case lookup n clientMessages of Nothing -> return (a,32,length vs') Just (ta',b,l) -> do ta <- getAtom ta' return (ta,b,l) let wl = bytes b vs <- io $ take (l * wl) <$> splitCInt vs' s <- dumpProperty' w a n ta b vs 0 (10 + length n) say " message" $ n ++ s debugEventsHook' _ = return () -- | Emit information about an atom. atomName :: Atom -> X String atomName a = withDisplay $ \d -> io $ fromMaybe ("(unknown atom " ++ show a ++ ")") <$> getAtomName d a -- | Emit an atom with respect to the current event. atomEvent :: String -> Atom -> X () atomEvent l a = atomName a >>= say l -- | Emit a window with respect to the current event. windowEvent :: String -> Window -> X () windowEvent l w = debugWindow w >>= say l -- | Helper to emit tagged event information. say :: String -> String -> X () say l s = XMonad.trace $ l ++ ' ':s -- | Deconstuct a list of 'CInt's into raw bytes splitCInt :: [CInt] -> IO Raw splitCInt vs = io $ withArray vs $ \p -> peekArray (4 * length vs) (castPtr p :: Ptr CUChar) -- | Specify how to decode some common client messages. clientMessages :: [(String,(String,Int,Int))] clientMessages = [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1)) ,("WM_CHANGE_STATE" ,("WM_STATE" ,32,2)) ,("WM_COMMAND" ,("STRING" , 8,0)) ,("WM_SAVE_YOURSELF" ,("STRING" , 8,0)) ] -- formatting properties. ick. -- -- @@@ Document the parser. Someday. type Raw = [CUChar] data Decode = Decode {property :: Atom -- original property atom ,pName :: String -- its name ,pType :: Atom -- base property type atom ,width :: Int -- declared data width ,window :: Window -- source window ,indent :: Int -- current indent (via local) ,limit :: Int -- line length } -- the result accumulates here mainly for the benefit of the indenter data DecodeState = DecS {value :: Raw -- unconsumed raw property value ,accum :: String -- output accumulator ,joint :: String -- separator when adding to accumulator } newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a) deriving (Functor ,Applicative ,Monad ,MonadIO ,MonadFail ,MonadState DecodeState ,MonadReader Decode ) -- | Retrive, parse, and dump a window property. As all the high-level property -- interfaces lose information necessary to decode properties correctly, we -- work at the lowest level available. dumpProperty :: HasCallStack => Atom -> String -> Window -> Int -> X String dumpProperty a n w i = do prop <- withDisplay $ \d -> io $ alloca $ \fmtp -> alloca $ \szp -> alloca $ \lenp -> alloca $ \ackp -> alloca $ \vsp -> do rc <- xGetWindowProperty d w a 0 maxBound False anyPropertyType fmtp szp lenp ackp vsp case rc of 0 -> do fmt <- fromIntegral <$> peek fmtp vs' <- peek vsp sz <- fromIntegral <$> peek szp case () of () | fmt == none -> xFree vs' >> return (Left "(property deleted)" ) | sz < 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++ show sz ++ ")" ) | sz `mod` 8 /= 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++ show sz ++ ")" ) | otherwise -> do len <- fromIntegral <$> peek lenp -- that's as in "ack! it's fugged!" ack <- fromIntegral <$> peek ackp vs <- peekArray (len * bytes sz) vs' _ <- xFree vs' return $ Right (fmt,sz,ack,vs) e -> return $ Left $ "getWindowProperty failed: " ++ show e case prop of Left _ -> return "" Right (fmt,sz,ack,vs) -> dumpProperty' w a n fmt sz vs ack i -- @@@ am I better off passing in the Decode and DecodeState? -- | Parse and dump a property (or a 'ClientMessage'). dumpProperty' :: HasCallStack => Window -- source window -> Atom -- property id -> String -- property name -> Atom -- property type -> Int -- bit width -> Raw -- raw value -> CULong -- size of un-dumped content -> Int -- indent for output formatting -> X String dumpProperty' w a n fmt sz vs ack i = do ptn <- atomName fmt let dec = Decode {property = a ,pName = n ,pType = fmt ,width = sz ,indent = i + length ptn + 6 ,window = w ,limit = 96 } dec' = dec {pType = cARDINAL ,width = 8 } ds = DecS {value = vs -- @@@ probably should push this outside, since it doesn't -- make sense for ClientMessage ,accum = " (" ++ ptn ++ ") " ,joint = "= " } (_,ds') <- runDecode dec ds $ dumpProp a n let fin = length (value ds') len = length vs lost = if ack == 0 then "" else " and " ++ show ack ++ " lost bytes" unk = case () of () | fin == len -> "undecodeable " | fin == 0 -> "." | otherwise -> " and remainder (" ++ show (len - fin) ++ '/':show len ++ ")" (_,ds'') <- if fin == 0 then return (True,ds') else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8 (_,ds''') <- if ack == 0 then return (True,ds'') else runDecode dec' (withJoint' " " ds'') $ propSimple lost -- @@@ return $ accum ds''' -- | A simplified version of 'dumpProperty\'', to format random values from -- events. quickFormat :: (HasCallStack, Storable i, Integral i) => [i] -> Decoder Bool -> X String quickFormat v f = do let vl = length v vs <- io $ allocaArray vl $ \p -> pokeArray p (map fromIntegral v :: [CULong]) >> peekArray (4 * vl) (castPtr p :: Ptr CUChar) let dec = Decode {property = none ,pName = "" ,pType = cARDINAL ,width = 32 ,indent = 0 ,window = none ,limit = maxBound } ds = DecS {value = vs ,accum = "" ,joint = "" } (r,ds') <- runDecode dec ds f return $ accum ds' ++ if r then "" else "?" -- | Launch a decoding parser, returning success and final state. runDecode :: Decode -> DecodeState -> Decoder Bool -> X (Bool,DecodeState) runDecode c s (Decoder p) = runStateT (runReaderT p c) s -- Coerce bit size to bytes. 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 -- pattern matching. dumpProp :: HasCallStack => Atom -> String -> Decoder Bool dumpProp _ "CLIPBOARD" = dumpSelection dumpProp _ "_NET_SUPPORTED" = dumpArray dumpAtom dumpProp _ "_NET_CLIENT_LIST" = dumpArray dumpWindow dumpProp _ "_NET_CLIENT_LIST_STACKING" = dumpArray dumpWindow dumpProp _ "_NET_NUMBER_OF_DESKTOPS" = dump32 dumpProp _ "_NET_VIRTUAL_ROOTS" = dumpArray dumpWindow dumpProp _ "_NET_DESKTOP_GEOMETRY" = dumpArray dump32 dumpProp _ "_NET_DESKTOP_VIEWPORT" = dumpList [("w",dump32) ,("h",dump32) ] dumpProp _ "_NET_CURRENT_DESKTOP" = dump32 dumpProp _ "_NET_DESKTOP_NAMES" = dumpArray dumpUTF dumpProp _ "_NET_ACTIVE_WINDOW" = dumpActiveWindow dumpProp _ "_NET_WORKAREA" = dumpList [("start" ,dumpList [("x",dump32) ,("y",dump32) ] ) ,("size" ,dumpList [("w",dump32) ,("h",dump32) ] ) ] dumpProp _ "_NET_SUPPORTING_WM_CHECK" = dumpWindow dumpProp _ "_NET_DESKTOP_LAYOUT" = dumpList [("orientation" ,dumpEnum nwmOrientation ) ,("size" ,dumpList [("cols",dump32) ,("rows",dump32) ] ) ,("origin" ,dumpEnum nwmOrigin ) ] dumpProp _ "_NET_SHOWING_DESKTOP" = dump32 dumpProp _ "_NET_WM_NAME" = dumpUTF dumpProp _ "_NET_WM_VISIBLE_NAME" = dumpUTF dumpProp _ "_NET_WM_ICON_NAME" = dumpUTF dumpProp _ "_NET_WM_VISIBLE_ICON_NAME" = dumpUTF -- @@@ the property is CARDINAL; the message is _NET_WM_DESKTOP of 5 dump32s -- [desktop/all, source indication, 3 zeroes] -- dumpProp _ "_NET_WM_DESKTOP" = dumpExcept [(0xFFFFFFFF,"all")] -- dump32 dumpProp _ "_NET_WM_DESKTOP" = dumpSetDesktop dumpProp _ "_NET_WM_WINDOW_TYPE" = dumpArray dumpAtom dumpProp _ "_NET_WM_STATE" = dumpNWState dumpProp _ "_NET_WM_ALLOWED_ACTIONS" = dumpArray dumpAtom dumpProp _ "_NET_WM_STRUT" = dumpList [("left gap" ,dump32) ,("right gap" ,dump32) ,("top gap" ,dump32) ,("bottom gap",dump32) ] dumpProp _ "_NET_WM_STRUT_PARTIAL" = dumpList [("left gap" ,dump32) ,("right gap" ,dump32) ,("top gap" ,dump32) ,("bottom gap" ,dump32) ,("left start" ,dump32) ,("left end" ,dump32) ,("right start" ,dump32) ,("right end" ,dump32) ,("top start" ,dump32) ,("top end" ,dump32) ,("bottom start",dump32) ,("bottom end" ,dump32) ] dumpProp _ "_NET_WM_ICON_GEOMETRY" = dumpList [("x",dump32) ,("y",dump32) ,("w",dump32) ,("h",dump32) ] -- no, I'm not going to duplicate xprop *completely*! dumpProp _ "_NET_WM_ICON" = propSimple "(icon)" dumpProp _ "_NET_WM_PID" = dumpPid dumpProp _ "_NET_WM_HANDLED_ICONS" = propSimple "(defined)" dumpProp _ "_NET_WM_USER_TIME" = dumpExcept [(0,"do not map initially")] dumpTime dumpProp _ "_NET_FRAME_EXTENTS" = dumpList [("left" ,dump32) ,("right" ,dump32) ,("top" ,dump32) ,("bottom",dump32) ] dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER" = dumpExcept [(0,"illegal value 0")] dump64 dumpProp _ "_NET_WM_OPAQUE_REGION" = dumpArray $ dumpList [("x",dump32) ,("y",dump32) ,("w",dump32) ,("h",dump32) ] dumpProp _ "_NET_WM_BYPASS_COMPOSITOR" = dumpEnum cpState dumpProp _ "_NET_STARTUP_ID" = dumpUTF dumpProp _ "WM_PROTOCOLS" = dumpArray dumpAtom dumpProp _ "WM_COLORMAP_WINDOWS" = dumpArray dumpWindow dumpProp _ "WM_STATE" = dumpState dumpProp _ "WM_LOCALE_NAME" = dumpString dumpProp _ "WM_CLIENT_LEADER" = dumpWindow dumpProp _ "_NET_WM_WINDOW_OPACITY" = dumpPercent dumpProp _ "XdndAware" = dumpArray dumpAtom dumpProp _ "_XKLAVIER_TRANSPARENT" = dumpInteger 32 dumpProp _ "_XKLAVIER_STATE" = dumpList [("state" ,dumpInteger 32) ,("indicators",dumpXKlInds) ] dumpProp _ "_MOTIF_DRAG_RECEIVER_INFO" = dumpMotifDragReceiver dumpProp _ "_OL_WIN_ATTR" = dumpOLAttrs dumpProp _ "_OL_DECOR_ADD" = dumpArray dumpAtom dumpProp _ "_OL_DECOR_DEL" = dumpArray dumpAtom dumpProp _ "_MOTIF_WM_HINTS" = dumpMwmHints dumpProp _ "_MOTIF_WM_INFO" = dumpMwmInfo dumpProp _ "_XMONAD_DECORATED_BY" = dumpWindow dumpProp _ "_XMONAD_DECORATION_FOR" = dumpWindow dumpProp a _ | a == wM_NAME = dumpString | a == pRIMARY = dumpSelection | a == sECONDARY = dumpSelection -- this is gross | a == wM_TRANSIENT_FOR = do root <- fromIntegral <$> inX (asks theRoot) w <- asks window WMHints {wmh_window_group = wgroup} <- inX $ asks display >>= io . flip getWMHints w dumpExcept [(0 ,"window group " ++ show wgroup) ,(root,"window group " ++ show wgroup) ] dumpWindow | a == rESOURCE_MANAGER = dumpString | a == wM_COMMAND = dumpString | a == wM_HINTS = dumpWmHints | a == wM_CLIENT_MACHINE = dumpString | a == wM_ICON_NAME = dumpString | a == wM_ICON_SIZE = dumpList [("min size" ,dumpList [("w",dump32) ,("h",dump32) ] ) ,("max size" ,dumpList [("w",dump32) ,("h",dump32) ] ) ,("increment" ,dumpList [("w",dump32) ,("h",dump32) ] ) ] | a == wM_NORMAL_HINTS = dumpSizeHints | a == wM_ZOOM_HINTS = dumpSizeHints | a == rGB_DEFAULT_MAP = (...) -- XStandardColormap | a == rGB_BEST_MAP = (...) -- " | a == rGB_RED_MAP = (...) -- " | a == rGB_GREEN_MAP = (...) -- " | a == rGB_BLUE_MAP = (...) -- " | a == rGB_GRAY_MAP = (...) -- " | a == wM_CLASS = dumpList [("name" ,dumpString) ,("class",dumpString) ] dumpProp _ s | s `isCountOf` "WM_S" = dumpSelection | s `isCountOf` "_NET_WM_CM_S" = dumpSelection | s `isCountOf` "_NET_DESKTOP_LAYOUT_S" = dumpSelection | s `isCountOf` "CUT_BUFFER" = dumpString -- and dumpProperties does the rest | otherwise = return False -- lower level decoders -- -- alter the current joint withJoint :: String -> Decoder a -> Decoder a withJoint j = ((modify $ withJoint' j) >>) withJoint' :: String -> DecodeState -> DecodeState withJoint' j s = s {joint = j} -- lift an X into a Decoder inX :: X a -> Decoder a inX = Decoder . lift . lift -- flip isPrefixOf, but the remainder must be all digits isCountOf :: String -> String -> Bool -- note that \NUL is safe because atom names have to be C strings s `isCountOf` pfx = null $ dropWhile isDigit $ map fst $ dropWhile (uncurry (==)) $ zip s $ pfx ++ repeat '\NUL' -- localize an increased indent withIndent :: Int -> Decoder a -> Decoder a withIndent w = local (\r -> r {indent = indent r + w}) -- dump an array of items. this dumps the entire property dumpArray :: HasCallStack => Decoder Bool -> Decoder Bool dumpArray item = do withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "") -- step through values as an array, ending on parse error or end of list dumpArray' :: HasCallStack => Decoder Bool -> String -> Decoder Bool dumpArray' item pfx = do vs <- gets value if null vs then append "]" else append pfx >> whenD item (dumpArray' item ",") -- keep parsing until a parse step fails -- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when', -- which suggests that 'whenX' is *also* the same function... yep. ISAGN whenD :: (HasCallStack, Monad m) => m Bool -> m Bool -> m Bool whenD p f = p >>= \b -> if b then f else return False -- verify a decoder parameter, else call error reporter -- once again, it's more general than I originally wrote guardR :: (HasCallStack, MonadReader r m, Eq v) => (r -> v) -- value selector -> v -- expected value -> (v -> v -> m a) -- error reporter -> m a -- continuation (hush) -> m a guardR sel val err good = do v <- asks sel if v == val then good else err v val -- this is kinda dumb fi :: HasCallStack => Bool -> a -> a -> a fi p n y = if p then y else n -- flip (if' p), if that existed -- verify we have the expected word size guardSize :: HasCallStack => Int -> Decoder Bool -> Decoder Bool -- see XSync documentation for this insanity guardSize 64 = guardR width 32 propSizeErr . guardSize' 8 (propShortErr' 1) guardSize w = guardR width w propSizeErr . guardSize' (bytes w) (propShortErr' 2) guardSize' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a guardSize' l n y = gets value >>= \vs -> fi (length vs >= bytes l) n y -- @guardSize@ doesn't work with empty arrays guardSize'' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a guardSize'' l n y = gets value >>= \vs -> fi (null vs || length vs >= bytes l) n y -- verify we have the expected property type guardType :: HasCallStack => Atom -> Decoder Bool -> Decoder Bool guardType t = guardR pType t propTypeErr -- dump a structure as a named tuple dumpList :: HasCallStack => [(String,Decoder Bool)] -> Decoder Bool dumpList proto = do a <- asks pType dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "(" -- same but elements have their own distinct types dumpList' :: HasCallStack => [(String,Decoder Bool,Atom)] -> Decoder Bool dumpList' proto = dumpList'' (maxBound :: CULong) proto "(" -- same but only dump elements identified by provided mask dumpListByMask :: HasCallStack => CULong -> [(String,Decoder Bool)] -> Decoder Bool dumpListByMask m p = do a <- asks pType dumpList'' m (map (\(s,d) -> (s,d,a)) p) "(" -- and the previous two combined dumpListByMask' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool dumpListByMask' m p = dumpList'' m p "(" dumpList'' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool dumpList'' _ [] _ = append ")" >> return True dumpList'' 0 _ _ = append ")" >> return True dumpList'' m ((l,p,t):ps) sep = do (e,sep') <- if m .&. 1 == 0 then do -- @@@ ew st <- get e <- local (\r -> r {pType = t}) p v' <- gets value put $ st {value = v'} return (e,sep) else do let label = sep ++ l ++ " = " append label e <- withJoint "" $ do local (\r -> r {pType = t ,indent = indent r + length label }) p return (e,",") if e then dumpList'' (m `shiftR` 1) ps sep' else return e -- do the getTextProperty dance, the hard way. -- @@@ @COMPOUND_TEXT@ not supported yet. dumpString :: HasCallStack => Decoder Bool dumpString = do fmt <- asks pType [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"] case () of () | fmt == cOMPOUND_TEXT -> guardSize'' 16 (propShortErr' 3) ( ... ) | fmt == sTRING -> guardSize'' 8 (propShortErr' 4) $ do vs <- gets value modify (\r -> r {value = []}) let ss = flip unfoldr (map twiddle vs) $ \s -> if null s then Nothing else let (w,s'') = break (== '\NUL') s s' = drop 1 s'' in Just (w,s') case ss of [s] -> append $ show s ss' -> let go (s:ss'') c = append c >> append (show s) >> go ss'' "," go [] _ = append "]" in append "[" >> go ss' "" | fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :) | otherwise -> inX (atomName fmt) >>= failure . ("unrecognized string type " ++) -- show who owns a selection dumpSelection :: HasCallStack => Decoder Bool dumpSelection = do -- system selections contain a window ID; others are random -- note that the window ID will be the same as the owner, so -- we don't really care anyway. we *do* want the selection owner a <- asks property owner <- inX $ withDisplay $ \d -> io $ xGetSelectionOwner d a if owner == none then append "unowned" else do w <- inX $ debugWindow owner append $ "owned by " ++ w -- for now, not querying Xkb dumpXKlInds :: HasCallStack => Decoder Bool dumpXKlInds = guardType iNTEGER $ do n <- fmap fromIntegral <$> getInt' 32 case n of Nothing -> propShortErr' 5 Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 []) where dumpInds :: HasCallStack => Word32 -> Word32 -> Int -> [String] -> [String] dumpInds n bt c bs | n == 0 && c == 1 = ["none"] | n == 0 = bs | n .&. bt /= 0 = dumpInds (n .&. complement bt) (bt `shiftL` 1) (c + 1) (show c:bs) | otherwise = dumpInds n (bt `shiftL` 1) (c + 1) bs -- decode an Atom dumpAtom :: HasCallStack => Decoder Bool dumpAtom = dumpAtom'' aTOM {- dumpAtom' :: HasCallStack => String -> Decoder Bool dumpAtom' t' = do t <- inX $ getAtom t' dumpAtom'' t -} dumpAtom'' :: HasCallStack => Atom -> Decoder Bool dumpAtom'' t = guardType t $ do a <- getInt' 32 case a of Nothing -> return False Just a' -> do an <- inX $ atomName $ fromIntegral a' append an dumpWindow :: HasCallStack => Decoder Bool dumpWindow = guardSize 32 $ guardType wINDOW $ do w <- getInt' 32 case w of Nothing -> return False Just 0 -> append "none" Just w' -> inX (debugWindow (fromIntegral w')) >>= append -- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list dumpActiveWindow :: HasCallStack => Decoder Bool dumpActiveWindow = guardSize 32 $ do t <- asks pType nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW" case () of () | t == wINDOW -> dumpWindow | t == nAW -> dumpList' [("source" ,dumpEnum awSource,cARDINAL) ,("timestamp" ,dumpTime ,cARDINAL) ,("active window",dumpWindow ,wINDOW ) ] _ -> do t' <- inX $ atomName t failure $ concat ["(bad type " ,t' ,"; expected WINDOW or _NET_ACTIVE_WINDOW)" ] -- likewise but for _NET_WM_DESKTOP dumpSetDesktop :: HasCallStack => Decoder Bool dumpSetDesktop = guardSize 32 $ do t <- asks pType nWD <- inX $ getAtom "_NET_WM_DESKTOP" case () of () | t == cARDINAL -> dumpExcept [(0xFFFFFFFF,"all")] dump32 | t == nWD -> dumpList' [("desktop",dumpExcept [(0xFFFFFFFF,"all")] dump32 ,cARDINAL) ,("source" ,dumpEnum awSource ,cARDINAL) ] _ -> do t' <- inX $ atomName t failure $ concat ["(bad type " ,t' ,"; expected CARDINAL or _NET_WM_DESKTOP)" ] -- and again for _NET_WM_STATE dumpNWState :: HasCallStack => Decoder Bool dumpNWState = guardSize'' 32 propShortErr $ do t <- asks pType nWS <- inX $ getAtom "_NET_WM_STATE" case () of () | t == aTOM -> dumpArray dumpAtom | t == nWS -> dumpList' [("action",dumpEnum nwAction,cARDINAL) ,("atom1" ,dumpAtom ,aTOM) ,("atom2" ,dumpAtom ,aTOM) ] _ -> do t' <- inX $ atomName t failure $ concat ["(bad type " ,t' ,"; expected ATOM or _NET_WM_STATE)" ] -- dump a generic CARDINAL value dumpInt :: HasCallStack => Int -> Decoder Bool dumpInt w = guardSize w $ guardType cARDINAL $ getInt w show -- INTEGER is the signed version of CARDINAL dumpInteger :: HasCallStack => Int -> Decoder Bool dumpInteger w = guardSize w $ guardType iNTEGER $ getInt w (show . signed w) -- reinterpret an unsigned as a signed signed :: HasCallStack => Int -> Integer -> Integer signed w i = bit (w + 1) - i -- and wrappers to keep the parse list in bounds dump64 :: HasCallStack => Decoder Bool dump64 = dumpInt 64 dump32 :: HasCallStack => Decoder Bool dump32 = dumpInt 32 {- not used in standard properties dump16 :: HasCallStack => Decoder Bool dump16 = dumpInt 16 -} dump8 :: HasCallStack => Decoder Bool dump8 = dumpInt 8 -- I am assuming for the moment that this is a single string. -- This might be false; consider the way the STRING properties -- handle lists. dumpUTF :: HasCallStack => Decoder Bool dumpUTF = do uTF8_STRING <- inX $ getAtom "UTF8_STRING" guardType uTF8_STRING $ guardSize'' 8 propShortErr $ do s <- gets value modify (\r -> r {value = []}) append . show . decode . map fromIntegral $ s return True -- dump an enumerated value using a translation table dumpEnum' :: HasCallStack => [String] -> Atom -> Decoder Bool dumpEnum' ss fmt = guardType fmt $ getInt 32 $ \r -> case () of () | r < 0 -> "undefined value " ++ show r | r >= genericLength ss -> "undefined value " ++ show r | otherwise -> genericIndex ss r -- we do not, unlike @xev@, try to ascii-art pixmaps. dumpPixmap :: HasCallStack => Decoder Bool dumpPixmap = guardType pIXMAP $ do p' <- getInt' 32 case p' of Nothing -> return False Just 0 -> append "none" Just p -> do append $ "pixmap " ++ showHex p "" g' <- inX $ withDisplay $ \d -> io $ (Just <$> getGeometry d (fromIntegral p)) `E.catch` \e -> case fromException e of Just x -> throw e `const` (x `asTypeOf` ExitSuccess) _ -> return Nothing case g' of Nothing -> append " (deleted)" Just (_,x,y,wid,ht,bw,dp) -> append $ concat [" (" ,show wid ,'x':show ht ,'x':show dp ,')':if bw == 0 then "" else '+':show bw ,"@(" ,show x ,',':show y ,")" ] dumpOLAttrs :: HasCallStack => Decoder Bool dumpOLAttrs = do pt <- inX $ getAtom "_OL_WIN_ATTR" guardType pt $ do msk <- getInt' 32 case msk of Nothing -> propShortErr' 7 Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom ) ,("menu" ,dump32 ) -- @@@ unk ,("pushpin" ,dumpEnum bool) ,("limited menu",dump32 ) -- @@@ unk ] dumpMwmHints :: HasCallStack => Decoder Bool dumpMwmHints = do ta <- asks property guardType ta $ do msk <- getInt' 32 case msk of Nothing -> propShortErr' 8 Just msk' -> dumpListByMask' (fromIntegral msk') [("functions" ,dumpBits mwmFuncs ,cARDINAL) ,("decorations",dumpBits mwmDecos ,cARDINAL) ,("input mode" ,dumpEnum mwmInputMode,cARDINAL) -- @@@ s/b iNTEGER? ,("status" ,dumpBits mwmState ,cARDINAL) ] dumpMwmInfo :: HasCallStack => Decoder Bool dumpMwmInfo = do ta <- asks property guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL) ,("window",dumpWindow ,wINDOW ) ] dumpSizeHints :: HasCallStack => Decoder Bool dumpSizeHints = do guardType wM_SIZE_HINTS $ do -- flags, 4 unused CARD32s, fields as specified by flags msk <- fmap fromIntegral <$> getInt' 32 eat (4 * 4) >> pure False case msk of Nothing -> propShortErr' 9 Just msk' -> dumpListByMask' msk' [("min size" ,dumpSize ,cARDINAL) ,("max size" ,dumpSize ,cARDINAL) ,("increment" ,dumpSize ,cARDINAL) ,("aspect ratio",dumpAspect,cARDINAL) ,("base size" ,dumpSize ,cARDINAL) ,("gravity" ,dumpGrav ,cARDINAL) ] dumpSize :: HasCallStack => Decoder Bool dumpSize = append "(" >> dump32 >> append "," >> dump32 >> append ")" dumpAspect :: HasCallStack => Decoder Bool dumpAspect = do -- have to do this manually since it doesn't really fit append "min = " dump32 append "/" dump32 append ", max = " dump32 append "/" dump32 dumpGrav :: HasCallStack => Decoder Bool dumpGrav = dumpEnum wmGravity -- the most common case dumpEnum :: HasCallStack => [String] -> Decoder Bool dumpEnum ss = dumpEnum' ss cARDINAL -- implement exceptional cases atop a normal dumper -- @@@ there's gotta be a better way dumpExcept :: HasCallStack => [(Integer,String)] -> Decoder Bool -> Decoder Bool dumpExcept xs item = do -- this horror brought to you by reparsing to get the right value for our use sp <- get rc <- item if not rc then return False else do that <- get -- if none match then we just restore the value parse vs <- gets value let w = (length (value sp) - length vs) * 8 -- now we get to reparse again so we get our copy of it put sp v <- fmap fromJust (getInt' w) -- and after all that, we can process the exception list dumpExcept' xs that v dumpExcept' :: HasCallStack => [(Integer,String)] -> DecodeState -> Integer -> Decoder Bool dumpExcept' [] that _ = put that >> return True dumpExcept' ((exc,str):xs) that val | exc == val = append str | otherwise = dumpExcept' xs that val -- use @ps@ to get process information. -- @@@@ assumes a POSIX @ps@, not a BSDish one. dumpPid :: HasCallStack => Decoder Bool dumpPid = guardType cARDINAL $ do n <- getInt' 32 case n of Nothing -> return False Just pid' -> do let pid = show pid' ps = (proc "/bin/ps" ["-fp" ++ pid]) {std_out = CreatePipe} (_,o,_,_) <- io $ createProcess ps case o of Nothing -> append $ "pid " ++ pid Just p' -> do prc <- io $ lines <$> hGetContents p' -- deliberately forcing it append $ if length prc < 2 then "pid " ++ pid else prc !! 1 dumpTime :: HasCallStack => Decoder Bool dumpTime = append "server event # " >> dump32 dumpState :: HasCallStack => Decoder Bool dumpState = do wM_STATE <- inX $ getAtom "WM_STATE" guardType wM_STATE $ dumpList' [("state" ,dumpEnum wmState,cARDINAL) ,("icon window",dumpWindow ,wINDOW ) ] dumpMotifDragReceiver :: HasCallStack => Decoder Bool dumpMotifDragReceiver = do ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO" guardType ta $ dumpList' [("endian" ,dumpMotifEndian,cARDINAL) ,("version" ,dump8 ,cARDINAL) ,("style" ,dumpMDropStyle ,cARDINAL) -- @@@ dummy ] dumpMDropStyle :: HasCallStack => Decoder Bool dumpMDropStyle = do d <- getInt' 8 pad 1 $ case d of Nothing -> propShortErr' 9 Just ps | ps == 0 -> pad 12 $ append "none" | ps == 1 -> pad 12 $ append "drop only" | ps == 2 -> append "prefer preregister " >> dumpMDPrereg | ps == 3 -> append "preregister " >> dumpMDPrereg | ps == 4 -> pad 12 $ append "prefer dynamic" | ps == 5 -> pad 12 $ append "dynamic" | ps == 6 -> pad 12 $ append "prefer receiver" | otherwise -> failure $ "unknown drop style " ++ show ps dumpMDPrereg :: HasCallStack => Decoder Bool dumpMDPrereg = do -- this is a bit ugly; we pretend to be extending the above dumpList' append "," append "proxy window = " withIndent 15 dumpWindow append "," append "drop sites = " dsc' <- getInt' 16 case dsc' of Nothing -> propShortErr' 10 Just dsc -> do withIndent 13 $ append (show dsc) pad 2 $ do append "," append "total size = " withIndent 13 dump32 dumpMDBlocks $ fromIntegral dsc dumpMDBlocks :: Int -> Decoder Bool dumpMDBlocks _ = propSimple "(drop site info)" -- @@@ maybe later if needed dumpMotifEndian :: HasCallStack => Decoder Bool dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do c <- map twiddle <$> eat 1 case c of ['l'] -> append "little" ['B'] -> append "big" _ -> failure "bad endian flag" pad :: HasCallStack => Int -> Decoder Bool -> Decoder Bool pad n p = do vs <- gets value if length vs < n then propShortErr' 11 else modify (\r -> r {value = drop n vs}) >> p dumpPercent :: HasCallStack => Decoder Bool dumpPercent = guardType cARDINAL $ do n <- getInt' 32 case n of Nothing -> return False Just n' -> let pct = 100 * fromIntegral n' / fromIntegral (maxBound :: Word32) pct :: Double in append $ show (round pct :: Integer) ++ "%" dumpWmHints :: HasCallStack => Decoder Bool dumpWmHints = guardType wM_HINTS $ do msk <- getInt' 32 case msk of Nothing -> return False Just msk' -> dumpListByMask' (fromIntegral msk') [("input" ,dumpEnum bool ,cARDINAL) ,("initial_state",dumpEnum wmState,cARDINAL) ,("icon_pixmap" ,dumpPixmap ,pIXMAP ) ,("icon_window" ,dumpWindow ,wINDOW ) ,("icon_x" ,dump32 ,cARDINAL) ,("icon_y" ,dump32 ,cARDINAL) ,("icon_mask" ,dumpPixmap ,pIXMAP ) ,("window_group" ,dumpWindow ,wINDOW ) ] dumpBits :: HasCallStack => [String] -> Decoder Bool dumpBits bs = guardType cARDINAL $ do n <- getInt' 32 case n of Nothing -> return False Just n' -> dumpBits' bs 1 (fromIntegral n') "" dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool dumpBits' [] _ n p = if n == 0 then return True else append (p ++ show n) dumpBits' (s:ss) b n p = do p' <- if n .&. b /= 0 then append (p ++ s) >> return "|" else return p dumpBits' ss (b `shiftL` 1) (n .&. complement b) p' -- enum definitions -- mwmFuncs :: [String] mwmFuncs = ["all except" ,"resize" ,"move" ,"minimize" ,"maximize" ,"close" ] mwmDecos :: [String] mwmDecos = ["all except" ,"border" ,"resize handle" ,"title" ,"menu button" ,"maximize button" ,"minimize button" ] mwmInputMode :: [String] mwmInputMode = ["modeless" ,"application modal" ,"system model" ,"full application modal" ] mwmState :: [String] mwmState = ["tearoff window" ] mwmHints :: [String] mwmHints = ["standard startup" ,"custom startup" ] awSource :: [String] awSource = ["unspecified" ,"application" ,"pager/task list" ] cpState :: [String] cpState = ["no preference","disable compositing","force compositing"] {- eventually... wmHintsFlags :: [String] wmHintsFlags = ["Input" ,"State" ,"IconPixmap" ,"IconWindow" ,"IconX" ,"IconY" ,"IconMask" ,"WindowGroup" ] wmCRMask :: [String] wmCRMask = ["X" ,"Y" ,"Width" ,"Height" ,"BorderWidth" ,"Sibling" ,"StackMode" ] -} wmPlacement :: [String] wmPlacement = ["Above" ,"Below" ,"TopIf" ,"BottomIf" ,"Opposite" ] bool :: [String] bool = ["False","True"] nwmOrientation :: [String] nwmOrientation = nwmEnum (Just "ORIENTATION") ["HORZ","VERT"] nwmOrigin :: [String] nwmOrigin = nwmEnum Nothing ["TOPLEFT","TOPRIGHT","BOTTOMRIGHT","BOTTOMLEFT"] wmState :: [String] wmState = ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"] nwAction :: [String] nwAction = ["Clear", "Set", "Toggle"] wmGravity :: [String] wmGravity = ["forget/unmap","NW","N","NE","W","C","E","SW","S","SE","static"] nwmEnum :: Maybe String -> [String] -> [String] nwmEnum Nothing vs = map ( "_NET_WM_" ++) vs nwmEnum (Just prefix) vs = map (("_NET_WM_" ++ prefix ++ "_") ++) vs -- and the lowest level coercions -- -- parse and return an integral value getInt' :: HasCallStack => Int -> Decoder (Maybe Integer) -- see XSync documentation for this insanity getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $ guardSize' 8 (propShortErr >> return Nothing) $ do lo <- inhale 32 hi <- inhale 32 return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1) getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $ guardSize' (bytes w) (propShortErr' 13 >> return Nothing) $ Just <$> inhale w -- parse an integral value and feed it to a show-er of some kind getInt :: Int -> (Integer -> String) -> Decoder Bool getInt w f = getInt' w >>= maybe (return False) (append . f) -- bottommost level: parse an integral value out of the stream. -- Not much in the way of error checking; it is assumed you used -- the appropriate guards. -- @@@@@@@@@ evil beyond evil. there *has* to be a better way inhale :: Int -> Decoder Integer inhale 8 = do [b] <- eat 1 return $ fromIntegral b inhale 16 = do [b0,b1] <- eat 2 io $ allocaArray 2 $ \p -> do pokeArray p [b0,b1] [v] <- peekArray 1 (castPtr p :: Ptr Word16) return $ fromIntegral v inhale 32 = do [b0,b1,b2,b3] <- eat 4 io $ allocaArray 4 $ \p -> do pokeArray p [b0,b1,b2,b3] [v] <- peekArray 1 (castPtr p :: Ptr Word32) return $ fromIntegral v inhale b = error $ "inhale " ++ show b eat :: Int -> Decoder Raw eat n = do (bs,rest) <- gets (splitAt n . value) modify (\r -> r {value = rest}) return bs -- actually do formatting type stuffs -- sorta stubbed for the moment -- eventually we should do indentation foo here append :: String -> Decoder Bool append = append' True -- and the same but for errors failure :: HasCallStack => String -> Decoder Bool failure = append' False . (++ prettyCallStack callStack) -- common appender append' :: Bool -> String -> Decoder Bool append' b s = do j <- gets joint modify (\r -> r {accum = accum r ++ j ++ s}) return b -- consume all and output a constant string propSimple :: String -> Decoder Bool propSimple s = modify (\r -> r {value = []}) >> append s -- report various errors propShortErr :: HasCallStack => Decoder Bool propShortErr = failure "(property ended prematurely)" -- debug version propShortErr' :: HasCallStack => Int -> Decoder Bool propShortErr' n = failure $ "(short prop " ++ show n ++ ")" propSizeErr :: Int -> Int -> Decoder Bool propSizeErr e a = failure $ "(bad bit width " ++ show a ++ "; expected " ++ show e ++ ")" propTypeErr :: Atom -> Atom -> Decoder Bool propTypeErr a e = do e' <- inX $ atomName e a' <- inX $ atomName a failure $ "(bad type " ++ a' ++"; expected " ++ e' ++ ")" -- for stubs (...) :: Decoder Bool (...) = do fmt <- asks pType >>= inX . atomName propSimple $ "(unimplemented type " ++ fmt ++ ")" -- you like fi, I like this twiddle :: (Enum a, Enum b) => a -> b twiddle = toEnum . fromEnum xmonad-contrib-0.18.0/XMonad/Hooks/DebugKeyEvents.hs0000644000000000000000000001010107346545000020377 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DebugKeyEvents -- Description : Track key events. -- Copyright : (c) 2011 Brandon S Allbery -- License : BSD -- -- Maintainer : Brandon S Allbery -- Stability : unstable -- Portability : unportable -- -- A debugging module to track key events, useful when you can't tell whether -- xmonad is processing some or all key events. ----------------------------------------------------------------------------- module XMonad.Hooks.DebugKeyEvents (-- * Usage -- $usage debugKeyEvents ) where import XMonad.Core import XMonad.Prelude import XMonad.Operations (cleanMask) import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Control.Monad.State (gets) import Data.Bits import Numeric (showHex) import System.IO (hPutStrLn ,stderr) -- $usage -- Add this to your handleEventHook to print received key events to the -- log (the console if you use @startx@/@xinit@, otherwise usually -- @~/.xsession-errors@). -- -- > , handleEventHook = debugKeyEvents -- -- If you already have a handleEventHook then you should append it: -- -- > , handleEventHook = ... <> debugKeyEvents -- -- Logged key events look like: -- -- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@ -- -- The @mask@ and @clean@ indicate the modifiers pressed along with -- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after -- sanitizing it (removing @numberLockMask@, etc.) -- -- For more detailed instructions on editing the logHook see -- . -- | Print key events to stderr for debugging debugKeyEvents :: Event -> X All 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 $ 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) -- | Convenient showHex variant hex :: (Integral n, Show n) => n -> String hex v = "0x" ++ showHex v "" -- | Convert a modifier mask into a useful string vmask :: KeyMask -> KeyMask -> String vmask numLockMask msk = unwords $ reverse $ fst $ foldr vmask' ([],msk) masks where masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++ [(numLockMask,"num" ) ,( lockMask,"lock" ) ,(controlMask,"ctrl" ) ,( shiftMask,"shift") ,( mod5Mask,"mod5" ) ,( mod4Mask,"mod4" ) ,( mod3Mask,"mod3" ) ,( mod2Mask,"mod2" ) ,( mod1Mask,"mod1" ) ] vmask' _ a@( _,0) = a vmask' (m,s) (ss,v) | v .&. m == m = (s:ss,v .&. complement m) vmask' _ r = r xmonad-contrib-0.18.0/XMonad/Hooks/DebugStack.hs0000644000000000000000000001035407346545000017541 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DebugStack -- Description : Dump the state of the StackSet. -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Dump the state of the 'StackSet'. A @logHook@ and @handleEventHook@ are -- also provided. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DebugStack (debugStack ,debugStackFull ,debugStackString ,debugStackFullString ,debugStackLogHook ,debugStackFullLogHook ,debugStackEventHook ,debugStackFullEventHook ) where import XMonad.Core import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Util.DebugWindow import Graphics.X11.Types (Window) import Graphics.X11.Xlib.Extras (Event) import Data.Map (member) -- | Print the state of the current window stack for the current workspace to -- @stderr@, which for most installations goes to @~/.xsession-errors@. -- "XMonad.Util.DebugWindow" is used to display the individual windows. debugStack :: X () debugStack = debugStackString >>= trace -- | Print the state of the current window stack for all workspaces to -- @stderr@, which for most installations goes to @~/.xsession-errors@. -- "XMonad.Util.DebugWindow" is used to display the individual windows. debugStackFull :: X () debugStackFull = debugStackFullString >>= trace -- | 'debugStack' packaged as a 'logHook'. (Currently this is identical.) debugStackLogHook :: X () debugStackLogHook = debugStack -- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.) debugStackFullLogHook :: X () debugStackFullLogHook = debugStackFull -- | 'debugStack' packaged as a 'handleEventHook'. You almost certainly do not -- want to use this unconditionally, as it will cause massive amounts of -- output and possibly slow @xmonad@ down severely. debugStackEventHook :: Event -> X All debugStackEventHook _ = debugStack >> return (All True) -- | 'debugStackFull' packaged as a 'handleEventHook'. You almost certainly do -- not want to use this unconditionally, as it will cause massive amounts of -- output and possibly slow @xmonad@ down severely. debugStackFullEventHook :: Event -> X All debugStackFullEventHook _ = debugStackFull >> return (All True) -- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'. debugStackString :: X String debugStackString = withWindowSet $ debugStackWs . W.workspace . W.current -- | Dump the state of all workspaces in the 'StackSet' as a multiline 'String'. -- @@@ this is in stackset order, which is roughly lru-ish debugStackFullString :: X String debugStackFullString = withWindowSet $ fmap (intercalate "\n") . mapM debugStackWs . W.workspaces -- | Dump the state of a workspace in the current 'StackSet' as a multiline 'String'. -- @ -- Workspace "foo:: -- mm -- * ww -- ^ww -- @ -- * indicates the focused window, ^ indicates a floating window debugStackWs :: W.Workspace String (Layout Window) Window -> X String debugStackWs w = withWindowSet $ \ws -> do let cur = if wt == W.currentTag ws then " (current)" else "" wt = W.tag w s <- emit ws $ W.integrate' . W.stack $ w return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s where emit :: WindowSet -> [Window] -> X [String] emit _ [] = return [" -empty workspace-"] emit ww ws = do (_,ss) <- foldM emit' (ww,[]) ws return ss emit' :: (WindowSet,[String]) -> Window -> X (WindowSet,[String]) emit' (ws,a) w' = do let focus = if Just w' == W.peek ws then '*' else ' ' float = if w' `member` W.floating ws then '^' else ' ' s <- debugWindow w' return (ws,(focus:float:s):a) xmonad-contrib-0.18.0/XMonad/Hooks/DynamicBars.hs0000644000000000000000000001534307346545000017724 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicBars -- Description : Manage per-screen status bars. -- Copyright : (c) Ben Boeckel 2012 -- License : BSD-style (as xmonad) -- -- Maintainer : mathstuf@gmail.com -- Stability : unstable -- Portability : unportable -- -- Manage per-screen status bars. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicBars {-# DEPRECATED "Use XMonad.Hooks.StatusBar instead" #-} ( -- * Usage -- $usage DynamicStatusBar , DynamicStatusBarCleanup , DynamicStatusBarPartialCleanup , dynStatusBarStartup , dynStatusBarStartup' , dynStatusBarEventHook , dynStatusBarEventHook' , multiPP , multiPPFormat ) where import Prelude import Control.Monad.Trans (lift) import Control.Monad.Writer (WriterT, execWriterT, tell) import Graphics.X11.Xinerama import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Graphics.X11.Xrandr 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 -- $usage -- Provides a few helper functions to manage per-screen status bars while -- dynamically responding to screen changes. A startup action, event hook, and -- a way to separate PP styles based on the screen's focus are provided: -- -- * The 'dynStatusBarStartup' hook which initializes the status bars. The -- first argument is an `ScreenId -> IO Handle` which spawns a status bar on the -- given screen and returns the pipe which the string should be written to. -- The second argument is a `IO ()` to shut down all status bars. This should -- be placed in your `startupHook`. -- -- * The 'dynStatusBarEventHook' hook which respawns status bars when the -- number of screens changes. The arguments are the same as for the -- `dynStatusBarStartup` function. This should be placed in your -- `handleEventHook`. -- -- * Each of the above functions have an alternate form -- (`dynStatusBarStartup'` and `dynStatusBarEventHook'`) which use a cleanup -- function which takes an additional `ScreenId` argument which allows for -- more fine-grained control for shutting down a specific screen's status bar. -- -- * The 'multiPP' function which allows for different output based on whether -- the screen for the status bar has focus (the first argument) or not (the -- second argument). This is for use in your `logHook`. -- -- * The 'multiPPFormat' function is the same as the 'multiPP' function, but it -- also takes in a function that can customize the output to status bars. -- -- The hooks take a 'DynamicStatusBar' function which is given the id of the -- screen to start up and returns the 'Handle' to the pipe to write to. The -- 'DynamicStatusBarCleanup' argument should tear down previous instances. It -- is called when the number of screens changes and on startup. -- newtype DynStatusBarInfo = DynStatusBarInfo { dsbInfo :: [(ScreenId, Handle)] } instance ExtensionClass DynStatusBarInfo where initialValue = DynStatusBarInfo [] type DynamicStatusBar = ScreenId -> IO Handle type DynamicStatusBarCleanup = IO () type DynamicStatusBarPartialCleanup = ScreenId -> IO () dynStatusBarSetup :: X () dynStatusBarSetup = do dpy <- asks display root <- asks theRoot io $ xrrSelectInput dpy root rrScreenChangeNotifyMask dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X () dynStatusBarStartup sb cleanup = do dynStatusBarSetup updateStatusBars sb cleanup dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X () dynStatusBarStartup' sb cleanup = do dynStatusBarSetup updateStatusBars' sb cleanup dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All dynStatusBarEventHook sb cleanup = dynStatusBarRun (updateStatusBars sb cleanup) dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> Event -> X All dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup) dynStatusBarRun :: X () -> Event -> X All dynStatusBarRun action RRScreenChangeNotifyEvent{} = action >> return (All True) dynStatusBarRun _ _ = return (All True) updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X () updateStatusBars sb cleanup = do (dsbInfoScreens, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo screens <- getScreens when (screens /= dsbInfoScreens) $ do newHandles <- liftIO $ do hClose `mapM_` dsbInfoHandles cleanup mapM sb screens XS.put $ DynStatusBarInfo (zip screens newHandles) updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X () updateStatusBars' sb cleanup = do (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 . snd) infoToClose mapM_ (cleanup . fst) infoToClose let newScreens = screens \\ dsbInfoScreens newHandles <- mapM sb newScreens return $ zip newScreens newHandles XS.put . DynStatusBarInfo $ infoToKeep ++ newInfo ----------------------------------------------------------------------------- -- The following code is from adamvo's xmonad.hs file. -- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs multiPP :: PP -- ^ The PP to use if the screen is focused -> PP -- ^ The PP to use otherwise -> X () multiPP = multiPPFormat dynamicLogString multiPPFormat :: (PP -> X String) -> PP -> PP -> X () multiPPFormat dynlStr focusPP unfocusPP = do (_, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo multiPP' dynlStr focusPP unfocusPP dsbInfoHandles multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X () multiPP' dynlStr focusPP unfocusPP handles = do st <- get let pickPP :: WorkspaceId -> WriterT (Last XState) X String pickPP ws = do let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st put st{ windowset = W.view ws $ windowset st } out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP when isFoc $ get >>= tell . Last . Just return out traverse_ put . getLast =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes =<< mapM screenWorkspace (zipWith const [0 .. ] handles) getScreens :: MonadIO m => m [ScreenId] getScreens = liftIO $ do screens <- do dpy <- openDisplay "" rects <- getScreenInfo dpy closeDisplay dpy return rects let ids = zip [0 .. ] screens return $ map fst ids xmonad-contrib-0.18.0/XMonad/Hooks/DynamicHooks.hs0000644000000000000000000000617207346545000020120 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : Braden.Shepherdson@gmail.com -- Stability : unstable -- Portability : unportable -- -- One-shot and permanent ManageHooks that can be updated at runtime. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicHooks ( -- * Usage -- $usage dynamicMasterHook ,addDynamicHook ,updateDynamicHook ,oneShotHook ) where import XMonad import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS -- $usage -- Provides two new kinds of 'ManageHooks' that can be defined at runtime. -- -- * One-shot 'ManageHooks' that are deleted after they execute. -- -- * Permanent 'ManageHooks' (unless you want to destroy them) -- -- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@! -- If you want them to last, you should create them as normal in your @xmonad.hs@. -- -- To use this module, add 'dynamicMasterHook' to your 'manageHook': -- -- > xmonad { manageHook = myManageHook <> dynamicMasterHook } -- -- You can then use the supplied functions in your keybindings: -- -- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat) -- data DynamicHooks = DynamicHooks { transients :: [(Query Bool, ManageHook)] , permanent :: ManageHook } instance ExtensionClass DynamicHooks where initialValue = DynamicHooks [] idHook -- this hook is always executed, and the contents of the stored hooks checked. -- note that transient hooks are run second, therefore taking precedence -- over permanent ones on matters such as which workspace to shift to. -- doFloat and doIgnore are idempotent. -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'. dynamicMasterHook :: ManageHook 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) = 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) -- | Modifies the permanent 'ManageHook' with an arbitrary function. updateDynamicHook :: (ManageHook -> ManageHook) -> X () updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) } -- | Creates a one-shot 'ManageHook'. Note that you have to specify the two -- parts of the 'ManageHook' separately. Where you would usually write: -- -- > className =? "example" --> doFloat -- -- you must call 'oneShotHook' as -- -- > oneShotHook dynHooksRef (className =? "example) doFloat -- oneShotHook :: Query Bool -> ManageHook -> X () oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):transients dh } xmonad-contrib-0.18.0/XMonad/Hooks/DynamicIcons.hs0000644000000000000000000001576307346545000020116 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicIcons -- Description : Dynamically update workspace names based on its contents\/windows on it. -- Copyright : (c) Will Pierlot -- License : BSD3-style (see LICENSE) -- -- Maintainer : Will Pierlot -- 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 -- -- <> -- -- 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-contrib-0.18.0/XMonad/Hooks/DynamicLog.hs0000644000000000000000000002200307346545000017545 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicLog -- Description : Send information about xmonad's state to an X11 property or standard output. -- Copyright : (c) Don Stewart -- License : BSD3-style (see LICENSE) -- -- Maintainer : Don Stewart -- 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 -- provides several drop-in logHooks for this purpose, as well as -- flexible tools for specifying your own formatting. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicLog ( -- * Usage -- $usage -- * Drop-in loggers xmobarProp, xmobar, statusBar, dzen, dzenWithFlags, dynamicLog, dynamicLogXinerama, xmonadPropLog, xmonadPropLog', xmonadDefProp, -- * Build your own formatter dynamicLogWithPP, dynamicLogString, PP(..), def, -- * Example formatters dzenPP, xmobarPP, sjanssenPP, byorgeyPP, -- * Formatting utilities wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft', xmobarColor, xmobarAction, xmobarBorder, xmobarRaw, xmobarStrip, xmobarStripTags, dzenColor, dzenEscape, dzenStrip, filterOutWsPP, -- * Internal formatting functions pprWindowSet, pprWindowSetXinerama, ) where -- Useful imports import XMonad import XMonad.Layout.LayoutModifier 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.hs@: -- -- > 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: -- -- > main = xmonad =<< xmobar myConfig -- > -- > myConfig = def { ... } -- -- There is also 'statusBar' if you'd like to use another status bar, or would -- like to use different formatting options. The 'xmobar', 'dzen', and -- 'statusBar' functions are preferred over the other options listed below, as -- they take care of all the necessary plumbing -- no shell scripting required! -- -- Alternatively, you can choose among several default status bar formats -- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the -- appropriate function, for instance: -- -- > main = xmonad $ def { -- > ... -- > logHook = dynamicLog -- > ... -- > } -- -- For more flexibility, you can also use 'dynamicLogWithPP' and supply -- your own pretty-printing format (by either defining one from scratch, -- or customizing one of the provided examples). -- For example: -- -- > -- use sjanssen's pretty-printer format, but with the sections -- > -- in reverse -- > logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse } -- -- Note that setting the @logHook@ only sets up xmonad's output; you -- are responsible for starting your own status bar program (e.g. dzen -- or xmobar) and making sure xmonad's output is piped into it -- appropriately, either by putting it in your @.xsession@ or similar -- file, or by using @spawnPipe@ in your @main@ function, for example: -- -- > import XMonad.Util.Run -- for spawnPipe and hPutStrLn -- > -- > main = do -- > h <- spawnPipe "xmobar -options -foo -bar" -- > xmonad $ def { -- > ... -- > logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h } -- -- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of -- your pretty-printer as in the example above; by default the status -- will be printed to stdout rather than the pipe you create. -- -- Even if you don't use a statusbar, 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)) -- ------------------------------------------------------------------------ -- | Run xmonad with a dzen status bar with specified dzen -- command line arguments. -- -- > main = xmonad =<< dzenWithFlags flags myConfig -- > -- > myConfig = def { ... } -- > -- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d" -- -- This function 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 -- ^ 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. -- -- > main = xmonad =<< dzen myConfig -- > -- > myConfig = def { ... } -- -- This works pretty much the same as the 'xmobar' function. -- dzen :: LayoutClass l Window => 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' -dock -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg -- | This function works like 'xmobarProp', but uses pipes instead of -- property-based logging. xmobar :: LayoutClass l Window => XConfig l -- ^ The base config -> IO (XConfig (ModifiedLayout AvoidStruts l)) xmobar = statusBar "xmobar" xmobarPP toggleStrutsKey -- | 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 -> (XConfig Layout -> (KeyMask, KeySym)) -- ^ The desired key binding to toggle bar visibility -> XConfig l -- ^ The base config -> IO (XConfig (ModifiedLayout AvoidStruts l)) 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 = defToggleStrutsKey -- | An example log hook, which prints status information to stdout in -- the default format: -- -- > 1 2 [3] 4 7 : full : title -- -- That is, the currently populated workspaces, the current -- workspace layout, and the title of the focused window. -- -- To customize the output format, see 'dynamicLogWithPP'. -- dynamicLog :: X () dynamicLog = dynamicLogWithPP def -- | -- Workspace logger with a format designed for Xinerama: -- -- > [1 9 3] 2 7 -- -- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively, -- and 2 and 7 are non-visible, non-empty workspaces. -- -- At the present time, the current layout and window title -- are not shown. The xinerama workspace format shown above can be (mostly) replicated -- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from -- "XMonad.Util.WorkspaceCompare". For example, -- -- > def { ppCurrent = dzenColor "red" "#efebe7" -- > , ppVisible = wrap "[" "]" -- > , ppSort = getSortByXineramaRule -- > } dynamicLogXinerama :: X () dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama -- | 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-contrib-0.18.0/XMonad/Hooks/DynamicProperty.hs0000644000000000000000000000163707346545000020662 0ustar0000000000000000-- | -- Module : XMonad.Hooks.DynamicProperty -- Description : Apply a ManageHook to an already-mapped window. -- Copyright : (c) Brandon S Allbery, 2015 -- License : BSD3-style (see LICENSE) -- Maintainer : allbery.b@gmail.com -- module XMonad.Hooks.DynamicProperty {-# DEPRECATED "Use \"XMonad.Hooks.OnPropertyChange\" instead." #-} ( module XMonad.Hooks.OnPropertyChange , dynamicPropertyChange , dynamicTitle ) where import XMonad import XMonad.Hooks.OnPropertyChange import XMonad.Prelude -- | 'dynamicPropertyChange' = 'onXPropertyChange' dynamicPropertyChange :: String -> ManageHook -> Event -> X All dynamicPropertyChange = onXPropertyChange -- | 'dynamicTitle' = 'onTitleChange' dynamicTitle :: ManageHook -> Event -> X All dynamicTitle = onTitleChange xmonad-contrib-0.18.0/XMonad/Hooks/EwmhDesktops.hs0000644000000000000000000006424507346545000020152 0ustar0000000000000000{-# 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 -- License : BSD -- -- Maintainer : Joachim Breitner -- Stability : unstable -- Portability : unportable -- -- Makes xmonad use the -- -- hints to tell panel applications about its workspaces and the windows -- therein. It also allows the user to interact with xmonad by clicking on -- panels and window lists. ----------------------------------------------------------------------------- module XMonad.Hooks.EwmhDesktops ( -- * Usage -- $usage ewmh, ewmhFullscreen, ewmhDesktopsManageHook, ewmhDesktopsMaybeManageHook, -- * Customization -- $customization -- ** Sorting/filtering of workspaces -- $customSort addEwmhWorkspaceSort, setEwmhWorkspaceSort, -- ** Renaming of workspaces -- $customRename addEwmhWorkspaceRename, setEwmhWorkspaceRename, -- ** Window activation -- $customActivate setEwmhActivateHook, -- ** Fullscreen -- $customFullscreen setEwmhFullscreenHooks, -- ** @_NET_DESKTOP_VIEWPORT@ -- $customManageDesktopViewport disableEwmhManageDesktopViewport, -- * Standalone hooks (deprecated) ewmhDesktopsStartup, ewmhDesktopsLogHook, ewmhDesktopsLogHookCustom, ewmhDesktopsEventHook, ewmhDesktopsEventHookCustom, fullscreenEventHook, fullscreenStartup, ) where import Codec.Binary.UTF8.String (encode) import Data.Bits import qualified Data.Map.Strict as M import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers import XMonad.Hooks.SetWMName 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.hs@: -- -- > import XMonad -- > import XMonad.Hooks.EwmhDesktops -- > -- > main = xmonad $ … . ewmhFullscreen . ewmh . … $ def{…} -- -- 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 -- . -- | 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 = ewmhDesktopsStartup <> startupHook c , handleEventHook = ewmhDesktopsEventHook <> handleEventHook c , logHook = ewmhDesktopsLogHook <> logHook c } -- $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 , fullscreenHooks :: (ManageHook, ManageHook) -- ^ configurable handling of fullscreen state requests , manageDesktopViewport :: Bool -- ^ manage @_NET_DESKTOP_VIEWPORT@? } instance Default EwmhDesktopsConfig where def = EwmhDesktopsConfig { workspaceSort = getSortByIndex , workspaceRename = pure pure , activateHook = doFocus , fullscreenHooks = (doFullFloat, doSink) , manageDesktopViewport = True } -- $customSort -- The list of workspaces exposed to EWMH pagers (like -- and -- ) and clients (such as -- and -- ) 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. -- ) 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'. -- -- 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 } -- $customFullscreen -- When a client sends a @_NET_WM_STATE@ request to add\/remove\/toggle the -- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to -- make the window fullscreen and revert its state. The default hooks are -- stateless: windows are fullscreened by turning them into fullscreen floats, -- and reverted by sinking them into the tiling layer. This behaviour can be -- configured by supplying a pair of 'ManageHook's to 'setEwmhFullscreenHooks'. -- -- See "XMonad.Actions.ToggleFullFloat" for a pair of hooks that store the -- original state of floating windows. -- | Set (replace) the hooks invoked when clients ask to add/remove the -- $_NET_WM_STATE_FULLSCREEN@ state. The defaults are 'doFullFloat' and -- 'doSink'. setEwmhFullscreenHooks :: ManageHook -> ManageHook -> XConfig l -> XConfig l setEwmhFullscreenHooks f uf = XC.modifyDef $ \c -> c{ fullscreenHooks = (f, uf) } -- $customManageDesktopViewport -- Setting @_NET_DESKTOP_VIEWPORT@ is typically desired but can lead to a -- confusing workspace list in polybar, where this information is used to -- re-group the workspaces by monitor. See -- . -- -- To avoid this, you can use: -- -- > main = xmonad $ … . disableEwmhManageDesktopViewport . ewmh . … $ def{…} -- -- Note that if you apply this configuration in an already running environment, -- the property may remain at its previous value. It can be removed by running: -- -- > xprop -root -remove _NET_DESKTOP_VIEWPORT -- -- Which should immediately fix your bar. -- disableEwmhManageDesktopViewport :: XConfig l -> XConfig l disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False } -- | 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. {-# DEPRECATED ewmhDesktopsLogHook "Use ewmh instead." #-} ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = XC.withDef ewmhDesktopsLogHook' -- | Generalized version of ewmhDesktopsLogHook that allows an arbitrary -- user-specified function to sort/filter the workspace list (post-sorting). {-# DEPRECATED ewmhDesktopsLogHookCustom "Use ewmh and addEwmhWorkspaceSort instead." #-} ewmhDesktopsLogHookCustom :: WorkspaceSort -> X () ewmhDesktopsLogHookCustom f = ewmhDesktopsLogHook' def{ workspaceSort = (f .) <$> workspaceSort def } -- | 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' -- | 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 @_NET_DESKTOP_NAMES@, @_NET_NUMBER_OF_DESKTOPS@ newtype DesktopNames = DesktopNames [String] deriving Eq instance ExtensionClass DesktopNames where initialValue = DesktopNames [] -- | Cached @_NET_CLIENT_LIST@ newtype ClientList = ClientList [Window] deriving Eq instance ExtensionClass ClientList where initialValue = ClientList [none] -- | Cached @_NET_CLIENT_LIST_STACKING@ newtype ClientListStacking = ClientListStacking [Window] deriving Eq instance ExtensionClass ClientListStacking where initialValue = ClientListStacking [none] -- | Cached @_NET_CURRENT_DESKTOP@ newtype CurrentDesktop = CurrentDesktop Int deriving Eq instance ExtensionClass CurrentDesktop where initialValue = CurrentDesktop (complement 0) -- | Cached @_NET_WM_DESKTOP@ newtype WindowDesktops = WindowDesktops (M.Map Window Int) deriving Eq instance ExtensionClass WindowDesktops where initialValue = WindowDesktops (M.singleton none (complement 0)) -- | Cached @_NET_ACTIVE_WINDOW@ newtype ActiveWindow = ActiveWindow Window deriving Eq instance ExtensionClass ActiveWindow where initialValue = ActiveWindow (complement none) -- | Cached @_NET_DESKTOP_VIEWPORT@ newtype MonitorTags = MonitorTags [WorkspaceId] deriving (Show,Eq) instance ExtensionClass MonitorTags where initialValue = MonitorTags [] -- | Compare the given value against the value in the extensible state. Run the -- action if it has changed. whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X () whenChanged = whenX . XS.modified . const ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X () ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport} = withWindowSet $ \s -> do sort' <- workspaceSort let ws = sort' $ W.workspaces s -- Set number of workspaces and names thereof rename <- workspaceRename let desktopNames = [ rename (W.tag w) w | w <- ws ] whenChanged (DesktopNames desktopNames) $ do setNumberOfDesktops (length desktopNames) setDesktopNames desktopNames -- Set client list which should be sorted by window age. We just -- guess that StackSet contains windows list in this order which -- isn't true but at least gives consistency with windows cycling let clientList = nub . concatMap (W.integrate' . W.stack) $ ws whenChanged (ClientList clientList) $ setClientList clientList -- @ws@ is sorted in the "workspace order", which, by default, is -- the lexicographical sorting on @WorkspaceId@. -- @_NET_CLIENT_LIST_STACKING@ is expected to be in the "bottom-to-top -- stacking order". It is unclear what that would mean for windows on -- invisible workspaces, but it seems reasonable to assume that windows on -- the current workspace should be "at the top". With the focused window to -- be the top most, meaning the last. -- -- There has been a number of discussions on the order of windows within a -- workspace. See: -- -- https://github.com/xmonad/xmonad-contrib/issues/567 -- https://github.com/xmonad/xmonad-contrib/pull/568 -- https://github.com/xmonad/xmonad-contrib/pull/772 let clientListStacking = let wsInFocusOrder = W.hidden s ++ (map W.workspace . W.visible) s ++ [W.workspace $ W.current s] stackWindows (W.Stack cur up down) = reverse up ++ down ++ [cur] workspaceWindows = maybe [] stackWindows . W.stack -- In case a window is a member of multiple workspaces, we keep -- only the last occurrence in the list. One that is closer to -- the top in the focus order. uniqueKeepLast = reverse . nub . reverse in uniqueKeepLast $ concatMap workspaceWindows wsInFocusOrder whenChanged (ClientListStacking clientListStacking) $ setClientListStacking clientListStacking -- Set current desktop number let current = W.currentTag s `elemIndex` map W.tag ws whenChanged (CurrentDesktop $ fromMaybe 0 current) $ mapM_ setCurrentDesktop current -- Set window-desktop mapping let windowDesktops = let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ] in M.unions $ zipWith f [0..] ws whenChanged (WindowDesktops windowDesktops) $ mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops) -- Set active window let activeWindow' = fromMaybe none (W.peek s) whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' -- Set desktop Viewport when manageDesktopViewport $ do let visibleScreens = W.current s : W.visible s currentTags = map (W.tag . W.workspace) visibleScreens whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws) -- | Create the viewports from the current 'WindowSet' and a list of -- already sorted workspace IDs. mkViewPorts :: WindowSet -> [WorkspaceId] -> X () mkViewPorts winset = setDesktopViewport . concat . mapMaybe (viewPorts M.!?) where foc = W.current winset -- Hidden workspaces are mapped to the current screen's viewport. viewPorts :: M.Map WorkspaceId [Position] viewPorts = M.fromList $ map mkVisibleViewPort (foc : W.visible winset) ++ map (mkViewPort foc) (W.hidden winset) mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position]) mkViewPort scr w = (W.tag w, mkPos scr) mkVisibleViewPort :: WindowScreen -> (WorkspaceId, [Position]) mkVisibleViewPort x = mkViewPort x (W.workspace x) mkPos :: WindowScreen -> [Position] mkPos scr = [rect_x (rect scr), rect_y (rect scr)] where rect = screenRect . W.screenDetail ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All ewmhDesktopsEventHook' 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 a_cd <- getAtom "_NET_CURRENT_DESKTOP" a_d <- getAtom "_NET_WM_DESKTOP" a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cw <- getAtom "_NET_CLOSE_WINDOW" if | mt == a_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 mempty ewmhDesktopsEventHook' _ _ = mempty -- | A 'ManageHook' that shifts windows to the workspace they want to be in. -- Useful for restoring browser windows to where they were before restart. -- -- To only use this for browsers (which might be a good idea, as many apps try -- to restore their window to their original position, but it's rarely -- desirable outside of security updates of multi-window apps like a browser), -- use this: -- -- > stringProperty "WM_WINDOW_ROLE" =? "browser" --> ewmhDesktopsManageHook ewmhDesktopsManageHook :: ManageHook ewmhDesktopsManageHook = maybeToDefinite ewmhDesktopsMaybeManageHook -- | 'ewmhDesktopsManageHook' as a 'MaybeManageHook' for use with -- 'composeOne'. Returns 'Nothing' if the window didn't indicate any desktop -- preference, otherwise 'Just' (even if the preferred desktop was out of -- bounds). ewmhDesktopsMaybeManageHook :: MaybeManageHook ewmhDesktopsMaybeManageHook = desktop >>= traverse doShiftI where doShiftI :: Int -> ManageHook doShiftI d = do sort' <- liftX . XC.withDef $ \EwmhDesktopsConfig{workspaceSort} -> workspaceSort ws <- liftX . gets $ map W.tag . sort' . W.workspaces . windowset maybe idHook doShift $ ws !? d -- | Add EWMH fullscreen functionality to the given config. ewmhFullscreen :: XConfig a -> XConfig a ewmhFullscreen c = c { startupHook = startupHook c <> fullscreenStartup , handleEventHook = handleEventHook c <> fullscreenEventHook } -- | Advertises EWMH fullscreen support to the X server. {-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-} fullscreenStartup :: X () fullscreenStartup = setFullscreenSupported -- | An event hook to handle applications that wish to fullscreen using the -- @_NET_WM_STATE@ protocol. This includes users of the @gtk_window_fullscreen()@ -- function, such as Totem, Evince and OpenOffice.org. -- -- Note this is not included in 'ewmh'. {-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-} fullscreenEventHook :: Event -> X All fullscreenEventHook = XC.withDef . fullscreenEventHook' fullscreenEventHook' :: Event -> EwmhDesktopsConfig -> X All fullscreenEventHook' ClientMessageEvent{ev_event_display = dpy, ev_window = win, ev_message_type = typ, ev_data = action:dats} EwmhDesktopsConfig{fullscreenHooks = (fullscreenHook, unFullscreenHook)} = do managed <- isClient win wmstate <- getAtom "_NET_WM_STATE" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" wstate <- fromMaybe [] <$> getProp32 wmstate win let isFull = fromIntegral fullsc `elem` wstate -- Constants for the _NET_WM_STATE protocol: remove = 0 add = 1 toggle = 2 chWstate f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate) when (managed && typ == wmstate && fi fullsc `elem` dats) $ do when (not isFull && (action == add || action == toggle)) $ do chWstate (fi fullsc:) windows . appEndo =<< runQuery fullscreenHook win when (isFull && (action == remove || action == toggle)) $ do chWstate $ delete (fi fullsc) windows . appEndo =<< runQuery unFullscreenHook win return $ All True fullscreenEventHook' _ _ = return $ All True setNumberOfDesktops :: (Integral a) => a -> X () setNumberOfDesktops n = withDisplay $ \dpy -> do a <- getAtom "_NET_NUMBER_OF_DESKTOPS" r <- asks theRoot io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral n] setCurrentDesktop :: (Integral a) => a -> X () setCurrentDesktop i = withDisplay $ \dpy -> do a <- getAtom "_NET_CURRENT_DESKTOP" r <- asks theRoot io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral i] setDesktopNames :: [String] -> X () setDesktopNames names = withDisplay $ \dpy -> do -- Names thereof r <- asks theRoot a <- getAtom "_NET_DESKTOP_NAMES" c <- getAtom "UTF8_STRING" let names' = map fromIntegral $ concatMap ((++[0]) . encode) names io $ changeProperty8 dpy r a c propModeReplace names' setClientList :: [Window] -> X () setClientList wins = withDisplay $ \dpy -> do r <- asks theRoot a <- getAtom "_NET_CLIENT_LIST" 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" io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral i] setActiveWindow :: Window -> X () setActiveWindow w = withDisplay $ \dpy -> do r <- asks theRoot a <- getAtom "_NET_ACTIVE_WINDOW" io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w] setDesktopViewport :: [Position] -> X () setDesktopViewport positions = withDisplay $ \dpy -> do r <- asks theRoot a <- io $ internAtom dpy "_NET_DESKTOP_VIEWPORT" True io $ changeProperty32 dpy r a cARDINAL propModeReplace (map fi positions) setSupported :: X () setSupported = withDisplay $ \dpy -> do r <- asks theRoot a <- getAtom "_NET_SUPPORTED" supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN" ,"_NET_WM_STATE_DEMANDS_ATTENTION" ,"_NET_NUMBER_OF_DESKTOPS" ,"_NET_CLIENT_LIST" ,"_NET_CLIENT_LIST_STACKING" ,"_NET_CURRENT_DESKTOP" ,"_NET_DESKTOP_NAMES" ,"_NET_ACTIVE_WINDOW" ,"_NET_WM_DESKTOP" ,"_NET_WM_STRUT" ,"_NET_WM_STRUT_PARTIAL" ,"_NET_DESKTOP_VIEWPORT" ] io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp) setWMName "xmonad" -- TODO: use in SetWMName, UrgencyHook addSupported :: [String] -> X () addSupported props = withDisplay $ \dpy -> do r <- asks theRoot 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-contrib-0.18.0/XMonad/Hooks/FadeInactive.hs0000644000000000000000000001031607346545000020045 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FadeInactive -- Description : Set the _NET_WM_WINDOW_OPACITY atom for inactive windows. -- Copyright : (c) 2008 Justin Bogner -- License : BSD -- -- Maintainer : Justin Bogner -- Stability : unstable -- Portability : unportable -- -- 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 ----------------------------------------------------------------------------- module XMonad.Hooks.FadeInactive ( -- * Usage -- $usage setOpacity, isUnfocused, isUnfocusedOnCurrentWS, fadeIn, fadeOut, fadeIf, fadeInactiveLogHook, fadeInactiveCurrentWSLogHook, fadeOutLogHook ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.FadeInactive -- > -- > myLogHook :: X () -- > myLogHook = fadeInactiveLogHook fadeAmount -- > where fadeAmount = 0.8 -- > -- > main = xmonad def { logHook = myLogHook } -- -- fadeAmount can be any rational between 0 and 1. -- you will need to have xcompmgr -- or something similar for this to do anything -- -- For more detailed instructions on editing the logHook see -- . -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY rationalToOpacity :: Integral a => Rational -> a rationalToOpacity perc | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability | otherwise = round $ perc * 0xffffffff -- | Sets the opacity of a window setOpacity :: Window -> Rational -> X () setOpacity w t = withDisplay $ \dpy -> do a <- getAtom "_NET_WM_WINDOW_OPACITY" io $ changeProperty32 dpy w a cARDINAL propModeReplace [rationalToOpacity t] -- | Fades a window out by setting the opacity fadeOut :: Rational -> Window -> X () fadeOut = flip setOpacity -- | Makes a window completely opaque fadeIn :: Window -> X () fadeIn = fadeOut 1 -- | Fades a window by the specified amount if it satisfies the first query, otherwise -- makes it opaque. fadeIf :: Query Bool -> Rational -> Query Rational fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1 -- | Sets the opacity of inactive windows to the specified amount fadeInactiveLogHook :: Rational -> X () fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused -- | Set the opacity of inactive windows, on the current workspace, to the -- specified amount. This is specifically usefull in a multi monitor setup. See -- 'isUnfocusedOnCurrentWS'. fadeInactiveCurrentWSLogHook :: Rational -> X () fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS -- | Returns True if the window doesn't have the focus. isUnfocused :: Query Bool 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 -- (xinerama) where multiple workspaces are visible. Using this, non-focused -- workspaces are are not faded out making it easier to look and read the -- content on them. isUnfocusedOnCurrentWS :: Query Bool isUnfocusedOnCurrentWS = do w <- ask ws <- liftX $ gets windowset let thisWS = w `elem` W.index ws unfocused = Just w /= W.peek ws return $ thisWS && unfocused -- | Fades out every window by the amount returned by the query. fadeOutLogHook :: Query Rational -> X () fadeOutLogHook qry = withWindowSet $ \s -> do let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++ concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) forM_ visibleWins $ liftA2 (=<<) setOpacity (runQuery qry) xmonad-contrib-0.18.0/XMonad/Hooks/FadeWindows.hs0000644000000000000000000002203507346545000017736 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FadeWindows -- Description : A more flexible and general compositing interface than FadeInactive. -- Copyright : Brandon S Allbery KF8NH -- License : BSD -- -- Maintainer : Brandon S Allbery KF8NH -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Hooks.FadeWindows (-- * Usage -- $usage -- * The 'logHook' for window fading fadeWindowsLogHook -- * The 'FadeHook' ,FadeHook ,Opacity ,idFadeHook -- * Predefined 'FadeHook's ,opaque ,solid ,transparent ,invisible ,transparency ,translucence ,fadeBy ,opacity ,fadeTo -- * 'handleEventHook' for mapped/unmapped windows ,fadeWindowsEventHook -- * 'doF' for simple hooks ,doS -- * Useful 'Query's for 'FadeHook's ,isFloating ,isUnfocused ) where import XMonad.Core import XMonad.Prelude import XMonad.ManageHook (liftX) import qualified XMonad.StackSet as W import XMonad.Hooks.FadeInactive (setOpacity ,isUnfocused ) import Control.Monad.Reader (ask ,asks) import Control.Monad.State (gets) import qualified Data.Map as M import Graphics.X11.Xlib.Extras (Event(..)) -- $usage -- To use this module, make sure your @xmonad@ core supports generalized -- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then -- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your -- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook': -- -- > , logHook = fadeWindowsLogHook myFadeHook -- > , handleEventHook = fadeWindowsEventHook -- > {- ... -} -- > -- > myFadeHook = composeAll [ opaque -- > , isUnfocused --> transparency 0.2 -- > ] -- -- The above is like FadeInactive with a fade value of 0.2. -- -- '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.ManageHelpers", which -- exports a number of Queries that can be used in either @ManageHook@ -- or @FadeHook@. -- -- Note that you need a compositing manager such as @xcompmgr@, -- @dcompmgr@, or @cairo-compmgr@ for window fading to work. If you -- aren't running a compositing manager, the opacity will be recorded -- but won't take effect until a compositing manager is started. -- -- For more detailed instructions on editing the 'logHook' see -- . -- -- For more detailed instructions on editing the 'handleEventHook', -- see: -- -- "XMonad.Doc.Extending#Editing_the_event_hook" -- (which sadly doesnt exist at the time of writing...) -- -- /WARNING:/ This module is very good at triggering bugs in -- compositing managers. Symptoms range from windows not being -- repainted until the compositing manager is restarted or the -- window is unmapped and remapped, to the machine becoming sluggish -- until the compositing manager is restarted (at which point a -- popup/dialog will suddenly appear; apparently it's getting into -- a tight loop trying to fade the popup in). I find it useful to -- have a key binding to restart the compositing manager; for example, -- -- main = xmonad $ def { -- {- ... -} -- } -- `additionalKeysP` -- [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")] -- {- ... -} -- ] -- -- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.) -- a window opacity to be carried in a Query. OEmpty is sort of a hack -- to make it obay the monoid laws data Opacity = Opacity Rational | OEmpty instance Semigroup Opacity where r <> OEmpty = r _ <> r = r instance Monoid Opacity where mempty = OEmpty -- | A FadeHook is similar to a ManageHook, but records window opacity. type FadeHook = Query Opacity -- | Render a window fully opaque. opaque :: FadeHook opaque = doS (Opacity 1) -- | Render a window fully transparent. transparent :: FadeHook transparent = doS (Opacity 0) -- | Specify a window's transparency. transparency :: Rational -- ^ The window's transparency as a fraction. -- @transparency 1@ is the same as 'transparent', -- whereas @transparency 0@ is the same as 'opaque'. -> FadeHook transparency = doS . Opacity . (1-) . clampRatio -- | Specify a window's opacity; this is the inverse of 'transparency'. opacity :: Rational -- ^ The opacity of a window as a fraction. -- @opacity 1@ is the same as 'opaque', -- whereas @opacity 0@ is the same as 'transparent'. -> FadeHook opacity = doS . Opacity . clampRatio fadeTo, translucence, fadeBy :: Rational -> FadeHook -- | An alias for 'transparency'. fadeTo = transparency -- | An alias for 'transparency'. translucence = transparency -- | An alias for 'opacity'. fadeBy = opacity invisible, solid :: FadeHook -- | An alias for 'transparent'. invisible = transparent -- | An alias for 'opaque'. solid = opaque -- | Like 'doF', but usable with 'ManageHook'-like hooks that -- aren't 'Query' wrapped around transforming functions ('Endo'). doS :: Monoid m => m -> Query m doS = return -- | The identity 'FadeHook', which renders windows 'opaque'. idFadeHook :: FadeHook idFadeHook = opaque -- | A Query to determine if a window is floating. isFloating :: Query Bool isFloating = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset -- boring windows can't be seen outside of a layout, so we watch messages with -- a dummy LayoutModifier and stow them in a persistent bucket. this is not -- entirely reliable given that boringAuto still isn't observable; we just hope -- those aren't visible and won;t be affected anyway -- @@@ punted for now, will be a separate module. it's still slimy, though -- | A 'logHook' to fade windows under control of a 'FadeHook', which is -- similar to but not identical to 'ManageHook'. fadeWindowsLogHook :: FadeHook -> X () fadeWindowsLogHook h = 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 $ \w -> do o <- userCodeDef (Opacity 1) (runQuery h w) setOpacity w $ case o of OEmpty -> 1 Opacity r -> r -- | A 'handleEventHook' to handle fading and unfading of newly mapped -- or unmapped windows; this avoids problems with layouts such as -- 'XMonad.Layout.Full' or "XMonad.Layout.Tabbed". This hook may -- also be useful with "XMonad.Hooks.FadeInactive". fadeWindowsEventHook :: Event -> X All fadeWindowsEventHook MapNotifyEvent{} = -- we need to run the fadeWindowsLogHook. only one way... asks config >>= logHook >> return (All True) fadeWindowsEventHook _ = return (All True) -- A utility to clamp opacity fractions to the range (0,1) clampRatio :: Rational -> Rational clampRatio r | r >= 0 && r <= 1 = r | r < 0 = 0 | otherwise = 1 xmonad-contrib-0.18.0/XMonad/Hooks/FloatNext.hs0000644000000000000000000000757107346545000017440 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FloatNext -- Description : Automatically send the next spawned window(s) to the floating layer. -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Hook and keybindings for automatically sending the next -- spawned window(s) to the floating layer. -- ----------------------------------------------------------------------------- module XMonad.Hooks.FloatNext ( -- * Usage -- $usage -- * The hook floatNextHook -- * Actions , floatNext , toggleFloatNext , floatAllNew , toggleFloatAllNew -- * Queries , willFloatNext , willFloatAllNew -- * Status bar utilities -- $pp , willFloatNextPP , willFloatAllNewPP , runLogHook ) where import XMonad import XMonad.Hooks.ToggleHook hookName :: String hookName = "__float" -- $usage -- This module provides actions (that can be set as keybindings) -- to automatically send the next spawned window(s) to the floating -- layer. -- -- You can use it by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.FloatNext -- -- and adding 'floatNextHook' to your 'ManageHook': -- -- > myManageHook = floatNextHook <> manageHook def -- -- The 'floatNext' and 'toggleFloatNext' functions can be used in key -- bindings to float the next spawned window: -- -- > , ((modm, xK_e), toggleFloatNext) -- -- 'floatAllNew' and 'toggleFloatAllNew' are similar but float all -- spawned windows until disabled again. -- -- > , ((modm, xK_r), toggleFloatAllNew) -- | This 'ManageHook' will selectively float windows as set -- by 'floatNext' and 'floatAllNew'. floatNextHook :: ManageHook floatNextHook = toggleHook hookName doFloat -- | @floatNext True@ arranges for the next spawned window to be -- sent to the floating layer, @floatNext False@ cancels it. floatNext :: Bool -> X () floatNext = hookNext hookName toggleFloatNext :: X () toggleFloatNext = toggleHookNext hookName -- | @floatAllNew True@ arranges for new windows to be -- sent to the floating layer, @floatAllNew False@ cancels it floatAllNew :: Bool -> X () floatAllNew = hookAllNew hookName toggleFloatAllNew :: X () toggleFloatAllNew = toggleHookAllNew hookName -- | Whether the next window will be set floating willFloatNext :: X Bool willFloatNext = willHookNext hookName -- | Whether new windows will be set floating willFloatAllNew :: X Bool willFloatAllNew = willHookAllNew hookName -- $pp -- The following functions are used to display the current -- state of 'floatNext' and 'floatAllNew' in your -- "XMonad.Hooks.StatusBar.PP". -- 'willFloatNextPP' and 'willFloatAllNewPP' 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 'floatNext'/... will be visible -- immediately: -- -- > , ((modm, xK_e), toggleFloatNext >> runLogHook) -- -- The @String -> String@ parameters to 'willFloatNextPP' and -- 'willFloatAllNewPP' will be applied to their output, you -- can use them to set the text color, etc., or you can just -- pass them 'id'. willFloatNextPP :: (String -> String) -> X (Maybe String) willFloatNextPP = willHookNextPP hookName willFloatAllNewPP :: (String -> String) -> X (Maybe String) willFloatAllNewPP = willHookAllNewPP hookName xmonad-contrib-0.18.0/XMonad/Hooks/Focus.hs0000644000000000000000000005075207346545000016612 0ustar0000000000000000{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module: XMonad.Hooks.Focus -- Description: Extends ManageHook EDSL to work on focused windows and current workspace. -- Copyright: sgf-dma, 2016 -- Maintainer: sgf.dma@gmail.com -- -- Extends "XMonad.ManageHook" EDSL to work on focused windows and current -- workspace. -- module XMonad.Hooks.Focus ( -- $main -- * FocusQuery. -- -- $focusquery Focus (..) , FocusLock (..) , toggleLock , focusLockOn , focusLockOff , FocusQuery , runFocusQuery , FocusHook -- * Lifting into FocusQuery. -- -- $lift , liftQuery , new , focused , focused' , focusedOn , focusedOn' , focusedCur , focusedCur' , newOn , newOnCur , unlessFocusLock -- * Commonly used actions for modifying focus. -- -- $common , keepFocus , switchFocus , keepWorkspace , switchWorkspace -- * Running FocusQuery. -- -- $running , manageFocus -- * Example configurations. -- -- $examples , activateSwitchWs , activateOnCurrentWs , activateOnCurrentKeepFocus ) where import Control.Arrow ((&&&)) import Control.Monad.Reader import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Hooks.ManageHelpers (currentWs) -- $main -- -- This module provides monad on top of Query monad providing additional -- information about new window: -- -- - workspace, where new window will appear; -- - focused window on workspace, where new window will appear; -- - current workspace; -- -- And a property in extensible state: -- -- - is focus lock enabled? Focus lock instructs all library's 'FocusHook' -- functions to not move focus or switch workspace. -- -- Lifting operations for standard 'ManageHook' EDSL combinators into -- 'FocusQuery' monad allowing to run these combinators on focused window and -- common actions for keeping focus and\/or workspace, switching focus and\/or -- workspace are also provided. -- -- == Quick start. -- -- I may use one of predefined configurations. -- -- 1. The default window activation behavior (switch to workspace with -- activated window and switch focus to it) expressed using this module: -- -- > import XMonad -- > -- > import XMonad.Hooks.EwmhDesktops -- > import XMonad.Hooks.Focus -- > -- > main :: IO () -- > main = do -- > let ah :: ManageHook -- > ah = activateSwitchWs -- > xcf = setEwmhActivateHook ah -- > . ewmh $ def{ modMask = mod4Mask } -- > xmonad xcf -- -- 2. Or i may move activated window to current workspace and switch focus to -- it: -- -- > let ah :: ManageHook -- > ah = activateOnCurrentWs -- -- 3. Or move activated window to current workspace, but keep focus unchanged: -- -- > let ah :: ManageHook -- > ah = activateOnCurrentKeepFocus -- -- 4. I may use regular 'ManageHook' combinators for filtering, which windows -- may activate. E.g. activate all windows, except firefox: -- -- > let ah :: ManageHook -- > ah = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") -- > --> activateSwitchWs -- -- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless -- xterm is focused on /current/ workspace: -- -- > let ah :: ManageHook -- > ah = manageFocus (not <$> focusedCur (className =? "XTerm") -- > --> liftQuery activateSwitchWs) -- -- or activate all windows, unless focused window on the workspace, -- /where activated window is/, is not a xterm: -- -- > let ah :: ManageHook -- > ah = manageFocus (not <$> focused (className =? "XTerm") -- > --> liftQuery activateSwitchWs) -- -- == Defining FocusHook. -- -- I may define my own 'FocusHook' like: -- -- > activateFocusHook :: FocusHook -- > activateFocusHook = composeAll -- > -- If 'gmrun' is focused on workspace, on which -- > -- /activated window/ is, keep focus unchanged. But i -- > -- may still switch workspace (thus, i use 'composeAll'). -- > -- See 'keepFocus' properties in the docs below. -- > [ focused (className =? "Gmrun") -- > --> keepFocus -- > -- Default behavior for activated windows: switch -- > -- workspace and focus. -- > , return True --> switchWorkspace <> switchFocus -- > ] -- > -- > newFocusHook :: FocusHook -- > newFocusHook = composeOne -- > -- Always switch focus to 'gmrun'. -- > [ new (className =? "Gmrun") -?> switchFocus -- > -- And always keep focus on 'gmrun'. Note, that -- > -- another 'gmrun' will steal focus from already -- > -- running one. -- > , focused (className =? "Gmrun") -?> keepFocus -- > -- If firefox dialog prompt (e.g. master password -- > -- prompt) is focused on current workspace and new -- > -- window appears here too, keep focus unchanged -- > -- (note, used predicates: @newOnCur <&&> focused@ is -- > -- the same as @newOnCur <&&> focusedCur@, but is -- > -- /not/ the same as just 'focusedCur' ) -- > , newOnCur <&&> focused -- > ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog) -- > -?> keepFocus -- > -- Default behavior for new windows: switch focus. -- > , return True -?> switchFocus -- > ] -- -- And then use it: -- -- > import XMonad -- > import XMonad.Util.EZConfig -- > -- > import XMonad.Hooks.EwmhDesktops -- > import XMonad.Hooks.ManageHelpers -- > import XMonad.Hooks.Focus -- > -- > -- > main :: IO () -- > main = do -- > let newFh :: ManageHook -- > newFh = manageFocus newFocusHook -- > acFh :: ManageHook -- > acFh = manageFocus activateFocusHook -- > xcf = setEwmhActivateHook acFh -- > . ewmh $ def -- > { manageHook = newFh <> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- > xmonad xcf -- -- Note: -- -- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor -- workspace won't be switched). -- - I need "XMonad.Hooks.EwmhDesktops" module for enabling window -- activation. -- - 'FocusHook' in 'manageHook' will be called /only/ for new windows. -- - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows. -- -- Alternatively, i may construct a single 'FocusHook' for both new and -- activated windows and then just add it to both 'manageHook' and 'setEwmhActivateHook': -- -- > let fh :: Bool -> ManageHook -- > fh activated = manageFocus $ composeOne -- > [ pure activated -?> activateFocusHook -- > , pure True -?> newFocusHook -- > ] -- > xcf = setEwmhActivateHook (fh True) -- > . ewmh $ def -- > { manageHook = fh False <> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- -- And more technical notes: -- -- - 'FocusHook' will run /many/ times, so it usually should not keep state -- or save results. Precisely, it may do anything, but it must be idempotent -- to operate properly. -- - 'FocusHook' will see new window at workspace, where functions on the -- /right/ from it in 'ManageHook' monoid place it. In other words, in -- @(Endo WindowSet)@ monoid i may see changes only from functions applied -- /before/ (more to the right in function composition). Thus, it's better to -- add 'FocusHook' the last. -- - 'FocusHook' functions won't see window shift to another workspace made -- by function from 'FocusHook' itself: new window workspace is determined -- /before/ running 'FocusHook' and even if later one of 'FocusHook' -- functions moves window to another workspace, predicates ('focused', -- 'newOn', etc) will still think new window is at workspace it was before. -- This can be worked around by splitting 'FocusHook' into several different -- values and evaluating each one separately, like: -- -- > (FH2 -- manageFocus --> MH2) <> (FH1 -- manageFocus --> MH1) <> .. -- -- E.g. -- -- > manageFocus FH2 <> manageFocus FH1 <> .. -- -- now @FH2@ will see window shift made by @FH1@. -- -- Another interesting example is moving all activated windows to current -- workspace by default, and applying 'FocusHook' after: -- -- > import XMonad -- > import XMonad.Util.EZConfig -- > -- > import XMonad.Hooks.EwmhDesktops -- > import XMonad.Hooks.ManageHelpers -- > import XMonad.Hooks.Focus -- > -- > main :: IO () -- > main = do -- > let fh :: Bool -> ManageHook -- > fh activated = manageFocus $ composeOne -- > [ pure activated -?> (newOnCur --> keepFocus) -- > , pure True -?> newFocusHook -- > ] -- > xcf = setEwmhActivateHook (fh True <> activateOnCurrentWs) -- > . ewmh $ def -- > { manageHook = fh False <> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)] -- > xmonad xcf -- > -- > newFocusHook :: FocusHook -- > newFocusHook = composeOne -- > -- Always switch focus to 'gmrun'. -- > [ new (className =? "Gmrun") -?> switchFocus -- > -- And always keep focus on 'gmrun'. Note, that -- > -- another 'gmrun' will steal focus from already -- > -- running one. -- > , focused (className =? "Gmrun") -?> keepFocus -- > -- If firefox dialog prompt (e.g. master password -- > -- prompt) is focused on current workspace and new -- > -- window appears here too, keep focus unchanged -- > -- (note, used predicates: @newOnCur <&&> focused@ is -- > -- the same as @newOnCur <&&> focusedCur@, but is -- > -- /not/ the same as just 'focusedCur' ) -- > , newOnCur <&&> focused -- > ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog) -- > -?> keepFocus -- > -- Default behavior for new windows: switch focus. -- > , return True -?> switchFocus -- > ] -- -- Note here: -- -- - i keep focus, when activated window appears on current workspace, in -- this example. -- - when @pure activated -?> (newOnCur --> keepFocus)@ runs, activated -- window will be /already/ on current workspace, thus, if i do not want to -- move some activated windows, i should filter them out before applying -- @activateOnCurrentWs@ 'FocusHook'. -- FocusQuery. -- $focusquery -- | Information about current workspace and focus. data Focus = Focus { -- | Workspace, where new window appears. newWorkspace :: WorkspaceId -- | Focused window on workspace, where new window -- appears. , focusedWindow :: Maybe Window -- | Current workspace. , currentWorkspace :: WorkspaceId } deriving (Show) instance Default Focus where def = Focus { focusedWindow = Nothing , newWorkspace = "" , currentWorkspace = "" } newtype FocusLock = FocusLock {getFocusLock :: Bool} deriving (Show) instance ExtensionClass FocusLock where initialValue = FocusLock False -- | Toggle stored focus lock state. toggleLock :: X () toggleLock = XS.modify (\(FocusLock b) -> FocusLock (not b)) -- | Lock focus. focusLockOn :: X () focusLockOn = XS.modify (const (FocusLock True)) -- | Unlock focus. focusLockOff :: X () focusLockOff = XS.modify (const (FocusLock False)) -- | Monad on top of 'Query' providing additional information about new -- window. newtype FocusQuery a = FocusQuery (ReaderT Focus Query a) deriving newtype (Functor, Applicative, Monad, MonadReader Focus, MonadIO) deriving (Semigroup, Monoid) via Ap FocusQuery a runFocusQuery :: FocusQuery a -> Focus -> Query a runFocusQuery (FocusQuery m) = runReaderT m type FocusHook = FocusQuery (Endo WindowSet) -- Lifting into 'FocusQuery'. -- $lift -- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'. liftQuery :: Query a -> FocusQuery a liftQuery = FocusQuery . lift -- | Run 'Query' on new window. new :: Query a -> FocusQuery a new = liftQuery -- | Run 'Query' on focused window on workspace, where new window appears. If -- there is no focused window, return 'False'. focused :: Query Bool -> FocusQuery Bool focused m = getAny <$> focused' (Any <$> m) -- | More general version of 'focused'. focused' :: Monoid a => Query a -> FocusQuery a focused' m = do mw <- asks focusedWindow liftQuery (maybe mempty (flip local m . const) mw) -- | Run 'Query' on window focused at particular workspace. If there is no -- focused window, return 'False'. focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool focusedOn i m = getAny <$> focusedOn' i (Any <$> m) -- | More general version of 'focusedOn'. focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a focusedOn' i m = liftQuery $ do mw <- liftX $ withWindowSet (return . W.peek . W.view i) maybe mempty (flip local m . const) mw -- | Run 'Query' on focused window on current workspace. If there is no -- focused window, return 'False'. Note, -- -- > focused <&&> newOnCur != focusedCur -- -- The first will affect only new or activated window appearing on current -- workspace, while the last will affect any window: focus even for windows -- appearing on other workpsaces will depend on focus on /current/ workspace. focusedCur :: Query Bool -> FocusQuery Bool focusedCur m = getAny <$> focusedCur' (Any <$> m) -- | More general version of 'focusedCur'. focusedCur' :: Monoid a => Query a -> FocusQuery a focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m -- | Does new window appear at particular workspace? newOn :: WorkspaceId -> FocusQuery Bool newOn i = asks ((i ==) . newWorkspace) -- | Does new window appear at current workspace? newOnCur :: FocusQuery Bool newOnCur = asks currentWorkspace >>= newOn -- | Execute 'Query', unless focus is locked. unlessFocusLock :: Monoid a => Query a -> Query a unlessFocusLock m = do FocusLock b <- liftX XS.get when' (not b) m -- Commonly used actions for modifying focus. -- -- $common -- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and -- 'switchWorkspace' overwrite each other (the letftmost will determine what -- happened): -- -- prop> keepFocus <> switchFocus = keepFocus -- prop> switchFocus <> keepFocus = switchFocus -- prop> keepWorkspace <> switchWorkspace = keepWorkspace -- prop> switchWorkspace <> keepWorkspace = switchWorkspace -- -- and operations from different pairs are commutative: -- -- prop> keepFocus <> switchWorkspace = switchWorkspace <> keepFocus -- prop> switchFocus <> switchWorkspace = switchWorkspace <> switchFocus -- -- etc. -- | Keep focus on workspace (may not be current), where new window appears. -- Workspace will not be switched. This operation is idempotent and -- effectively returns focus to window focused on that workspace before -- applying @(Endo WindowSet)@ function. keepFocus :: FocusHook keepFocus = focused' $ ask >>= \w -> doF $ \ws -> W.view (W.currentTag ws) . W.focusWindow w $ ws -- | Switch focus to new window on workspace (may not be current), where new -- window appears. Workspace will not be switched. This operation is -- idempotent. switchFocus :: FocusHook switchFocus = do FocusLock b <- liftQuery . liftX $ XS.get if b -- When focus lock is enabled, call 'keepFocus' explicitly (still no -- 'keepWorkspace') to overwrite default behavior. then keepFocus else new $ ask >>= \w -> doF $ \ws -> W.view (W.currentTag ws) . W.focusWindow w $ ws -- | Keep current workspace. Focus will not be changed at either current or -- new window's workspace. This operation is idempotent and effectively -- switches to workspace, which was current before applying @(Endo WindowSet)@ -- function. keepWorkspace :: FocusHook keepWorkspace = do ws <- asks currentWorkspace liftQuery . doF $ W.view ws -- | Switch workspace to one, where new window appears. Focus will not be -- changed at either current or new window's workspace. This operation is -- idempotent. switchWorkspace :: FocusHook switchWorkspace = do FocusLock b <- liftQuery . liftX $ XS.get if b -- When focus lock is enabled, call 'keepWorkspace' explicitly (still no -- 'keepFocus') to overwrite default behavior. then keepWorkspace else do ws <- asks newWorkspace liftQuery . doF $ W.view ws -- Running FocusQuery. -- $running -- | I don't know at which workspace new window will appear until @(Endo -- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run, -- but in @(Endo WindowSet)@ function i can't already execute monadic actions, -- because it's pure. So, i compute result for every workspace here and just -- use it later in @(Endo WindowSet)@ function. Note, though, that this will -- execute monadic actions many times, and therefore assume, that result of -- 'FocusHook' does not depend on the number of times it was executed. manageFocus :: FocusHook -> ManageHook manageFocus m = do fws <- liftX . withWindowSet $ return . map (W.tag &&& fmap W.focus . W.stack) . W.workspaces ct <- currentWs let r = def {currentWorkspace = ct} hs <- forM fws $ \(i, mw) -> do f <- runFocusQuery m (r {focusedWindow = mw, newWorkspace = i}) return (i, f) reader (selectHook hs) >>= doF where -- | Select and apply @(Endo WindowSet)@ function depending on which -- workspace new window appeared now. selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet selectHook cfs nw ws = fromMaybe ws $ do i <- W.findTag nw ws f <- lookup i cfs return (appEndo f ws) when' :: (Monad m, Monoid a) => Bool -> m a -> m a when' b mx | b = mx | otherwise = return mempty -- Exmaple configurations. -- $examples -- | Default EWMH window activation behavior: switch to workspace with -- activated window and switch focus to it. Not to be used in a 'manageHook'. activateSwitchWs :: ManageHook activateSwitchWs = manageFocus (switchWorkspace <> switchFocus) -- | Move activated window to current workspace. Not to be used in a 'manageHook'. activateOnCurrent' :: ManageHook activateOnCurrent' = currentWs >>= unlessFocusLock . doShift -- | Move activated window to current workspace and switch focus to it. Note, -- that i need to explicitly call 'switchFocus' here, because otherwise, when -- activated window is /already/ on current workspace, focus won't be -- switched. Not to be used in a 'manageHook'. activateOnCurrentWs :: ManageHook activateOnCurrentWs = manageFocus (newOnCur --> switchFocus) <> activateOnCurrent' -- | Move activated window to current workspace, but keep focus unchanged. -- Not to be used in a 'manageHook'. activateOnCurrentKeepFocus :: ManageHook activateOnCurrentKeepFocus = manageFocus (newOnCur --> keepFocus) <> activateOnCurrent' xmonad-contrib-0.18.0/XMonad/Hooks/InsertPosition.hs0000644000000000000000000000645107346545000020521 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : vogt.adam@gmail.com -- Stability : unstable -- Portability : portable -- -- Configure where new windows should be added and which window should be -- focused. -- ----------------------------------------------------------------------------- module XMonad.Hooks.InsertPosition ( -- * Usage -- $usage setupInsertPosition, insertPosition ,Focus(..), Position(..) ) where import XMonad (ManageHook, MonadReader (ask), XConfig (manageHook)) import XMonad.Prelude (Endo (Endo), find) import qualified XMonad.StackSet as W -- $usage -- You can use this module by importing it in your @xmonad.hs@: -- -- > import XMonad.Hooks.InsertPosition -- -- You then just have to add 'setupInsertPosition' to your @main@ function: -- -- > main = xmonad $ … $ setupInsertPosition Master Newer $ def { … } -- -- Alternatively (i.e., you should /not/ do this if you already have set -- up the above combinator), you can also directly insert -- 'insertPosition' into your manageHook: -- -- > xmonad def { manageHook = insertPosition Master Newer <> myManageHook } -- -- NOTE: You should you put the manageHooks that use 'doShift' to take effect -- /before/ 'insertPosition', so that the window order will be consistent. -- Because ManageHooks compose from right to left (like function composition -- '.'), this means that 'insertPosition' should be the leftmost ManageHook. data Position = Master | End | Above | Below data Focus = Newer | Older -- | A combinator for setting up 'insertPosition'. setupInsertPosition :: Position -> Focus -> XConfig a -> XConfig a setupInsertPosition pos foc cfg = cfg{ manageHook = insertPosition pos foc <> manageHook cfg } -- | insertPosition. A manage hook for placing new windows. XMonad's default is -- the same as using: @insertPosition Above Newer@. insertPosition :: Position -> Focus -> ManageHook insertPosition pos foc = Endo . g <$> ask where g w = viewingWs w (updateFocus w . ins w . W.delete' w) ins w = (\f ws -> maybe id W.focusWindow (W.peek ws) $ f ws) $ case pos of Master -> W.insertUp w . W.focusMaster End -> insertDown w . W.modify' focusLast' Above -> W.insertUp w Below -> insertDown w updateFocus = case foc of Older -> const id Newer -> W.focusWindow -- | Modify the StackSet when the workspace containing w is focused viewingWs :: (Eq a, Eq s, Eq i, Show i) =>a-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)-> W.StackSet i l a s sd-> W.StackSet i l a s sd viewingWs w f = do i <- W.tag . W.workspace . W.current ws <- find (elem w . W.integrate' . W.stack) . W.workspaces maybe id (fmap (W.view i . f) . W.view . W.tag) ws -- | 'insertDown' and 'focusLast' belong in XMonad.StackSet? insertDown :: (Eq a) => a -> W.StackSet i l a s sd -> W.StackSet i l a s sd insertDown w = W.swapDown . W.insertUp w focusLast' :: W.Stack a -> W.Stack a focusLast' st = case reverse (W.integrate st) of [] -> st (l : ws) -> W.Stack l ws [] xmonad-contrib-0.18.0/XMonad/Hooks/ManageDebug.hs0000644000000000000000000001107007346545000017660 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's. -- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator. -- Or use @debugManageHookOn@ for a triggerable version, specifying the -- triggering key sequence in "XMonad.Util.EZConfig" syntax. Or use the -- individual hooks in whatever way you see fit. -- ----------------------------------------------------------------------------- -- -- module XMonad.Hooks.ManageDebug (debugManageHook ,debugManageHookOn ,manageDebug ,maybeManageDebug ,manageDebugLogHook ,debugNextManagedWindow ) where import XMonad import XMonad.Hooks.DebugStack import XMonad.Util.DebugWindow import XMonad.Util.EZConfig import qualified XMonad.Util.ExtensibleState as XS -- state for manageHook debugging to trigger logHook debugging data MSDFinal = DoLogHook | SkipLogHook deriving Show data MSDTrigger = MSDActivated | MSDInactive deriving Show data ManageStackDebug = MSD MSDFinal MSDTrigger deriving Show instance ExtensionClass ManageStackDebug where initialValue = MSD SkipLogHook MSDInactive -- | A combinator to add full 'ManageHook' debugging in a single operation. debugManageHook :: XConfig l -> XConfig l debugManageHook cf = cf {logHook = manageDebugLogHook <> logHook cf ,manageHook = manageDebug <> manageHook cf } -- | A combinator to add triggerable 'ManageHook' debugging in a single operation. -- Specify a key sequence as a string in "XMonad.Util.EZConfig" syntax; press -- this key before opening the window to get just that logged. debugManageHookOn :: String -> XConfig l -> XConfig l debugManageHookOn key cf = cf {logHook = manageDebugLogHook <> logHook cf ,manageHook = maybeManageDebug <> manageHook cf } `additionalKeysP` [(key,debugNextManagedWindow)] -- | Place this at the start of a 'ManageHook', or possibly other places for a -- more limited view. It will show the current 'StackSet' state and the new -- window, and set a flag so that @manageDebugLogHook@ will display the -- final 'StackSet' state. -- -- Note that the initial state shows only the current workspace; the final -- one shows all workspaces, since your 'manageHook' might use e.g. 'doShift', manageDebug :: ManageHook manageDebug = do w <- ask liftX $ do trace "== manageHook; current stack ==" debugStackString >>= trace ws <- debugWindow w trace $ "new window:\n " ++ ws -- technically we don't care about go here, since only maybeManageDebug -- uses it XS.modify $ \(MSD _ go') -> MSD DoLogHook go' idHook -- | @manageDebug@ only if the user requested it with @debugNextManagedWindow@. maybeManageDebug :: ManageHook maybeManageDebug = do go <- liftX $ do MSD _ go' <- XS.get -- leave it active, as we may manage multiple windows before the logHook -- so we now deactivate it in the logHook return go' case go of MSDActivated -> manageDebug _ -> idHook -- | If @manageDebug@ has set the debug-stack flag, show the stack. manageDebugLogHook :: X () manageDebugLogHook = do MSD log' _ <- XS.get case log' of DoLogHook -> do trace "== manageHook; final stack ==" debugStackFullString >>= trace -- see comment in maybeManageDebug XS.put $ MSD SkipLogHook MSDInactive _ -> idHook -- | Request that the next window to be managed be @manageDebug@-ed. This can -- be used anywhere an X action can, such as key bindings, mouse bindings -- (presumably with 'const'), 'startupHook', etc. debugNextManagedWindow :: X () debugNextManagedWindow = XS.modify $ \(MSD log' _) -> MSD log' MSDActivated xmonad-contrib-0.18.0/XMonad/Hooks/ManageDocks.hs0000644000000000000000000003162207346545000017702 0ustar0000000000000000{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP, LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageDocks -- Description : Automatically manage 'dock' type programs. -- Copyright : (c) Joachim Breitner -- License : BSD -- -- Maintainer : Joachim Breitner -- Stability : unstable -- Portability : unportable -- -- This module provides tools to automatically manage 'dock' type programs, -- such as gnome-panel, kicker, dzen, and xmobar. module XMonad.Hooks.ManageDocks ( -- * Usage -- $usage docks, manageDocks, checkDock, AvoidStruts(..), avoidStruts, avoidStrutsOn, ToggleStruts(..), SetStruts(..), module XMonad.Util.Types, #ifdef TESTING r2c, c2r, RectC(..), #endif -- * For developers of other modules ("XMonad.Actions.FloatSnap") calcGap, -- * Standalone hooks (deprecated) docksEventHook, docksStartupHook, ) where ----------------------------------------------------------------------------- import XMonad import Foreign.C.Types (CLong) import XMonad.Layout.LayoutModifier import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s) import qualified XMonad.Util.ExtensibleState as XS import XMonad.Prelude import qualified Data.Set as S import qualified Data.Map as M import qualified XMonad.StackSet as W -- $usage -- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Hooks.ManageDocks -- -- Wrap your xmonad config with a call to 'docks', like so: -- -- > main = xmonad $ … . docks . … $ def{…} -- -- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout -- to prevent windows from overlapping these windows. -- -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) -- > where tall = Tall 1 (3/100) (1/2) -- -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding -- similar to: -- -- > ,((modm, xK_b ), sendMessage ToggleStruts) -- -- If you have multiple docks, you can toggle their gaps individually. -- For example, to toggle only the top gap: -- -- > ,((modm .|. controlMask, xK_t), sendMessage $ ToggleStrut U) -- -- Similarly, you can use 'D', 'L', and 'R' to individually toggle -- gaps on the bottom, left, or right. -- -- If you want certain docks to be avoided but others to be covered by -- default, you can manually specify the sides of the screen on which -- docks should be avoided, using 'avoidStrutsOn'. For example: -- -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- -- For detailed instructions on editing your key bindings, see -- . -- -- | Add docks functionality to the given config. See above for an example. docks :: XConfig a -> XConfig a docks c = c { startupHook = docksStartupHook <> startupHook c , handleEventHook = docksEventHook <> handleEventHook c , manageHook = manageDocks <> manageHook c } type WindowStruts = M.Map Window [Strut] 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 Nothing modifiedStrutCache :: (Maybe WindowStruts -> X WindowStruts) -> X Bool modifiedStrutCache f = XS.modifiedM $ fmap (StrutCache . Just) . f . 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 <> 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. -- Ignores xmonad's own windows (usually _NET_WM_WINDOW_TYPE_DESKTOP) to avoid -- unnecessary refreshes. checkDock :: Query Bool checkDock = isDockOrDesktop <&&> (not <$> isXMonad) where isDockOrDesktop = ask >>= \w -> liftX $ do dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w case mbr of Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs _ -> return False isXMonad = className =? "xmonad" -- | Whenever a new dock appears, refresh the layout immediately to avoid the -- new dock. {-# DEPRECATED docksEventHook "Use docks instead." #-} docksEventHook :: Event -> X All docksEventHook MapNotifyEvent{ ev_window = w } = do whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ whenX (updateStrutCache w) refreshDocks return (All True) 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) $ whenX (updateStrutCache w) refreshDocks return (All True) 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 = void getStrutCache -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut] getStrut w = do msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w case msp of Just sp -> return $ parseStrutPartial sp Nothing -> maybe [] parseStrut <$> getProp32s "_NET_WM_STRUT" w where parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound] parseStrut _ = [] parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2] = filter (\(_, n, _, _) -> n /= 0) [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)] parseStrutPartial _ = [] -- | Goes through the list of windows and find the gap so that all -- STRUT settings are satisfied. calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) calcGap ss = do rootw <- asks theRoot struts <- filter careAbout . concat . M.elems <$> getStrutCache -- If possible, we grab the window attributes of the root window rather -- than checking the width of the screen because xlib caches this info -- and it tends to be incorrect after RAndR screen <- safeGetWindowAttributes rootw >>= \case Nothing -> gets $ r2c . screenRect . W.screenDetail . W.current . windowset Just wa -> pure . r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa) return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts where careAbout (s,_,_,_) = s `S.member` ss -- | Adjust layout automagically: don't cover up any docks, status -- bars, etc. -- -- Note that this modifier must be applied before any modifier that -- changes the screen rectangle, or struts will be applied in the wrong -- place and may affect the other modifier(s) in odd ways. This is -- most commonly seen with the 'spacing' modifier and friends. avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a avoidStruts = avoidStrutsOn [U,D,L,R] -- | Adjust layout automagically: don't cover up docks, status bars, -- etc. on the indicated sides of the screen. Valid sides are 'U' -- (top), 'D' (bottom), 'R' (right), or 'L' (left). The warning in -- 'avoidStruts' applies to this modifier as well. avoidStrutsOn :: LayoutClass l a => [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) 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) instance Message ToggleStruts -- | SetStruts is a message constructor used to set or unset specific struts, -- regardless of whether or not the struts were originally set. Here are some -- example bindings: -- -- Show all gaps: -- -- > ,((modm .|. shiftMask ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] []) -- -- Hide all gaps: -- -- > ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound]) -- -- Show only upper and left gaps: -- -- > ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound]) -- -- Hide the bottom keeping whatever the other values were: -- -- > ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D]) data SetStruts = SetStruts { addedStruts :: [Direction2D] , removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added. } deriving (Read,Show) instance Message SetStruts instance LayoutModifier AvoidStruts a where modifyLayout (AvoidStruts ss) w r = do srect <- fmap ($ r) (calcGap ss) -- Ensure _NET_WORKAREA is not set. -- See: https://github.com/xmonad/xmonad-contrib/pull/79 rmWorkarea runLayout w srect pureMess as@(AvoidStruts ss) m | Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss) | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss) | Just (SetStruts n k) <- fromMessage m , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k) , newSS /= ss = Just $ AvoidStruts newSS | Just UpdateDocks <- fromMessage m = Just as | otherwise = Nothing where toggleAll x | S.null x = S.fromList [minBound .. maxBound] | otherwise = S.empty toggleOne x xs | x `S.member` xs = S.delete x xs | otherwise = x `S.insert` xs rmWorkarea :: X () rmWorkarea = withDisplay $ \dpy -> do a <- getAtom "_NET_WORKAREA" r <- asks theRoot io (deleteProperty dpy r a) -- | (Direction, height\/width, initial pixel, final pixel). type Strut = (Direction2D, CLong, CLong, CLong) -- | (Initial x pixel, initial y pixel, -- final x pixel, final y pixel). newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show) -- | Invertible conversion. r2c :: Rectangle -> RectC r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1) -- | Invertible conversion. c2r :: RectC -> Rectangle c2r (RectC (x1, y1, x2, y2)) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1) reduce :: RectC -> Strut -> RectC -> RectC reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) = RectC $ case s of L | p (y0, y1) && qh x1 -> (mx x0 sx0, y0 , x1 , y1 ) R | p (y0, y1) && qv sx1 x0 -> (x0 , y0 , mn x1 sx1, y1 ) U | p (x0, x1) && qh y1 -> (x0 , mx y0 sy0, x1 , y1 ) D | p (x0, x1) && qv sy1 y0 -> (x0 , y0 , x1 , mn y1 sy1) _ -> (x0 , y0 , x1 , y1 ) where mx a b = max a (b + n) mn a b = min a (b - n) p r = r `overlaps` (l, h) -- Filter out struts that cover the entire rectangle: qh d1 = n <= d1 qv sd1 d0 = sd1 - n >= d0 -- | Do the two ranges overlap? -- -- Precondition for every input range @(x, y)@: @x '<=' y@. -- -- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@. overlaps :: Ord a => (a, a) -> (a, a) -> Bool (a, b) `overlaps` (x, y) = inRange (a, b) x || inRange (a, b) y || inRange (x, y) a where inRange (i, j) k = i <= k && k <= j xmonad-contrib-0.18.0/XMonad/Hooks/ManageHelpers.hs0000644000000000000000000002767107346545000020252 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageHelpers -- Description : Helper functions to be used in manageHook. -- Copyright : (c) Lukas Mai -- License : BSD -- -- Maintainer : Lukas Mai -- Stability : unstable -- Portability : unportable -- -- This module provides helper functions to be used in @manageHook@. Here's -- how you might use this: -- -- > import XMonad.Hooks.ManageHelpers -- > main = -- > xmonad def{ -- > ... -- > manageHook = composeOne [ -- > isKDETrayWindow -?> doIgnore, -- > transience, -- > isFullscreen -?> doFullFloat, -- > resource =? "stalonetray" -?> doIgnore -- > ], -- > ... -- > } -- -- Here's how you can define more helpers like the ones from this module: -- -- > -- some function you want to transform into an infix operator -- > f :: a -> b -> Bool -- > -- > -- a new helper -- > q ***? x = fmap (\a -> f a x) q -- or: (\b -> f x b) -- > -- or -- > q ***? x = fmap (`f` x) q -- or: (x `f`) -- -- Any existing operator can be "lifted" in the same way: -- -- > q ++? x = fmap (++ x) q module XMonad.Hooks.ManageHelpers ( Side(..), composeOne, (-?>), (/=?), (^?), (~?), ($?), (<==?), (>), (-?>>), currentWs, windowTag, isInProperty, isKDETrayWindow, isFullscreen, isMinimized, isDialog, pid, desktop, transientTo, maybeToDefinite, MaybeManageHook, transience, transience', clientLeader, sameBy, shiftToSame, shiftToSame', doRectFloat, doFullFloat, doCenterFloat, doSideFloat, 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 System.Posix (ProcessID) -- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northeast -- etc. @C@ stands for Center. data Side = SC | NC | CE | CW | SE | SW | NE | NW | C deriving (Read, Show, Eq) -- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe type MaybeManageHook = Query (Maybe (Endo WindowSet)) -- | A grouping type, which can hold the outcome of a predicate Query. -- This is analogous to group types in regular expressions. -- TODO: create a better API for aggregating multiple Matches logically data Match a = Match Bool a -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as -- a candidate returns a 'Just' value, effectively running only the first match -- (whereas 'composeAll' continues and executes all matching rules). composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a composeOne = foldr try (return mempty) where try q z = do x <- q maybe z return x infixr 0 -?>, -->>, -?>> -- | q \/=? x. if the result of q equals x, return False (/=?) :: (Eq a, Functor m) => m a -> a -> m Bool q /=? x = fmap (/= x) q -- | q ^? x. if the result of @x `isPrefixOf` q@, return True (^?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool q ^? x = fmap (x `isPrefixOf`) q -- | q ~? x. if the result of @x `isInfixOf` q@, return True (~?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool q ~? x = fmap (x `isInfixOf`) q -- | q $? x. if the result of @x `isSuffixOf` q@, return True ($?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool q $? x = fmap (x `isSuffixOf`) q -- | q <==? x. if the result of q equals x, return True grouped with q (<==?) :: (Eq a, 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 ( m a -> a -> m (Match a) q ) :: (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. (-->>) :: (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 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. (-?>>) :: (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 -- | Return the current workspace 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 r <- getProp32s "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" w return $ case r of Just [_] -> True _ -> False -- | Helper to check if a window property contains certain value. isInProperty :: String -> String -> Query Bool isInProperty p v = ask >>= \w -> liftX $ do va <- getAtom v r <- getProp32s p w return $ case r of Just xs -> fromIntegral va `elem` xs _ -> False -- | A predicate to check whether a window wants to fill the whole screen. -- See also 'doFullFloat'. isFullscreen :: Query Bool isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN" -- | A predicate to check whether a window is hidden (minimized). -- See also "XMonad.Actions.Minimize". isMinimized :: Query Bool isMinimized = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN" -- | A predicate to check whether a window is a dialog. 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 . pid :: Query (Maybe ProcessID) pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w <&> \case Just [x] -> Just (fromIntegral x) _ -> Nothing -- | This function returns 'Just' the @_NET_WM_DESKTOP@ property for a -- particular window if set, 'Nothing' otherwise. -- -- See . desktop :: Query (Maybe Int) desktop = ask >>= \w -> liftX $ getProp32s "_NET_WM_DESKTOP" w <&> \case Just [x] -> Just (fromIntegral x) _ -> Nothing -- | A predicate to check whether a window is Transient. -- It holds the result which might be the window it is transient to -- or it might be 'Nothing'. transientTo :: Query (Maybe Window) transientTo = do w <- ask d <- (liftX . asks) display liftIO $ getTransientForHint d w -- | A convenience 'MaybeManageHook' that will check to see if a window -- is transient, and then move it to its parent. transience :: MaybeManageHook transience = transientTo > 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 . 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 :: (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. -> ManageHook doRectFloat r = ask >>= \w -> doF (W.float w r) -- | Floats the window and makes it use the whole screen. Equivalent to -- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@. doFullFloat :: ManageHook doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1 -- | Floats a new window using a rectangle computed as a function of -- the rectangle that it would have used by default. doFloatDep :: (W.RationalRect -> W.RationalRect) -> ManageHook doFloatDep move = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w) -- | Floats a new window with its original size, and its top left -- corner at a specific point on the screen (both coordinates should -- be in the range 0 to 1). doFloatAt :: Rational -> Rational -> ManageHook doFloatAt x y = doFloatDep move where move (W.RationalRect _ _ w h) = W.RationalRect x y w h -- | Floats a new window with its original size on the specified side of a -- screen doSideFloat :: Side -> ManageHook doSideFloat side = doFloatDep move where move (W.RationalRect _ _ w h) = W.RationalRect cx cy w 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 doCenterFloat = doSideFloat C -- | Hides window and ignores it. doHideIgnore :: ManageHook doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w) -- | Sinks a window doSink :: ManageHook doSink = 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-contrib-0.18.0/XMonad/Hooks/Minimize.hs0000644000000000000000000000335307346545000017307 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Minimize -- Description : Handle window manager hints to minimize and restore windows. -- Copyright : (c) Justin Bogner 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Justin Bogner -- Stability : unstable -- Portability : not portable -- -- Handles window manager hints to minimize and restore windows. Use -- this with "XMonad.Layout.Minimize". -- ----------------------------------------------------------------------------- module XMonad.Hooks.Minimize ( -- * Usage -- $usage minimizeEventHook ) where import XMonad import XMonad.Actions.Minimize import XMonad.Prelude -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Minimize -- > import XMonad.Layout.Minimize -- > -- > myHandleEventHook = minimizeEventHook -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout -- > , handleEventHook = myHandleEventHook } minimizeEventHook :: Event -> X All minimizeEventHook ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = dt} = do a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cs <- getAtom "WM_CHANGE_STATE" when (mt == a_aw) $ maximizeWindow w when (mt == a_cs) $ case listToMaybe dt of Nothing -> pure () Just dth -> do let message = fromIntegral dth when (message == normalState) $ maximizeWindow w when (message == iconicState) $ minimizeWindow w return (All True) minimizeEventHook _ = return (All True) xmonad-contrib-0.18.0/XMonad/Hooks/Modal.hs0000644000000000000000000002423707346545000016566 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -------------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Modal -- Description : Implements true modality in xmonad key-bindings. -- Copyright : (c) 2018 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Author : L. S. Leary -- Maintainer : Yecine Megdiche -- Stability : unstable -- Portability : unportable -- -- This module implements modal keybindings for xmonad. -- -------------------------------------------------------------------------------- -- --< Imports & Exports >-- {{{ module XMonad.Hooks.Modal ( -- * Usage -- $Usage modal , modeWithExit , mode , Mode , mkKeysEz , setMode , exitMode -- * Provided Modes #ProvidedModes# -- $ProvidedModes , noModModeLabel , noModMode , floatModeLabel , floatMode , overlayedFloatModeLabel , overlayedFloatMode , floatMap , overlay -- * Logger , logMode ) where -- core import XMonad -- base import Data.Bits ( (.&.) , complement ) import Data.List import qualified Data.Map.Strict as M -- contrib import XMonad.Actions.FloatKeys ( keysMoveWindow , keysResizeWindow ) import XMonad.Prelude import XMonad.Util.EZConfig ( parseKeyCombo , mkKeymap ) import qualified XMonad.Util.ExtensibleConf as XC import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Grab import XMonad.Util.Loggers import XMonad.Util.Parser ( runParser ) -- }}} -- Original Draft By L.S.Leary : https://gist.github.com/LSLeary/6741b0572d62db3f0cea8e6618141b2f -- --< Usage >-- {{{ -- $Usage -- -- This module provides modal keybindings in xmonad. If you're not familiar with -- modal keybindings from Vim, you can think of modes as submaps from -- "XMonad.Actions.Submap", but after each action you execute, you land back in -- the submap until you explicitly exit the submap. To use this module you -- should apply the 'modal' function to the config, which will setup the list of -- modes (or rather, @XConfig Layout -> Mode@) you provide: -- -- > -- > import XMonad -- > import XMonad.Hooks.Modal -- > import XMonad.Util.EZConfig -- > import qualified Data.Map as M -- > -- > main :: IO () -- > main = -- > xmonad -- > . modal [noModMode, floatMode 10, overlayedFloatMode 10, sayHelloMode] -- > $ def -- > `additionalKeysP` [ ("M-S-n", setMode noModModeLabel) -- > , ("M-S-r", setMode floatModeLabel) -- > , ("M-S-z", setMode overlayedFloatModeLabel) -- > , ("M-S-h", setMode "Hello") -- > ] -- > -- > sayHelloMode :: Mode -- > sayHelloMode = mode "Hello" $ mkKeysEz -- > [ ("h", xmessage "Hello, World!") -- > , ("M-g", xmessage "Goodbye, World!") -- > ] -- -- Alternatively, one could have defined @sayHelloMode@ as -- -- > sayHelloMode :: Mode -- > sayHelloMode = mode "Hello" $ \cfg -> -- > M.fromList [ ((noModMask, xK_h), xmessage "Hello, World!") -- > , ((modMask cfg, xK_g), xmessage "Goodbye, World!") -- > ] -- -- In short, a 'Mode' has a label describing its purpose, as well as -- attached keybindings. These are of the form -- -- - @[(String, X ())]@, or -- -- - @XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())@. -- -- The former—accessible via 'mkKeysEz'—is how specifying keys work with -- "XMonad.Util.EZConfig", while the latter is more geared towards how -- defining keys works by default in xmonad. Note that, by default, -- modes are exited with the Escape key. If one wishes to customise -- this, the 'modeWithExit' function should be used instead of 'mode' -- when defining a new mode. -- -- The label of the active mode can be logged with 'logMode' to be -- displayed in a status bar, for example (For more information check -- "XMonad.Util.Loggers"). Some examples are included in [the provided -- modes](#g:ProvidedModes). -- }}} -- --< Types >-- {{{ -- | From a list of "XMonad.Util.EZConfig"-style bindings, generate a -- key representation. -- -- >>> mkKeysEz [("h", xmessage "Hello, world!")] mkKeysEz :: [(String, X ())] -> (XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())) mkKeysEz = flip mkKeymap -- | The mode type. Use 'mode' or 'modeWithExit' to create modes. data Mode = Mode { label :: !String , boundKeys :: !(XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())) } -- | Newtype for the extensible config. newtype ModeConfig = MC [Mode] deriving Semigroup -- | Newtype for the extensible state. newtype CurrentMode = CurrentMode { currentMode :: Maybe Mode } instance ExtensionClass CurrentMode where initialValue = CurrentMode Nothing -- }}} -- --< Private >-- {{{ -- | The active keybindings corresponding to the active 'Mode' (or lack -- thereof). currentKeys :: X (M.Map (ButtonMask, KeySym) (X ())) currentKeys = do cnf <- asks config XS.gets currentMode >>= \case Just m -> pure (boundKeys m cnf) Nothing -> join keys <$> asks config -- | Grab the keys corresponding to the active 'Mode' (or lack thereof). regrab :: X () regrab = grab . M.keys =<< currentKeys -- | Called after changing the mode. Grabs the correct keys and runs the -- 'logHook'. refreshMode :: X () refreshMode = regrab >> asks config >>= logHook -- | Event hook to control the keybindings. modalEventHook :: Event -> X All modalEventHook = customRegrabEvHook regrab <> \case KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code } | t == keyPress -> withDisplay $ \dpy -> do kp <- (,) <$> cleanMask m <*> io (keycodeToKeysym dpy code 0) kbs <- currentKeys userCodeDef () (whenJust (M.lookup kp kbs) id) pure (All False) _ -> pure (All True) -- }}} -- --< Public >-- {{{ -- | Adds the provided modes to the user's config, and sets up the bells -- and whistles needed for them to work. modal :: [Mode] -> XConfig l -> XConfig l modal modes = XC.once (\cnf -> cnf { startupHook = startupHook cnf <> initModes , handleEventHook = handleEventHook cnf <> modalEventHook } ) (MC modes) where initModes = XS.put (CurrentMode Nothing) >> refreshMode -- | Create a 'Mode' from the given binding to 'exitMode', label and -- keybindings. modeWithExit :: String -> String -> (XConfig Layout -> M.Map (KeyMask, KeySym) (X ())) -> Mode modeWithExit exitKey mlabel keys = Mode mlabel $ \cnf -> let exit = fromMaybe (0, xK_Escape) $ runParser (parseKeyCombo cnf) exitKey in M.insert exit exitMode (keys cnf) -- | Create a 'Mode' from the given label and keybindings. Sets the -- @escape@ key to 'exitMode'. mode :: String -> (XConfig Layout -> M.Map (KeyMask, KeySym) (X ())) -> Mode mode = modeWithExit "" -- | Set the current 'Mode' based on its label. setMode :: String -> X () setMode l = do XC.with $ \(MC ls) -> case find ((== l) . label) ls of Nothing -> mempty Just m -> do XS.modify $ \cm -> cm { currentMode = Just m } refreshMode -- | Exits the current mode. exitMode :: X () exitMode = do XS.modify $ \m -> m { currentMode = Nothing } refreshMode -- | A 'Logger' to display the current mode. logMode :: Logger logMode = fmap label <$> XS.gets currentMode -- Provided modes noModModeLabel, floatModeLabel, overlayedFloatModeLabel :: String noModModeLabel = "NoMod" floatModeLabel = "Float" overlayedFloatModeLabel = "Overlayed Float" -- | In this 'Mode', all keybindings are available without the need for pressing -- the modifier. Pressing @escape@ exits the mode. noModMode :: Mode noModMode = mode noModModeLabel $ \cnf -> stripModifier (modMask cnf) (keys cnf cnf) -- | Generates the keybindings for 'floatMode' and 'overlayedFloatMode'. floatMap :: KeyMask -- ^ Move mask -> KeyMask -- ^ Enlarge mask -> KeyMask -- ^ Shrink mask -> Int -- ^ Step size -> M.Map (ButtonMask, KeySym) (X ()) floatMap move enlarge shrink s = M.fromList [ -- move ((move, xK_h) , withFocused (keysMoveWindow (-s, 0))) , ((move, xK_j) , withFocused (keysMoveWindow (0, s))) , ((move, xK_k) , withFocused (keysMoveWindow (0, -s))) , ((move, xK_l) , withFocused (keysMoveWindow (s, 0))) -- enlarge , ((enlarge, xK_h), withFocused (keysResizeWindow (s, 0) (1, 0))) , ((enlarge, xK_j), withFocused (keysResizeWindow (0, s) (0, 0))) , ((enlarge, xK_k), withFocused (keysResizeWindow (0, s) (0, 1))) , ((enlarge, xK_l), withFocused (keysResizeWindow (s, 0) (0, 0))) -- shrink , ((shrink, xK_h), withFocused (keysResizeWindow (-s, 0) (0, 0))) , ((shrink, xK_j), withFocused (keysResizeWindow (0, -s) (0, 1))) , ((shrink, xK_k), withFocused (keysResizeWindow (0, -s) (0, 0))) , ((shrink, xK_l), withFocused (keysResizeWindow (-s, 0) (1, 0))) , ((noModMask, xK_Escape), exitMode) ] -- | A mode to control floating windows with @{hijk}@, @M-{hijk}@ and -- @M-S-{hijk}@ in order to respectively move, enlarge and -- shrink windows. floatMode :: Int -- ^ Step size -> Mode floatMode i = mode floatModeLabel $ \XConfig { modMask } -> floatMap noModMask modMask (modMask .|. shiftMask) i -- | Similar to 'resizeMode', but keeps the bindings of the original -- config active. overlayedFloatMode :: Int -- ^ Step size -> Mode overlayedFloatMode = overlay overlayedFloatModeLabel . floatMode -- | Modifies a mode so that the keybindings are merged with those from -- the config instead of replacing them. overlay :: String -- ^ Label for the new mode -> Mode -- ^ Base mode -> Mode overlay label m = Mode label $ \cnf -> boundKeys m cnf <> keys cnf cnf -- | Strips the modifier key from the provided keybindings. stripModifier :: ButtonMask -- ^ Modifier to remove -> M.Map (ButtonMask, KeySym) (X ()) -- ^ Original keybinding map -> M.Map (ButtonMask, KeySym) (X ()) stripModifier mask = M.mapKeys $ \(m, k) -> (m .&. complement mask, k) -- }}} xmonad-contrib-0.18.0/XMonad/Hooks/OnPropertyChange.hs0000644000000000000000000001070607346545000020755 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.OnPropertyChange -- Description : Apply a manageHook on a property (e.g., @WM_CLASS@) change -- Copyright : (c) Brandon S Allbery, 2015 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module to apply a ManageHook to an already-mapped window when a property -- changes. This would commonly be used to match browser windows by title, -- since the final title will only be set after (a) the window is mapped, -- (b) its document has been loaded, (c) all load-time scripts have run. -- (Don't blame browsers for this; it's inherent in HTML and the DOM. And -- changing title dynamically is explicitly permitted by ICCCM and EWMH; -- you don't really want to have your editor window umapped/remapped to -- show the current document and modified state in the titlebar, do you?) -- -- This is a handleEventHook that triggers on a PropertyChange event. It -- currently ignores properties being removed, in part because you can't -- do anything useful in a ManageHook involving nonexistence of a property. -- -- This module could also be useful for Electron applications like Spotify -- which sets its WM_CLASS too late for window manager to map it properly. -- ----------------------------------------------------------------------------- module XMonad.Hooks.OnPropertyChange ( -- * Usage -- $usage onXPropertyChange, onTitleChange, onClassChange, ) where import XMonad import XMonad.Prelude -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.DynamicProperty -- -- Enable it by including in you handleEventHook definition: -- -- > main = xmonad $ def -- > { ... -- > , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")) -- > , ... -- > } -- -- Or you could create a dynamicManageHook as below: -- -- > myDynamicManageHook :: ManageHook -- > myDynamicManageHook = -- > composeAll -- > [ className =? "Spotify" --> doShift (myWorkspaces !! 4), -- > title =? "maybe_special_terminal" <||> title =? "special_terminal" --> doCenterFloat, -- > className =? "dynamicApp" <&&> title =? "dynamic_app" --> doCenterFloat -- > ] -- -- And then use it in your handleEventHookDefinition: -- -- > main = xmonad $ def -- > { ... -- > , handleEventHook = onXPropertyChange "WM_NAME" myDynamicManageHook -- > , ... -- > } -- -- | -- Run a 'ManageHook' when a specific property is changed on a window. Note -- that this will run on any window which changes the property, so you should -- be very specific in your 'ManageHook' matching (lots of windows change -- their titles on the fly!): -- -- > onXPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2") -- -- Note that the fixity of (-->) won't allow it to be mixed with ($), so you -- can't use the obvious $ shorthand. -- -- > onXPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work! -- -- Consider instead phrasing it like any -- other 'ManageHook': -- -- > main = xmonad $ def -- > { ... -- > , handleEventHook = onXPropertyChange "WM_NAME" myDynHook -- > , ... -- > } -- > -- > myDynHook = composeAll [...] -- onXPropertyChange :: String -> ManageHook -> Event -> X All onXPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do pa <- getAtom prop when (ps == propertyNewValue && a == pa) $ do g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w) windows g return mempty -- so anything else also processes it onXPropertyChange _ _ _ = return mempty -- | A shorthand for dynamic titles; i.e., applications changing their -- @WM_NAME@ property. onTitleChange :: ManageHook -> Event -> X All -- strictly, this should also check _NET_WM_NAME. practically, both will -- change and each gets its own PropertyEvent, so we'd need to record that -- we saw the event for that window and ignore the second one. Instead, just -- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false, -- since there's always someone who can't bother being compliant.) onTitleChange = onXPropertyChange "WM_NAME" -- | A shorthand for dynamic resource and class names; i.e., -- applications changing their @WM_CLASS@ property. onClassChange :: ManageHook -> Event -> X All onClassChange = onXPropertyChange "WM_CLASS" xmonad-contrib-0.18.0/XMonad/Hooks/Place.hs0000644000000000000000000004145607346545000016560 0ustar0000000000000000{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Place -- Description : Automatic placement of floating windows. -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Automatic placement of floating windows. -- ----------------------------------------------------------------------------- module XMonad.Hooks.Place ( -- * Usage -- $usage -- * Placement actions placeFocused , placeHook -- * Placement policies -- $placements , Placement , smart , simpleSmart , fixed , underMouse , inBounds , withGaps -- * Others , purePlaceWindow ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Actions.FloatKeys import qualified Data.Map as M import Data.Ratio ((%)) import Control.Monad.Trans (lift) -- $usage -- This module provides a 'ManageHook' that automatically places -- floating windows at appropriate positions on the screen, as well -- as an 'X' action to manually trigger repositioning. -- -- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Place -- -- and adding 'placeHook' to your 'manageHook', for example: -- -- > main = xmonad $ def { manageHook = placeHook simpleSmart -- > <> manageHook def } -- -- Note that 'placeHook' should be applied after most other hooks, especially hooks -- such as 'doFloat' and 'doShift'. Since hooks combined with '<>' are applied from -- right to left, this means that 'placeHook' should be the /first/ hook in your chain. -- -- You can also define a key to manually trigger repositioning with 'placeFocused' by -- adding the following to your keys definition: -- -- > , ((modm, xK_w), placeFocused simpleSmart) -- -- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies -- the placement policy to use (smart, under the mouse, fixed position, etc.). See -- 'Placement' for a list of available policies. {- Placement policies -} -- $placements -- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'. -- -- A few examples: -- -- * Basic smart placement -- -- > myPlacement = simpleSmart -- -- * Under the mouse (pointer at the top-left corner), but constrained -- inside of the screen area -- -- > myPlacement = inBounds (underMouse (0, 0)) -- -- * Smart placement with a preference for putting windows near -- the center of the screen, and with 16px gaps at the top and bottom -- of the screen where no window will be placed -- -- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5)) -- | The type of placement policies data Placement = Smart (Rational, Rational) | Fixed (Rational, Rational) | UnderMouse (Rational, Rational) | Bounds (Dimension, Dimension, Dimension, Dimension) Placement deriving (Show, Read, Eq) -- | Try to place windows with as little overlap as possible smart :: (Rational, Rational) -- ^ Where the window should be placed inside -- the available area. See 'fixed'. -> Placement smart = Smart simpleSmart :: Placement simpleSmart = inBounds $ smart (0,0) -- | Place windows at a fixed position fixed :: (Rational, Rational) -- ^ Where windows should go. -- -- * (0,0) -> top left of the screen -- -- * (1,0) -> top right of the screen -- -- * etc -> Placement fixed = Fixed -- | Place windows under the mouse underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to -- the window's frame; see 'fixed'. -> Placement underMouse = UnderMouse -- | Apply the given placement policy, constraining the -- placed windows inside the screen boundaries. inBounds :: Placement -> Placement inBounds = Bounds (0,0,0,0) -- | Same as 'inBounds', but allows specifying gaps along the screen's edges withGaps :: (Dimension, Dimension, Dimension, Dimension) -- ^ top, right, bottom and left gaps -> Placement -> Placement withGaps = Bounds {- Placement functions -} -- | Repositions the focused window according to a placement policy. Works for -- both \"real\" floating windows and windows in a 'WindowArranger'-based -- layout. placeFocused :: Placement -> X () placeFocused p = withFocused $ \window -> do info <- gets $ screenInfo . S.current . windowset floats <- gets $ M.keys . S.floating . windowset r'@(Rectangle x' y' _ _) <- placeWindow p window info floats -- use X.A.FloatKeys if the window is floating, send -- a WindowArranger message otherwise. 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 pointer <- Query $ lift $ getPointer window return $ Endo $ \theWS -> fromMaybe theWS $ do let currentRect = screenRect $ S.screenDetail $ S.current theWS floats = M.keys $ S.floating theWS guard(window `elem` floats ) -- Look for the workspace(s) on which the window is to be -- spawned. Each of them also needs an associated screen -- rectangle; for hidden workspaces, we use the current -- workspace's screen. let infos = find ((window `elem`) . stackContents . S.stack . fst) $ [screenInfo $ S.current theWS] ++ map screenInfo (S.visible theWS) ++ map (, currentRect) (S.hidden theWS) case infos of Nothing -> empty Just info -> do let (workspace, screen) = info rs = mapMaybe (`M.lookup` allRs) $ organizeClients workspace window floats r' = purePlaceWindow p screen rs pointer r newRect = r2rr screen r' newFloats = M.insert window newRect (S.floating theWS) return $ theWS { S.floating = newFloats } placeWindow :: Placement -> Window -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle) -- ^ The workspace with reference to which the window should be placed, -- and the screen's geometry. -> [Window] -- ^ The list of floating windows. -> X Rectangle placeWindow p window (ws, s) floats = do (r, rs, pointer) <- getNecessaryData window ws floats return $ purePlaceWindow p s rs pointer r -- | Compute the new position of a window according to a placement policy. purePlaceWindow :: Placement -- ^ The placement strategy -> Rectangle -- ^ The screen -> [Rectangle] -- ^ The other visible windows -> (Position, Position) -- ^ The pointer's position. -> 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) in checkBounds s' $ purePlaceWindow p' s' rs p w purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w purePlaceWindow (UnderMouse (rx, ry)) _ _ (px, py) (Rectangle _ _ w h) = Rectangle (px - truncate (rx * fi w)) (py - truncate (ry * fi h)) w h purePlaceWindow (Smart ratios) s rs _ w = placeSmart ratios s rs (rect_width w) (rect_height w) -- | Helper: Places a Rectangle at a fixed position indicated by two Rationals -- inside another, placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle placeRatio (rx, ry) (Rectangle x1 y1 w1 h1) (Rectangle _ _ w2 h2) = Rectangle (scale rx x1 (x1 + fi w1 - fi w2)) (scale ry y1 (y1 + fi h1 - fi h2)) w2 h2 -- | Helper: Ensures its second parameter is contained inside the first -- by possibly moving it. checkBounds :: Rectangle -> Rectangle -> Rectangle checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) = Rectangle (max x1 (min (x1 + fi w1 - fi w2) x2)) (max y1 (min (y1 + fi h1 - fi h2) y2)) w2 h2 {- Utilities -} scale :: (RealFrac a, Integral b) => a -> b -> b -> b scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1 r2rr :: Rectangle -> Rectangle -> S.RationalRect r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h) = S.RationalRect ((fi x-fi x0) % fi w0) ((fi y-fi y0) % fi h0) (fi w % fi w0) (fi h % fi h0) {- Querying stuff -} stackContents :: Maybe (S.Stack w) -> [w] 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) getWindowRectangle :: Window -> X Rectangle getWindowRectangle window = do d <- asks display (_, x, y, w, h, _, _) <- io $ getGeometry d window -- We can't use the border width returned by -- getGeometry because it will be 0 if the -- window isn't mapped yet. b <- asks $ borderWidth . config return $ Rectangle x y (w + 2*b) (h + 2*b) getAllRectangles :: X (M.Map Window Rectangle) getAllRectangles = do ws <- gets windowset let allWindows = join $ map (stackContents . S.stack) $ (S.workspace . S.current) ws : (map S.workspace . S.visible) ws ++ S.hidden ws allRects <- mapM getWindowRectangle allWindows return $ M.fromList $ zip allWindows allRects organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window] organizeClients ws w floats = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w) $ stackContents $ S.stack ws in reverse layoutCs ++ reverse floatCs -- About the ordering: the smart algorithm will overlap windows -- starting ith the head of the list. So: -- - we put the non-floating windows first since they'll -- probably be below the floating ones, -- - we reverse the lists, since the newer/more important -- windows are usually near the head. getPointer :: Window -> X (Position, Position) getPointer window = do d <- asks display (_,_,_,x,y,_,_,_) <- io $ queryPointer d window return (fi x,fi y) -- | Return values are, in order: window's rectangle, -- other windows' rectangles and pointer's coordinates. getNecessaryData :: Window -> S.Workspace WorkspaceId (Layout Window) Window -> [Window] -> X (Rectangle, [Rectangle], (Position, Position)) getNecessaryData window ws floats = do r <- getWindowRectangle window rs <- mapM getWindowRectangle (organizeClients ws window floats) pointer <- getPointer window return (r, rs, pointer) {- Smart placement algorithm -} -- | Alternate representation for rectangles. data SmartRectangle a = SR { sr_x0, sr_y0 :: a -- ^ Top left coordinates, inclusive , sr_x1, sr_y1 :: a -- ^ Bottom right coorsinates, exclusive } deriving (Show, Eq) r2sr :: Rectangle -> SmartRectangle Position r2sr (Rectangle x y w h) = SR x y (x + fi w) (y + fi h) sr2r :: SmartRectangle Position -> Rectangle sr2r (SR x0 y0 x1 y1) = Rectangle x0 y0 (fi $ x1 - x0) (fi $ y1 - y0) width :: Num a => SmartRectangle a -> a width r = sr_x1 r - sr_x0 r height :: Num a => SmartRectangle a -> a height r = sr_y1 r - sr_y0 r isEmpty :: Real a => SmartRectangle a -> Bool isEmpty r = (width r <= 0) || (height r <= 0) contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool contains r1 r2 = sr_x0 r1 <= sr_x0 r2 && sr_y0 r1 <= sr_y0 r2 && sr_x1 r1 >= sr_x1 r2 && sr_y1 r1 >= sr_y1 r2 -- | Main placement function placeSmart :: (Rational, Rational) -- ^ point of the screen where windows -- should be placed first, if possible. -> Rectangle -- ^ screen -> [Rectangle] -- ^ other clients -> Dimension -- ^ width -> Dimension -- ^ height -> Rectangle placeSmart (rx, ry) s@(Rectangle sx sy sw sh) rs w h = let free = map sr2r $ findSpace (r2sr s) (map r2sr rs) (fi w) (fi h) in position free (scale rx sx (sx + fi sw - fi w)) (scale ry sy (sy + fi sh - fi h)) w h -- | Second part of the algorithm: -- Chooses the best position in which to place a window, -- according to a list of free areas and an ideal position for -- the top-left corner. -- We can't use semi-open surfaces for this, so we go back to -- X11 Rectangles/Positions/etc instead. position :: [Rectangle] -- ^ Free areas -> Position -> Position -- ^ Ideal coordinates -> Dimension -> Dimension -- ^ Width and height of the window -> Rectangle position rs x y w h = minimumBy distanceOrder $ map closest rs where distanceOrder r1 r2 = compare (distance (rect_x r1,rect_y r1) (x,y) :: Dimension) (distance (rect_x r2,rect_y r2) (x,y) :: Dimension) distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) $ fi $ (x1 - x2)^(2::Int) + (y1 - y2)^(2::Int) closest r = checkBounds r (Rectangle x y w h) -- | First part of the algorithm: -- Tries to find an area in which to place a new -- rectangle so that it overlaps as little as possible with -- other rectangles already present. The first rectangles in -- the list will be overlapped first. findSpace :: Real a => SmartRectangle a -- ^ The total available area -> [SmartRectangle a] -- ^ The parts already in use -> a -- ^ Width of the rectangle to place -> a -- ^ Height of the rectangle to place -> [SmartRectangle a] findSpace total [] _ _ = [total] findSpace total rs@(_:rs') w h = case filter largeEnough $ cleanup $ subtractRects total rs of [] -> findSpace total rs' w h as -> as where largeEnough r = width r >= w && height r >= h -- | Subtracts smaller rectangles from a total rectangle -- , returning a list of remaining rectangular areas. subtractRects :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] subtractRects total [] = [total] subtractRects total (r:rs) = do total' <- subtractRects total rs filter (not . isEmpty) [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right , total' {sr_y0 = max (sr_y0 total') (sr_y1 r)} -- Below , total' {sr_x1 = min (sr_x1 total') (sr_x0 r)} -- Left ] -- | "Nubs" a list of rectangles, dropping all those that are -- already contained in another rectangle of the list. cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a] cleanup rs = foldr dropIfContained [] $ sortBy sizeOrder rs sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering sizeOrder r1 r2 | w1 < w2 = LT | w1 == w2 && h1 < h2 = LT | w1 == w2 && h1 == h2 = EQ | otherwise = GT where w1 = width r1 w2 = width r2 h1 = height r1 h2 = height r2 dropIfContained :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] dropIfContained r rs = if any (`contains` r) rs then rs else r:rs xmonad-contrib-0.18.0/XMonad/Hooks/PositionStoreHooks.hs0000644000000000000000000001112507346545000021347 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.PositionStoreHooks -- Description : Hooks for XMonad.Util.PositionStore. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- -- For windows, that do not request a particular position, a random position will -- be assigned. This prevents windows from piling up exactly on top of each other. -- -- The EventHook makes sure that windows are deleted from the PositionStore -- when they are closed. -- ----------------------------------------------------------------------------- module XMonad.Hooks.PositionStoreHooks ( -- * Usage -- $usage positionStoreManageHook, positionStoreEventHook ) 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 qualified Data.Set as S -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.PositionStoreHooks -- -- and adding 'positionStoreManageHook' to your 'ManageHook' as well -- as 'positionStoreEventHook' to your event hooks. To be accurate -- about window sizes, the module needs to know if any decoration is in effect. -- This is specified with the first argument: Supply 'Nothing' for no decoration, -- otherwise use 'Just def' or similar to inform the module about the -- decoration theme used. -- -- > myManageHook = positionStoreManageHook Nothing <> manageHook def -- > myHandleEventHook = positionStoreEventHook -- > -- > main = xmonad def { manageHook = myManageHook -- > , handleEventHook = myHandleEventHook -- > } -- positionStoreManageHook :: Maybe Theme -> ManageHook positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook positionStoreInit :: Maybe Theme -> Window -> X () positionStoreInit mDecoTheme w = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do let decoH = maybe 0 decoHeight mDecoTheme -- take decoration into account, which - in its current -- form - makes windows smaller to make room for it ws <- gets windowset arbitraryOffsetX <- randomIntOffset arbitraryOffsetY <- randomIntOffset if (wa_x wa == 0) && (wa_y wa == 0) then do let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws modifyPosStore (\ps -> posStoreInsert ps w (Rectangle (srX + fi arbitraryOffsetX) (srY + fi arbitraryOffsetY) (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr ) else do sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) let sr = screenRect . W.screenDetail $ sc sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting -- a somewhat unfortunate inter-dependency -- with 'XMonad.Hooks.ManageDocks' modifyPosStore (\ps -> posStoreInsert ps w (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 = io $ randomRIO (42, 242) positionStoreEventHook :: Event -> X All positionStoreEventHook DestroyWindowEvent{ev_window = w, ev_event_type = et} = do when (et == destroyNotify) $ modifyPosStore (`posStoreRemove` w) return (All True) positionStoreEventHook _ = return (All True) xmonad-contrib-0.18.0/XMonad/Hooks/RefocusLast.hs0000644000000000000000000002564207346545000017765 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-} -------------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.RefocusLast -- Description : Hooks and actions to refocus the previous window. -- Copyright : (c) 2018 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Maintainer : L. S. Leary -- Stability : unstable -- Portability : unportable -- -- Provides hooks and actions that keep track of recently focused windows on a -- per workspace basis and automatically refocus the last window on loss of the -- current (if appropriate as determined by user specified criteria). -------------------------------------------------------------------------------- -- --< Imports & Exports >-- {{{ module XMonad.Hooks.RefocusLast ( -- * Usage -- $Usage -- * Hooks refocusLastLogHook, refocusLastLayoutHook, refocusLastWhen, -- ** Predicates -- $Predicates refocusingIsActive, isFloat, -- * Actions toggleRefocusing, toggleFocus, swapWithLast, refocusWhen, shiftRLWhen, updateRecentsOn, -- * Types -- $Types RecentWins(..), RecentsMap(..), RefocusLastLayoutHook(..), RefocusLastToggle(..), -- * Library functions withRecentsIn, ) where import XMonad import XMonad.Prelude (All (..), asum, fromMaybe, when) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Stack (findS, mapZ_) import XMonad.Layout.LayoutModifier import qualified Data.Map.Strict as M -- }}} -- --< Usage >-- {{{ -- $Usage -- To use this module, you must either include 'refocusLastLogHook' in your log -- hook __or__ 'refocusLastLayoutHook' in your layout hook; don't use both. -- This suffices to make use of both 'toggleFocus' and 'shiftRLWhen' but will -- not refocus automatically upon loss of the current window; for that you must -- include in your event hook @'refocusLastWhen' pred@ for some valid @pred@. -- -- The event hooks that trigger refocusing only fire when a window is lost -- completely, not when it's simply e.g. moved to another workspace. Hence you -- will need to use @'shiftRLWhen' pred@ or @'refocusWhen' pred@ as appropriate -- if you want the same behaviour in such cases. -- -- Example configuration: -- -- > import XMonad -- > import XMonad.Hooks.RefocusLast -- > import qualified Data.Map.Strict as M -- > -- > main :: IO () -- > main = xmonad def -- > { handleEventHook = refocusLastWhen myPred <> handleEventHook def -- > , logHook = refocusLastLogHook <> logHook def -- > -- , layoutHook = refocusLastLayoutHook $ layoutHook def -- > , keys = refocusLastKeys <> keys def -- > } where -- > myPred = refocusingIsActive <||> isFloat -- > refocusLastKeys cnf -- > = M.fromList -- > $ ((modMask cnf , xK_a), toggleFocus) -- > : ((modMask cnf .|. shiftMask, xK_a), swapWithLast) -- > : ((modMask cnf , xK_b), toggleRefocusing) -- > : [ ( (modMask cnf .|. shiftMask, n) -- > , windows =<< shiftRLWhen myPred wksp -- > ) -- > | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf) -- > ] -- -- }}} -- --< Types >-- {{{ -- $Types -- The types and constructors used in this module are exported principally to -- aid extensibility; typical users will have nothing to gain from this section. -- | Data type holding onto the previous and current @Window@. data RecentWins = Recent { previous :: !Window, current :: !Window } deriving (Show, Read, Eq) -- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace. -- Is an instance of @ExtensionClass@ with persistence of state. newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins) deriving (Show, Read, Eq) instance ExtensionClass RecentsMap where initialValue = RecentsMap M.empty extensionType = PersistentExtension -- | A 'LayoutModifier' that updates the 'RecentWins' for a workspace upon -- relayout. data RefocusLastLayoutHook a = RefocusLastLayoutHook deriving (Show, Read) instance LayoutModifier RefocusLastLayoutHook a where modifyLayout _ w@(W.Workspace tg _ _) r = updateRecentsOn tg >> runLayout w r -- | A newtype on @Bool@ to act as a universal toggle for refocusing. newtype RefocusLastToggle = RefocusLastToggle { refocusing :: Bool } deriving (Show, Read, Eq) instance ExtensionClass RefocusLastToggle where initialValue = RefocusLastToggle { refocusing = True } extensionType = PersistentExtension -- }}} -- --< Public Hooks >-- {{{ -- | A log hook recording the current workspace's most recently focused windows -- into extensible state. refocusLastLogHook :: X () refocusLastLogHook = withWindowSet (updateRecentsOn . W.currentTag) -- | Records a workspace's recently focused windows into extensible state upon -- relayout. Potentially a less wasteful alternative to @refocusLastLogHook@, -- as it does not run on @WM_NAME@ @propertyNotify@ events. refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a refocusLastLayoutHook = ModifiedLayout RefocusLastLayoutHook -- | Given a predicate on the event window determining whether or not to act, -- construct an event hook that runs iff the core xmonad event handler will -- unmanage the window, and which shifts focus to the last focused window on -- the appropriate workspace if desired. refocusLastWhen :: Query Bool -> Event -> X All refocusLastWhen p event = All True <$ case event of UnmapEvent { ev_send_event = synth, ev_window = w } -> do e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) when (synth || e == 0) (refocusLast w) DestroyWindowEvent { ev_window = w } -> refocusLast w _ -> return () where refocusLast w = whenX (runQuery p w) . withWindowSet $ \ws -> whenJust (W.findTag w ws) $ \tag -> withRecentsIn tag () $ \lw cw -> when (w == cw) . modify $ \xs -> xs { windowset = tryFocusIn tag [lw] ws } -- }}} -- --< Predicates >-- {{{ -- $Predicates -- Impure @Query Bool@ predicates on event windows for use as arguments to -- 'refocusLastWhen', 'shiftRLWhen' and 'refocusWhen'. Can be combined with -- '<||>' or '<&&>'. Use like e.g. -- -- > , handleEventHook = refocusLastWhen refocusingIsActive -- -- or in a keybinding: -- -- > windows =<< shiftRLWhen (refocusingIsActive <&&> isFloat) "3" -- -- It's also valid to use a property lookup like @className =? "someProgram"@ as -- a predicate, and it should function as expected with e.g. @shiftRLWhen@. -- In the event hook on the other hand, the window in question has already been -- unmapped or destroyed, so external lookups to X properties don't work: -- only the information fossilised in xmonad's state is available. -- | Holds iff refocusing is toggled active. refocusingIsActive :: Query Bool refocusingIsActive = (liftX . XS.gets) refocusing -- | Holds iff the event window is a float. isFloat :: Query Bool isFloat = ask >>= \w -> (liftX . gets) (M.member w . W.floating . windowset) -- }}} -- --< Public Actions >-- {{{ -- | Toggle automatic refocusing at runtime. Has no effect unless the -- @refocusingIsActive@ predicate has been used. toggleRefocusing :: X () toggleRefocusing = XS.modify (RefocusLastToggle . not . refocusing) -- | Refocuses the previously focused window; acts as a toggle. -- Is not affected by @toggleRefocusing@. toggleFocus :: X () toggleFocus = withRecents $ \lw cw -> when (cw /= lw) . windows $ tryFocus [lw] -- | Swaps the current and previous windows of the current workspace. -- Is not affected by @toggleRefocusing@. swapWithLast :: X () swapWithLast = withRecents $ \lw cw -> when (cw /= lw) . windows . modify''. mapZ_ $ \w -> if | (w == lw) -> cw | (w == cw) -> lw | otherwise -> w where modify'' f = W.modify (f Nothing) (f . Just) -- | Given a target workspace and a predicate on its current window, produce a -- 'windows' suitable function that will refocus that workspace appropriately. -- Allows you to hook refocusing into any action you can run through -- @windows@. See the implementation of @shiftRLWhen@ for a straight-forward -- usage example. refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet) refocusWhen p tag = withRecentsIn tag id $ \lw cw -> do b <- runQuery p cw return (if b then tryFocusIn tag [cw, lw] else id) -- | Sends the focused window to the specified workspace, refocusing the last -- focused window if the predicate holds on the current window. Note that the -- native version of this, @windows . W.shift@, has a nice property that this -- does not: shifting a window to another workspace then shifting it back -- preserves its place in the stack. Can be used in a keybinding like e.g. -- -- > windows =<< shiftRLWhen refocusingIsActive "3" -- -- or -- -- > (windows <=< shiftRLWhen refocusingIsActive) "3" -- -- where '<=<' is imported from "Control.Monad". shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet) shiftRLWhen p to = withWindowSet $ \ws -> do refocus <- refocusWhen p (W.currentTag ws) let shift = maybe id (W.shiftWin to) (W.peek ws) return (refocus . shift) -- | Perform an update to the 'RecentWins' for the specified workspace. -- The RefocusLast log and layout hooks are both implemented trivially in -- terms of this function. Only exported to aid extensibility. updateRecentsOn :: WorkspaceId -> X () updateRecentsOn tag = withWindowSet $ \ws -> whenJust (W.peek $ W.view tag ws) $ \fw -> do m <- getRecentsMap let insertRecent l c = XS.put . RecentsMap $ M.insert tag (Recent l c) m case M.lookup tag m of Just (Recent _ cw) -> when (cw /= fw) (insertRecent cw fw) Nothing -> insertRecent fw fw -- }}} -- --< Utilities >-- {{{ -- | Focuses the first window in the list it can find on the current workspace. tryFocus :: [Window] -> WindowSet -> WindowSet tryFocus wins = W.modify' $ \s -> fromMaybe s . asum $ (\w -> findS (== w) s) <$> wins -- | Operate the above on a specified workspace. tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet tryFocusIn tag wins ws = W.view (W.currentTag ws) . tryFocus wins . W.view tag $ ws -- | Get the RecentsMap out of extensible state and remove its newtype wrapper. getRecentsMap :: X (M.Map WorkspaceId RecentWins) getRecentsMap = XS.get >>= \(RecentsMap m) -> return m -- | Perform an X action dependent on successful lookup of the RecentWins for -- the specified workspace, or return a default value. withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a withRecentsIn tag dflt f = maybe (return dflt) (\(Recent lw cw) -> f lw cw) . M.lookup tag =<< getRecentsMap -- | The above specialised to the current workspace and unit. withRecents :: (Window -> Window -> X ()) -> X () withRecents f = withWindowSet $ \ws -> withRecentsIn (W.currentTag ws) () f -- }}} xmonad-contrib-0.18.0/XMonad/Hooks/Rescreen.hs0000644000000000000000000001401207346545000017266 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} -- | -- Module : XMonad.Hooks.Rescreen -- Description : Custom hooks for screen (xrandr) configuration changes. -- Copyright : (c) 2021 Tomáš Janoušek -- License : BSD3 -- Maintainer : Tomáš Janoušek -- -- Custom hooks for screen (xrandr) configuration changes. -- module XMonad.Hooks.Rescreen ( -- * Usage -- $usage addAfterRescreenHook, addRandrChangeHook, RescreenConfig(..), 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 -- ('XMonad.Hooks.StatusBar.dynamicSBs' uses this module internally), as well -- as to actually invoke xrandr or autorandr when an output is (dis)connected. -- -- To use this, include the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Rescreen -- -- define your custom hooks: -- -- > myAfterRescreenHook :: X () -- > myAfterRescreenHook = spawn "fbsetroot -solid red" -- -- > myRandrChangeHook :: X () -- > myRandrChangeHook = spawn "autorandr --change" -- -- and hook them into your 'xmonad' config: -- -- > main = xmonad $ … -- > . addAfterRescreenHook myAfterRescreenHook -- > . addRandrChangeHook myRandrChangeHook -- > . … -- > $ def{…} -- -- See documentation of 'rescreenHook' for details about when these hooks are -- called. -- | Hook configuration for 'rescreenHook'. data RescreenConfig = RescreenConfig { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen' , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects } 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 = userCodeDef () h } -- | Shortcut for 'rescreenHook'. addRandrChangeHook :: X () -> XConfig l -> XConfig l addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () 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-contrib-0.18.0/XMonad/Hooks/ScreenCorners.hs0000644000000000000000000001437707346545000020311 0ustar0000000000000000{-# 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) -- -- Maintainer : Nils Schweinsberg -- Stability : unstable -- Portability : unportable -- -- Run @X ()@ actions by touching the edge of your screen with your mouse. -- ----------------------------------------------------------------------------- module XMonad.Hooks.ScreenCorners ( -- * Usage -- $usage -- * Adding screen corners ScreenCorner (..) , addScreenCorner , addScreenCorners -- * Event hook , screenCornerEventHook -- * Layout hook , screenCornerLayoutHook ) where import XMonad.Prelude import XMonad import XMonad.Layout.LayoutModifier import qualified Data.Map as M import qualified XMonad.Util.ExtensibleState as XS data ScreenCorner = SCUpperLeft | SCUpperRight | SCLowerLeft | SCLowerRight deriving (Eq, Ord, Show) -------------------------------------------------------------------------------- -- ExtensibleState modifications -------------------------------------------------------------------------------- newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ())) instance ExtensionClass ScreenCornerState where initialValue = ScreenCornerState M.empty -- | Add one single @X ()@ action to a screen corner addScreenCorner :: ScreenCorner -> X () -> X () addScreenCorner corner xF = do ScreenCornerState m <- XS.get (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions Nothing -> (, 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_ (uncurry addScreenCorner) -------------------------------------------------------------------------------- -- Xlib functions -------------------------------------------------------------------------------- -- "Translate" a ScreenCorner to real (x,y) Positions createWindowAt :: ScreenCorner -> X Window createWindowAt SCUpperLeft = createWindowAt' 0 0 createWindowAt SCUpperRight = withDisplay $ \dpy -> let w = displayWidth dpy (defaultScreen dpy) - 1 in createWindowAt' (fi w) 0 createWindowAt SCLowerLeft = withDisplay $ \dpy -> let h = displayHeight dpy (defaultScreen dpy) - 1 in createWindowAt' 0 (fi h) createWindowAt SCLowerRight = withDisplay $ \dpy -> let w = displayWidth dpy (defaultScreen dpy) - 1 h = displayHeight dpy (defaultScreen dpy) - 1 in createWindowAt' (fi w) (fi h) -- Create a new X window at a (x,y) Position createWindowAt' :: Position -> Position -> X Window createWindowAt' x y = withDisplay $ \dpy -> io $ do rootw <- rootWindow dpy (defaultScreen dpy) let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy attrmask = cWOverrideRedirect w <- allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow dpy -- display rootw -- parent window x -- x y -- y 1 -- width 1 -- height 0 -- border width 0 -- depth inputOnly -- class visual -- visual attrmask -- valuemask attributes -- attributes -- we only need mouse entry events selectInput dpy w enterWindowMask mapWindow dpy w sync dpy False return w -------------------------------------------------------------------------------- -- Event hook -------------------------------------------------------------------------------- -- | Handle screen corner events screenCornerEventHook :: Event -> X All screenCornerEventHook CrossingEvent { ev_window = win } = do ScreenCornerState m <- XS.get case M.lookup win m of Just (_, xF) -> xF Nothing -> return () return (All True) screenCornerEventHook _ = return (All True) -------------------------------------------------------------------------------- -- Layout hook -------------------------------------------------------------------------------- data ScreenCornerLayout a = ScreenCornerLayout deriving ( Read, Show ) instance LayoutModifier ScreenCornerLayout a where hook ScreenCornerLayout = withDisplay $ \dpy -> do ScreenCornerState m <- XS.get io $ mapM_ (raiseWindow dpy) $ M.keys m unhook = hook screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout -------------------------------------------------------------------------------- -- $usage -- -- This extension adds KDE-like screen corners to XMonad. By moving your cursor -- into one of your screen corners you can trigger an @X ()@ action, for -- example @"XMonad.Actions.GridSelect".goToSelected@ or -- @"XMonad.Actions.CycleWS".nextWS@ etc. -- -- To use it, import it on top of your @xmonad.hs@: -- -- > import XMonad.Hooks.ScreenCorners -- -- Then add your screen corners in our startup hook: -- -- > myStartupHook = do -- > ... -- > addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200}) -- > addScreenCorners [ (SCLowerRight, nextWS) -- > , (SCLowerLeft, prevWS) -- > ] -- -- Then add layout hook: -- -- > myLayout = screenCornerLayoutHook $ tiled ||| Mirror tiled ||| Full where -- > tiled = Tall nmaster delta ratio -- > nmaster = 1 -- > ratio = 1 / 2 -- > delta = 3 / 100 -- -- And finally wait for screen corner events in your event hook: -- -- > myEventHook e = do -- > ... -- > screenCornerEventHook e xmonad-contrib-0.18.0/XMonad/Hooks/Script.hs0000644000000000000000000000272607346545000016775 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Script -- Description : Simple interface for running a ~\/.xmonad\/hooks script with the name of a hook. -- Copyright : (c) Trevor Elliott -- License : BSD3-style (see LICENSE) -- -- Maintainer : Trevor Elliott -- Stability : unstable -- Portability : unportable -- -- Provides a simple interface for running a ~\/.xmonad\/hooks script with the -- name of a hook. -- ----------------------------------------------------------------------------- module XMonad.Hooks.Script ( -- * Usage -- $usage -- * Script Hook Interface execScriptHook ) where -- -- Useful Imports -- import XMonad -- $usage -- -- This module allows you to run a centrally located script with the text -- name of a hook. The script is assumed to be located at @~\/.xmonad\/hooks@. -- -- For example, if you wanted to run the hook "startup" in your script every -- time your startup hook ran, you could modify your xmonad config as such: -- -- > main = xmonad $ def { -- > ... -- > startupHook = execScriptHook "startup" -- > ... -- > } -- -- Now, every time the startup hook runs, the command -- @~\/.xmonad\/hooks startup@ will also. -- | Execute a named script hook execScriptHook :: String -> X () execScriptHook hook = do xmonadDir <- asks (cfgDir . directories) let script = xmonadDir ++ "/hooks " spawn (script ++ hook) xmonad-contrib-0.18.0/XMonad/Hooks/ServerMode.hs0000644000000000000000000001011507346545000017573 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ServerMode -- Description : Send commands to a running xmonad process. -- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : polson2@hawk.iit.edu -- Stability : unstable -- Portability : unportable -- -- This is an 'EventHook' that will receive commands from an external -- client. Also consider "XMonad.Hooks.EwmhDesktops" together with -- @wmctrl@. -- -- See @scripts/xmonadctl.hs@ for the client. -- ----------------------------------------------------------------------------- module XMonad.Hooks.ServerMode ( -- * Usage -- $usage serverModeEventHook , serverModeEventHook' , serverModeEventHookCmd , serverModeEventHookCmd' , serverModeEventHookF ) where import System.IO import XMonad import XMonad.Prelude import XMonad.Actions.Commands -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode -- -- Then edit your @handleEventHook@ by adding the appropriate event hook from below -- | Executes a command of the list when receiving its index via a special ClientMessageEvent -- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers -- 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 -- serverModeEventHook :: Event -> X All serverModeEventHook = serverModeEventHook' defaultCommands -- | serverModeEventHook' additionally takes an action to generate the list of -- commands. serverModeEventHook' :: X [(String,X ())] -> Event -> X All 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 = zipWith (++) (map show [1 :: Int ..]) (map ((++) " - " . fst) cl) -- | Executes a command of the list when receiving its name via a special ClientMessageEvent. -- Uses "XMonad.Actions.Commands#defaultCommands" as the default. -- -- > main = xmonad def { handleEventHook = serverModeEventHookCmd } -- -- > xmonadctl run # Tells xmonad to generate a run prompt -- serverModeEventHookCmd :: Event -> X All serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands -- | Additionally takes an action to generate the list of commands serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All 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) -- | Listens for an atom, then executes a callback function whenever it hears it. -- A trivial example that prints everything supplied to it on xmonad's standard out: -- -- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) } -- -- > xmonadctl -a XMONAD_PRINT "hello world" -- serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do d <- asks display atm <- io $ internAtom d key False if | mt == atm, Just dth <- listToMaybe dt -> do let atom = fromIntegral dth cmd <- io $ getAtomName d atom case cmd of Just command -> func command Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom) | otherwise -> pure () return (All True) serverModeEventHookF _ _ _ = return (All True) xmonad-contrib-0.18.0/XMonad/Hooks/SetWMName.hs0000644000000000000000000001156007346545000017325 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.SetWMName -- Description : Set the WM name to a given string. -- Copyright : © 2007 Ivan Tarasov -- License : BSD -- -- Maintainer : Ivan.Tarasov@gmail.com -- Stability : experimental -- Portability : unportable -- -- Sets the WM name to a given string, so that it could be detected using -- _NET_SUPPORTING_WM_CHECK protocol. -- -- May be useful for making Java GUI programs work, just set WM name to \"LG3D\" -- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later. -- -- To your @xmonad.hs@ file, add the following line: -- -- > import XMonad.Hooks.SetWMName -- -- Then edit your @startupHook@: -- -- > startupHook = setWMName "LG3D" -- -- For details on the problems with running Java GUI programs in non-reparenting -- WMs, see and -- related bugs. -- -- Setting WM name to "compiz" does not solve the problem, because of yet -- another bug in AWT code (related to insets). For LG3D insets are explicitly -- set to 0, while for other WMs the insets are \"guessed\" and the algorithm -- fails miserably by guessing absolutely bogus values. -- -- For detailed instructions on editing your hooks, see -- and "XMonad.Doc.Extending". ----------------------------------------------------------------------------- module XMonad.Hooks.SetWMName ( setWMName , getWMName ) where 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 () setWMName name = do atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom atom_NET_WM_NAME <- getAtom "_NET_WM_NAME" atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED" atom_UTF8_STRING <- getAtom "UTF8_STRING" root <- asks theRoot supportWindow <- getSupportWindow 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 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 propModeReplace (latin1StringToCCharList name) -- declare which _NET protocols are supported (append to the list if it exists) 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 latin1StringToCCharList :: String -> [CChar] latin1StringToCCharList = map (fromIntegral . ord) 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 if valid then return $ fromJust w else createSupportWindow -- is there a better way to check the validity of the window? isValidWindow :: Window -> X Bool isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do status <- xGetWindowAttributes dpy w p return (status /= 0) -- this code was translated from C (see OpenBox WM, screen.c) createSupportWindow :: X Window createSupportWindow = withDisplay $ \dpy -> do root <- asks theRoot let visual = defaultVisual dpy (defaultScreen dpy) -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib window <- io $ allocaSetWindowAttributes $ \winAttrs -> do set_override_redirect winAttrs True -- WM cannot decorate/move/close this window set_event_mask winAttrs propertyChangeMask -- not sure if this is needed let bogusX = -100 bogusY = -100 in createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs 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-contrib-0.18.0/XMonad/Hooks/ShowWName.hs0000644000000000000000000000501507346545000017373 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ShowWName -- Description : Like 'XMonad.Layout.ShowWName', but as a logHook -- Copyright : (c) 2022 Tony Zorman -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tony Zorman -- -- Flash the names of workspaces name when switching to them. This is a -- reimplementation of "XMonad.Layout.ShowWName" as a logHook. ----------------------------------------------------------------------------- module XMonad.Hooks.ShowWName ( -- * Usage -- $usage showWNameLogHook, SWNConfig(..), flashName, ) where import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad import XMonad.Layout.ShowWName (SWNConfig (..)) import XMonad.Prelude import XMonad.Util.XUtils (WindowConfig (..), showSimpleWindow) import Control.Concurrent (threadDelay) {- $usage You can use this module with the following in your @xmonad.hs@: > import XMonad.Hooks.ShowWName > > main :: IO () > main = xmonad $ def > { logHook = showWNameLogHook def > } Whenever a workspace gains focus, the above logHook will flash its name. You can customise the duration of the flash, as well as colours by customising the 'SWNConfig' argument that 'showWNameLogHook' takes. Alternatively, you can also bind 'flashName' to a key and manually invoke it when you want to know which workspace you are on. -} -- | LogHook for flashing the name of a workspace upon entering it. showWNameLogHook :: SWNConfig -> X () showWNameLogHook cfg = do LastShown s <- XS.get foc <- withWindowSet (pure . W.currentTag) unless (s == foc) $ do flashName cfg XS.put (LastShown foc) -- | Flash the name of the currently focused workspace. flashName :: SWNConfig -> X () flashName cfg = do n <- withWindowSet (pure . W.currentTag) showSimpleWindow cfg' [n] >>= \w -> void . xfork $ do dpy <- openDisplay "" threadDelay (fromEnum $ swn_fade cfg * 1000000) -- 1_000_000 needs GHC 8.6.x and up void $ destroyWindow dpy w closeDisplay dpy where cfg' :: WindowConfig cfg' = def{ winFont = swn_font cfg, winBg = swn_bgcolor cfg, winFg = swn_color cfg } -- | Last shown workspace. newtype LastShown = LastShown WorkspaceId deriving (Show, Read) instance ExtensionClass LastShown where initialValue :: LastShown initialValue = LastShown "" extensionType :: LastShown -> StateExtension extensionType = PersistentExtension xmonad-contrib-0.18.0/XMonad/Hooks/StatusBar.hs0000644000000000000000000005723607346545000017447 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, TypeApplications, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.StatusBar -- Description : Composable and dynamic status bars. -- Copyright : (c) Yecine Megdiche -- License : BSD3-style (see LICENSE) -- -- Maintainer : Yecine Megdiche -- Stability : unstable -- Portability : unportable -- -- xmonad calls the logHook with every internal state update, which is -- useful for (among other things) outputting status information to an -- external status bar program such as xmobar or dzen. -- -- This module provides a composable interface for (re)starting these status -- bars and logging to them, either using pipes or X properties. There's also -- "XMonad.Hooks.StatusBar.PP" which provides an abstraction and some -- utilities for customization what is logged to a status bar. Together, these -- are a modern replacement for "XMonad.Hooks.DynamicLog", which is now just a -- compatibility wrapper. -- ----------------------------------------------------------------------------- module XMonad.Hooks.StatusBar ( -- * Usage -- $usage StatusBarConfig(..), withSB, withEasySB, defToggleStrutsKey, -- * Available Configs -- $availableconfigs statusBarProp, statusBarPropTo, statusBarGeneric, statusBarPipe, -- * Multiple Status Bars -- $multiple -- * Dynamic Status Bars -- $dynamic dynamicSBs, dynamicEasySBs, -- * Property Logging utilities xmonadPropLog, xmonadPropLog', xmonadDefProp, -- * Managing status bar Processes -- $sbprocess spawnStatusBar, killStatusBar, killAllStatusBars, startAllStatusBars, ) where import Control.Exception (SomeException, try) import Data.IORef (newIORef, readIORef, writeIORef) import qualified Codec.Binary.UTF8.String as UTF8 (encode) import qualified Data.Map as M import System.IO (hClose) import System.Posix.Signals (sigTERM, signalProcessGroup) import System.Posix.Types (ProcessID) import Foreign.C (CChar) import XMonad import XMonad.Prelude import XMonad.Util.Run import qualified XMonad.Util.ExtensibleState as XS import XMonad.Layout.LayoutModifier import XMonad.Hooks.ManageDocks import XMonad.Hooks.Rescreen import XMonad.Hooks.StatusBar.PP import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.StatusBar -- > import XMonad.Hooks.StatusBar.PP -- -- The easiest way to use this module with xmobar, as well as any other -- status bar that supports property logging, is to use 'statusBarProp' -- with 'withEasySB'; these take care of the necessary plumbing: -- -- > mySB = statusBarProp "xmobar" (pure xmobarPP) -- > main = xmonad $ withEasySB mySB defToggleStrutsKey def -- -- You can read more about X11 properties -- [here](https://en.wikipedia.org/wiki/X_Window_System_core_protocol#Properties) -- or -- [here](https://tronche.com/gui/x/xlib/window-information/properties-and-atoms.html), -- although you don't have to understand them in order to use the functions -- mentioned above. -- -- Most users will, however, want to customize the logging and integrate it -- into their existing custom xmonad configuration. The 'withSB' -- function is more appropriate in this case: it doesn't touch your -- keybindings, layout modifiers, or event hooks; instead, you're expected -- to configure "XMonad.Hooks.ManageDocks" yourself. Here's what that might -- look like: -- -- > mySB = statusBarProp "xmobar" (pure myPP) -- > main = xmonad . withSB mySB . ewmh . docks $ def {...} -- -- You then have to tell your status bar to read from the @_XMONAD_LOG@ property -- of the root window. In the case of xmobar, this is achieved by simply using -- the @XMonadLog@ plugin instead of @StdinReader@ in your @.xmobarrc@: -- -- > Config { ... -- > , commands = [ Run XMonadLog, ... ] -- > , template = "%XMonadLog% }{ ..." -- > } -- -- If you don't have an @.xmobarrc@, create it; the @XMonadLog@ plugin is not -- part of the default xmobar configuration and your status bar will not show -- workspace information otherwise! -- -- With 'statusBarProp', you need to use property logging. Make sure the -- status bar you use supports reading a property string from the root window, -- or use some kind of wrapper that reads the property and pipes it into the -- bar (e.g. @xmonadpropread | dzen2@, see @scripts/xmonadpropread.hs@). The -- default property is @_XMONAD_LOG@, which is conveniently saved in 'xmonadDefProp'. -- You can use another property by using the function 'statusBarPropTo'. -- -- If your status bar does not support property-based logging, you may also try -- 'statusBarPipe'. -- It can be used in the same way as 'statusBarProp' above (for xmobar, you now -- have to use the @StdinReader@ plugin in your @.xmobarrc@). Instead of -- writing to a property, this function opens a pipe and makes the given status -- bar read from that pipe. -- Please be aware that this kind of setup is very bug-prone and hence is -- discouraged: if anything goes wrong with the bar, xmonad will freeze! -- -- Also note that 'statusBarPipe' returns 'IO StatusBarConfig', so -- you need to evaluate it before passing it to 'withSB' or 'withEasySB': -- -- > main = do -- > mySB <- statusBarPipe "xmobar" (pure myPP) -- > xmonad $ withSB mySB myConf -- $plumbing -- If you do not want to use any of the "batteries included" functions above, -- you can also add all of the necessary plumbing yourself (the source of -- 'withSB' might come in handy here). -- -- 'xmonadPropLog' allows you to write a string to the @_XMONAD_LOG@ property of -- the root window. Together with 'dynamicLogString', you can now simply set -- your 'logHook' to the appropriate function; for instance: -- -- > main = xmonad $ def { -- > ... -- > , logHook = xmonadPropLog =<< dynamicLogString myPP -- > ... -- > } -- -- If you want to define your own property name, use 'xmonadPropLog'' instead of -- 'xmonadPropLog'. -- -- If you just want to use the default pretty-printing format, you can replace -- @myPP@ with 'def' in the above 'logHook'. -- -- Note that setting 'logHook' only sets up xmonad's output; you are -- responsible for starting your own status bar program and making sure it reads -- from the property that xmonad writes to. To start your bar, simply put it -- into your 'startupHook'. You will also have also have to add 'docks' and -- 'avoidStruts' to your config. Putting all of this together would look -- something like -- -- > import XMonad.Util.SpawnOnce (spawnOnce) -- > import XMonad.Hooks.ManageDocks (avoidStruts, docks) -- > -- > main = do -- > xmonad $ docks $ def { -- > ... -- > , logHook = xmonadPropLog =<< dynamicLogString myPP -- > , startupHook = spawnOnce "xmobar" -- > , layoutHook = avoidStruts myLayout -- > ... -- > } -- > myPP = def { ... } -- > myLayout = ... -- -- If you want a keybinding to toggle your bar, you will also need to add this -- to the rest of your keybindings. -- -- The above has the problem that xmobar will not get restarted whenever you -- restart xmonad ('XMonad.Util.SpawnOnce.spawnOnce' will simply prevent your -- chosen status bar from spawning again). Using 'statusBarProp', however, takes -- care of the necessary plumbing /and/ keeps track of the started status bars, so -- they can be correctly restarted with xmonad. This is achieved using -- 'spawnStatusBar' to start them and 'killStatusBar' to kill -- previously started bars. -- -- Even if you don't use a status bar, you can still use 'dynamicLogString' to -- show on-screen notifications in response to some events. For example, to show -- the current layout when it changes, you could make a keybinding to cycle the -- layout and display the current status: -- -- > ((mod1Mask, xK_a), sendMessage NextLayout >> (dynamicLogString myPP >>= xmessage)) -- -- If you use a status bar that does not support reading from a property -- (like dzen), and you don't want to use the 'statusBar' function, you can, -- again, also manually add all of the required components, like this: -- -- > import XMonad.Util.Run (hPutStrLn, spawnPipe) -- > -- > main = do -- > h <- spawnPipe "dzen2 -options -foo -bar" -- > xmonad $ def { -- > ... -- > , logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h } -- > ... -- > } -- -- In the above, note that if you use @spawnPipe@ you need to redefine the -- 'ppOutput' field of your pretty-printer; by default the status will be -- printed to stdout rather than the pipe you create. This was meant to be -- used together with running xmonad piped to a status bar like so: @xmonad | -- dzen2@, and is what the old 'XMonad.Hooks.DynamicLog.dynamicLog' assumes, -- but it isn't recommended in modern setups. Applications launched from -- xmonad inherit its stdout and stderr, and will print their own garbage to -- the status bar. -- | This datataype abstracts a status bar to provide a common interface -- functions like 'statusBarPipe' or 'statusBarProp'. Once defined, a status -- bar can be incorporated in 'XConfig' by using 'withSB' or -- 'withEasySB', which take care of the necessary plumbing. data StatusBarConfig = StatusBarConfig { sbLogHook :: X () -- ^ What and how to log to the status bar. , sbStartupHook :: X () -- ^ How to start the status bar. , sbCleanupHook :: X () -- ^ How to kill the status bar. } instance Semigroup StatusBarConfig where StatusBarConfig l s c <> StatusBarConfig l' s' c' = StatusBarConfig (l <> l') (s <> s') (c <> c') instance Monoid StatusBarConfig where mempty = StatusBarConfig mempty mempty mempty -- | Per default, all the hooks do nothing. instance Default StatusBarConfig where def = mempty -- | Incorporates a 'StatusBarConfig' into an 'XConfig' by taking care of the -- necessary plumbing (starting, restarting and logging to it). -- -- Using this function multiple times to combine status bars may result in -- only one status bar working properly. See the section on using multiple -- status bars for more details. withSB :: LayoutClass l Window => StatusBarConfig -- ^ The status bar config -> XConfig l -- ^ The base config -> XConfig l withSB (StatusBarConfig lh sh ch) conf = conf { logHook = logHook conf *> lh , startupHook = startupHook conf *> ch *> sh } -- | Like 'withSB', but takes an extra key to toggle struts. It also -- applies the 'avoidStruts' layout modifier and the 'docks' combinator. -- -- Using this function multiple times to combine status bars may result in -- only one status bar working properly. See the section on using multiple -- status bars for more details. withEasySB :: LayoutClass l Window => StatusBarConfig -- ^ The status bar config -> (XConfig Layout -> (KeyMask, KeySym)) -- ^ The key binding -> XConfig l -- ^ The base config -> XConfig (ModifiedLayout AvoidStruts l) withEasySB sb k conf = docks . withSB sb $ conf { layoutHook = avoidStruts (layoutHook conf) , keys = (<>) <$> keys' <*> keys conf } where k' conf' = case k conf' of (0, 0) -> -- This usually means the user passed 'def' for the keybinding -- function, and is otherwise meaningless to harmful depending on -- whether 383ffb7 has been applied to xmonad or not. So do what -- they probably intend. -- -- A user who wants no keybinding function should probably use -- 'withSB' instead, especially since NoSymbol didn't do anything -- sane before 383ffb7. ++bsa defToggleStrutsKey conf' key -> key keys' = (`M.singleton` sendMessage ToggleStruts) . k' -- | Default @mod-b@ key binding for 'withEasySB' defToggleStrutsKey :: XConfig t -> (KeyMask, KeySym) defToggleStrutsKey XConfig{modMask = modm} = (modm, xK_b) -- | Creates a 'StatusBarConfig' that uses property logging to @_XMONAD_LOG@, which -- is set in 'xmonadDefProp' statusBarProp :: String -- ^ The command line to launch the status bar -> X PP -- ^ The pretty printing options -> StatusBarConfig statusBarProp = statusBarPropTo xmonadDefProp -- | Like 'statusBarProp', but lets you define the property statusBarPropTo :: String -- ^ Property to write the string to -> String -- ^ The command line to launch the status bar -> X PP -- ^ The pretty printing options -> StatusBarConfig statusBarPropTo prop cmd pp = statusBarGeneric cmd $ xmonadPropLog' prop =<< dynamicLogString =<< pp -- | A generic 'StatusBarConfig' that launches a status bar but takes a -- generic @X ()@ logging function instead of a 'PP'. This has several uses: -- -- * With 'xmonadPropLog' or 'xmonadPropLog'' in the logging function, a -- custom non-'PP'-based logger can be used for logging into an @xmobar@. -- -- * With 'mempty' as the logging function, it's possible to manage a status -- bar that reads information from EWMH properties like @taffybar@. -- -- * With 'mempty' as the logging function, any other dock like @trayer@ or -- @stalonetray@ can be managed by this module. statusBarGeneric :: String -- ^ The command line to launch the status bar -> X () -- ^ What and how to log to the status bar ('sbLogHook') -> StatusBarConfig statusBarGeneric cmd lh = def { sbLogHook = lh , sbStartupHook = spawnStatusBar cmd , sbCleanupHook = killStatusBar cmd } -- | Like 'statusBarProp', but uses pipe-based logging instead. statusBarPipe :: String -- ^ The command line to launch the status bar -> X PP -- ^ The pretty printing options -> IO StatusBarConfig statusBarPipe cmd xpp = do hRef <- newIORef Nothing return $ def { sbStartupHook = io (writeIORef hRef . Just =<< spawnPipe cmd) , sbLogHook = do h' <- io (readIORef hRef) whenJust h' $ \h -> io . hPutStrLn h =<< dynamicLogString =<< xpp , sbCleanupHook = io $ readIORef hRef >>= (`whenJust` hClose) >> writeIORef hRef Nothing } -- $multiple -- 'StatusBarConfig' is a 'Monoid', which means that multiple status bars can -- be combined together using '<>' or 'mconcat' and passed to 'withSB'. -- -- Here's an example of what such declarative configuration of multiple status -- bars may look like: -- -- > -- Make sure to setup the xmobar configs accordingly -- > xmobarTop = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top" (pure ppTop) -- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom) -- > xmobar1 = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1" (pure pp1) -- > -- > main = xmonad $ withSB (xmobarTop <> xmobarBottom <> xmobar1) myConfig -- -- And here is an example of the related xmobar configuration for the multiple -- status bars mentioned above: -- -- > xmobarrc_top -- > Config { ... -- > , commands = [ Run XPropertyLog "_XMONAD_LOG_1", ... ] -- > , template = "%_XMONAD_LOG_1% }{ ..." -- > } -- -- The above example also works if the different status bars support different -- logging methods: you could mix property logging and logging via pipes. -- One thing to keep in mind is that if multiple bars read from the same -- property, their content will be the same. If you want to use property-based -- logging with multiple bars, they should read from different properties. -- -- "XMonad.Util.Loggers" includes loggers that can be bound to specific screens, -- like 'logCurrentOnScreen', that might be useful with multiple screens. -- -- Long-time xmonad users will note that the above config is equivalent to -- the following less robust and more verbose configuration that they might -- find in their old configs: -- -- > main = do -- > -- do not use this, this is an example of a deprecated config -- > xmproc0 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_top" -- > xmproc1 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" -- > xmproc2 <- spawnPipe "xmobar -x 1 ~/.config/xmobar/xmobarrc1" -- > xmonad $ def { -- > ... -- > , logHook = dynamicLogWithPP ppTop { ppOutput = hPutStrLn xmproc0 } -- > >> dynamicLogWithPP ppBottom { ppOutput = hPutStrLn xmproc1 } -- > >> dynamicLogWithPP pp1 { ppOutput = hPutStrLn xmproc2 } -- > ... -- > } -- -- By using the new interface, the config becomes more declarative and there's -- less room for errors. -- -- The only *problem* now is that the status bars will not be updated when your screen -- configuration changes (by plugging in a monitor, for example). Check the section -- on dynamic status bars for how to do that. -- $dynamic -- Using multiple status bars by just combining them with '<>' works well -- as long as the screen configuration does not change often. If it does, -- you should use 'dynamicSBs': by providing a function that creates -- status bars, it takes care of setting up the event hook, the log hook -- and the startup hook necessary to make the status bars, well, dynamic. -- -- > xmobarTop = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top" (pure ppTop) -- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom) -- > xmobar1 = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1" (pure pp1) -- > -- > barSpawner :: ScreenId -> 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) -- | Start all status bars. Note that you do not need this in your startup hook. -- This can be bound to a keybinding for example to be used in tandem with -- `killAllStatusBars`. startAllStatusBars :: X () startAllStatusBars = XS.get >>= traverse_ (sbStartupHook . snd) . getASBs xmonad-contrib-0.18.0/XMonad/Hooks/StatusBar/0000755000000000000000000000000007346545000017076 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Hooks/StatusBar/PP.hs0000644000000000000000000005407507346545000017764 0ustar0000000000000000{-# 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 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Don Stewart -- Stability : unstable -- Portability : unportable -- -- xmonad calls the logHook with every internal state update, which is -- useful for (among other things) outputting status information to an -- external status bar program such as xmobar or dzen. -- -- This module provides a pretty-printing abstraction and utilities that can -- be used to customize what is logged to a status bar. See -- "XMonad.Hooks.StatusBar" for an abstraction over starting these status -- bars. Together these are a modern replacement for -- "XMonad.Hooks.DynamicLog", which is now just a compatibility wrapper. -- ----------------------------------------------------------------------------- module XMonad.Hooks.StatusBar.PP ( -- * Usage -- $usage -- * Build your own formatter PP(..), def, dynamicLogString, dynamicLogString', dynamicLogWithPP, -- * Predicates and formatters -- $predicates WS(..), WSPP, WSPP', fallbackPrinters, isUrgent, isCurrent, isVisible, isVisibleNoWindows, isHidden, -- * Example formatters dzenPP, xmobarPP, sjanssenPP, byorgeyPP, -- * Formatting utilities wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft', xmobarColor, xmobarFont, xmobarAction, xmobarBorder, xmobarRaw, xmobarStrip, xmobarStripTags, dzenColor, dzenEscape, dzenStrip, filterOutWsPP, -- * Internal formatting functions pprWindowSet, pprWindowSetXinerama ) where import Control.Monad.Reader import Control.DeepSeq import qualified Data.List.NonEmpty as NE import XMonad import XMonad.Prelude import qualified XMonad.StackSet as S import XMonad.Util.NamedWindows import XMonad.Util.WorkspaceCompare import XMonad.Hooks.UrgencyHook -- $usage -- An example usage for this module would be: -- -- > import XMonad -- > import XMonad.Hooks.StatusBar -- > import XMonad.Hooks.StatusBar.PP -- > -- > myPP = def { ppCurrent = xmobarColor "black" "white" } -- > mySB = statusBarProp "xmobar" (pure myPP) -- > main = xmonad . withEasySB mySB defToggleStrutsKey $ myConfig -- -- Check "XMonad.Hooks.StatusBar" for more examples and an in depth -- explanation. -- | The 'PP' type allows the user to customize the formatting of -- status information. data PP = PP { ppCurrent :: WorkspaceId -> String -- ^ how to print the tag of the currently focused -- workspace , ppVisible :: WorkspaceId -> String -- ^ how to print tags of visible but not focused -- workspaces (xinerama only) , ppHidden :: WorkspaceId -> String -- ^ how to print tags of hidden workspaces which -- contain windows , ppHiddenNoWindows :: WorkspaceId -> String -- ^ how to print tags of empty hidden workspaces , ppVisibleNoWindows :: Maybe (WorkspaceId -> String) -- ^ how to print tags of empty visible workspaces , ppUrgent :: WorkspaceId -> String -- ^ format to be applied to tags of urgent workspaces. , ppRename :: String -> WindowSpace -> String -- ^ rename/augment the workspace tag -- (note that @WindowSpace -> …@ acts as a Reader monad) , ppSep :: String -- ^ separator to use between different log sections -- (window name, layout, workspaces) , ppWsSep :: String -- ^ separator to use between workspace tags , ppTitle :: String -> String -- ^ window title format for the focused window. To display -- the titles of all windows—even unfocused ones—check -- 'XMonad.Util.Loggers.logTitles'. , ppTitleSanitize :: String -> String -- ^ escape / sanitizes input to 'ppTitle' , ppLayout :: String -> String -- ^ layout name format , ppOrder :: [String] -> [String] -- ^ how to order the different log sections. By -- default, this function receives a list with three -- formatted strings, representing the workspaces, -- the layout, and the current window titles, -- respectively. If you have specified any extra -- loggers in 'ppExtras', their output will also be -- appended to the list. To get them in the reverse -- order, you can just use @ppOrder = reverse@. If -- you don't want to display the current layout, you -- could use something like @ppOrder = \\(ws:_:t:_) -> -- [ws,t]@, and so on. , ppSort :: X ([WindowSpace] -> [WindowSpace]) -- ^ how to sort the workspaces. See -- "XMonad.Util.WorkspaceCompare" for some useful -- sorts. , ppExtras :: [X (Maybe String)] -- ^ loggers for generating extra information such as -- time and date, system load, battery status, and so -- on. See "XMonad.Util.Loggers" for examples, or create -- your own! , ppOutput :: String -> IO () -- ^ applied to the entire formatted string in order to -- output it. Can be used to specify an alternative -- output method (e.g. write to a pipe instead of -- stdout), and\/or to perform some last-minute -- formatting. Note that this is only used by -- 'dynamicLogWithPP'; it won't work with 'dynamicLogString' or -- "XMonad.Hooks.StatusBar". , ppPrinters :: WSPP -- ^ extend workspace types with custom predicates. -- Check $predicates for more details. } -- | The default pretty printing options: -- -- > 1 2 [3] 4 7 : full : title -- -- That is, the currently populated workspaces, the current -- workspace layout, and the title of the focused window. instance Default PP where def = PP { ppCurrent = wrap "[" "]" , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const "" , ppVisibleNoWindows = Nothing , ppUrgent = id , ppRename = pure , ppSep = " : " , ppWsSep = " " , ppTitle = shorten 80 , ppTitleSanitize = xmobarStrip . dzenEscape , ppLayout = id , ppOrder = id , ppOutput = putStrLn , ppSort = getSortByIndex , ppExtras = [] , ppPrinters = empty } -- | Format the current status using the supplied pretty-printing format, -- and write it to stdout. dynamicLogWithPP :: PP -> X () dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp -- | The same as 'dynamicLogWithPP', except it simply returns the status -- as a formatted string without actually printing it to stdout, to -- allow for further processing, or use in some application other than -- a status bar. dynamicLogString :: PP -> X String dynamicLogString pp = userCodeDef "_|_" (dynamicLogString' pp) -- | The guts of 'dynamicLogString'. Forces the result, so it may throw -- an exception (most commonly because 'ppOrder' is non-total). Use -- 'dynamicLogString' for a version that catches the exception and -- produces an error string. dynamicLogString' :: PP -> X String dynamicLogString' pp = do winset <- gets windowset urgents <- readUrgents sort' <- ppSort pp -- layout description let ld = description . S.layout . S.workspace . S.current $ winset -- workspace list let ws = pprWindowSet sort' urgents pp winset -- run extra loggers, ignoring any that generate errors. extras <- mapM (userCodeDef Nothing) $ ppExtras pp -- window title wt <- maybe (pure "") (fmap show . getName) . S.peek $ winset return $! force $ sepBy (ppSep pp) . ppOrder pp $ [ ws , ppLayout pp ld , ppTitle pp $ ppTitleSanitize pp wt ] ++ catMaybes extras -- | Format the workspace information, given a workspace sorting function, -- a list of urgent windows, a pretty-printer format, and the current -- WindowSet. pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ map S.workspace (S.current s : S.visible s) ++ S.hidden s where fmt :: WindowSpace -> String fmt w = pr (ppRename pp (S.tag w) w) where printers = ppPrinters pp <|> fallbackPrinters pr = fromMaybe id $ runReaderT printers $ WS{ wsUrgents = urgents, wsWindowSet = s, wsWS = w, wsPP = pp } -- $predicates -- Using 'WSPP' with 'ppPrinters' allows extension modules (and users) to -- extend 'PP' with new workspace types beyond 'ppCurrent', 'ppUrgent', and -- the rest. -- | The data available to 'WSPP''. data WS = WS{ wsUrgents :: [Window] -- ^ Urgent windows , wsWindowSet :: WindowSet -- ^ The entire 'WindowSet', for context , wsWS :: WindowSpace -- ^ The 'WindowSpace' being formatted , wsPP :: PP -- ^ The actual final 'PP' } -- XXX: ReaderT instead of -> because there is no -- -- > instance Alternative (Λa. r -> Maybe a) -- -- (there cannot be, Haskell has no Λ), and there is no -- -- > instance Alternative (Compose ((->) r) Maybe) -- -- either, and even if there was, Compose isn't very practical. -- -- But we don't need Alternative for WS -> Bool, so we use the simple -- function-based reader for the condition functions, as their definitions are -- much prettier that way. This may be a bit confusing. :-/ type WSPP' = ReaderT WS Maybe -- | The type allowing to build formatters (and predicates). See -- the source 'fallbackPrinters' for an example. type WSPP = WSPP' (WorkspaceId -> String) -- | For a 'PP' @pp@, @fallbackPrinters pp@ returns the default 'WSPP' -- used to format workspaces: the formatter chosen corresponds to the -- first matching workspace type, respecting the following precedence: -- 'ppUrgent', 'ppCurrent', 'ppVisible', 'ppVisibleNoWindows', 'ppHidden', -- 'ppHiddenNoWindows'. -- -- This can be useful if one needs to use the default set of formatters and -- post-process their output. (For pre-processing their input, there's -- 'ppRename'.) fallbackPrinters :: WSPP fallbackPrinters = isUrgent ?-> ppUrgent <|> isCurrent' ?-> ppCurrent <|> isVisible' ?-> ppVisible <|> isVisibleNoWindows' ?-> liftA2 fromMaybe ppVisible ppVisibleNoWindows <|> isHidden' ?-> ppHidden <|> pure True ?-> ppHiddenNoWindows where cond ?-> ppr = (asks cond >>= guard) *> asks (ppr . wsPP) -- | Predicate for urgent workspaces. isUrgent :: WS -> Bool isUrgent WS{..} = any (\x -> (== Just (S.tag wsWS)) (S.findTag x wsWindowSet)) wsUrgents -- | Predicate for the current workspace. Caution: assumes default -- precedence is respected. isCurrent' :: WS -> Bool isCurrent' WS{..} = S.tag wsWS == S.currentTag wsWindowSet -- | Predicate for the current workspace. isCurrent :: WS -> Bool isCurrent = (not <$> isUrgent) <&&> isCurrent' -- | Predicate for visible workspaces. Caution: assumes default -- precedence is respected. isVisible' :: WS -> Bool isVisible' = isVisibleNoWindows' <&&> isJust . S.stack . wsWS -- | Predicate for visible workspaces. isVisible :: WS -> Bool isVisible = (not <$> isUrgent) <&&> (not <$> isCurrent') <&&> isVisible' -- | Predicate for visible workspaces that have no windows. Caution: -- assumes default precedence is respected. isVisibleNoWindows' :: WS -> Bool isVisibleNoWindows' WS{..} = S.tag wsWS `elem` visibles where visibles = map (S.tag . S.workspace) (S.visible wsWindowSet) -- | Predicate for visible workspaces that have no windows. isVisibleNoWindows :: WS -> Bool isVisibleNoWindows = (not <$> isUrgent) <&&> (not <$> isCurrent') <&&> (not <$> isVisible') <&&> isVisibleNoWindows' -- | Predicate for non-empty hidden workspaces. Caution: assumes default -- precedence is respected. isHidden' :: WS -> Bool isHidden' = isJust . S.stack . wsWS -- | Predicate for hidden workspaces. isHidden :: WS -> Bool isHidden = (not <$> isUrgent) <&&> (not <$> isCurrent') <&&> (not <$> isVisible') <&&> (not <$> isVisibleNoWindows') <&&> isHidden' pprWindowSetXinerama :: WindowSet -> String pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen where onscreen = map (S.tag . S.workspace) . sortOn S.screen $ S.current ws : S.visible ws offscreen = map S.tag . filter (isJust . S.stack) . sortOn S.tag $ S.hidden ws -- | Wrap a string in delimiters, unless it is empty. wrap :: String -- ^ left delimiter -> String -- ^ right delimiter -> String -- ^ output string -> String wrap _ _ "" = "" wrap l r m = l ++ m ++ r -- | Pad a string with a leading and trailing space. pad :: String -> String pad = wrap " " " " -- | Trim leading and trailing whitespace from a string. trim :: String -> String trim = f . f where f = reverse . dropWhile isSpace -- | Limit a string to a certain length, adding "..." if truncated. shorten :: Int -> String -> String shorten = shorten' "..." -- | Limit a string to a certain length, adding @end@ if truncated. shorten' :: String -> Int -> String -> String shorten' end n xs | length xs < n = xs | otherwise = take (n - length end) xs ++ end -- | Like 'shorten', but truncate from the left instead of right. shortenLeft :: Int -> String -> String shortenLeft = shortenLeft' "..." -- | Like 'shorten'', but truncate from the left instead of right. shortenLeft' :: String -> Int -> String -> String shortenLeft' end n xs | l < n = xs | otherwise = end ++ drop (l - n + length end) xs where l = length xs -- | Output a list of strings, ignoring empty ones and separating the -- rest with the given separator. sepBy :: String -- ^ separator -> [String] -- ^ fields to output -> String sepBy sep = intercalate sep . filter (not . null) -- | Use dzen escape codes to output a string with given foreground -- and background colors. dzenColor :: String -- ^ foreground color: a color name, or #rrggbb format -> String -- ^ background color -> String -- ^ output string -> String dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2) where (fg1,fg2) | null fg = ("","") | otherwise = ("^fg(" ++ fg ++ ")","^fg()") (bg1,bg2) | null bg = ("","") | otherwise = ("^bg(" ++ bg ++ ")","^bg()") -- | Escape any dzen metacharacters. dzenEscape :: String -> String dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x]) -- | Strip dzen formatting or commands. dzenStrip :: String -> String dzenStrip = strip [] where strip keep x | null x = keep | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x) | "^" `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= ')') $ x) | otherwise = let (good,x') = span (/= '^') x in strip (keep ++ good) x' -- | Use xmobar escape codes to output a string with the font at the given index xmobarFont :: Int -- ^ index: index of the font to use (0: standard font) -> String -- ^ output string -> String xmobarFont index = wrap ("") "" -- | 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 "" where t = concat [""] -- | 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 = "" r = "" -- | 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 "" where prefix = "" -- | 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 [""] -- | Strip xmobar markup, specifically the \, \ and \ tags -- and the matching tags like \. xmobarStrip :: String -> String xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) converge :: (Eq a) => (a -> a) -> a -> a converge f a = fst . NE.head . notEmpty -- If this function terminates, we will find a match. . dropWhile (uncurry (/=)) . zip xs $ drop 1 xs where xs = iterate f a xmobarStripTags :: [String] -- ^ tags -> String -> String -- ^ with all \...\ 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 = "" -- | 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-contrib-0.18.0/XMonad/Hooks/StatusBar/WorkspaceScreen.hs0000644000000000000000000000730707346545000022537 0ustar0000000000000000{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} {- | Module : XMonad.Hooks.StatusBar.WorkspaceScreen Description : Combine workspace names with screen information Copyright : (c) Yecine Megdiche License : BSD3-style (see LICENSE) Maintainer : Yecine Megdiche Stability : unstable Portability : unportable In multi-head setup, it might be useful to have screen information of the visible workspaces combined with the workspace name, for example in a status bar. This module provides utility functions to do just that. -} module XMonad.Hooks.StatusBar.WorkspaceScreen ( -- * Usage -- $usage combineWithScreen , combineWithScreenName , combineWithScreenNumber , WorkspaceScreenCombiner -- * Limitations -- $limitations ) where import Graphics.X11.Xrandr import XMonad import XMonad.Hooks.StatusBar.PP import XMonad.Prelude import qualified XMonad.StackSet as W {- $usage You can use this module with the following in your @xmonad.hs@: > import XMonad > import XMonad.Hooks.StatusBar > import XMonad.Hooks.StatusBar.PP > import XMonad.Hooks.StatusBar.WorkspaceScreen For example, to add the screen number in parentheses to each visible workspace number, you can use 'combineWithScreenNumber': > myWorkspaceScreenCombiner :: WorkspaceId -> String -> String > myWorkspaceScreenCombiner w sc = w <> wrap "(" ")" sc > > mySB = statusBarProp "xmobar" (combineWithScreenNumber myWorkspaceScreenCombiner xmobarPP) > main = xmonad $ withEasySB mySB defToggleStrutsKey def This will annotate the workspace names as following: > [1(0)] 2 3 4 <5(1)> 6 7 8 9 To use the screen's name instead, checkout 'combineWithScreenName': > [1(eDP-1)] 2 3 4 <5(HDMI-1)> 6 7 8 9 For advanced cases, use 'combineWithScreen'. -} {- $limitations For simplicity, this module assumes xmonad screen ids match screen/monitor numbers as managed by the X server (for example, as given by @xrandr --listactivemonitors@). Thus, it may not work well when screens show an overlapping range of the framebuffer, e.g. when using a projector. This also means that it doesn't work with "XMonad.Layout.LayoutScreens". (This isn't difficult to fix, PRs welcome.) -} -- | Type synonym for a function that combines a workspace name with a screen. type WorkspaceScreenCombiner = WorkspaceId -> WindowScreen -> String -- | A helper function that returns a list of screen names. screenNames :: X [Maybe String] screenNames = do XConf { display, theRoot } <- ask let getName mi = getAtomName display (xrr_moninf_name mi) io $ maybe (pure []) (traverse getName) =<< xrrGetMonitors display theRoot True -- | Combine a workspace name with the screen name it's visible on. combineWithScreenName :: (WorkspaceId -> String -> String) -> PP -> X PP combineWithScreenName c = combineWithScreen $ do screens <- screenNames return $ \w sc -> maybe w (c w) $ join (screens !? fi (W.screen sc)) -- | Combine a workspace name with the screen number it's visible on. combineWithScreenNumber :: (WorkspaceId -> String -> String) -> PP -> X PP combineWithScreenNumber c = combineWithScreen . return $ \w sc -> c w (show @Int . fi . W.screen $ sc) -- | Combine a workspace name with a screen according to the given -- 'WorkspaceScreenCombiner'. combineWithScreen :: X WorkspaceScreenCombiner -> PP -> X PP combineWithScreen xCombiner pp = do combiner <- xCombiner ss <- withWindowSet (return . W.screens) return $ pp { ppRename = ppRename pp <=< \s w -> maybe s (combiner s) (find ((== W.tag w) . W.tag . W.workspace) ss) } xmonad-contrib-0.18.0/XMonad/Hooks/TaffybarPagerHints.hs0000644000000000000000000000653007346545000021251 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 -- Stability : unstable -- Portability : unportable -- -- This module exports additional X properties that allow -- [taffybar](https://github.com/taffybar/taffybar) to understand the state of -- XMonad. -- ----------------------------------------------------------------------------- module XMonad.Hooks.TaffybarPagerHints ( -- $usage pagerHints, pagerHintsLogHook, pagerHintsEventHook, setCurrentLayoutProp, setVisibleWorkspacesProp, ) where import Codec.Binary.UTF8.String (encode) import Foreign.C.Types (CInt) import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Hooks.TaffybarPagerHints (pagerHints) -- > -- > main = xmonad $ ewmh $ pagerHints $ def -- > ... -- | The \"Current Layout\" custom hint. xLayoutProp :: X Atom xLayoutProp = getAtom "_XMONAD_CURRENT_LAYOUT" -- | The \"Visible Workspaces\" custom hint. xVisibleProp :: X Atom xVisibleProp = getAtom "_XMONAD_VISIBLE_WORKSPACES" -- | Add support for the \"Current Layout\" and \"Visible Workspaces\" custom -- hints to the given config. pagerHints :: XConfig a -> XConfig a pagerHints c = c { handleEventHook = handleEventHook c <> pagerHintsEventHook , logHook = logHook c <> pagerHintsLogHook } -- | Update the current values of both custom hints. pagerHintsLogHook :: X () pagerHintsLogHook = do withWindowSet (setCurrentLayoutProp . description . W.layout . W.workspace . W.current) withWindowSet (setVisibleWorkspacesProp . map (W.tag . W.workspace) . W.visible) -- | Set the value of the \"Current Layout\" custom hint to the one given. setCurrentLayoutProp :: String -> X () setCurrentLayoutProp l = withDisplay $ \dpy -> do r <- asks theRoot a <- xLayoutProp c <- getAtom "UTF8_STRING" let l' = map fromIntegral (encode l) io $ changeProperty8 dpy r a c propModeReplace l' -- | Set the value of the \"Visible Workspaces\" hint to the one given. setVisibleWorkspacesProp :: [String] -> X () setVisibleWorkspacesProp vis = withDisplay $ \dpy -> do r <- asks theRoot a <- xVisibleProp c <- getAtom "UTF8_STRING" let vis' = map fromIntegral $ concatMap ((++[0]) . encode) vis io $ changeProperty8 dpy r a c propModeReplace vis' -- | Handle all \"Current Layout\" events received from pager widgets, and -- set the current layout accordingly. pagerHintsEventHook :: Event -> X All pagerHintsEventHook ClientMessageEvent { ev_message_type = mt , ev_data = d } = withWindowSet $ \_ -> do a <- xLayoutProp when (mt == a) $ sendLayoutMessage d return (All True) pagerHintsEventHook _ = return (All True) -- | Request a change in the current layout by sending an internal message -- to XMonad. sendLayoutMessage :: [CInt] -> X () sendLayoutMessage (x:_) | x < 0 = sendMessage FirstLayout | otherwise = sendMessage NextLayout sendLayoutMessage [] = return () xmonad-contrib-0.18.0/XMonad/Hooks/ToggleHook.hs0000644000000000000000000001352407346545000017571 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ToggleHook -- Description : Hook and keybindings for toggling hook behavior. -- Copyright : Ben Boeckel -- License : BSD-style (see LICENSE) -- -- Maintainer : Ben Boeckel -- Stability : unstable -- Portability : unportable -- -- Hook and keybindings for toggling hook behavior. ----------------------------------------------------------------------------- module XMonad.Hooks.ToggleHook ( -- * Usage -- $usage -- * The hook toggleHook , toggleHook' -- * Actions , hookNext , toggleHookNext , hookAllNew , toggleHookAllNew -- * Queries , willHook , willHookNext , willHookAllNew -- * Status bar utilities -- $pp , willHookNextPP , willHookAllNewPP , runLogHook ) where import Prelude hiding (all) import XMonad import XMonad.Prelude (guard, join) import qualified XMonad.Util.ExtensibleState as XS import Control.Arrow (first, second) import Data.Map {- Helper functions -} _set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () _set n f b = modify' n (f $ const b) _toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () _toggle n f = modify' n (f not) _get :: String -> ((Bool, Bool) -> a) -> X a _get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks) _pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f {- The current state is kept here -} newtype HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Read, Show) instance ExtensionClass HookState where initialValue = HookState empty extensionType = PersistentExtension modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' n f = XS.modify (HookState . setter . hooks) where setter m = insert n (f (findWithDefault (False, False) n m)) m -- $usage -- This module provides actions (that can be set as keybindings) -- to be able to cause hooks to be occur on a conditional basis. -- -- You can use it by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.ToggleHook -- -- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the -- name of the hook and @hook@ is the hook to execute based on the state. -- -- > myManageHook = toggleHook "float" doFloat <> manageHook def -- -- Additionally, toggleHook' is provided to toggle between two hooks (rather -- than on/off). -- -- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <> manageHook def -- -- The 'hookNext' and 'toggleHookNext' functions can be used in key -- bindings to set whether the hook is applied or not. -- -- > , ((modm, xK_e), toggleHookNext "float") -- -- 'hookAllNew' and 'toggleHookAllNew' are similar but float all -- spawned windows until disabled again. -- -- > , ((modm, xK_r), toggleHookAllNew "float") -- | This 'ManageHook' will selectively apply a hook as set -- by 'hookNext' and 'hookAllNew'. toggleHook :: String -> ManageHook -> ManageHook toggleHook n h = toggleHook' n h idHook toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook toggleHook' n th fh = do m <- liftX $ XS.gets hooks (next, all) <- return $ findWithDefault (False, False) n m liftX $ XS.put $ HookState $ insert n (False, all) m if next || all then th else fh -- | @hookNext name True@ arranges for the next spawned window to -- have the hook @name@ applied, @hookNext name False@ cancels it. hookNext :: String -> Bool -> X () hookNext n = _set n first toggleHookNext :: String -> X () toggleHookNext n = _toggle n first -- | @hookAllNew name True@ arranges for new windows to -- have the hook @name@ applied, @hookAllNew name False@ cancels it hookAllNew :: String -> Bool -> X () hookAllNew n = _set n second toggleHookAllNew :: String -> X () toggleHookAllNew n = _toggle n second -- | Query what will happen at the next ManageHook call for the hook @name@. willHook :: String -> X Bool willHook n = willHookNext n <||> willHookAllNew n -- | Whether the next window will trigger the hook @name@. willHookNext :: String -> X Bool willHookNext n = _get n fst -- | Whether new windows will trigger the hook @name@. willHookAllNew :: String -> X Bool willHookAllNew n = _get n snd -- $pp -- The following functions are used to display the current -- state of 'hookNext' and 'hookAllNew' in your -- "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 -- immediately: -- -- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook) -- -- The @String -> String@ parameters to 'willHookNextPP' and -- 'willHookAllNewPP' will be applied to their output, you -- can use them to set the text color, etc., or you can just -- pass them 'id'. willHookNextPP :: String -> (String -> String) -> X (Maybe String) willHookNextPP n = _pp n fst "Next" willHookAllNewPP :: String -> (String -> String) -> X (Maybe String) willHookAllNewPP n = _pp n snd "All" runLogHook :: X () runLogHook = join $ asks $ logHook . config xmonad-contrib-0.18.0/XMonad/Hooks/UrgencyHook.hs0000644000000000000000000005775407346545000020001 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.UrgencyHook -- Description : Configure an action to occur when a window demands your attention. -- Copyright : Devin Mullins -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- 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.) -- ----------------------------------------------------------------------------- module XMonad.Hooks.UrgencyHook ( -- * Usage -- $usage -- ** Pop up a temporary dzen -- $temporary -- ** Highlight in existing dzen -- $existing -- ** Useful keybinding -- $keybinding -- * Troubleshooting -- $troubleshooting -- * Example: Setting up irssi + rxvt-unicode -- $example -- ** Configuring irssi -- $irssi -- ** Configuring screen -- $screen -- ** Configuring rxvt-unicode -- $urxvt -- ** Configuring xmonad -- $xmonad -- * Stuff for your config file: withUrgencyHook, withUrgencyHookC, UrgencyConfig(..), urgencyConfig, SuppressWhen(..), RemindWhen(..), focusUrgent, clearUrgents, dzenUrgencyHook, DzenUrgencyHook(..), NoUrgencyHook(..), BorderUrgencyHook(..), FocusHook(..), filterUrgencyHook, filterUrgencyHook', minutes, seconds, askUrgent, doAskUrgent, -- * Stuff for developers: readUrgents, withUrgents, clearUrgents', StdoutUrgencyHook(..), SpawnUrgencyHook(..), UrgencyHook(urgencyHook), Interval, borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook ) 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 Data.Bits (testBit) import qualified Data.Set as S import System.IO (hPutStrLn, stderr) import Foreign.C.Types (CLong) -- $usage -- -- To wire this up, first add: -- -- > import XMonad.Hooks.UrgencyHook -- -- to your import list in your config file. Now, you have a decision to make: -- When a window deems itself urgent, do you want to pop up a temporary dzen -- bar telling you so, or do you have an existing dzen wherein you would like to -- highlight urgent workspaces? -- $temporary -- -- Enable your urgency hook by wrapping your config record in a call to -- 'withUrgencyHook'. For example: -- -- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } -- > $ def -- -- This will pop up a dzen bar for five seconds telling you you've got an -- urgent window. -- $existing -- -- In order for xmonad to track urgent windows, you must install an urgency hook. -- You can use the above 'dzenUrgencyHook', or if you're not interested in the -- extra popup, install NoUrgencyHook, as so: -- -- > main = xmonad $ withUrgencyHook NoUrgencyHook -- > $ def -- -- 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'. -- $troubleshooting -- -- There are three steps to get right: -- -- 1. The X client must set the UrgencyHint flag. How to configure this -- depends on the application. If you're using a terminal app, this is in -- two parts: -- -- * The console app must send a ^G (bell). In bash, a helpful trick is -- @sleep 1; echo -e \'\\a\'@. -- -- * The terminal must convert the bell into UrgencyHint. -- -- 2. XMonad must be configured to notice UrgencyHints. If you've added -- withUrgencyHook, you may need to hit mod-shift-space to reset the layout. -- -- 3. The dzen must run when told. Run @dzen2 -help@ and make sure that it -- supports all of the arguments you told DzenUrgencyHook to pass it. Also, -- set up a keybinding to the 'dzen' action in "XMonad.Util.Dzen" to test -- if that works. -- -- As best you can, try to isolate which one(s) of those is failing. -- $example -- -- This is a commonly asked example. By default, the window doesn't get flagged -- urgent when somebody messages you in irssi. You will have to configure some -- things. If you're using different tools than this, your mileage will almost -- certainly vary. (For example, in Xchat2, it's just a simple checkbox.) -- $irssi -- @Irssi@ is not an X11 app, so it can't set the @UrgencyHint@ flag on @XWMHints@. -- However, on all console applications is bestown the greatest of all notification -- systems: the bell. That's right, Ctrl+G, ASCII code 7, @echo -e '\a'@, your -- friend, the bell. To configure @irssi@ to send a bell when you receive a message: -- -- > /set beep_msg_level MSGS NOTICES INVITES DCC DCCMSGS HILIGHT -- -- Consult your local @irssi@ documentation for more detail. -- $screen -- A common way to run @irssi@ is within the lovable giant, @screen@. Some distros -- (e.g. Ubuntu) like to configure @screen@ to trample on your poor console -- applications -- in particular, to turn bell characters into evil, smelly -- \"visual bells.\" To turn this off, add: -- -- > vbell off # or remove the existing 'vbell on' line -- -- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for an -- immediate but temporary fix. -- $urxvt -- Rubber, meet road. Urxvt is the gateway between console apps and X11. To tell -- urxvt to set an @UrgencyHint@ when it receives a bell character, first, have -- an urxvt version 8.3 or newer, and second, set the following in your -- @.Xdefaults@: -- -- > urxvt.urgentOnBell: true -- -- Depending on your setup, you may need to @xrdb@ that. -- $xmonad -- Hopefully you already read the section on how to configure xmonad. If not, -- hopefully you know where to find it. -- | This is the method to enable an urgency hook. It uses the default -- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHookC' -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) => h -> XConfig l -> XConfig l withUrgencyHook hook = withUrgencyHookC hook def -- | This lets you modify the defaults set in 'urgencyConfig'. An example: -- -- > withUrgencyHookC dzenUrgencyHook { ... } def { suppressWhen = Focused } -- -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration. withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) => h -> UrgencyConfig -> XConfig l -> XConfig l withUrgencyHookC hook urgConf conf = conf { handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e, logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf, startupHook = cleanupStaleUrgents >> startupHook conf } newtype Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show) onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents onUrgents f = Urgents . f . fromUrgents instance ExtensionClass Urgents where initialValue = Urgents [] extensionType = PersistentExtension -- | Global configuration, applied to all types of 'UrgencyHook'. See -- 'urgencyConfig' for the defaults. data UrgencyConfig = UrgencyConfig { suppressWhen :: SuppressWhen -- ^ when to trigger the urgency hook , remindWhen :: RemindWhen -- ^ when to re-trigger the urgency hook } deriving (Read, Show) -- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window. -- The default is 'Visible'. Prefix each of the following with \"don't bug me when\": data SuppressWhen = Visible -- ^ the window is currently visible | OnScreen -- ^ the window is on the currently focused physical screen | Focused -- ^ the window is currently focused | Never -- ^ ... aww, heck, go ahead and bug me, just in case. deriving (Read, Show) -- | A set of choices as to when you want to be re-notified of an urgent -- window. Perhaps you focused on something and you miss the dzen popup bar. Or -- you're AFK. Or you feel the need to be more distracted. I don't care. -- -- The interval arguments are in seconds. See the 'minutes' helper. data RemindWhen = Dont -- ^ triggering once is enough | Repeatedly Int Interval -- ^ repeat \ times every \ seconds | Every Interval -- ^ repeat every \ until the urgency hint is cleared deriving (Read, Show) -- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@. minutes :: Rational -> Rational minutes secs = secs * 60 -- | The default 'UrgencyConfig': @urgencyConfig = 'def'@. urgencyConfig :: UrgencyConfig urgencyConfig = def {-# DEPRECATED urgencyConfig "Use def insetad." #-} -- | The default 'UrgencyConfig': @suppressWhen = 'Visible', remindWhen = 'Dont'@. -- Use a variation of this in your config just as you would use any -- other instance of 'def'. instance Default UrgencyConfig where def = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont } -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings. -- Example keybinding: -- -- > , ((modm , xK_BackSpace), focusUrgent) focusUrgent :: X () focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe -- | Just makes the urgents go away. -- Example keybinding: -- -- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) clearUrgents :: X () 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 -- contain urgent windows. readUrgents :: X [Window] readUrgents = XS.gets fromUrgents -- | An HOF version of 'readUrgents', for those who prefer that sort of thing. 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 type Interval = Rational -- | An urgency reminder, as reified for 'RemindWhen'. -- The last value is the countdown number, for 'Repeatedly'. data Reminder = Reminder { timer :: TimerId , window :: Window , interval :: Interval , remaining :: Maybe Int } deriving (Show,Read,Eq) instance ExtensionClass [Reminder] where initialValue = [] extensionType = PersistentExtension -- | Stores the list of urgency reminders. readReminders :: X [Reminder] readReminders = XS.get adjustReminders :: ([Reminder] -> [Reminder]) -> X () adjustReminders = XS.modify data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show) -- | Change the _NET_WM_STATE property by applying a function to the list of atoms. changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X () changeNetWMState dpy w f = do wmstate <- getAtom "_NET_WM_STATE" 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 :) -- | Remove an atom from the _NET_WM_STATE property. removeNetWMState :: Display -> Window -> Atom -> X () removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom) -- | Get the _NET_WM_STATE propertly as a [CLong] getNetWMState :: Window -> X [CLong] getNetWMState w = do a_wmstate <- getAtom "_NET_WM_STATE" fromMaybe [] <$> getProp32 a_wmstate w -- The Non-ICCCM Manifesto: -- Note: Some non-standard choices have been made in this implementation to -- account for the fact that things are different in a tiling window manager: -- 1. In normal window managers, windows may overlap, so clients wait for focus to -- be set before urgency is cleared. In a tiling WM, it's sufficient to be able -- see the window, since we know that means you can see it completely. -- 2. The urgentOnBell setting in rxvt-unicode sets urgency even when the window -- has focus, and won't clear until it loses and regains focus. This is stupid. -- In order to account for these quirks, we track the list of urgent windows -- ourselves, allowing us to clear urgency when a window is visible, and not to -- set urgency if a window is visible. If you have a better idea, please, let us -- know! handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X () handleEvent wuh event = case event of -- WM_HINTS urgency flag PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> 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 -- Window destroyed DestroyWindowEvent {ev_window = w} -> markNotUrgent w -- _NET_WM_STATE_DEMANDS_ATTENTION requested by client ClientMessageEvent {ev_event_display = dpy, ev_window = w, ev_message_type = t, ev_data = action:atoms} -> do a_wmstate <- getAtom "_NET_WM_STATE" a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION" wstate <- getNetWMState w let demandsAttention = fromIntegral a_da `elem` wstate remove = 0 add = 1 toggle = 2 when (t == a_wmstate && fromIntegral a_da `elem` atoms) $ do when (action == add || (action == toggle && not demandsAttention)) $ do markUrgent w addNetWMState dpy w a_da when (action == remove || (action == toggle && demandsAttention)) $ do markNotUrgent w removeNetWMState dpy w a_da _ -> mapM_ handleReminder =<< readReminders where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder markUrgent w = do adjustUrgents (\ws -> if w `elem` ws then ws else w : ws) callUrgencyHook wuh w userCodeDef () =<< asks (logHook . config) markNotUrgent w = do adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window) userCodeDef () =<< asks (logHook . config) callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X () callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w = whenX (not <$> shouldSuppress sw w) $ do userCodeDef () $ urgencyHook hook w case rw of Repeatedly times int -> addReminder w int $ Just times Every int -> addReminder w int Nothing Dont -> return () addReminder :: Window -> Rational -> Maybe Int -> X () addReminder w int times = do timerId <- startTimer int let reminder = Reminder timerId w int times adjustReminders (\rs -> if w `elem` map window rs then rs else reminder : rs) reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a) reminderHook (WithUrgencyHook hook _) reminder = do case remaining reminder of Just x | x > 0 -> remind $ Just (x - 1) Just _ -> adjustReminders $ delete reminder Nothing -> remind Nothing return Nothing where remind remaining' = do userCode $ urgencyHook hook (window reminder) adjustReminders $ delete reminder addReminder (window reminder) (interval reminder) remaining' shouldSuppress :: SuppressWhen -> Window -> X Bool shouldSuppress sw w = elem w <$> suppressibleWindows sw cleanupUrgents :: SuppressWhen -> X () 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 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 suppressibleWindows OnScreen = gets $ W.index . windowset suppressibleWindows Focused = gets $ maybeToList . W.peek . windowset suppressibleWindows Never = return [] -------------------------------------------------------------------------------- -- Urgency Hooks -- | The class definition, and some pre-defined instances. class UrgencyHook h where urgencyHook :: h -> Window -> X () instance UrgencyHook (Window -> X ()) where urgencyHook = id data NoUrgencyHook = NoUrgencyHook deriving (Read, Show) instance UrgencyHook NoUrgencyHook where urgencyHook _ _ = return () -- | Your set of options for configuring a dzenUrgencyHook. data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, -- ^ number of microseconds to display the dzen -- (hence, you'll probably want to use 'seconds') args :: [String] -- ^ list of extra args (as 'String's) to pass to dzen } deriving (Read, Show) instance UrgencyHook DzenUrgencyHook where urgencyHook DzenUrgencyHook { duration = d, args = a } w = do name <- getName w ws <- gets windowset whenJust (W.findTag w ws) (flash name) where flash name index = dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d {- | A hook which will automatically send you to anything which sets the urgent flag (as opposed to printing some sort of message. You would use this as usual, eg. > withUrgencyHook FocusHook $ myconfig { ... -} focusHook :: Window -> X () focusHook = urgencyHook FocusHook data FocusHook = FocusHook deriving (Read, Show) instance UrgencyHook FocusHook where urgencyHook _ _ = focusUrgent -- | A hook that sets the border color of an urgent window. The color -- will remain until the next time the window gains or loses focus, at -- which point the standard border color from the XConfig will be applied. -- You may want to use suppressWhen = Never with this: -- -- > withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "#ff0000" } urgencyConfig { suppressWhen = Never } ... -- -- (This should be @urgentBorderColor@ but that breaks "XMonad.Layout.Decoration". -- @borderColor@ breaks anyone using 'XPConfig' from "XMonad.Prompt". We need to -- think a bit more about namespacing issues, maybe.) borderUrgencyHook :: String -> Window -> X () borderUrgencyHook = urgencyHook . BorderUrgencyHook newtype BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: String } deriving (Read, Show) instance UrgencyHook BorderUrgencyHook where urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w = withDisplay $ \dpy -> do c' <- io (initColor dpy cs) case c' of Just c -> setWindowBorderWithFallback dpy w cs c _ -> io $ hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor " ,show cs ," in BorderUrgencyHook" ] -- | Flashes when a window requests your attention and you can't see it. -- Defaults to a duration of five seconds, and no extra args to dzen. -- See 'DzenUrgencyHook'. dzenUrgencyHook :: DzenUrgencyHook dzenUrgencyHook = def -- | @'def' = 'dzenUrgencyHook'@. instance Default DzenUrgencyHook where def = DzenUrgencyHook { duration = seconds 5, args = [] } -- | Spawn a commandline thing, appending the window id to the prefix string -- you provide. (Make sure to add a space if you need it.) Do your crazy -- xcompmgr thing. spawnUrgencyHook :: String -> Window -> X () spawnUrgencyHook = urgencyHook . SpawnUrgencyHook newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show) instance UrgencyHook SpawnUrgencyHook where urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w -- | For debugging purposes, really. stdoutUrgencyHook :: Window -> X () stdoutUrgencyHook = urgencyHook StdoutUrgencyHook data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show) instance UrgencyHook StdoutUrgencyHook where urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w -- | urgencyhook such that windows on certain workspaces -- never get urgency set. -- -- Useful for scratchpad workspaces perhaps: -- -- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) def) filterUrgencyHook :: [WorkspaceId] -> Window -> X () 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-contrib-0.18.0/XMonad/Hooks/WallpaperSetter.hs0000644000000000000000000002171707346545000020650 0ustar0000000000000000----------------------------------- -- | -- Module : XMonad.Hooks.WallpaperSetter -- Description : Change the wallpapers depending on visible workspaces. -- Copyright : (c) Anton Pirogov, 2014 -- License : BSD3 -- -- Maintainer : Anton Pirogov -- Stability : unstable -- Portability : unportable -- -- Log hook which changes the wallpapers depending on visible workspaces. ----------------------------------- module XMonad.Hooks.WallpaperSetter ( -- * Usage -- $usage wallpaperSetter , WallpaperConf(..) , Wallpaper(..) , WallpaperList(..) , defWallpaperConf , defWPNamesJpg, defWPNamesPng, defWPNames -- *TODO -- $todo ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS import System.IO import System.Process import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (()) import System.Random (randomRIO) import qualified Data.Map as M -- $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. -- -- This was especially tested with multi-head setups - if you have two monitors and swap -- the workspaces, the wallpapers will be swapped too, scaled accordingly and rotated if necessary -- (e.g. if you are using your monitor rotated but only have wide wallpapers). -- -- Add a log hook like this: -- -- > myWorkspaces = ["1:main","2:misc","3","4"] -- > ... -- > main = xmonad $ def { -- > logHook = wallpaperSetter defWallpaperConf { -- > wallpapers = defWPNames myWorkspaces -- > <> WallpaperList [("1:main",WallpaperDir "1")] -- > } -- > } -- > ... -- $todo -- * implement a kind of image cache like in wallpaperd to remove or at least reduce the lag -- -- * 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) instance ExtensionClass WCState where initialValue = WCState Nothing Nothing -- | Represents a wallpaper data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper | WallpaperDir FilePath -- ^ Random wallpaper from this subdirectory deriving (Eq, Show, Read) newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)] deriving (Show,Read) instance Semigroup WallpaperList where WallpaperList w1 <> WallpaperList w2 = WallpaperList $ M.toList $ M.fromList w2 `M.union` M.fromList w1 instance Monoid WallpaperList where mempty = WallpaperList [] -- | Complete wallpaper configuration passed to the hook data WallpaperConf = WallpaperConf { wallpaperBaseDir :: FilePath -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/) , wallpapers :: WallpaperList -- ^ List of the wallpaper associations for workspaces } deriving (Show, Read) -- | default configuration. looks in \~\/.wallpapers/ for WORKSPACEID.jpg defWallpaperConf :: WallpaperConf defWallpaperConf = WallpaperConf "" $ WallpaperList [] instance Default WallpaperConf where def = defWallpaperConf {-# DEPRECATED defWPNames "Use defWPNamesJpg instead" #-} defWPNames :: [WorkspaceId] -> WallpaperList 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 WCState oldws h <- XS.get visws <- getVisibleWorkspaces when (Just visws /= oldws) $ do wpconf' <- completeWPConf wpconf wspicpaths <- getPicPathsAndWSRects wpconf' -- terminate old call if any to prevent unnecessary CPU overload when switching WS too fast case h of Nothing -> return () Just pid -> liftIO $ terminateProcess pid handle <- applyWallpaper wspicpaths XS.put $ WCState (Just visws) $ Just handle -- Helper functions ------------------- -- | Picks a random element from a list pickFrom :: [a] -> IO a pickFrom list = do i <- randomRIO (0,length list - 1) return $ list !! i -- | get absolute picture path of the given wallpaper picture -- or select a random one if it is a directory getPicPath :: WallpaperConf -> Wallpaper -> IO (Maybe FilePath) getPicPath conf (WallpaperDir dir) = do direxists <- doesDirectoryExist $ wallpaperBaseDir conf dir if direxists then do files <- getDirectoryContents $ wallpaperBaseDir conf dir let files' = filter (not . ("." `isPrefixOf`)) files file <- pickFrom files' return $ Just $ wallpaperBaseDir conf dir file else return Nothing getPicPath conf (WallpaperFix file) = do exist <- doesFileExist path return $ if exist then Just path else Nothing where path = wallpaperBaseDir conf file -- | Take a path to a picture, return (width, height) if the path is a valid picture -- (requires imagemagick tool identify to be installed) getPicRes :: FilePath -> IO (Maybe (Int,Int)) getPicRes picpath = do (_, Just outh,_,_pid) <- createProcess $ (proc "identify" ["-format", "%w %h", picpath]) { std_out = CreatePipe } output <- hGetContents outh return $ case map reads (words output) of -- mapM Text.Read.readMaybe is better but only in ghc>=7.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 completeWPConf (WallpaperConf dir (WallpaperList ws)) = do home <- liftIO getHomeDirectory winset <- gets windowset let tags = map S.tag $ S.workspaces winset dir' = if null dir then home ".wallpapers" else dir ws' = if null ws then defWPNames tags else WallpaperList ws return (WallpaperConf dir' ws') getVisibleWorkspaces :: X [WorkspaceId] getVisibleWorkspaces = do winset <- gets windowset return $ map (S.tag . S.workspace) . sortOn S.screen $ S.current winset : S.visible winset getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)] getPicPathsAndWSRects wpconf = do winset <- gets windowset paths <- liftIO getPicPaths visws <- getVisibleWorkspaces let visscr = S.current winset : S.visible winset visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr getRect tag = screenRect $ fromJust $ M.lookup tag visrects foundpaths = [ (getRect n, p) | (n, Just p) <- paths, n `elem` visws ] return foundpaths where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y >>= \p -> return (x,p)) wl WallpaperList wl = wallpapers wpconf -- | Gets a list of geometry rectangles and filenames, builds and sets wallpaper applyWallpaper :: [(Rectangle, FilePath)] -> X ProcessHandle applyWallpaper parts = do winset <- gets windowset let (vx,vy) = getVScreenDim winset layers <- liftIO $ mapM layerCommand parts let basepart ="convert -size " ++ show vx ++ "x" ++ show vy ++ " xc:black" endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -" cmd = basepart ++ unwords layers ++ endpart liftIO $ runCommand cmd getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer) 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) pratio = fromIntegral px / fromIntegral py in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1 layerCommand :: (Rectangle, FilePath) -> IO String layerCommand (rect, path) = do res <- getPicRes path return $ case needsRotation rect <$> res of Nothing -> "" 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 " xmonad-contrib-0.18.0/XMonad/Hooks/WindowSwallowing.hs0000644000000000000000000003127607346545000021051 0ustar0000000000000000{-# 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. -- Stability : unstable -- Portability : unportable -- -- Provides a handleEventHook that implements window swallowing. -- -- If you open a GUI-window (i.e. feh) from the terminal, -- the terminal will normally still be shown on screen, unnecessarily -- taking up space on the screen. -- With window swallowing, can detect that you opened a window from within another -- window, and allows you "swallow" that parent window for the time the new -- window is running. -- -- __NOTE__ that this does not always work perfectly: -- -- - Because window swallowing needs to check the process hierarchy, it requires -- both the child and the parent to be distinct processes. This means that -- applications which implement instance sharing cannot be supported by window swallowing. -- Most notably, this excludes some terminal emulators as well as tmux -- from functioning as the parent process. It also excludes a good amount of -- child programs, because many graphical applications do implement instance sharing. -- For example, window swallowing will probably not work with your browser. -- -- - To check the process hierarchy, we need to be able to get the process ID -- by looking at the window. This requires the @_NET_WM_PID@ X-property to be set. -- If any application you want to use this with does not provide the @_NET_WM_PID@, -- there is not much you can do except for reaching out to the author of that -- application and asking them to set that property. Additionally, -- applications running in their own PID namespace, such as those in -- Flatpak, can't set a correct @_NET_WM_PID@ even if they wanted to. ----------------------------------------------------------------------------- module XMonad.Hooks.WindowSwallowing ( -- * Usage -- $usage swallowEventHook, swallowEventHookSub ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.SubLayouts import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.WindowProperties import XMonad.Util.Process ( getPPIDChain ) import qualified Data.Map.Strict as M import System.Posix.Types ( ProcessID ) -- $usage -- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WindowSwallowing -- -- and using 'swallowEventHook' somewhere in your 'handleEventHook', for example: -- -- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True) -- -- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layout.SubLayouts" is used; -- instead of swallowing the window it will merge the child window with the parent. (this does not work with floating windows) -- -- For more information on editing your handleEventHook and key bindings, -- see and "XMonad.Doc.Extending". -- | Run @action@ iff both parent- and child queries match and the child -- is a child by PID. -- -- A 'MapRequestEvent' is called right before a window gets opened. We -- intercept that call to possibly open the window ourselves, swapping -- out it's parent processes window for the new window in the stack. handleMapRequestEvent :: Query Bool -> Query Bool -> Window -> (Window -> X ()) -> X () handleMapRequestEvent parentQ childQ childWindow action = -- For a window to be opened from within another window, that other window -- must be focused. Thus the parent window that would be swallowed has to be -- the currently focused window. withFocused $ \parentWindow -> do -- First verify that both windows match the given queries parentMatches <- runQuery parentQ parentWindow childMatches <- runQuery childQ childWindow when (parentMatches && childMatches) $ do -- read the windows _NET_WM_PID properties childWindowPid <- getProp32s "_NET_WM_PID" childWindow parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow case (parentWindowPid, childWindowPid) of (Just (parentPid : _), Just (childPid : _)) -> do -- check if the new window is a child process of the last focused window -- using the process ids. isChild <- liftIO $ fi childPid `isChildOf` fi parentPid when isChild $ do action parentWindow _ -> return () return () -- | handleEventHook that will merge child windows via -- "XMonad.Layout.SubLayouts" when they are opened from another window. swallowEventHookSub :: Query Bool -- ^ query the parent window has to match for window swallowing to occur. -- Set this to @return True@ to run swallowing for every parent. -> Query Bool -- ^ query the child window has to match for window swallowing to occur. -- Set this to @return True@ to run swallowing for every child -> Event -- ^ The event to handle. -> X All swallowEventHookSub parentQ childQ event = All True <$ case event of MapRequestEvent{ev_window=childWindow} -> handleMapRequestEvent parentQ childQ childWindow $ \parentWindow -> do manage childWindow sendMessage (Merge parentWindow childWindow) _ -> pure () -- | handleEventHook that will swallow child windows when they are -- opened from another window. swallowEventHook :: Query Bool -- ^ query the parent window has to match for window swallowing to occur. -- Set this to @return True@ to run swallowing for every parent. -> Query Bool -- ^ query the child window has to match for window swallowing to occur. -- Set this to @return True@ to run swallowing for every child -> Event -- ^ The event to handle. -> X All swallowEventHook parentQ childQ event = do case event of MapRequestEvent{ev_window=childWindow} -> handleMapRequestEvent parentQ childQ childWindow $ \parentWindow -> do -- We set the newly opened window as the focused window, replacing the parent window. -- If the parent window was floating, we transfer that data to the child, -- such that it shows up at the same position, with the same dimensions. windows ( W.modify' (\x -> x { W.focus = childWindow }) . moveFloatingState parentWindow childWindow ) XS.modify (addSwallowedParent parentWindow childWindow) -- This is called in many circumstances, most notably for us: -- right before a window gets closed. We store the current -- state of the window stack here, such that we know where the -- child window was on the screen when restoring the swallowed parent process. ConfigureEvent{} -> withWindowSet $ \ws -> do XS.modify . setStackBeforeWindowClosing . currentStack $ ws XS.modify . setFloatingBeforeWindowClosing . W.floating $ ws -- This is called right after any window closes. DestroyWindowEvent { ev_event = eventId, ev_window = childWindow } -> -- Because DestroyWindowEvent is emitted a lot more often then you think, -- this check verifies that the event is /actually/ about closing a window. when (eventId == childWindow) $ do -- we get some data from the extensible state, most notably we ask for -- the \"parent\" window of the now closed window. maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow) maybeOldStack <- XS.gets stackBeforeWindowClosing oldFloating <- XS.gets floatingBeforeClosing case (maybeSwallowedParent, maybeOldStack) of -- If there actually is a corresponding swallowed parent window for this window, -- we will try to restore it. -- Because there are some cases where the stack-state is not stored correctly in the ConfigureEvent hook, -- we have to first check if the stack-state is valid. -- If it is, we can restore the parent exactly where the child window was before being closed. -- If the stored stack-state is invalid however, we still restore the window -- by just inserting it as the focused window in the stack. -- -- After restoring, we remove the information about the swallowing from the state. (Just parent, Nothing) -> do windows (insertIntoStack parent) deleteState childWindow (Just parent, Just oldStack) -> do stackStoredCorrectly <- do curStack <- withWindowSet (return . currentStack) let oldLen = length (W.integrate oldStack) let curLen = length (W.integrate' curStack) return (oldLen - 1 == curLen && childWindow == W.focus oldStack) if stackStoredCorrectly then windows (\ws -> updateCurrentStack (const $ Just $ oldStack { W.focus = parent }) $ moveFloatingState childWindow parent $ ws { W.floating = oldFloating } ) else windows (insertIntoStack parent) deleteState childWindow _ -> return () _ -> return () return $ All True where deleteState :: Window -> X () deleteState childWindow = do XS.modify $ removeSwallowed childWindow XS.modify $ setStackBeforeWindowClosing Nothing -- | insert a window as focused into the current stack, moving the previously focused window down the stack insertIntoStack :: a -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd insertIntoStack win = W.modify (Just $ W.Stack win [] []) (\s -> Just $ s { W.focus = win, W.down = W.focus s : W.down s }) -- | run a pure transformation on the Stack of the currently focused workspace. updateCurrentStack :: (Maybe (W.Stack a) -> Maybe (W.Stack a)) -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd updateCurrentStack f = W.modify (f Nothing) (f . Just) currentStack :: W.StackSet i l a sid sd -> Maybe (W.Stack a) currentStack = W.stack . W.workspace . W.current -- | move the floating state from one window to another, sinking the original window moveFloatingState :: Ord a => a -- ^ window to move from -> a -- ^ window to move to -> W.StackSet i l a s sd -> W.StackSet i l a s sd moveFloatingState from to ws = ws { W.floating = M.delete from $ maybe (M.delete to (W.floating ws)) (\r -> M.insert to r (W.floating ws)) (M.lookup from (W.floating ws)) } -- | check if a given process is a child of another process. This depends on "pstree" being in the PATH -- NOTE: this does not work if the child process does any kind of process-sharing. isChildOf :: ProcessID -- ^ child PID -> ProcessID -- ^ parent PID -> IO Bool isChildOf child parent = (parent `elem`) <$> getPPIDChain child data SwallowingState = SwallowingState { currentlySwallowed :: M.Map Window Window -- ^ mapping from child window window to the currently swallowed parent window , stackBeforeWindowClosing :: Maybe (W.Stack Window) -- ^ current stack state right before DestroyWindowEvent is sent , floatingBeforeClosing :: M.Map Window W.RationalRect -- ^ floating map of the stackset right before DestroyWindowEvent is sent } deriving (Show) getSwallowedParent :: Window -> SwallowingState -> Maybe Window getSwallowedParent win SwallowingState { currentlySwallowed } = M.lookup win currentlySwallowed addSwallowedParent :: Window -> Window -> SwallowingState -> SwallowingState addSwallowedParent parent child s@SwallowingState { currentlySwallowed } = s { currentlySwallowed = M.insert child parent currentlySwallowed } removeSwallowed :: Window -> SwallowingState -> SwallowingState removeSwallowed child s@SwallowingState { currentlySwallowed } = s { currentlySwallowed = M.delete child currentlySwallowed } setStackBeforeWindowClosing :: Maybe (W.Stack Window) -> SwallowingState -> SwallowingState setStackBeforeWindowClosing stack s = s { stackBeforeWindowClosing = stack } setFloatingBeforeWindowClosing :: M.Map Window W.RationalRect -> SwallowingState -> SwallowingState setFloatingBeforeWindowClosing x s = s { floatingBeforeClosing = x } instance ExtensionClass SwallowingState where initialValue = SwallowingState { currentlySwallowed = mempty , stackBeforeWindowClosing = Nothing , floatingBeforeClosing = mempty } xmonad-contrib-0.18.0/XMonad/Hooks/WorkspaceByPos.hs0000644000000000000000000000352107346545000020436 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.WorkspaceByPos -- Description : Move new window to non-focused screen based on its requested geometry. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Hooks.WorkspaceByPos ( -- * Usage -- $usage workspaceByPos ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import Control.Monad.Except (runExceptT, throwError) import Control.Monad.Trans (lift) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceByPos -- > -- > myManageHook = workspaceByPos <> manageHook def -- > -- > main = xmonad def { manageHook = myManageHook } workspaceByPos :: ManageHook workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask needsMoving :: Window -> X (Maybe WorkspaceId) needsMoving w = safeGetWindowAttributes w >>= \case Nothing -> pure Nothing Just wa -> fmap (either (const Nothing) Just) . runExceptT $ do -- only relocate windows with non-zero position guard $ wa_x wa /= 0 || wa_y wa /= 0 ws <- gets windowset sc <- lift $ fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) Just wkspc <- lift $ screenWorkspace (W.screen sc) guard $ W.currentTag ws /= wkspc return wkspc `asTypeOf` throwError "" xmonad-contrib-0.18.0/XMonad/Hooks/WorkspaceHistory.hs0000644000000000000000000001215207346545000021043 0ustar0000000000000000{-# LANGUAGE DerivingVia #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.WorkspaceHistory -- Description : Keep track of workspace viewing order. -- Copyright : (c) 2013 Dmitri Iouchtchenko -- License : BSD3-style (see LICENSE) -- -- Maintainer : Dmitri Iouchtchenko -- Stability : unstable -- Portability : unportable -- -- Keeps track of workspace viewing order. -- ----------------------------------------------------------------------------- module XMonad.Hooks.WorkspaceHistory ( -- * Usage -- $usage -- * Hooking workspaceHistoryHook , workspaceHistoryHookExclude -- * Querying , workspaceHistory , workspaceHistoryByScreen , workspaceHistoryWithScreen -- * Handling edits , workspaceHistoryTransaction , workspaceHistoryModify ) where import Control.Applicative import Control.DeepSeq import Prelude import XMonad import XMonad.StackSet hiding (delete, filter, new) import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy, listToMaybe) import qualified XMonad.Util.ExtensibleState as XS -- $usage -- To record the order in which you view workspaces, you can use this -- module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook) -- -- Then add the hook to your 'logHook': -- -- > main = xmonad $ def -- > { ... -- > , logHook = ... >> workspaceHistoryHook >> ... -- > , ... -- > } -- -- 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. newtype WorkspaceHistory = WorkspaceHistory { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in -- reverse-chronological order. } deriving (Read, Show) deriving NFData via [(Int, WorkspaceId)] instance ExtensionClass WorkspaceHistory where initialValue = WorkspaceHistory [] extensionType = PersistentExtension -- | A 'logHook' that keeps track of the order in which workspaces have -- been viewed. workspaceHistoryHook :: X () workspaceHistoryHook = workspaceHistoryHookExclude [] -- | Like 'workspaceHistoryHook', but with the ability to exclude -- certain workspaces. workspaceHistoryHookExclude :: [WorkspaceId] -> X () workspaceHistoryHookExclude ws = XS.modify' . update =<< gets windowset where update :: WindowSet -> WorkspaceHistory -> WorkspaceHistory update s = force . updateLastActiveOnEachScreenExclude ws s workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)] workspaceHistoryWithScreen = XS.gets history workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])] workspaceHistoryByScreen = map (\wss -> (maybe 0 fst (listToMaybe wss), map snd wss)) . groupBy (\a b -> fst a == fst b) . sortBy (\a b -> compare (fst a) $ fst b)<$> workspaceHistoryWithScreen -- | A list of workspace tags in the order they have been viewed, with the -- most recent first. No duplicates are present, but not all workspaces are -- guaranteed to appear, and there may be workspaces that no longer exist. workspaceHistory :: X [WorkspaceId] workspaceHistory = nub . map snd <$> XS.gets history workspaceHistoryTransaction :: X () -> X () workspaceHistoryTransaction action = do startingHistory <- XS.gets history action new <- flip updateLastActiveOnEachScreen (WorkspaceHistory startingHistory) <$> gets windowset XS.put $! force new -- | Update the last visible workspace on each monitor if needed -- already there, or move it to the front if it is. updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory updateLastActiveOnEachScreen = 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 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 = Just newEntry == firstOnScreen sid curr in if alreadyCurrent || wid `elem` ws then curr else newEntry : delete newEntry curr -- | Modify a the workspace history with a given pure function. workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X () workspaceHistoryModify action = XS.modify' $ force . WorkspaceHistory . action . history xmonad-contrib-0.18.0/XMonad/Hooks/XPropManage.hs0000644000000000000000000000637307346545000017714 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.XPropManage -- Description : ManageHook matching on XProperties. -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : unstable -- Portability : unportable -- -- A ManageHook matching on XProperties. ----------------------------------------------------------------------------- module XMonad.Hooks.XPropManage ( -- * Usage -- $usage xPropManageHook, XPropMatch, pmX, pmP ) where import Control.Exception as E import Control.Monad.Trans (lift) import XMonad import XMonad.Prelude (Endo (..), chr) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.XPropManage -- > import qualified XMonad.StackSet as W -- > import XMonad.Actions.TagWindows -- > import Data.List -- -- > manageHook = xPropManageHook xPropMatches -- > -- > xPropMatches :: [XPropMatch] -- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2"))) -- > , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen")) -- > , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3")) -- > ] -- -- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND -- -- A XPropMatch consists of a list of conditions and function telling what to do. -- -- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1, -- and an function which matches onto the value of the property (represented as a List -- of Strings). -- -- If a match succeeds the function is called immediately, can perform any action and then return -- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the -- WindowSet use just 'pmP function'. -- -- \*1 You can get the available properties of an application with the xprop utility. STRING properties -- should work fine. Others might not work. -- type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet)) pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet) pmX f w = f w >> return id pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet) pmP f _ = return f xPropManageHook :: [XPropMatch] -> ManageHook xPropManageHook tms = mconcat $ map propToHook tms where propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f mkQuery (a, tf) = fmap tf (getQuery a) mkHook func = ask >>= Query . lift . fmap Endo . func 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 = concatMap splitAtNull | otherwise = id return (filt p prop) getQuery :: Atom -> Query [String] getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p splitAtNull :: String -> [String] splitAtNull s = case dropWhile (== chr 0) s of "" -> [] s' -> w : splitAtNull s'' where (w, s'') = break (== chr 0) s' xmonad-contrib-0.18.0/XMonad/Layout/0000755000000000000000000000000007346545000015360 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Layout/Accordion.hs0000644000000000000000000000402207346545000017613 0ustar0000000000000000{-# 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 -- -- Maintainer : glasser@mit.edu -- Stability : stable -- Portability : unportable -- -- LayoutClass that puts non-focused windows in ribbons at the top and bottom -- of the screen. ----------------------------------------------------------------------------- module XMonad.Layout.Accordion ( -- * Usage -- $usage Accordion(Accordion)) where import XMonad import qualified XMonad.StackSet as W import Data.Ratio -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Accordion -- -- Then edit your @layoutHook@ by adding the Accordion layout: -- -- > myLayout = Accordion ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data Accordion a = Accordion deriving ( Read, Show ) instance LayoutClass Accordion Window where pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms where ups = reverse $ W.up ws dns = W.down ws (top, allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc (center, bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop (allButBottom, _) = splitVerticallyBy (7%8 :: Ratio Int) sc mainPane | ups /= [] && dns /= [] = center | ups /= [] = allButTop | dns /= [] = allButBottom | otherwise = sc tops = if ups /= [] then splitVertically (length ups) top else [] bottoms = if dns /= [] then splitVertically (length dns) bottom else [] xmonad-contrib-0.18.0/XMonad/Layout/AutoMaster.hs0000644000000000000000000001147707346545000020012 0ustar0000000000000000{-# 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) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.AutoMaster ( -- * Usage -- $usage autoMaster, AutoMaster ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Prelude import qualified XMonad.StackSet as W import Control.Arrow (first) -- $usage -- This module defines layout modifier named autoMaster. It separates -- screen in two parts - master and slave. Master windows are arranged -- in one row, in slave area underlying layout is run. Size of slave area -- automatically increases when number of slave windows is increasing. -- -- You can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.AutoMaster -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = autoMaster 1 (1/100) Grid ||| ... -- -- In this example, master area by default contains 1 window (you can -- change this number in runtime with usual IncMasterN message), changing -- slave area size with 1/100 on each Shrink/Expand message. -- | Data type for layout modifier data AutoMaster a = AutoMaster Int Float Float deriving (Read,Show) instance (Eq w) => LayoutModifier AutoMaster w where modifyLayout (AutoMaster k bias _) = autoLayout k bias pureMess = autoMess -- | Handle Shrink/Expand and IncMasterN messages autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a) 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 Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta -- | Main layout function autoLayout :: (Eq w, LayoutClass l w) => Int -> Float -> W.Workspace WorkspaceId (l w) w -> Rectangle -> X ([(w, Rectangle)], Maybe (l w)) autoLayout k bias wksp rect = do let stack = W.stack wksp let ws = W.integrate' stack let n = length ws if null ws then runLayout wksp rect else if n<=k then return (divideRow rect ws,Nothing) else do let master = take k ws let filtStack = stack >>= W.filter (`notElem` master) wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias) 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 where calcHeight :: Int -> Float calcHeight 1 = 1.0 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 -- | 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) -- | Divide rectangle between windows divideRow :: Rectangle -> [a] -> [(a, Rectangle)] divideRow (Rectangle x y w h) ws = zip ws rects where n = length ws oneW = fromIntegral w `div` n oneRect = Rectangle x y (fromIntegral oneW) h rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect -- | Shift rectangle right shiftR :: Position -> Rectangle -> Rectangle shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h -- | User interface function autoMaster :: LayoutClass l a => Int -> -- Number of master windows Float -> -- Step for which to increment/decrement master area size with Shrink/Expand l a -> ModifiedLayout AutoMaster l a autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta) xmonad-contrib-0.18.0/XMonad/Layout/AvoidFloats.hs0000644000000000000000000002760707346545000020143 0ustar0000000000000000{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.AvoidFloats -- Description : Avoid floats when placing tiled windows. -- Copyright : (c) 2014 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : (c) Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- Find a maximum empty rectangle around floating windows and use that area -- to display non-floating windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.AvoidFloats ( -- * Usage -- $usage avoidFloats, avoidFloats', AvoidFloatMsg(..), AvoidFloatItemMsg(..), ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Prelude (fi, mapMaybe, maximumBy, sortOn) import qualified XMonad.StackSet as W import Data.Ord import qualified Data.Map as M import qualified Data.Set as S -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Layout.AvoidFloats -- -- and modify the layouts to call avoidFloats on the layouts where you want the -- non-floating windows to not be behind floating windows. -- -- > layoutHook = ... ||| avoidFloats Full ||| ... -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Then add appropriate key bindings, for example: -- -- > ,((modm .|. shiftMask, xK_b), sendMessage AvoidFloatToggle) -- > ,((modm .|. controlMask, xK_b), withFocused $ sendMessage . AvoidFloatToggleItem) -- > ,((modm .|. shiftMask .|. controlMask, xK_b), sendMessage (AvoidFloatSet False) >> sendMessage AvoidFloatClearItems) -- -- For detailed instructions on editing your key bindings, see -- . -- -- Note that this module is incompatible with an old way of configuring -- "XMonad.Actions.FloatSnap". If you are having problems, please update your -- configuration. -- | Avoid floating windows unless the resulting area for windows would be too small. -- In that case, use the whole screen as if this layout modifier wasn't there. -- No windows are avoided by default, they need to be added using signals. avoidFloats :: l a -- ^ Layout to modify. -> ModifiedLayout AvoidFloats l a avoidFloats = avoidFloats' 100 100 False -- | Avoid floating windows unless the resulting area for windows would be too small. -- In that case, use the whole screen as if this layout modifier wasn't there. avoidFloats' :: Int -- ^ Minimum width of the area used for non-floating windows. -> Int -- ^ Minimum height of the area used for non-floating windows. -> Bool -- ^ If floating windows should be avoided by default. -> l a -- ^ Layout to modify. -> ModifiedLayout AvoidFloats l a avoidFloats' w h act = ModifiedLayout (AvoidFloats Nothing S.empty w h act) data AvoidFloats a = AvoidFloats { cache :: Maybe ((M.Map a W.RationalRect, Rectangle), Rectangle) , chosen :: S.Set a , minw :: Int , minh :: Int , avoidAll :: Bool } deriving (Read, Show) -- | Change the state of the whole avoid float layout modifier. data AvoidFloatMsg = 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. -- | 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. instance Message AvoidFloatMsg instance Typeable a => Message (AvoidFloatItemMsg a) instance LayoutModifier AvoidFloats Window where modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do floating <- gets $ W.floating . windowset case cache lm of Just (key, mer) | key == (floating,r) -> (, 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 (, 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 (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 (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 in Just $ lm { chosen = op a (chosen lm), cache = Nothing } | otherwise = Nothing pruneWindows :: AvoidFloats Window -> AvoidFloats Window pruneWindows lm = case cache lm of Nothing -> 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 -- described in \"On the maximum empty rectangle problem\" by A. Naamad, D.T. -- Lee and W.-L HSU. Published in Discrete Applied Mathematics 8 (1984.) maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle] maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge where upAndDownEdge = findGaps br 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 (boundLeft', boundRight', _) = shrinkBounds boundLeft boundRight boundRects r (top br) in mkRect boundLeft' boundRight' (top br) (top r) ?: rs everyUpper :: Rectangle -- ^ The current rectangle where the top edge is used. -> Rectangle -- ^ The current rectangle where the bottom edge is used. -> ([Rectangle],Int,Int,[Rectangle]) -- ^ List of MERs found so far, left bound, right bound and list of rectangles used for bounds. -> ([Rectangle],Int,Int,[Rectangle]) everyUpper lower upper (rs, boundLeft, boundRight, boundRects) = (r?:rs, boundLeft', boundRight', boundRects') where r = mkRect boundLeft' boundRight' (bottom upper) (top lower) (boundLeft', boundRight', boundRects') = shrinkBounds boundLeft boundRight boundRects lower (bottom upper) shrinkBounds :: Int -> Int -> [Rectangle] -> Rectangle -> Int -> (Int, Int, [Rectangle]) shrinkBounds boundLeft boundRight boundRects lower upperLimit = (boundLeft', boundRight', boundRects') where (shrinkers, boundRects') = span (\a -> bottom a > upperLimit) boundRects (boundLeft', boundRight') = foldr (shrinkBounds' lower) (boundLeft, boundRight) $ filter (\a -> top a < top lower) shrinkers shrinkBounds' :: Rectangle -> Rectangle -> (Int, Int) -> (Int, Int) shrinkBounds' mr r (boundLeft, boundRight) | right r < right mr = (max boundLeft $ right r, boundRight) | left r > left mr = (boundLeft, min boundRight $ left r) | otherwise = (right r, left r) -- r is horizontally covering all of mr; make sure the area of this rectangle will always be 0. 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) in if any (\a -> left a <= left r && right r <= right a) rs then Nothing else mkRect boundLeft boundRight (bottom r) (bottom br) -- | Split rectangles that horizontally fully contains another rectangle -- without sharing either the left or right side. splitContainers :: [Rectangle] -> [Rectangle] splitContainers rects = splitContainers' [] $ sortOn rect_width rects where splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle] splitContainers' res [] = res splitContainers' res (r:rs) = splitContainers' (r:res) $ concatMap (doSplit r) rs doSplit :: Rectangle -> Rectangle -> [Rectangle] doSplit guide r | left guide <= left r || right r <= right guide = [r] | otherwise = let w0 = fi (rect_x guide - rect_x r) + (rect_width guide `div` 2) w1 = rect_width r - w0 in [ Rectangle (rect_x r) (rect_y r) w0 (rect_height r) , Rectangle (rect_x r + fi w0) (rect_y r) w1 (rect_height r) ] -- | Find all horizontal gaps that are left empty from top to bottom of screen. findGaps :: 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) $ sortOn (Down . left) $ filter inBounds rs lastgap = mkRect end (right br) (top br) (bottom br) in lastgap?:gaps where findGaps' :: Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int) findGaps' r (gaps, end) = let gap = mkRect end (left r) (top br) (bottom br) in (gap?:gaps, max end (right r)) inBounds :: Rectangle -> Bool inBounds r = left r < right br && left br < right r (?:) :: Maybe a -> [a] -> [a] Just x ?: xs = x:xs _ ?: xs = xs left, right, top, bottom, area :: Rectangle -> Int left r = fi (rect_x r) right r = fi (rect_x r) + fi (rect_width r) top r = fi (rect_y r) bottom r = fi (rect_y r) + fi (rect_height r) area r = fi (rect_width r * rect_height r) mkRect :: Int -> Int -> Int -> Int -> Maybe Rectangle mkRect l r t b = let rect = Rectangle (fi l) (fi t) (fi $ max 0 $ r-l) (fi $ max 0 $ b-t) in if area rect > 0 then Just rect else Nothing xmonad-contrib-0.18.0/XMonad/Layout/BinaryColumn.hs0000644000000000000000000001112107346545000020312 0ustar0000000000000000{-# 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) -- -- Maintainer : Campbell Barton -- Stability : unstable -- Portability : unportable -- -- Provides Column layout that places all windows in one column. -- Each window is half the height of the previous, -- except for the last pair of windows. -- -- Note: Originally based on "XMonad.Layout.Column" with changes: -- -- * Adding/removing windows doesn't resize all other windows. -- (last window pair exception). -- * Minimum window height option. -- ----------------------------------------------------------------------------- module XMonad.Layout.BinaryColumn ( -- * Usage -- $usage BinaryColumn (..) ) where import XMonad import qualified XMonad.StackSet import qualified Data.List -- $usage -- This module defines layout named BinaryColumn. -- It places all windows in one column. -- Windows heights are calculated to prevent window resizing whenever -- a window is added or removed. -- This is done by keeping the last two windows in the stack the same height. -- -- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.BinaryColumn -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = BinaryColumn 1.0 32 ||| ... -- -- The first value causes the master window to take exactly half of the screen, -- the second ensures that windows are no less than 32 pixels tall. -- -- Shrink/Expand can be used to adjust the first value by increments of 0.1. -- -- * 2.0 uses all space for the master window -- (minus the space for windows which get their fixed height). -- * 0.0 gives an evenly spaced grid. -- Negative values reverse the sizes so the last -- window in the stack becomes larger. -- data BinaryColumn a = BinaryColumn Float Int deriving (Read, Show) instance XMonad.LayoutClass BinaryColumn a where pureLayout = columnLayout pureMessage = columnMessage columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a) columnMessage (BinaryColumn q min_size) m = fmap resize (fromMessage m) where resize Shrink = BinaryColumn (max (-2.0) (q - 0.1)) min_size resize Expand = BinaryColumn (min 2.0 (q + 0.1)) min_size columnLayout :: BinaryColumn a -> XMonad.Rectangle -> XMonad.StackSet.Stack a -> [(a, XMonad.Rectangle)] columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects where ws = XMonad.StackSet.integrate stack n = length ws scale_abs = abs scale heights_noflip = let -- Regular case: check for min size. f 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, divide, False) else (value_max, m_fl, True) size_next = size - value m_next = m - 1 in value : 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 m size divide True = let divide_next = fromIntegral m value_even = (fromIntegral size / divide) value = round value_even :: Integer m_next = m - 1 size_next = size - value in value : 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) divide_init = if scale_abs == 0.0 then fromIntegral n else 1.0 / (0.5 * scale_abs) heights = if scale < 0.0 then Data.List.reverse (take n heights_noflip) else heights_noflip ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]] rects = zipWith (curry (mkRect rect)) heights ys mkRect :: XMonad.Rectangle -> (Integer,XMonad.Position) -> XMonad.Rectangle mkRect (XMonad.Rectangle xs ys ws _) (h, y) = XMonad.Rectangle xs (ys + fromIntegral y) ws (fromInteger h) xmonad-contrib-0.18.0/XMonad/Layout/BinarySpacePartition.hs0000644000000000000000000011470707346545000022020 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE DoAndIfThenElse #-} {-# 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 -- 2015 Anton Pirogov -- 2019 Mateusz Karbowy -- Stability : unstable -- Portability : unportable -- -- Layout where new windows will split the focused window in half, based off of BSPWM -- ----------------------------------------------------------------------------- module XMonad.Layout.BinarySpacePartition ( -- * Usage -- $usage emptyBSP , BinarySpacePartition , Rotate(..) , Swap(..) , ResizeDirectional(.., ExpandTowards, ShrinkFrom, MoveSplit) , TreeRotate(..) , TreeBalance(..) , FocusParent(..) , SelectMoveNode(..) , Direction2D(..) , SplitShiftDirectional(..) ) where import XMonad import XMonad.Prelude hiding (insert) import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers (isMinimized) import XMonad.Util.Stack hiding (Zipper) import XMonad.Util.Types -- for mouse resizing import XMonad.Layout.WindowArranger (WindowArrangerMsg(SetGeometry)) -- for "focus parent" node border import XMonad.Util.XUtils import qualified Data.Map as M import qualified Data.Set as S import Data.Ratio ((%)) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.BinarySpacePartition -- -- Then add the layout, using the default BSP (BinarySpacePartition) -- -- > myLayout = emptyBSP ||| etc .. -- -- It may be a good idea to use "XMonad.Actions.Navigation2D" to move between the windows. -- -- This layout responds to SetGeometry and is compatible with e.g. "XMonad.Actions.MouseResize" -- or "XMonad.Layout.BorderResize". You should probably try both to decide which is better for you, -- if you want to be able to resize the splits with the mouse. -- -- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard: -- -- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R) -- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L) -- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D) -- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U) -- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R) -- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L) -- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D) -- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U) -- > , ((modm, xK_r ), sendMessage Rotate) -- > , ((modm, xK_s ), sendMessage Swap) -- > , ((modm, xK_n ), sendMessage FocusParent) -- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode) -- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode) -- > , ((modm .|. shiftMask .|. ctrlMask , xK_j ), sendMessage $ SplitShift Prev) -- > , ((modm .|. shiftMask .|. ctrlMask , xK_k ), sendMessage $ SplitShift Next) -- -- Here's an alternative key mapping, this time using additionalKeysP, -- arrow keys, and slightly different behavior when resizing windows -- -- > , ("M-M1-", sendMessage $ ExpandTowards L) -- > , ("M-M1-", sendMessage $ ShrinkFrom L) -- > , ("M-M1-", sendMessage $ ExpandTowards U) -- > , ("M-M1-", sendMessage $ ShrinkFrom U) -- > , ("M-M1-C-", sendMessage $ ShrinkFrom R) -- > , ("M-M1-C-", sendMessage $ ExpandTowards R) -- > , ("M-M1-C-", sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-", sendMessage $ ExpandTowards D) -- > , ("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, -- but tunes the split ratios in a way that each window gets the same amount of space: -- -- > , ((myModMask, xK_a), sendMessage Balance) -- > , ((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 instance Message TreeRotate -- | 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 = ExpandTowardsBy Direction2D Rational | ShrinkFromBy Direction2D Rational | MoveSplitBy Direction2D Rational instance Message ResizeDirectional -- | @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 instance Message Swap -- | 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 instance Message SelectMoveNode data Axis = Horizontal | Vertical deriving (Show, Read, Eq) -- | Message for shifting window by splitting its neighbour newtype SplitShiftDirectional = SplitShift Direction1D instance Message SplitShiftDirectional oppositeDirection :: Direction2D -> Direction2D oppositeDirection U = D oppositeDirection D = U oppositeDirection L = R oppositeDirection R = L oppositeAxis :: Axis -> Axis oppositeAxis Vertical = Horizontal oppositeAxis Horizontal = Vertical toAxis :: Direction2D -> Axis toAxis U = Horizontal toAxis D = Horizontal toAxis L = Vertical toAxis R = Vertical split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle) split Horizontal r (Rectangle sx sy sw sh) = (r1, r2) where r1 = Rectangle sx sy sw sh' r2 = Rectangle sx (sy + fromIntegral sh') sw (sh - sh') sh' = floor $ fromIntegral sh * r split Vertical r (Rectangle sx sy sw sh) = (r1, r2) where r1 = Rectangle sx sy sw' sh r2 = Rectangle (sx + fromIntegral sw') sy (sw - sw') sh sw' = floor $ fromIntegral sw * r data Split = Split { axis :: Axis , ratio :: Rational } deriving (Show, Read, Eq) oppositeSplit :: Split -> Split oppositeSplit (Split d r) = Split (oppositeAxis d) r increaseRatio :: Split -> Rational -> Split increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta))) data Tree a = Leaf Int | Node { value :: a , left :: Tree a , right :: Tree a } deriving (Show, Read, Eq) numLeaves :: Tree a -> Int numLeaves (Leaf _) = 1 numLeaves (Node _ l r) = numLeaves l + numLeaves r -- right or left rotation of a (sub)tree, no effect if rotation not possible rotTree :: Direction2D -> Tree a -> Tree a rotTree _ (Leaf n) = Leaf n rotTree R n@(Node _ (Leaf _) _) = n rotTree L n@(Node _ _ (Leaf _)) = n rotTree R (Node sp (Node sp2 l2 r2) r) = Node sp2 l2 (Node sp r2 r) rotTree L (Node sp l (Node sp2 l2 r2)) = Node sp2 (Node sp l l2) r2 rotTree _ t = t data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show, Read, Eq) swapCrumb :: Crumb a -> Crumb a swapCrumb (LeftCrumb s t) = RightCrumb s t swapCrumb (RightCrumb s t) = LeftCrumb s t parentVal :: Crumb a -> a parentVal (LeftCrumb s _) = s parentVal (RightCrumb s _) = s modifyParentVal :: (a -> a) -> Crumb a -> Crumb a modifyParentVal f (LeftCrumb s t) = LeftCrumb (f s) t modifyParentVal f (RightCrumb s t) = RightCrumb (f s) t type Zipper a = (Tree a, [Crumb a]) toZipper :: Tree a -> Zipper a toZipper t = (t, []) goLeft :: Zipper a -> Maybe (Zipper a) goLeft (Leaf _, _) = Nothing goLeft (Node x l r, bs) = Just (l, LeftCrumb x r:bs) goRight :: Zipper a -> Maybe (Zipper a) goRight (Leaf _, _) = Nothing goRight (Node x l r, bs) = Just (r, RightCrumb x l:bs) goUp :: Zipper a -> Maybe (Zipper a) goUp (_, []) = Nothing goUp (t, LeftCrumb x r:cs) = Just (Node x t r, cs) goUp (t, RightCrumb x l:cs) = Just (Node x l t, cs) goSibling :: Zipper a -> Maybe (Zipper a) goSibling (_, []) = Nothing goSibling z@(_, LeftCrumb _ _:_) = Just z >>= goUp >>= goRight goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft top :: Zipper a -> Zipper a top z = maybe z top (goUp z) toTree :: Zipper a -> Tree a toTree = fst . top goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a) goToNthLeaf _ z@(Leaf _, _) = Just z goToNthLeaf n z@(t, _) = if numLeaves (left t) > n then do z' <- goLeft z goToNthLeaf n z' else do z' <- goRight z goToNthLeaf (n - (numLeaves . left $ t)) z' toggleSplits :: Tree Split -> Tree Split toggleSplits (Leaf l) = Leaf l toggleSplits (Node s l r) = Node (oppositeSplit s) (toggleSplits l) (toggleSplits r) splitCurrent :: Zipper Split -> Maybe (Zipper Split) splitCurrent (Leaf _, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (Leaf 0), []) splitCurrent (Leaf _, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf 0) (Leaf 0), crumb:cs) splitCurrent (n, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (toggleSplits n), []) splitCurrent (n, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf 0) (toggleSplits n), crumb:cs) removeCurrent :: Zipper a -> Maybe (Zipper a) 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 _) (Leaf _), cs) = Just (Leaf 0, cs) removeCurrent z@(Node{}, _) = goLeft z >>= removeCurrent rotateCurrent :: Zipper Split -> Maybe (Zipper Split) rotateCurrent l@(_, []) = Just l rotateCurrent (n, c:cs) = Just (n, modifyParentVal oppositeSplit c:cs) swapCurrent :: Zipper a -> Maybe (Zipper a) swapCurrent l@(_, []) = Just l swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs) insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split) insertLeftLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs) insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs) insertLeftLeaf Node{} z = Just z insertLeftLeaf _ _ = Nothing insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split) insertRightLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs) insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs) insertRightLeaf Node{} z = Just z insertRightLeaf _ _ = Nothing findRightLeaf :: Zipper Split -> Maybe (Zipper Split) findRightLeaf n@(Node{}, _) = goRight n >>= findRightLeaf findRightLeaf l@(Leaf _, _) = Just l findLeftLeaf :: Zipper Split -> Maybe (Zipper Split) findLeftLeaf n@(Node{}, _) = goLeft n findLeftLeaf l@(Leaf _, _) = Just l findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split) findTheClosestLeftmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= goLeft >>= findRightLeaf findTheClosestLeftmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= findTheClosestLeftmostLeaf findTheClosestLeftmostLeaf _ = Nothing findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split) findTheClosestRightmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= findTheClosestRightmostLeaf findTheClosestRightmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= goRight >>= findLeftLeaf findTheClosestRightmostLeaf _ = Nothing splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split) splitShiftLeftCurrent l@(_, []) = Just l splitShiftLeftCurrent l@(_, (RightCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead. splitShiftLeftCurrent l@(n, _) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split) splitShiftRightCurrent l@(_, []) = Just l splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead. splitShiftRightCurrent l@(n, _) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool isAllTheWay _ _ (_, []) = True isAllTheWay R _ (_, LeftCrumb s _:_) | axis s == Vertical = False isAllTheWay L _ (_, RightCrumb s _:_) | axis s == Vertical = False isAllTheWay D _ (_, LeftCrumb s _:_) | axis s == Horizontal = False isAllTheWay U _ (_, RightCrumb s _:_) | axis s == Horizontal = False isAllTheWay dir diff z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir diff 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 -> 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 -> 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 -> 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 getSplit d z = do let fs = findSplit d z if isNothing fs then findClosest d z else fs findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split) findClosest _ z@(_, []) = Just z findClosest d z@(_, LeftCrumb s _:_) | axis s == d = Just z findClosest d z@(_, RightCrumb s _:_) | axis s == d = Just z findClosest d z = goUp z >>= findClosest d findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split) findSplit _ (_, []) = Nothing findSplit d z@(_, LeftCrumb s _:_) | axis s == d = Just z findSplit d z = goUp z >>= findSplit d resizeSplit :: Direction2D -> (Rational,Rational) -> Zipper Split -> Maybe (Zipper Split) resizeSplit _ _ z@(_, []) = Just z resizeSplit dir (xsc,ysc) z = case goToBorder dir z of Nothing -> Just z Just (t@Node{}, crumb) -> Just $ case dir of R -> (t{value=sp{ratio=scaleRatio (ratio sp) xsc}}, crumb) D -> (t{value=sp{ratio=scaleRatio (ratio sp) ysc}}, crumb) L -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) xsc}}, crumb) U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb) where sp = value t scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac Just (Leaf{}, _) -> undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf) -- starting from a leaf, go to node representing a border of the according window goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split) goToBorder L z@(_, RightCrumb (Split Vertical _) _:_) = goUp z goToBorder L z = goUp z >>= goToBorder L goToBorder R z@(_, LeftCrumb (Split Vertical _) _:_) = goUp z goToBorder R z = goUp z >>= goToBorder R goToBorder U z@(_, RightCrumb (Split Horizontal _) _:_) = goUp z goToBorder U z = goUp z >>= goToBorder U goToBorder D z@(_, LeftCrumb (Split Horizontal _) _:_) = goUp z goToBorder D z = goUp z >>= goToBorder D -- takes a list of indices and numerates the leaves of a given tree numerate :: [Int] -> Tree a -> Tree a numerate ns t = snd $ num ns t where num (n:nns) (Leaf _) = (nns, Leaf n) num [] (Leaf _) = ([], Leaf 0) num n (Node s l r) = (n'', Node s nl nr) where (n', nl) = num n l (n'', nr) = num n' r -- return values of leaves from left to right as list flatten :: Tree a -> [Int] flatten (Leaf n) = [n] flatten (Node _ l r) = flatten l++flatten r -- adjust ratios to make window areas equal equalize :: Zipper Split -> Maybe (Zipper Split) equalize (t, cs) = Just (eql t, cs) where eql (Leaf n) = Leaf n eql n@(Node s l r) = Node s{ratio=fromIntegral (numLeaves l) % fromIntegral (numLeaves n)} (eql l) (eql r) -- generate a symmetrical balanced tree for n leaves from given tree, preserving leaf labels balancedTree :: Zipper Split -> Maybe (Zipper Split) balancedTree (t, cs) = Just (numerate (flatten t) $ balanced (numLeaves t), cs) where balanced 1 = Leaf 0 balanced 2 = Node (Split Horizontal 0.5) (Leaf 0) (Leaf 0) balanced m = Node (Split Horizontal 0.5) (balanced (m`div`2)) (balanced (m-m`div`2)) -- attempt to rotate splits optimally in order choose more quad-like rects optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split) optimizeOrientation rct (t, cs) = Just (opt t rct, cs) where opt (Leaf v) _ = Leaf v opt (Node sp l r) rect = Node sp' (opt l lrect) (opt r rrect) where (Rectangle _ _ w1 h1,Rectangle _ _ w2 h2) = split (axis sp) (ratio sp) rect (Rectangle _ _ w3 h3,Rectangle _ _ w4 h4) = split (axis $ oppositeSplit sp) (ratio sp) rect f w h = if w > h then w'/h' else h'/w' where (w',h') = (fromIntegral w :: Double, fromIntegral h :: Double) wratio = min (f w1 h1) (f w2 h2) wratio' = min (f w3 h3) (f w4 h4) sp' = if wratio Zipper a -> Maybe (Zipper a) goToNode (NodeRef _ dirs _) z = foldM gofun z dirs where gofun z' L = goLeft z' gofun z' R = goRight z' gofun _ _ = Nothing toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef toNodeRef _ Nothing = noRef toNodeRef l (Just (_, cs)) = NodeRef l (reverse $ map crumbToDir cs) [] where crumbToDir (LeftCrumb _ _) = L crumbToDir (RightCrumb _ _) = R -- returns the leaf a noderef is leading to, if any nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int nodeRefToLeaf n (Just z) = case goToNode n z of Just (Leaf l, _) -> Just l Just (Node{}, _) -> Nothing Nothing -> Nothing nodeRefToLeaf _ Nothing = Nothing leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef leafToNodeRef l b = toNodeRef l (makeZipper b >>= goToNthLeaf l) data BinarySpacePartition a = BinarySpacePartition { getOldRects :: [(Window,Rectangle)] , getFocusedNode :: NodeRef , getSelectedNode :: NodeRef , getTree :: Maybe (Tree Split) } deriving (Show, Read,Eq) -- | an empty BinarySpacePartition to use as a default for adding windows to. emptyBSP :: BinarySpacePartition a emptyBSP = BinarySpacePartition [] noRef noRef Nothing makeBSP :: Tree Split -> BinarySpacePartition a makeBSP = BinarySpacePartition [] noRef noRef . Just makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split) makeZipper (BinarySpacePartition _ _ _ Nothing) = Nothing makeZipper (BinarySpacePartition _ _ _ (Just t)) = Just . toZipper $ t size :: BinarySpacePartition a -> Int size = maybe 0 numLeaves . getTree zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b zipperToBinarySpacePartition Nothing = emptyBSP zipperToBinarySpacePartition (Just z) = BinarySpacePartition [] noRef noRef . Just . toTree . top $ z rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle] rectangles (BinarySpacePartition _ _ _ Nothing) _ = [] rectangles (BinarySpacePartition _ _ _ (Just (Leaf _))) rootRect = [rootRect] rectangles (BinarySpacePartition _ _ _ (Just node)) rootRect = rectangles (makeBSP . left $ node) leftBox ++ rectangles (makeBSP . right $ node) rightBox where (leftBox, rightBox) = split (axis info) (ratio info) rootRect info = value node getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle getNodeRect b r n = fromMaybe (Rectangle 0 0 1 1) (makeZipper b >>= goToNode n >>= getRect []) where getRect ls (_, []) = Just $ foldl (\r' (s,f) -> f $ split' s r') r ls getRect ls z@(_, LeftCrumb s _:_) = goUp z >>= getRect ((s,fst):ls) getRect ls z@(_, RightCrumb s _:_) = goUp z >>= getRect ((s,snd):ls) split' s = split (axis s) (ratio s) doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> BinarySpacePartition a doToNth f b = b{getTree=getTree $ zipperToBinarySpacePartition $ makeZipper b >>= goToNode (getFocusedNode b) >>= f} splitNth :: BinarySpacePartition a -> BinarySpacePartition a splitNth (BinarySpacePartition _ _ _ Nothing) = makeBSP (Leaf 0) splitNth b = doToNth splitCurrent b removeNth :: BinarySpacePartition a -> BinarySpacePartition a removeNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP removeNth (BinarySpacePartition _ _ _ (Just (Leaf _))) = emptyBSP removeNth b = doToNth removeCurrent b rotateNth :: BinarySpacePartition a -> BinarySpacePartition a rotateNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP rotateNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b rotateNth b = doToNth rotateCurrent b swapNth :: BinarySpacePartition a -> BinarySpacePartition a swapNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b swapNth b = doToNth swapCurrent b splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b splitShiftNth Prev b = doToNth splitShiftLeftCurrent b splitShiftNth Next b = doToNth splitShiftRightCurrent b growNthTowards :: Direction2D -> 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 -> Rational -> BinarySpacePartition a -> BinarySpacePartition a shrinkNthFrom _ _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP shrinkNthFrom _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b shrinkNthFrom dir diff b = doToNth (shrinkTreeFrom dir diff) b autoSizeNth :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a autoSizeNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP autoSizeNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b autoSizeNth dir diff b = doToNth (autoSizeTree dir diff) b resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP resizeSplitNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b resizeSplitNth dir sc b = doToNth (resizeSplit dir sc) b -- rotate tree left or right around parent of nth leaf rotateTreeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a rotateTreeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP rotateTreeNth U b = b rotateTreeNth D b = b rotateTreeNth dir b@(BinarySpacePartition _ _ _ (Just _)) = doToNth (\t -> case goUp t of Nothing -> Just t Just (t', c) -> Just (rotTree dir t', c)) b equalizeNth :: BinarySpacePartition a -> BinarySpacePartition a equalizeNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP equalizeNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b equalizeNth b = doToNth equalize b rebalanceNth :: BinarySpacePartition a -> Rectangle -> BinarySpacePartition a rebalanceNth (BinarySpacePartition _ _ _ Nothing) _ = emptyBSP rebalanceNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) _ = b rebalanceNth b r = doToNth (balancedTree >=> optimizeOrientation r) b flattenLeaves :: BinarySpacePartition a -> [Int] flattenLeaves (BinarySpacePartition _ _ _ Nothing) = [] flattenLeaves (BinarySpacePartition _ _ _ (Just t)) = flatten t -- we do this before an action to look afterwards which leaves moved where numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a numerateLeaves b@(BinarySpacePartition _ _ _ Nothing) = b numerateLeaves b@(BinarySpacePartition _ _ _ (Just t)) = b{getTree=Just $ numerate ns t} where ns = [0..(numLeaves t-1)] -- if there is a selected and focused node and the focused is not a part of selected, -- move selected node to be a child of focused node moveNode :: BinarySpacePartition a -> BinarySpacePartition a moveNode b@(BinarySpacePartition _ (NodeRef (-1) _ _) _ _) = b moveNode b@(BinarySpacePartition _ _ (NodeRef (-1) _ _) _) = b moveNode b@(BinarySpacePartition _ _ _ Nothing) = b moveNode b@(BinarySpacePartition _ f s (Just ot)) = case makeZipper b >>= goToNode s of Just (n, LeftCrumb _ t:cs) -> b{getTree=Just $ insert n $ top (t, cs)} Just (n, RightCrumb _ t:cs) -> b{getTree=Just $ insert n $ top (t, cs)} _ -> b where insert t z = case goToNode f z of Nothing -> ot --return original tree (abort) Just (n, c:cs) -> toTree (Node (Split (oppositeAxis . axis . parentVal $ c) 0.5) t n, c:cs) Just (n, []) -> toTree (Node (Split Vertical 0.5) t n, []) ------------------------------------------ -- returns index of focused window or 0 for empty stack index :: W.Stack a -> Int index s = case toIndex (Just s) of (_, Nothing) -> 0 (_, Just int) -> int --move windows to new positions according to tree transformations, keeping focus on originally focused window --CAREFUL here! introduce a bug here and have fun debugging as your windows start to disappear or explode adjustStack :: Maybe (W.Stack Window) --original stack -> Maybe (W.Stack Window) --stack without floating windows -> [Window] --just floating windows of this WS -> Maybe (BinarySpacePartition Window) -- Tree with numbered leaves telling what to move where -> Maybe (W.Stack Window) --resulting stack adjustStack orig Nothing _ _ = orig --no new stack -> no changes adjustStack orig _ _ Nothing = orig --empty tree -> no changes adjustStack orig s fw (Just b) = if length ls tree incomplete, no changes else fromIndex ws' fid' where ws' = mapMaybe (`M.lookup` wsmap) ls ++ fw fid' = fromMaybe 0 $ elemIndex focused ws' wsmap = M.fromList $ zip [0..] ws -- map: old index in list -> window ls = flattenLeaves b -- get new index ordering from tree (ws,fid) = toIndex s focused = ws !! fromMaybe 0 fid --replace the window stack of the managed workspace with our modified stack replaceStack :: Maybe (W.Stack Window) -> X () replaceStack s = do st <- get let wset = windowset st cur = W.current wset wsp = W.workspace cur put st{windowset=wset{W.current=cur{W.workspace=wsp{W.stack=s}}}} replaceFloating :: M.Map Window W.RationalRect -> X () replaceFloating wsm = do st <- get let wset = windowset st put st{windowset=wset{W.floating=wsm}} -- some helpers to filter windows -- getFloating :: X [Window] getFloating = M.keys . W.floating <$> gets windowset -- all floating windows getHidden :: X [Window] getHidden = getStackSet >>= filterM (runQuery isMinimized) . W.integrate' getStackSet :: X (Maybe (W.Stack Window)) getStackSet = W.stack . W.workspace . W.current <$> gets windowset -- windows on this WS (with floating) getScreenRect :: X Rectangle getScreenRect = screenRect . W.screenDetail . W.current <$> gets windowset withoutFloating :: [Window] -> [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window) withoutFloating fs hs = maybe Nothing (unfloat fs hs) -- ignore messages if current focus is on floating window, otherwise return stack without floating unfloat :: [Window] -> [Window] -> W.Stack Window -> Maybe (W.Stack Window) unfloat fs hs s = if W.focus s `elem` fs then Nothing else Just $ s{W.up = W.up s \\ (fs ++ hs), W.down = W.down s \\ (fs ++ hs)} instance LayoutClass BinarySpacePartition Window where doLayout b r s = do let b' = layout b b'' <- updateNodeRef b' (size b/=size b') r let rs = rectangles b'' r wrs = zip ws rs return (wrs, Just b''{getOldRects=wrs}) where ws = W.integrate s l = length ws layout bsp | l == sz = bsp | l > sz = layout $ splitNth bsp | otherwise = layout $ removeNth bsp where sz = size bsp handleMessage b_orig m | Just msg@(SetGeometry _) <- fromMessage m = handleResize b msg | Just FocusParent <- fromMessage m = do let n = getFocusedNode b let n' = toNodeRef (refLeaf n) (makeZipper b >>= goToNode n >>= goUp) return $ Just b{getFocusedNode=n'{refWins=refWins n}} | Just SelectNode <- fromMessage m = do let n = getFocusedNode b let s = getSelectedNode b removeBorder $ refWins s let s' = if refLeaf n == refLeaf s && refPath n == refPath s then noRef else n{refWins=[]} return $ Just b{getSelectedNode=s'} | otherwise = do ws <- getStackSet fs <- getFloating hs <- getHidden r <- getScreenRect -- removeBorder $ refWins $ getSelectedNode b let lws = withoutFloating fs hs ws -- tiled windows on WS lfs = maybe [] W.integrate ws \\ maybe [] W.integrate lws -- untiled windows on WS b' = handleMesg r -- transform tree (concerns only tiled windows) ws' = adjustStack ws lws lfs b' -- apply transformation to window stack, reintegrate floating wins replaceStack ws' return b' where handleMesg r = msum [ fmap resize (fromMessage m) , fmap rotate (fromMessage m) , fmap swap (fromMessage m) , fmap rotateTr (fromMessage m) , fmap (balanceTr r) (fromMessage m) , fmap move (fromMessage m) , fmap splitShift (fromMessage m) ] 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 rotateTr RotateR = resetFoc $ rotateTreeNth R b balanceTr _ Equalize = resetFoc $ equalizeNth b balanceTr r Balance = resetFoc $ rebalanceNth b r move MoveNode = resetFoc $ moveNode b move SelectNode = b --should not happen here, is done above, as we need X monad splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b b = numerateLeaves b_orig resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf= -1} ,getSelectedNode=(getSelectedNode bsp){refLeaf= -1}} description _ = "BSP" -- React to SetGeometry message to work with BorderResize/MouseResize handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window)) handleResize b (SetGeometry newrect@(Rectangle _ _ w h)) = do ws <- getStackSet fs <- getFloating hs <- getHidden case W.focus <$> ws of Nothing -> return Nothing Just win -> do (_,_,_,_,_,mx,my,_) <- withDisplay (\d -> io $ queryPointer d win) let oldrect@(Rectangle _ _ ow oh) = fromMaybe (Rectangle 0 0 0 0) $ lookup win $ getOldRects b let (xsc,ysc) = (fi w % fi ow, fi h % fi oh) (xsc',ysc') = (rough xsc, rough ysc) dirs = changedDirs oldrect newrect (fi mx,fi my) n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs hs ws -- unless (isNothing dir) $ debug $ -- show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh) -- ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my) return $ case n of Just _ -> Just $ foldl' (\b' d -> resizeSplitNth d (xsc',ysc') b') b dirs Nothing -> Nothing --focused window is floating -> ignore where rough v = min 1.5 $ max 0.75 v -- extreme scale factors are forbidden handleResize _ _ = return Nothing -- find out which borders have been pulled. We need the old and new rects and the mouse coordinates changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D] changedDirs (Rectangle _ _ ow oh) (Rectangle _ _ w h) (mx,my) = catMaybes [lr, ud] where lr = if ow==w then Nothing else Just (if (fi mx :: Double) > (fi ow :: Double)/2 then R else L) ud = if oh==h then Nothing else Just (if (fi my :: Double) > (fi oh :: Double)/2 then D else U) -- node focus border helpers ---------------------------- updateNodeRef :: BinarySpacePartition Window -> Bool -> Rectangle -> X (BinarySpacePartition Window) updateNodeRef b force r = do let n = getFocusedNode b let s = getSelectedNode b removeBorder (refWins n++refWins s) l <- getCurrFocused b' <- if refLeaf n /= l || refLeaf n == (-1) || force then return b{getFocusedNode=leafToNodeRef l b} else return b b'' <- if force then return b'{getSelectedNode=noRef} else return b' renderBorders r b'' where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getHidden <*> getStackSet) -- create border around focused node if necessary renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a) renderBorders r b = do let l = nodeRefToLeaf (getFocusedNode b) $ makeZipper b wssel <- if refLeaf (getSelectedNode b)/=(-1) then createBorder (getNodeRect b r (getSelectedNode b)) $ Just "#00ff00" else return [] let b' = b{getSelectedNode=(getSelectedNode b){refWins=wssel}} if refLeaf (getFocusedNode b')==(-1) || isJust l || size b'<2 then return b' else do ws' <- createBorder (getNodeRect b' r (getFocusedNode b')) Nothing return b'{getFocusedNode=(getFocusedNode b'){refWins=ws'}} -- create a window for each border line, show, add into stack and set floating createBorder :: Rectangle -> Maybe String -> X [Window] createBorder (Rectangle wx wy ww wh) c = do bw <- asks (borderWidth.config) bc <- case c of Nothing -> asks (focusedBorderColor.config) Just s -> return s let rects = [ Rectangle wx wy ww (fi bw) , Rectangle wx wy (fi bw) wh , Rectangle wx (wy+fi wh-fi bw) ww (fi bw) , Rectangle (wx+fi ww-fi bw) wy (fi bw) wh ] ws <- mapM (\r -> createNewWindow r Nothing bc False) rects showWindows ws 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 where toRR (Rectangle x y w h) = W.RationalRect (fi x) (fi y) (fi w) (fi h) -- remove border line windows from stack + floating, kill removeBorder :: [Window] -> X () removeBorder ws = do modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws}) 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-contrib-0.18.0/XMonad/Layout/BorderResize.hs0000644000000000000000000002450207346545000020316 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.BorderResize -- Description : Resize windows by dragging their borders with the mouse. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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, -- but it is probably must useful in a floating layout such as -- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested. -- See the documentation of PositionStoreFloat for a typical usage example. -- ----------------------------------------------------------------------------- module XMonad.Layout.BorderResize ( -- * Usage -- $usage borderResize , borderResizeNear , BorderResize (..) , RectWithBorders, BorderInfo, ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils import XMonad.Prelude(when) import qualified Data.Map as M -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.BorderResize -- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...) -- > main = xmonad def { layoutHook = myLayout } -- type BorderBlueprint = (Rectangle, Glyph, BorderType) data BorderType = RightSideBorder | LeftSideBorder | TopSideBorder | BottomSideBorder deriving (Show, Read, Eq) data BorderInfo = BI { bWin :: Window, bRect :: Rectangle, bType :: BorderType } deriving (Show, Read) type RectWithBorders = (Rectangle, [BorderInfo]) data BorderResize a = BR { brBorderSize :: !Dimension -- ^ Still resize when this number of pixels around the border. , brWrsLastTime :: !(M.Map Window RectWithBorders) } deriving (Show, Read) borderResize :: l a -> ModifiedLayout BorderResize l a borderResize = borderResizeNear 2 -- | Like 'borderResize', but takes the number of pixels near the border -- up to which dragging still resizes a window. borderResizeNear :: Dimension -> l a -> ModifiedLayout BorderResize l a borderResizeNear borderSize = ModifiedLayout (BR borderSize M.empty) instance LayoutModifier BorderResize Window where redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout (BR borderSize wrsLastTime) _ _ wrs = do let correctOrder = map fst wrs wrsCurrent = M.fromList wrs wrsGone = M.difference wrsLastTime wrsCurrent wrsAppeared = M.difference wrsCurrent wrsLastTime wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent handleGone wrsGone wrsCreated <- handleAppeared borderSize wrsAppeared let wrsChanged = handleStillThere borderSize wrsStillThere wrsThisTime = M.union wrsChanged wrsCreated return (compileWrs wrsThisTime correctOrder, Just $ BR borderSize wrsThisTime) -- What we return is the original wrs with the new border -- windows inserted at the correct positions - this way, the core -- will restack the borders correctly. -- We also return information about our borders, so that we -- can handle events that they receive and destroy them when -- they are no longer needed. where testIfUnchanged entry@(rLastTime, _) rCurrent = if rLastTime == rCurrent then (Nothing, entry) else (Just rCurrent, entry) handleMess (BR borderSize wrsLastTime) m | Just e <- fromMessage m :: Maybe Event = handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing | Just _ <- fromMessage m :: Maybe LayoutMessages = handleGone wrsLastTime >> return (Just $ BR borderSize M.empty) handleMess _ _ = return Nothing compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder in concatMap compileWr wrs compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)] compileWr (w, (r, borderInfos)) = let borderWrs = for borderInfos $ \bi -> (bWin bi, bRect bi) in borderWrs ++ [(w, r)] handleGone :: M.Map Window RectWithBorders -> X () handleGone wrsGone = mapM_ deleteWindow borderWins where borderWins = map bWin . concatMap snd . M.elems $ wrsGone handleAppeared :: Dimension -> M.Map Window Rectangle -> X (M.Map Window RectWithBorders) handleAppeared borderSize wrsAppeared = do let wrs = M.toList wrsAppeared wrsCreated <- mapM (handleSingleAppeared borderSize) wrs return $ M.fromList wrsCreated handleSingleAppeared :: Dimension ->(Window, Rectangle) -> X (Window, RectWithBorders) handleSingleAppeared borderSize (w, r) = do let borderBlueprints = prepareBorders borderSize r borderInfos <- mapM createBorder borderBlueprints return (w, (r, borderInfos)) handleStillThere :: Dimension -> M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders handleStillThere borderSize = M.map (handleSingleStillThere borderSize) handleSingleStillThere :: Dimension -> (Maybe Rectangle, RectWithBorders) -> RectWithBorders handleSingleStillThere _ (Nothing, entry) = entry handleSingleStillThere borderSize (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) where changedBorderBlueprints = prepareBorders borderSize rCurrent updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints -- assuming that the four borders are always in the same order updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r } createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))] createBorderLookupTable wrsLastTime = 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 :: Dimension -> Rectangle -> [BorderBlueprint] prepareBorders borderSize (Rectangle x y wh ht) = [(Rectangle (x + fi wh - fi borderSize) y borderSize ht, xC_right_side , RightSideBorder), (Rectangle x y borderSize ht , xC_left_side , LeftSideBorder), (Rectangle x y wh borderSize , xC_top_side , TopSideBorder), (Rectangle x (y + fi ht - fi borderSize) wh borderSize, xC_bottom_side, BottomSideBorder) ] handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress, Just edge <- lookup ew borders = case edge of (RightSideBorder, hostWin, Rectangle hx hy _ hht) -> 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) -> mouseDrag (\x _ -> do 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) -> mouseDrag (\_ y -> do 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 _) -> mouseDrag (\_ y -> do let nht = max 1 $ fi (y - hy) rect = Rectangle hx hy hwh nht focus hostWin when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) handleResize _ _ = return () createBorder :: BorderBlueprint -> X BorderInfo createBorder (borderRect, borderCursor, borderType) = do borderWin <- createInputWindow borderCursor borderRect return BI { bWin = borderWin, bRect = borderRect, bType = borderType } createInputWindow :: Glyph -> Rectangle -> X Window createInputWindow cursorGlyph r = withDisplay $ \d -> do win <- mkInputWindow d r io $ selectInput d win (exposureMask .|. buttonPressMask) cursor <- io $ createFontCursor d cursorGlyph io $ defineCursor d win cursor io $ freeCursor d cursor showWindow win return win mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do rw <- asks theRoot let screen = defaultScreenOfDisplay d visual = defaultVisualOfScreen screen attrmask = cWOverrideRedirect io $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes for :: [a] -> (a -> b) -> [b] for = flip map reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order = 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 Just result -> [(e, result)] Nothing -> [] xmonad-contrib-0.18.0/XMonad/Layout/BoringWindows.hs0000644000000000000000000002067007346545000020514 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.BoringWindows -- Description : Mark windows as boring. -- Copyright : (c) 2008 David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- BoringWindows is an extension to allow windows to be marked boring -- ----------------------------------------------------------------------------- module XMonad.Layout.BoringWindows ( -- * Usage -- $usage boringWindows, boringAuto, markBoring, markBoringEverywhere, clearBoring, focusUp, focusDown, focusMaster, swapUp, swapDown, siftUp, siftDown, UpdateBoring(UpdateBoring), BoringMessage(Replace,Merge), BoringWindows() -- * Tips -- ** variant of 'Full' -- $simplest ) where import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) import XMonad(LayoutClass, Message, X, fromMessage, broadcastMessage, sendMessage, windows, withFocused, Window) import XMonad.Prelude import XMonad.Util.Stack (reverseS) import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.BoringWindows -- -- Then edit your @layoutHook@ by adding the layout modifier: -- -- > myLayout = boringWindows (Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- -- Then to your keybindings, add: -- -- > , ((modm, xK_j), focusUp) -- > , ((modm, xK_k), focusDown) -- > , ((modm, xK_m), focusMaster) -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring | Replace String [Window] | Merge String [Window] | 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 instance Message UpdateBoring 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) boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing) -- | Mark windows that are not given rectangles as boring boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just [])) instance LayoutModifier BoringWindows Window where redoLayout b@BoringWindows{ hiddenBoring = bs } _r mst arrs = do let bs' = W.integrate' mst \\ map fst arrs return (arrs, Just $ b { hiddenBoring = bs' <$ bs } ) handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m | Just (Replace k ws) <- fromMessage m , 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 } | Just (Merge k ws) <- fromMessage m , maybe True (not . null . (ws \\)) (M.lookup k nbs) = rjl bst { namedBoring = M.insertWith union k ws nbs } | Just (IsBoring w) <- fromMessage m , w `notElem` cbs = rjl bst { chosenBoring = w:cbs } | Just ClearBoring <- fromMessage m, not (null cbs) = rjl bst { namedBoring = M.empty, chosenBoring = []} | Just FocusUp <- fromMessage m = do windows $ W.modify' $ skipBoring W.focusUp' return Nothing | Just FocusDown <- fromMessage m = do windows $ W.modify' $ skipBoring W.focusDown' return Nothing | Just FocusMaster <- fromMessage m = do windows $ W.modify' $ skipBoring W.focusDown' -- wiggle focus to make sure . skipBoring W.focusUp' -- no boring window gets the focus . focusMaster' return Nothing | 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 -- | Variant of 'focusMaster' that works on a -- 'Stack' rather than an entire 'StackSet'. focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c focusMaster' (W.Stack t (l:ls) rs) = W.Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls) swapUp' :: W.Stack a -> W.Stack a swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs) swapUp' (W.Stack t [] rs) = W.Stack t (reverse rs) [] siftUpSkipping :: Eq a => [a] -> W.Stack a -> W.Stack a siftUpSkipping bs (W.Stack t ls rs) | (skips, l:ls') <- spanLeft = W.Stack t ls' (reverse skips ++ l : rs) | (skips, r:rs') <- spanRight = W.Stack t (rs' ++ r : ls) (reverse skips) | otherwise = W.Stack t ls rs where spanLeft = span (`elem` bs) ls spanRight = span (`elem` bs) (reverse rs) {- $simplest An alternative to 'Full' is "XMonad.Layout.Simplest". Less windows are ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows to be uninteresting by some other layout modifier (ex. "XMonad.Layout.Minimize") -} xmonad-contrib-0.18.0/XMonad/Layout/ButtonDecoration.hs0000644000000000000000000000403507346545000021201 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ButtonDecoration -- Description : Decoration that includes buttons, executing actions when clicked on. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- -- Note: For maximizing and minimizing to actually work, you will need -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your -- setup. See the documentation of those modules for more information. -- ----------------------------------------------------------------------------- module XMonad.Layout.ButtonDecoration ( -- * Usage: -- $usage buttonDeco, ButtonDecoration, ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationAddons -- > import XMonad.Layout.ButtonDecoration -- -- Then edit your @layoutHook@ by adding the ButtonDecoration to -- your layout: -- -- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- buttonDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a buttonDeco s c = decoration s c $ NFD True newtype ButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ButtonDecoration a where describeDeco _ = "ButtonDeco" decorationCatchClicksHook _ = titleBarButtonHandler decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () xmonad-contrib-0.18.0/XMonad/Layout/CenterMainFluid.hs0000644000000000000000000000771107346545000020733 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.CenterMainFluid -- Description : Three column layout with master in center and unoccupied spaces reserved. -- Copyright : (c) 2023 Mahdi Seyedan -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : Mahdi Seyedan. -- Stability : unstable -- Portability : unportable -- -- A three column layout with main column in the center and -- two stack columns surrounding it. There will be always -- a pane in the center column and unoccupied spaces on the -- sides are reserved. -- It's best suited for ultrawide montiors, where a single -- stretched window might be annoying. ----------------------------------------------------------------------------- module XMonad.Layout.CenterMainFluid ( -- * Usage -- $usage CenterMainFluid (..) ) where import XMonad import qualified XMonad.StackSet as W import Control.Monad (msum) -- $usage -- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.CenterMainFluid -- -- Then edit your @layoutHook@ by adding the CenterMainFluid layout: -- -- > myLayoutHook = CenterMainFluid 1 (3/100) (70/100) ||| ... -- > main = xmonad def { layoutHook = myLayout } -- -- The first argument specifies how many windows initially appear in the center -- column. The second argument specifies the amount to resize while resizing -- and the third argument specifies the initial size of the center column. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Arguments are nmaster, delta, fraction. Supports 'Shrink', 'Expand' and -- 'IncMasterN' data CenterMainFluid a = CenterMainFluid { cmfNMaster :: !Int -- ^ The default number of windows in the center pane (default: 1) , cmfRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100) , cmfRatio :: !Rational -- ^ Default proportion of screen occupied by the center pane (default: 70/100) } deriving (Show,Read) instance LayoutClass CenterMainFluid a where pureLayout (CenterMainFluid nmaster _ frac) r s | frac == 0 = drop nmaster layout | frac == 1 = take nmaster layout | otherwise = layout where layout = zip ws rs ws = W.integrate s rs = tile3 frac r nmaster (length ws) pureMessage (CenterMainFluid nmaster delta frac) m = msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = CenterMainFluid nmaster delta (max 0 $ frac-delta) resize Expand = CenterMainFluid nmaster delta (min 1 $ frac+delta) incmastern (IncMasterN d) = CenterMainFluid (max 0 (nmaster+d)) delta frac description _ = "CenterMainFluid" tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] tile3 f r nmaster n | nmaster <= 0 || n <= nmaster = splitVertically n middleR | otherwise = masters ++ rights ++ lefts where (leftR, middleR, rightR) = split3HorizontallyBy f r (halfN, remaining) = (n - nmaster) `divMod` 2 masters = splitVertically nmaster middleR lefts = splitVertically halfN leftR rights = splitVertically (halfN + remaining) rightR -- | Divide the screen into three rectangles, using a rational to specify the ratio of center one split3HorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle, Rectangle) split3HorizontallyBy f (Rectangle sx sy sw sh) = ( Rectangle sx sy sidew sh , Rectangle (sx + fromIntegral sidew) sy middlew sh , Rectangle (sx + fromIntegral sidew + fromIntegral middlew) sy sidew sh ) where middlew = floor $ fromIntegral sw * f sidew = (sw - fromIntegral middlew) `div` 2 xmonad-contrib-0.18.0/XMonad/Layout/CenteredIfSingle.hs0000644000000000000000000000643207346545000021073 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.CenteredIfSingle -- Description : If only a single window is shown, center it on screen -- Copyright : (c) 2021 Leon Kowarschick -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : Leon Kowarschick. -- Stability : unstable -- Portability : unportable -- -- A layout modifier that, if there is only a single window on screen, places -- that window in the center of the screen. -- This is especially useful on wide screen setups, where the window would otherwise -- be unnecessarily far away from the center of your field of vision. -- ----------------------------------------------------------------------------- module XMonad.Layout.CenteredIfSingle ( -- * Usage -- $usage centeredIfSingle, CenteredIfSingle ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Prelude (fi) -- $usage -- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Layout.CenteredIfSingle -- -- and adding the 'centeredIfSingle' layoutmodifier to your layouts. -- -- > myLayoutHook = centeredIfSingle 0.7 0.8 Grid ||| ... -- -- For more information on configuring your layouts see -- -- and "XMonad.Doc.Extending". -- | Layout Modifier that places a window in the center of the screen, -- leaving room on the left and right if there is only a single window. -- The first argument is the horizontal and the second one the vertical -- ratio of the screen the centered window should take up. Both numbers -- should be between 0.0 and 1.0. data CenteredIfSingle a = CenteredIfSingle !Double !Double deriving (Show, Read) instance LayoutModifier CenteredIfSingle Window where pureModifier (CenteredIfSingle ratioX ratioY) r _ [(onlyWindow, _)] = ([(onlyWindow, rectangleCenterPiece ratioX ratioY r)], Nothing) pureModifier _ _ _ winRects = (winRects, Nothing) -- | Layout Modifier that places a window in the center of the screen, -- leaving room on all sides if there is only a single window centeredIfSingle :: Double -- ^ Horizontal ratio of the screen the centered window should take up; should be a value between 0.0 and 1.0 -> Double -- ^ Vertical ratio; should also be a value between 0.0 and 1.0 -> l a -- ^ The layout that will be used if more than one window is open -> ModifiedLayout CenteredIfSingle l a centeredIfSingle ratioX ratioY = ModifiedLayout (CenteredIfSingle ratioX ratioY) -- | Calculate the center piece of a rectangle given the percentage of the outer rectangle it should occupy. rectangleCenterPiece :: Double -> Double -> Rectangle -> Rectangle rectangleCenterPiece ratioX ratioY (Rectangle rx ry rw rh) = Rectangle startX startY width height where startX = rx + left startY = ry + top width = newSize rw left height = newSize rh top left = rw `scaleBy` ratioX top = rh `scaleBy` ratioY newSize :: Dimension -> Position -> Dimension newSize dim pos = fi $ fi dim - pos * 2 scaleBy :: Dimension -> Double -> Position scaleBy dim ratio = floor $ fi dim * (1.0 - ratio) / 2 xmonad-contrib-0.18.0/XMonad/Layout/CenteredMaster.hs0000644000000000000000000001013007346545000020614 0ustar0000000000000000{-# 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) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.CenteredMaster ( -- * Usage -- $usage centerMaster, topRightMaster, CenteredMaster, TopRightMaster, ) where import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W import Control.Arrow (first) -- $usage -- This module defines two new layout modifiers: centerMaster and topRightMaster. -- centerMaster places master window at center of screen, on top of others. -- All other windows in background are managed by base layout. -- topRightMaster is like centerMaster, but places master window in top right corner instead of center. -- -- Yo can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.CenteredMaster -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = centerMaster Grid ||| ... -- | Function that decides where master window should be placed type Positioner = Rectangle -> Rectangle -- | Data type for LayoutModifier data CenteredMaster a = CenteredMaster deriving (Read,Show) instance LayoutModifier CenteredMaster Window where modifyLayout CenteredMaster = applyPosition (center (5/7) (5/7)) data TopRightMaster a = TopRightMaster deriving (Read,Show) instance LayoutModifier TopRightMaster Window where modifyLayout TopRightMaster = applyPosition (topRight (3/7) (1/2)) -- | Modifier that puts master window in center, other windows in background -- are managed by given layout centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a centerMaster = ModifiedLayout CenteredMaster -- | Modifier that puts master window in top right corner, other windows in background -- are managed by given layout topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a topRightMaster = ModifiedLayout TopRightMaster -- | Internal function, doing main job applyPosition :: (LayoutClass l a, Eq a) => Positioner -> W.Workspace WorkspaceId (l a) a -> Rectangle -> X ([(a, Rectangle)], Maybe (l a)) applyPosition pos wksp rect = do let stack = W.stack wksp let ws = W.integrate' stack case ws of [] -> runLayout wksp rect (firstW : other) -> do let filtStack = stack >>= W.filter (firstW /=) wrs <- runLayout (wksp {W.stack = filtStack}) rect return $ first ((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), -- place that window fullscreen. place :: Positioner -> [a] -> Rectangle -> Rectangle place _ [] rect = rect place pos _ rect = pos rect -- | Function that calculates Rectangle at top right corner of given Rectangle topRight :: Float -> Float -> Rectangle -> Rectangle topRight rx ry (Rectangle sx sy sw sh) = Rectangle x sy w h where w = round (fromIntegral sw * rx) h = round (fromIntegral sh * ry) x = sx + fromIntegral (sw-w) -- | Function that calculates Rectangle at center of given Rectangle. center :: Float -> Float -> Rectangle -> Rectangle center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h where w = round (fromIntegral sw * rx) h = round (fromIntegral sh * ry) x = sx + fromIntegral (sw-w) `div` 2 y = sy + fromIntegral (sh-h) `div` 2 xmonad-contrib-0.18.0/XMonad/Layout/Circle.hs0000644000000000000000000000255707346545000017126 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Circle -- Description : An elliptical, overlapping layout. -- Copyright : (c) Peter De Wachter -- License : BSD-style (see LICENSE) -- -- Maintainer : Peter De Wachter -- Stability : unstable -- Portability : unportable -- -- Circle is an elliptical, overlapping layout, by Peter De Wachter -- ----------------------------------------------------------------------------- module XMonad.Layout.Circle {-# DEPRECATED "Use XMonad.Layout.CircleEx instead" #-} ( -- * Usage -- $usage pattern Circle ) where -- actually it's an ellipse import GHC.Real (Ratio(..)) import XMonad.Layout.CircleEx -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Circle -- -- Then edit your @layoutHook@ by adding the Circle layout: -- -- > myLayout = Circle ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". pattern Circle :: CircleEx a pattern Circle = CircleEx 1 (70 :% 99) (2 :% 5) 1 0 xmonad-contrib-0.18.0/XMonad/Layout/CircleEx.hs0000644000000000000000000002013407346545000017412 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.CircleEx -- Description : An elliptical, overlapping layout—extended version. -- Copyright : (c) Peter De Wachter, Ilya V. Portnov -- License : BSD-style (see LICENSE) -- -- Maintainer : Ilya V. Portnov -- Stability : unstable -- Portability : unportable -- -- Circle is an elliptical, overlapping layout. Original code by Peter De Wachter, -- extended by Ilya Porntov. ----------------------------------------------------------------------------- module XMonad.Layout.CircleEx ( -- * Usage -- $usage CircleEx (..), circle, circleEx, CircleExMsg (..) ) where import Data.Ratio import XMonad import XMonad.StackSet (Stack) import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- -- The layout puts the first N windows (called master) into the center of -- screen. All others (called secondary, or stack) are organized in a circle -- (well, ellipse). When opening a new secondary window, its size will be -- slightly smaller than that of its predecessor (this is configurable). If -- the number of master windows is set to zero, all windows will be arranged -- in a circle. If there is more than one master window, they will be stacked -- in the center on top of each other. The size of each additional master -- window will again be slightly smaller than that of the former. -- -- Since a picture says more than a thousand words, you see one -- . -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.CircleEx -- -- Then edit your @layoutHook@ by adding the 'CircleEx' layout: -- -- > myCircle = circleEx {cDelta = -3*pi/4} -- > myLayout = myCircle ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- This layout understands standard messages: -- -- * 'IncMasterN': increase or decrease the number of master windows. -- * 'Shrink' and 'Expand': change the size of master windows. -- -- More layout-specific messages are also supported, see 'CircleExMsg' below. -- -- For more detailed instructions on editing the layoutHook see: -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | The layout data type. It is recommended to not use the 'CircleEx' data -- constructor directly, and instead rely on record update syntax; for -- example: @circleEx {cMasterRatio = 4%5}@. In this way you can avoid nasty -- surprises if one day additional fields are added to @CircleEx@. data CircleEx a = CircleEx { cNMaster :: !Int -- ^ Number of master windows. Default value is 1. , cMasterRatio :: !Rational -- ^ Size of master window in relation to screen size. -- Default value is @4%5@. , cStackRatio :: !Rational -- ^ Size of first secondary window in relation to screen size. -- Default value is @3%5@. , cMultiplier :: !Rational -- ^ Coefficient used to calculate the sizes of subsequent secondary -- windows. The size of the next window is calculated as the -- size of the previous one multiplied by this value. -- This value is also used to scale master windows, in case -- there is more than one. -- Default value is @5%6@. Set this to 1 if you want all secondary -- windows to have the same size. , cDelta :: !Double -- ^ Angle of rotation of the whole circle layout. Usual values -- are from 0 to 2π, although it will work outside -- this range as well. Default value of 0 means that the first -- secondary window will be placed at the right side of screen. } deriving (Eq, Show, Read) -- | Circle layout with default settings: -- -- * Number of master windows is set to 1 -- * @cMasterRatio@ is set to @70/99@, which is nearly @1/sqrt(2)@ -- * @cStackRatio@ is set to @2/5@ -- * @cMultiplier@ is set to 1, which means all secondary windows -- will have the same size -- -- This can be used as a drop-in replacement for "XMonad.Layout.Circle". circle :: CircleEx a circle = CircleEx 1 (70%99) (2%5) 1 0 -- | Another variant of default settings for circle layout: -- -- * Number of master windows is set to 1 -- * @cMasterRatio@ is set to @4/5@ -- * @cStackRatio@ is set to @3/5@ -- * @cMultiplier@ is set to @5/6@ -- circleEx :: CircleEx a circleEx = CircleEx 1 (4%5) (3%5) (5%6) 0 -- | Specific messages understood by CircleEx layout. data CircleExMsg = Rotate !Double -- ^ Rotate secondary windows by specific angle | IncStackRatio !Rational -- ^ Increase (or decrease, with negative value) sizes of secondary windows | IncMultiplier !Rational -- ^ Increase 'cMultiplier'. deriving (Eq, Show, Typeable) instance Message CircleExMsg instance LayoutClass CircleEx Window where doLayout :: CircleEx Window -> Rectangle -> Stack Window -> X ([(Window, Rectangle)], Maybe (CircleEx Window)) doLayout layout rect stack = do result <- raiseFocus $ circleLayout layout rect $ W.integrate stack return (result, Nothing) pureMessage :: CircleEx Window -> SomeMessage -> Maybe (CircleEx Window) pureMessage layout m = msum [changeMasterN <$> fromMessage m, resize <$> fromMessage m, specific <$> fromMessage m] where deltaSize = 11 % 10 resize :: Resize -> CircleEx a resize Shrink = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout / deltaSize} resize Expand = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout * deltaSize} changeMasterN :: IncMasterN -> CircleEx a changeMasterN (IncMasterN d) = layout {cNMaster = max 0 (cNMaster layout + d)} specific :: CircleExMsg -> CircleEx a specific (Rotate delta) = layout {cDelta = delta + cDelta layout} specific (IncStackRatio delta) = layout {cStackRatio = max 0.1 $ min 2.0 $ delta + cStackRatio layout} specific (IncMultiplier delta) = layout {cMultiplier = max 0.1 $ min 2.0 $ delta + cMultiplier layout} circleLayout :: CircleEx a -> Rectangle -> [a] -> [(a, Rectangle)] circleLayout _ _ [] = [] circleLayout (CircleEx {..}) rectangle wins = master (take cNMaster wins) ++ rest (drop cNMaster wins) where master :: [a] -> [(a, Rectangle)] master ws = zip ws $ map (placeCenter cMasterRatio cMultiplier rectangle) [cNMaster-1, cNMaster-2 .. 0] rest :: [a] -> [(a, Rectangle)] rest ws = zip ws $ zipWith (placeSatellite cStackRatio cMultiplier rectangle) (map (+ cDelta) [0, pi*2 / fromIntegral (length ws) ..]) [0 ..] raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] raiseFocus wrs = do focused <- withWindowSet (return . W.peek) return $ case find ((== focused) . Just . fst) wrs of Just x -> x : delete x wrs Nothing -> wrs placeCenter :: Rational -> Rational -> Rectangle -> Int -> Rectangle placeCenter ratio multiplier (Rectangle x y width height) n = Rectangle x' y' width' height' where m = ratio * multiplier ^ n width' = round (m * fromIntegral width) height' = round (m * fromIntegral height) x' = x + fromIntegral (width - width') `div` 2 y' = y + fromIntegral (height - height') `div` 2 placeSatellite :: Rational -> Rational -> Rectangle -> Double -> Int -> Rectangle placeSatellite ratio multiplier (Rectangle x y width height) alpha n = Rectangle x' y' width' height' where m = ratio * multiplier ^ n x' = x + round (rx + rx * cos alpha) y' = y + round (ry + ry * sin alpha) rx = fromIntegral (width - width') / 2 ry = fromIntegral (height - height') / 2 width' = round (fromIntegral width * m) height' = round (fromIntegral height * m) xmonad-contrib-0.18.0/XMonad/Layout/Column.hs0000644000000000000000000000517507346545000017161 0ustar0000000000000000{-# 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) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Provides Column layout that places all windows in one column. Windows -- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is -- given. With Shrink/Expand messages you can change the q value. -- ----------------------------------------------------------------------------- module XMonad.Layout.Column ( -- * Usage -- $usage Column (..) ) where import XMonad import qualified XMonad.StackSet as W -- $usage -- This module defines layot named Column. It places all windows in one -- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... = -- q, where `q' is given (thus, windows heights are members of geometric -- progression). With Shrink/Expand messages one can change the `q' value. -- -- You can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.Column -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = Column 1.6 ||| ... -- -- In this example, each next window will have height 1.6 times less then -- previous window. newtype Column a = Column Float deriving (Read,Show) instance LayoutClass Column a where pureLayout = columnLayout pureMessage = columnMessage columnMessage :: Column a -> SomeMessage -> Maybe (Column a) columnMessage (Column q) m = fmap resize (fromMessage m) where resize Shrink = Column (q-0.1) resize Expand = Column (q+0.1) columnLayout :: Column a -> Rectangle -> W.Stack a -> [(a,Rectangle)] columnLayout (Column q) rect stack = zip ws rects where ws = W.integrate stack n = length ws heights = map (xn n rect q) [1..n] ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]] 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 else round (fromIntegral h*q^(n-k)*(1-q)/(1-q^n)) xmonad-contrib-0.18.0/XMonad/Layout/Combo.hs0000644000000000000000000001647007346545000016763 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Combo -- Description : A layout that combines multiple layouts. -- Copyright : (c) David Roundy -- License : BSD-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- A layout that combines multiple layouts. -- ----------------------------------------------------------------------------- module XMonad.Layout.Combo ( -- * Usage -- $usage combineTwo, CombineTwo ) where import XMonad hiding (focus) import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..)) import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe) import XMonad.StackSet (Stack (..), Workspace (..), integrate') import XMonad.Util.Stack (zipperFocusedAtFirstOf) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Combo -- -- and add something like -- -- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) -- -- to your layouts. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- combineTwo is a new simple layout combinator. It allows the -- combination of two layouts using a third to split the screen -- between the two, but has the advantage of allowing you to -- dynamically adjust the layout, in terms of the number of windows in -- each sublayout. To do this, use "XMonad.Layout.WindowNavigation", -- and add the following key bindings (or something similar): -- -- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) -- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) -- -- For detailed instruction on editing the key binding see -- . -- -- These bindings will move a window into the sublayout that is -- up\/down\/left\/right of its current position. Note that there is some -- weirdness in combineTwo, in that the mod-tab focus order is not very closely -- related to the layout order. This is because we're forced to keep track of -- the window positions separately, and this is ugly. If you don't like this, -- lobby for hierarchical stacks in core xmonad or go reimplement the core of -- xmonad yourself. data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a) deriving (Read, Show) combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) => super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a combineTwo = C2 [] [] instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutClass (CombineTwo (l ()) l1 l2) a where runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s) where arrange [] = do l1' <- 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' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources) l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources) super' <- fromMaybe super <$> handleMessage super (SomeMessage ReleaseResources) return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') arrange origws = do let w2' = case origws `intersect` w2 of [] -> take 1 origws [x] -> [x] x -> case origws \\ x of [] -> init x _ -> x superstack = Stack { focus=(), up=[], down=[()] } s1 = zipperFocusedAtFirstOf f' (origws \\ w2') s2 = zipperFocusedAtFirstOf f' w2' f' = case s of (Just s') -> focus s':delete (focus s') f Nothing -> f ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 return (wrs1++wrs2, Just $ C2 f' w2' (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' <- 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' <- 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' | otherwise = do ml1' <- broadcastPrivate m [l1] ml2' <- broadcastPrivate m [l2] msuper' <- broadcastPrivate m [super] if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2 f ws2 (fromMaybe super (listToMaybe =<< msuper')) (fromMaybe l1 (listToMaybe =<< ml1')) (fromMaybe l2 (listToMaybe =<< ml2')) else return Nothing description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++ description l2 ++" with "++ description super 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 (`maybe` id) ol nml else return Nothing where f l = handleMessage l a `catchX` return Nothing xmonad-contrib-0.18.0/XMonad/Layout/ComboP.hs0000644000000000000000000002172707346545000017104 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ComboP -- Description : Combine multiple layouts and specify where to put new windows. -- Copyright : (c) Konstantin Sobolev -- License : BSD-style (see LICENSE) -- -- Maintainer : Konstantin Sobolev -- Stability : unstable -- Portability : unportable -- -- A layout that combines multiple layouts and allows to specify where to put -- new windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.ComboP ( -- * Usage -- $usage combineTwoP, CombineTwoP, SwapWindow(..), PartitionWins(..), Property(..) ) where import XMonad hiding (focus) import XMonad.Layout.WindowNavigation import XMonad.Prelude import XMonad.StackSet ( Workspace (..), Stack(..) ) import qualified XMonad.StackSet as W import XMonad.Util.Stack (zipperFocusedAtFirstOf) import XMonad.Util.WindowProperties -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ComboP -- -- and add something like -- -- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) (ClassName "Firefox") -- -- to your layouts. This way all windows with class = \"Firefox\" will always go -- to the left pane, all others - to the right. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with -- addition of a 'Property' which tells where to put new windows. Windows mathing -- the property will go into the first part, all others will go into the second -- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces -- 'SwapWindow' message which sends focused window to the other part. It is -- required because @Move@ commands don't work when one of the parts is empty. -- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key -- bindings (or something similar): -- -- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) -- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) -- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage $ SwapWindow) -- -- For detailed instruction on editing the key binding see -- . 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) instance Message SwapWindow data PartitionWins = PartitionWins -- ^ Reset the layout and -- partition all windows into the -- correct sub-layout. Useful for -- when window properties have -- changed and you want ComboP to -- update which layout a window -- belongs to. deriving (Read, Show) instance Message PartitionWins data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property deriving (Read, Show) combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) => super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window combineTwoP = C2P [] [] [] instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (CombineTwoP (l ()) l1 l2) Window where doLayout (C2P f w1 w2 super l1 l2 prop) rinput s = let origws = W.integrate s -- passed in windows w1c = origws `intersect` w1 -- current windows in the first pane w2c = origws `intersect` w2 -- current windows in the second pane new = origws \\ (w1c ++ w2c) -- new windows superstack = Just Stack { focus=(), up=[], down=[()] } f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most in do matching <- hasProperty prop `filterM` new -- new windows matching predecate let w1' = w1c ++ matching -- updated first pane windows w2' = w2c ++ (new \\ matching) -- updated second pane windows s1 = zipperFocusedAtFirstOf f' w1' -- first pane stack s2 = zipperFocusedAtFirstOf f' w2' -- second pane stack ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 return (wrs1++wrs2, Just $ C2P f' w1' w2' (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 | Just SwapWindow <- fromMessage m = swap us | Just (SwapWindowN 0) <- fromMessage m = swap us | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1 | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `elem` ws1, w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `elem` ws2, w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop | otherwise = do ml1' <- handleMessage l1 m ml2' <- handleMessage l2 m msuper' <- handleMessage super m if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2P f ws1 ws2 (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 -- send focused window to the other pane. Does nothing if we don't -- own the focused window swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) => CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window)) swap (C2P f ws1 ws2 super l1 l2 prop) = do mst <- gets (W.stack . W.workspace . W.current . windowset) let (ws1', ws2') = case mst of Nothing -> (ws1, ws2) Just st -> if foc `elem` ws1 then (foc `delete` ws1, foc:ws2) else if foc `elem` ws2 then (foc:ws1, foc `delete` ws2) else (ws1, ws2) where foc = W.focus st if (ws1,ws2) == (ws1',ws2') then return Nothing else return $ Just $ C2P f ws1' ws2' super l1 l2 prop -- forwards the message to the sublayout which contains the focused window forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) => CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window)) forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do ml1 <- forwardIfFocused l1 ws1 m ml2 <- forwardIfFocused l2 ws2 m ms <- if isJust ml1 || isJust ml2 then return Nothing else handleMessage super m if isJust ml1 || isJust ml2 || isJust ms 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 forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window)) 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 then handleMessage l m else return Nothing -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: xmonad-contrib-0.18.0/XMonad/Layout/Cross.hs0000644000000000000000000001132707346545000017011 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} -- | -- Module : XMonad.Layout.Cross -- Description : A Cross Layout with the main window in the center. -- Copyright : (c) Luis Cabellos -- License : BSD3-style (see LICENSE) -- -- Maintainer : Luis Cabellos -- Stability : stable -- Portability : portable -- -- A Cross Layout with the main window in the center. -- module XMonad.Layout.Cross {-# DEPRECATED "Use XMonad.Layout.Circle or XMonad.Layout.ThreeColumn.ThreeColMid instead" #-} ( -- * Usage -- $usage simpleCross , Cross(..) ) where import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage ) import XMonad.StackSet( focus, up, down ) import XMonad.Prelude( msum ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Cross -- -- Then edit your @layoutHook@ by adding one of the Cross layouts: -- -- > myLayout = simpleCross ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- apply a factor to a Rectangle Dimension (<%>) :: Dimension -> Rational -> Dimension 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' -- messages increment the size of the main window. -- -- The focus keybindings change the center window, while other windows -- cycle through the side positions. With the Cross layout only four -- windows are shown around the focused window, two ups and two downs, -- no matter how many are in the current stack. I.e. focus down cycles the -- window below focused into the center; focus up cycles the window above. data Cross a = Cross { crossProp :: !Rational, -- ^ Proportion of screen occupied by the main window. crossInc :: !Rational -- ^ Percent of main window to increment by when resizing. } deriving( Show, Read ) -- | A simple Cross Layout. It places the focused window in the center. -- The proportion of the screen used by the main window is 4\/5. simpleCross :: Cross a 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) pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)] where resize Shrink = Cross (max (1/100) $ f - d) d resize Expand = Cross (min 1 $ f + d) d description _ = "Cross" -- 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)) (rw <%> f) (rh <%> f) where invf = (1/2) * (1-f) -- get the rectangles for the up windows upRects :: Rectangle -> Rational -> [Rectangle] upRects r f = [topRectangle r nf, rightRectangle r nf] where nf = f * (8/10) -- get the rectangles for the down windows downRects :: Rectangle -> Rational -> [Rectangle] downRects r f = [bottomRectangle r nf, leftRectangle r nf] where nf = f * (8/10) topRectangle :: Rectangle -> Rational -> Rectangle topRectangle (Rectangle rx ry rw rh) f = Rectangle (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)))) (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))))) (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)))) (rw <%> (1/2)) (rh <%> f) xmonad-contrib-0.18.0/XMonad/Layout/Decoration.hs0000644000000000000000000005473207346545000020016 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Decoration -- Description : A layout modifier and a class for easily creating decorated layouts. -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier and a class for easily creating decorated -- layouts. ----------------------------------------------------------------------------- module XMonad.Layout.Decoration ( -- * Usage: -- $usage decoration , Theme (..), def , Decoration , DecorationMsg (..) , DecorationStyle (..) , DefaultDecoration (..) , Shrinker (..), DefaultShrinker , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile , isInStack, isVisible, isInvisible, isWithin, fi , findWindowByDecoration , module XMonad.Layout.LayoutModifier , DecorationState, OrigWin ) where import Foreign.C.Types(CInt) import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.UrgencyHook import XMonad.Layout.LayoutModifier import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList) import XMonad.Util.NamedWindows (getName) import XMonad.Util.Invisible import XMonad.Util.XUtils import XMonad.Util.Font import XMonad.Util.Image -- $usage -- This module is intended for layout developers, who want to decorate -- their layouts. End users will not find here very much for them. -- -- For examples of 'DecorationStyle' instances you can have a look at -- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed", -- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration". -- | A layout modifier that, with a 'Shrinker', a 'Theme', a -- 'DecorationStyle', and a layout, will decorate this layout -- according to the decoration style provided. -- -- For some usage examples see "XMonad.Layout.DecorationMadness". decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds) -- | A 'Theme' is a record of colors, font etc., to customize a -- 'DecorationStyle'. -- -- For a collection of 'Theme's see "XMonad.Util.Themes" data Theme = Theme { activeColor :: String -- ^ Color of the active window , inactiveColor :: String -- ^ Color of the inactive window , urgentColor :: String -- ^ Color of the urgent window , activeBorderColor :: String -- ^ Color of the border of the active window , inactiveBorderColor :: String -- ^ Color of the border of the inactive window , urgentBorderColor :: String -- ^ Color of the border of the urgent window , activeBorderWidth :: Dimension -- ^ Width of the border of the active window , inactiveBorderWidth :: Dimension -- ^ Width of the border of the inactive window , urgentBorderWidth :: Dimension -- ^ Width of the border of the urgent window , activeTextColor :: String -- ^ Color of the text of the active window , inactiveTextColor :: String -- ^ Color of the text of the inactive window , urgentTextColor :: String -- ^ Color of the text of the urgent window , fontName :: String -- ^ Font name , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') , decoHeight :: Dimension -- ^ Height of the decorations , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar. -- Refer to for a use "XMonad.Layout.ImageButtonDecoration" , windowTitleIcons :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar. -- Inner @[Bool]@ is a row in a icon bitmap. } deriving (Show, Read) -- | The default xmonad 'Theme'. instance Default Theme where def = Theme { activeColor = "#999999" , inactiveColor = "#666666" , urgentColor = "#FFFF00" , activeBorderColor = "#FFFFFF" , inactiveBorderColor = "#BBBBBB" , urgentBorderColor = "##00FF00" , activeBorderWidth = 1 , inactiveBorderWidth = 1 , urgentBorderWidth = 1 , activeTextColor = "#FFFFFF" , inactiveTextColor = "#BFBFBF" , urgentTextColor = "#FF0000" #ifdef XFT , fontName = "xft:monospace" #else , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" #endif , decoWidth = 200 , decoHeight = 20 , windowTitleAddons = [] , windowTitleIcons = [] } -- | A 'Decoration' layout modifier will handle 'SetTheme', a message -- to dynamically change the decoration 'Theme'. newtype DecorationMsg = SetTheme Theme instance Message DecorationMsg -- | The 'Decoration' state component, where the list of decorated -- window's is zipped with a list of decoration. A list of decoration -- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'. -- The 'Window' will be displayed only if the rectangle is of type -- 'Just'. data DecorationState = DS { decos :: [(OrigWin,DecoWin)] , font :: XMonadFont } type DecoWin = (Maybe Window, Maybe Rectangle) type OrigWin = (Window,Rectangle) -- | The 'Decoration' 'LayoutModifier'. This data type is an instance -- of the 'LayoutModifier' class. This data type will be passed, -- together with a layout, to the 'ModifiedLayout' type constructor -- to modify the layout by adding decorations according to a -- 'DecorationStyle'. data Decoration ds s a = Decoration (Invisible Maybe DecorationState) s Theme (ds a) deriving (Show, Read) -- | The 'DecorationStyle' class, defines methods used in the -- implementation of the 'Decoration' 'LayoutModifier' instance. A -- type instance of this class is passed to the 'Decoration' type in -- order to decorate a layout, by using these methods. class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where -- | The description that the 'Decoration' modifier will display. describeDeco :: ds a -> String describeDeco = show -- | Shrink the window's rectangle when applying a decoration. shrink :: ds a -> Rectangle -> Rectangle -> Rectangle shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) -- | The decoration event hook decorationEventHook :: ds a -> DecorationState -> Event -> X () decorationEventHook = handleMouseFocusDrag -- | A hook that can be used to catch the cases when the user -- clicks on the decoration. If you return True here, the click event -- will be considered as dealt with and no further processing will take place. decorationCatchClicksHook :: ds a -> Window -> Int -- ^ distance from the left where the click happened on the decoration -> Int -- ^ distance from the right where the click happened on the decoration -> X Bool decorationCatchClicksHook _ _ _ _ = return False -- | This hook is called while a window is dragged using the decoration. -- The hook can be overwritten if a different way of handling the dragging -- is required. decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () decorationWhileDraggingHook _ = handleDraggingInProgress -- | This hoook is called after a window has been dragged using the decoration. decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw -- | The pure version of the main method, 'decorate'. pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht') then Just $ Rectangle x y wh ht else Nothing -- | Given the theme's decoration width and height, the screen -- rectangle, the windows stack, the list of windows and -- rectangles returned by the underlying layout and window to be -- decorated, tupled with its rectangle, produce a 'Just' -- 'Rectangle' or 'Nothing' if the window is not to be decorated. decorate :: ds a -> Dimension -> Dimension -> Rectangle -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle) decorate ds w h r s wrs wr = return $ pureDecoration ds w h r s wrs wr -- | The default 'DecorationStyle', with just the default methods' -- implementations. data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) instance Eq a => DecorationStyle DefaultDecoration a -- | The long 'LayoutModifier' instance for the 'Decoration' type. -- -- In 'redoLayout' we check the state: if there is no state we -- initialize it. -- -- The state is 'diff'ed against the list of windows produced by the -- underlying layout: removed windows get deleted and new ones -- decorated by 'createDecos', which will call 'decorate' to decide if -- a window must be given a 'Rectangle', in which case a decoration -- window will be created. -- -- After that we resync the updated state with the windows' list and -- then we process the resynced stated (as we do with a new state). -- -- First we map the decoration windows, we update each decoration to -- reflect any decorated window's change, and we insert, in the list -- of windows and rectangles returned by the underlying layout, the -- decoration for each window. This way xmonad will restack the -- decorations and their windows accordingly. At the end we remove -- invisible\/stacked windows. -- -- Message handling is quite simple: when needed we release the state -- component of the 'Decoration' 'LayoutModifier'. Otherwise we call -- 'handleEvent', which will call the appropriate 'DecorationStyle' -- methods to perform its tasks. instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do releaseResources s return ([], Just $ Decoration (I Nothing) sh t ds) redoLayout _ _ Nothing _ = return ([], Nothing) redoLayout (Decoration st sh t ds) sc (Just stack) wrs | I Nothing <- st = initState t ds sc stack wrs >>= processState | I (Just s) <- st = do let dwrs = decos s (d,a) = curry diff (get_ws dwrs) ws toDel = todel d dwrs toAdd = toadd a wrs deleteDecos (map snd toDel) let ndwrs = map (, (Nothing,Nothing)) toAdd ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs processState (s {decos = ndecos }) where ws = map fst wrs get_w = fst . fst get_ws = map get_w del_dwrs = listFromList get_w notElem find_dw i = fst . snd . flip (!!) i todel d = filter (flip elem d . get_w) toadd a = filter (flip elem a . fst ) check_dwr dwr = case dwr of (Nothing, Just dr) -> do dw <- createDecoWindow t dr return (Just dw, Just dr) _ -> return dwr resync _ [] = return [] resync d ((w,r):xs) = case w `elemIndex` get_ws d of Just i -> do dr <- decorate ds (decoWidth t) (decoHeight t) sc stack wrs (w,r) dwr <- check_dwr (find_dw i d, dr) dwrs <- resync d xs return $ ((w,r),dwr) : dwrs Nothing -> resync d xs -- We drop any windows that are *precisely* stacked underneath -- another window: these must be intended to be tabbed! remove_stacked rs ((w,r):xs) | r `elem` rs = remove_stacked rs xs | otherwise = (w,r) : remove_stacked (r:rs) xs remove_stacked _ [] = [] insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs insert_dwr (x ,( _ , _ )) xs = x:xs dwrs_to_wrs = remove_stacked [] . foldr insert_dwr [] processState s = do let ndwrs = decos s showDecos (map snd ndwrs) 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 | Just e <- fromMessage m = do decorationEventHook ds s e handleEvent sh t s e return Nothing | Just Hide <- fromMessage m = do hideDecos (map snd dwrs) return Nothing | Just (SetTheme nt) <- fromMessage m = do releaseResources s return $ Just $ Decoration (I Nothing) sh nt ds | Just ReleaseResources <- fromMessage m = do releaseResources s return $ Just $ Decoration (I Nothing) sh t ds handleMess _ _ = return Nothing modifierDescription (Decoration _ _ _ ds) = describeDeco ds -- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent' -- only. 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) | ExposeEvent {ev_window = w} <- e , 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 -- way we can start dragging unfocused windows too. handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X () handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew , ev_event_type = et , ev_x_root = ex , ev_y_root = ey } | et == buttonPress , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do let Rectangle dx _ dwh _ = fromJust decoRectM distFromLeft = ex - fi dx distFromRight = fi dwh - (ex - fi dx) dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) unless dealtWith $ mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return () handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () handleDraggingInProgress ex ey (_, r) x y = do let rect = Rectangle (x - (fi ex - rect_x r)) (y - (fi ey - rect_y r)) (rect_width r) (rect_height r) sendMessage $ SetGeometry rect -- | Given a window and the state, if a matching decoration is in the -- state return it with its ('Maybe') 'Rectangle'. lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle)) lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) | otherwise = lookFor w dwrs lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs lookFor _ [] = Nothing findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle)) findWindowByDecoration w ds = lookFor w (decos ds) -- | Initialize the 'DecorationState' by initializing the font -- structure and by creating the needed decorations. initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState initState t ds sc s wrs = do fs <- initXMF (fontName t) dwrs <- createDecos t ds sc s wrs wrs return $ DS dwrs fs -- | Delete windows stored in the state and release the font structure. releaseResources :: DecorationState -> X () releaseResources s = do deleteDecos (map snd $ decos s) releaseXMF (font s) -- | Create the decoration windows of a list of windows and their -- rectangles, by calling the 'decorate' method of the -- 'DecorationStyle' received. createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] createDecos t ds sc s wrs ((w,r):xs) = do deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r) case deco of Just dr -> do dw <- createDecoWindow t dr dwrs <- createDecos t ds sc s wrs xs return $ ((w,r), (Just dw, Just dr)) : dwrs Nothing -> do dwrs <- createDecos t ds sc s wrs xs return $ ((w,r), (Nothing, Nothing)) : dwrs createDecos _ _ _ _ _ [] = return [] createDecoWindow :: Theme -> Rectangle -> X Window 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 . mapMaybe fst . filter (isJust . snd) hideDecos :: [DecoWin] -> X () hideDecos = hideWindows . mapMaybe fst deleteDecos :: [DecoWin] -> X () deleteDecos = deleteWindows . mapMaybe fst updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X () updateDecos s t f = mapM_ $ updateDeco s t f -- | Update a decoration window given a shrinker, a theme, the font -- structure and the needed 'Rectangle's updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X () updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do -- xmonad-contrib #809 -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@ -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is -- quadratic due to using 'init' nw <- fmap (take 2048 . takeWhile (/= '\n') . show) (getName w) ur <- readUrgents dpy <- asks display let focusColor win ic ac uc = maybe ic (\focusw -> case () of _ | focusw == win -> ac | win `elem` ur -> uc | otherwise -> ic) . W.peek <$> gets windowset (bc,borderc,borderw,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t) (activeColor t, activeBorderColor t, activeBorderWidth t, activeTextColor t) (urgentColor t, urgentBorderColor t, urgentBorderWidth t, urgentTextColor t) let s = shrinkIt sh name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) nw let als = AlignCenter : map snd (windowTitleAddons t) strs = name : map fst (windowTitleAddons t) i_als = map snd (windowTitleIcons t) icons = map fst (windowTitleIcons t) paintTextAndIcons dw fs wh ht borderw bc borderc tc bc als strs i_als icons updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w updateDeco _ _ _ _ = return () -- | True if the window is in the 'Stack'. The 'Window' comes second -- to facilitate list processing, even though @w \`isInStack\` s@ won't -- work...;) isInStack :: Eq a => W.Stack a -> a -> Bool isInStack s = flip elem (W.integrate s) -- | Given a 'Rectangle' and a list of 'Rectangle's is True if the -- 'Rectangle' is not completely contained by any 'Rectangle' of the -- list. isVisible :: Rectangle -> [Rectangle] -> Bool isVisible r = and . foldr f [] where f x xs = if r `isWithin` x then False : xs else True : xs -- | The contrary of 'isVisible'. isInvisible :: Rectangle -> [Rectangle] -> Bool isInvisible r = not . isVisible r -- | True is the first 'Rectangle' is totally within the second -- 'Rectangle'. isWithin :: Rectangle -> Rectangle -> Bool isWithin (Rectangle x y w h) (Rectangle rx ry rw rh) | x >= rx, x <= rx + fi rw , y >= ry, y <= ry + fi rh , x + fi w <= rx + fi rw , y + fi h <= ry + fi rh = True | otherwise = False shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String shrinkWhile sh p x = sw $ sh x where sw [n] = return n sw [] = return "" sw (n:ns) = do cond <- p n if cond then sw ns else return n data CustomShrink = CustomShrink instance Show CustomShrink where show _ = "" instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] class (Read s, Show s) => Shrinker s where shrinkIt :: s -> String -> [String] data DefaultShrinker = DefaultShrinker instance Show DefaultShrinker where show _ = "" instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] instance Shrinker DefaultShrinker where shrinkIt _ "" = [""] shrinkIt s cs = cs : shrinkIt s (init cs) shrinkText :: DefaultShrinker shrinkText = DefaultShrinker xmonad-contrib-0.18.0/XMonad/Layout/DecorationAddons.hs0000644000000000000000000001324107346545000021135 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationAddons -- Description : Various stuff that can be added to the decoration. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.DecorationAddons ( titleBarButtonHandler ,defaultThemeWithButtons ,handleScreenCrossing ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.Decoration import XMonad.Actions.WindowMenu import XMonad.Actions.Minimize import XMonad.Layout.Maximize import XMonad.Hooks.ManageDocks import XMonad.Util.Font import XMonad.Util.PositionStore import XMonad.Prelude import qualified Data.Set as S minimizeButtonOffset :: Int minimizeButtonOffset = 48 maximizeButtonOffset :: Int maximizeButtonOffset = 25 closeButtonOffset :: Int closeButtonOffset = 10 buttonSize :: Int buttonSize = 10 -- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. -- It will intercept clicks on the buttons of the decoration and invoke the associated action. -- To actually see the buttons, you will need to use a theme that includes them. -- See 'defaultThemeWithButtons' below. titleBarButtonHandler :: Window -> Int -> Int -> X Bool titleBarButtonHandler mainw distFromLeft distFromRight = do 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. defaultThemeWithButtons :: Theme defaultThemeWithButtons = def { windowTitleAddons = [ (" (M)", AlignLeft) , ("_" , AlignRightOffset minimizeButtonOffset) , ("[]" , AlignRightOffset maximizeButtonOffset) , ("X" , AlignRightOffset closeButtonOffset) ] } -- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration. -- It will check if the window has been dragged onto another screen and shift it there. -- The PositionStore is also updated accordingly, as this is designed to be used together -- with "XMonad.Layout.PositionStoreFloat". handleScreenCrossing :: Window -> Window -> X Bool handleScreenCrossing w decoWin = withDisplay $ \d -> do root <- asks theRoot (_, _, _, px, py, _, _, _) <- io $ queryPointer d root ws <- gets windowset sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py) maybeWksp <- screenWorkspace $ W.screen sc let targetWksp = maybeWksp >>= \wksp -> W.findTag w ws >>= \currentWksp -> if currentWksp /= wksp then Just wksp else Nothing case targetWksp of Just wksp -> do -- find out window under cursor on target workspace -- apparently we have to switch to the workspace first -- to make this work, which unforunately introduces some flicker windows $ \ws' -> W.view wksp ws' (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root -- adjust PositionStore let oldScreenRect = screenRect . W.screenDetail $ W.current ws newScreenRect = screenRect . W.screenDetail $ sc {-- somewhat ugly hack to get proper ScreenRect, creates unwanted inter-dependencies TODO: get ScreenRects in a proper way --} oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) wa <- io $ getWindowAttributes d decoWin modifyPosStore (\ps -> posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) oldScreenRect' newScreenRect') -- set focus correctly so the window will be inserted -- at the correct position on the target workspace -- and then shift the window windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws' -- return True to signal that screen crossing has taken place return True Nothing -> return False xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx.hs0000644000000000000000000001057507346545000020310 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx -- Description : Advanced window decorations module for XMonad -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This set of modules contains a set of type classes and their implementations -- which define a flexible and extensible mechanism of window decorations. -- -- <> -- Click -- for a larger version. -- -- Within this mechanism, there are the following entities which define -- how decorations will look and work: -- -- * Main object is @DecorationEx@ layout modifier. It is from where everything -- starts. It creates, shows and hides decoration windows (rectangles) when -- needed. It is parameterized with decoration geometry, decoration engine and -- theme. It calls these components to do their parts of the work. -- * @DecorationGeometry@ defines where decoration rectangles should be placed. -- For example, standard horizontal bar above each window; or tab bar. -- * @DecorationEngine@ defines how decorations look and how they react on clicks. -- Different implementations of the decoration engine can use different APIs -- to draw decorations. Within this package, there is one implementation -- (@TextDecoration@), which uses plain Xlib calls, and displays decoration -- widgets with text fragments, like @[X]@ or @[_]@. Other engines can, for -- example, use the Cairo library to draw nice gradients and image-based widgets. -- * A Decoration widget is an element placed on a window decoration. It defines how -- it looks and how it responds to clicks. Examples include usual window -- buttons (minimize, maximize, close), window icon, window title. -- * A Decoration theme defines colors and fonts for the decoration engine. It also -- contains a list of decoration widgets and says where to place them (at the -- left, at the right or in the center). -- -- This mechanism makes major use of parameterized data types and type families, -- in order to make it possible to define different types of decorations, and -- easily combine different aspects of decorations. For example, each decoration -- engine can be combined with each decoration geometry. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx ( -- * Usage: -- $usage -- * Standard decoration settings decorationEx, textDecoration, textTabbed, dwmStyleDeco, -- * Decoration-related types TextDecoration (..), DefaultGeometry (..), TabbedGeometry (..), DwmGeometry (..), DecorationEx, -- * Theme types BoxBorders (..), BorderColors, SimpleStyle (..), GenericTheme (..), ThemeEx, -- * Widget types StandardCommand (..), GenericWidget (..), StandardWidget, -- * Utility functions for themes themeEx, borderColor, shadowBorder, -- * Convinience re-exports Shrinker (..), shrinkText, -- * Standard widgets titleW, toggleStickyW, minimizeW, maximizeW, closeW, dwmpromoteW, moveToNextGroupW, moveToPrevGroupW ) where import XMonad.Layout.Decoration import XMonad.Layout.DecorationEx.Common import XMonad.Layout.DecorationEx.Widgets import XMonad.Layout.DecorationEx.Geometry import XMonad.Layout.DecorationEx.LayoutModifier import XMonad.Layout.DecorationEx.TextEngine import XMonad.Layout.DecorationEx.TabbedGeometry import XMonad.Layout.DecorationEx.DwmGeometry -- $usage -- -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationEx -- Then edit your @layoutHook@ by adding the DwmStyle decoration to -- your layout: -- -- > myTheme = ThemeEx {...} -- > myL = textDecoration shrinkText myTheme (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- This module exports only some definitions from it's submodules, -- most likely to be used from user configurations. To define -- your own decoration types you will likely have to import specific -- submodules. xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/0000755000000000000000000000000007346545000017744 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/Common.hs0000644000000000000000000002646107346545000021541 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.Common -- Description : Declaration of types used by DecorationEx module, -- and commonly used utility functions. -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This module exposes a number of types which are used by other sub-modules -- of "XMonad.Layout.DecorationEx" module. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.Common ( -- * Common types WindowDecoration (..) , WindowCommand (..) , DecorationWidget (..) , WidgetPlace (..) , WidgetLayout (..) , HasWidgets (..) , ClickHandler (..) , ThemeAttributes (..) , XPaintingContext , BoxBorders (..) , BorderColors , ThemeStyleType (..) , SimpleStyle (..) , GenericTheme (..) , ThemeEx -- * Utilities , widgetLayout , windowStyleType , genericWindowStyle , themeEx , borderColor , shadowBorder ) where import qualified Data.Map as M import Data.Bits (testBit) import XMonad import qualified XMonad.StackSet as W import XMonad.Hooks.UrgencyHook import qualified XMonad.Layout.Decoration as D -- | Information about decoration of one window data WindowDecoration = WindowDecoration { wdOrigWindow :: !Window -- ^ Original window (one being decorated) , wdOrigWinRect :: !Rectangle -- ^ Rectangle of original window , wdDecoWindow :: !(Maybe Window) -- ^ Decoration window, or Nothing if this window should not be decorated , wdDecoRect :: !(Maybe Rectangle) -- ^ Rectangle for decoration window , wdWidgets :: ![WidgetPlace] -- ^ Places for widgets } -- | Type class for window commands (such as maximize or close window) class (Read cmd, Show cmd) => WindowCommand cmd where -- | Execute the command executeWindowCommand :: cmd -> Window -> X Bool -- | Is the command currently in `checked' state. -- For example, for 'sticky' command, check if the -- window is currently sticky. isCommandChecked :: cmd -> Window -> X Bool -- | Type class for decoration widgets class (WindowCommand (WidgetCommand widget), Read widget, Show widget) => DecorationWidget widget where -- | Type of window commands which this type of widgets can execute type WidgetCommand widget -- | Get window command which is associated with this widget. widgetCommand :: widget -> Int -> WidgetCommand widget -- | Check if the widget is shrinkable, i.e. if it's width -- can be reduced if there is not enough place in the decoration. isShrinkable :: widget -> Bool -- | Layout of widgets data WidgetLayout a = WidgetLayout { wlLeft :: ![a] -- ^ Widgets that should be aligned to the left side of decoration , wlCenter :: ![a] -- ^ Widgets that should be in the center of decoration , wlRight :: ![a] -- ^ Widgets taht should be aligned to the right side of decoration } -- | Data type describing where the decoration widget (e.g. window button) -- should be placed. -- All coordinates are relative to decoration rectangle. data WidgetPlace = WidgetPlace { wpTextYPosition :: !Position -- ^ Y position of text base line -- (for widgets like window title or text-based buttons) , wpRectangle :: !Rectangle -- ^ Rectangle where to place the widget } deriving (Show) -- | Generic data type which is used to -- describe characteristics of rectangle borders. data BoxBorders a = BoxBorders { bxTop :: !a , bxRight :: !a , bxBottom :: !a , bxLeft :: !a } deriving (Eq, Read, Show) -- | Convinience data type describing colors of decoration rectangle borders. type BorderColors = BoxBorders String -- | Data type describing look of window decoration -- in particular state (active or inactive) data SimpleStyle = SimpleStyle { sBgColor :: !String -- ^ Decoration background color , sTextColor :: !String -- ^ Text (foreground) color , sTextBgColor :: !String -- ^ Text background color , sDecoBorderWidth :: !Dimension -- ^ Width of border of decoration rectangle. Set to 0 to disable the border. , sDecorationBorders :: !BorderColors -- ^ Colors of borders of decoration rectangle. } deriving (Show, Read) -- | Type class for themes, which claims that -- the theme contains the list of widgets and their alignments. class HasWidgets theme widget where themeWidgets :: theme widget -> WidgetLayout widget -- | Type class for themes, which claims that -- the theme can describe how the decoration should respond -- to clicks on decoration itself (between widgets). class ClickHandler theme widget where -- | This is called when the user clicks on the decoration rectangle -- (not on one of widgets). onDecorationClick :: theme widget -> Int -- ^ Mouse button number -> Maybe (WidgetCommand widget) -- | Determine if it is possible to drag window by it's decoration -- with mouse button. isDraggingEnabled :: theme widget -> Int -- ^ Mouse button number -> Bool -- | Type class for themes, which claims that the theme -- is responsible for determining looks of decoration. class (Read theme, Show theme) => ThemeAttributes theme where -- | Type which describes looks of decoration in one -- of window states (active, inactive, urgent, etc). type Style theme -- | Select style based on window state. selectWindowStyle :: theme -> Window -> X (Style theme) -- | Define padding between decoration rectangle and widgets. widgetsPadding :: theme -> BoxBorders Dimension -- | Initial background color of decoration rectangle. -- When decoration widget is created, it is initially filled -- with this color. defaultBgColor :: theme -> String -- | Font name defined in the theme. themeFontName :: theme -> String -- | Generic Theme data type. This is used -- by @TextEngine@ and can be used by other relatively -- simple decoration engines. data GenericTheme style widget = GenericTheme { exActive :: !style -- ^ Decoration style for active (focused) windows , exInactive :: !style -- ^ Decoration style for inactive (unfocused) windows , exUrgent :: !style -- ^ Decoration style for urgent windows , exPadding :: !(BoxBorders Dimension) -- ^ Padding between decoration rectangle and widgets , exFontName :: !String -- ^ Font name , exOnDecoClick :: !(M.Map Int (WidgetCommand widget)) -- ^ Correspondence between mouse button number and window command. , exDragWindowButtons :: ![Int] -- ^ For which mouse buttons dragging is enabled , exWidgetsLeft :: ![widget] -- ^ Widgets that should appear at the left of decoration rectangle (listed left to right) , exWidgetsCenter :: ![widget] -- ^ Widgets that should appear in the center of decoration rectangle (listed left to right) , exWidgetsRight :: ![widget] -- ^ Widgets that should appear at the right of decoration rectangle (listed left to right) } deriving instance (Show widget, Show (WidgetCommand widget), Show style) => Show (GenericTheme style widget) deriving instance (Read widget, Read (WidgetCommand widget), Read style) => Read (GenericTheme style widget) -- | Convience type for themes used by @TextDecoration@. type ThemeEx widget = GenericTheme SimpleStyle widget instance HasWidgets (GenericTheme style) widget where themeWidgets theme = WidgetLayout (exWidgetsLeft theme) (exWidgetsCenter theme) (exWidgetsRight theme) -- | Supported states of windows (on which looks of decorations can depend). data ThemeStyleType = ActiveWindow | UrgentWindow | InactiveWindow deriving (Eq, Show, Read) -- | Utility function to convert WidgetLayout to plain list of widgets. widgetLayout :: WidgetLayout widget -> [widget] widgetLayout ws = wlLeft ws ++ wlCenter ws ++ wlRight ws -- | Painting context for decoration engines based on plain X11 calls. type XPaintingContext = (Display, Pixmap, GC) instance (Show widget, Read widget, Read (WidgetCommand widget), Show (WidgetCommand widget)) => ThemeAttributes (ThemeEx widget) where type Style (ThemeEx widget) = SimpleStyle selectWindowStyle theme w = genericWindowStyle w theme defaultBgColor t = sBgColor $ exInactive t widgetsPadding = exPadding themeFontName = exFontName instance ClickHandler (GenericTheme SimpleStyle) widget where onDecorationClick theme button = M.lookup button (exOnDecoClick theme) isDraggingEnabled theme button = button `elem` exDragWindowButtons theme -- | Generic utility function to select style from @GenericTheme@ -- based on current state of the window. genericWindowStyle :: Window -> GenericTheme style widget -> X style genericWindowStyle win theme = do styleType <- windowStyleType win return $ case styleType of ActiveWindow -> exActive theme InactiveWindow -> exInactive theme UrgentWindow -> exUrgent theme -- | Detect type of style to be used from current state of the window. windowStyleType :: Window -> X ThemeStyleType windowStyleType win = do mbFocused <- W.peek <$> gets windowset isWmStateUrgent <- (win `elem`) <$> readUrgents isUrgencyBitSet <- withDisplay $ \dpy -> do hints <- io $ getWMHints dpy win return $ wmh_flags hints `testBit` urgencyHintBit if isWmStateUrgent || isUrgencyBitSet then return UrgentWindow else return $ case mbFocused of Nothing -> InactiveWindow Just focused | focused == win -> ActiveWindow | otherwise -> InactiveWindow -- | Convert Theme type from "XMonad.Layout.Decoration" to -- theme type used by "XMonad.Layout.DecorationEx.TextEngine". themeEx :: Default (WidgetCommand widget) => D.Theme -> ThemeEx widget themeEx t = GenericTheme { exActive = SimpleStyle (D.activeColor t) (D.activeTextColor t) (D.activeColor t) (D.activeBorderWidth t) (borderColor $ D.activeColor t) , exInactive = SimpleStyle (D.inactiveColor t) (D.inactiveTextColor t) (D.inactiveColor t) (D.inactiveBorderWidth t) (borderColor $ D.inactiveColor t) , exUrgent = SimpleStyle (D.urgentColor t) (D.urgentTextColor t) (D.urgentColor t) (D.urgentBorderWidth t) (borderColor $ D.urgentColor t) , exPadding = BoxBorders 0 4 0 4 , exFontName = D.fontName t , exOnDecoClick = M.fromList [(1, def)] , exDragWindowButtons = [1] , exWidgetsLeft = [] , exWidgetsCenter = [] , exWidgetsRight = [] } instance Default (WidgetCommand widget) => Default (ThemeEx widget) where def = themeEx (def :: D.Theme) borderColor :: String -> BorderColors borderColor c = BoxBorders c c c c shadowBorder :: String -> String -> BorderColors shadowBorder highlight shadow = BoxBorders highlight shadow shadow highlight xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/DwmGeometry.hs0000644000000000000000000001055607346545000022552 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.DwmGeometry -- Description : DWM-style window decoration geometry -- Copyright : (c) 2007 Andrea Rossato, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This defines window decorations which are shown as a bar of fixed width -- on top of window. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.DwmGeometry ( -- * Usage: -- $usage DwmGeometry (..), dwmStyleDeco, dwmStyleDecoEx ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import qualified XMonad.Layout.Decoration as D import XMonad.Layout.DecorationEx.LayoutModifier import XMonad.Layout.DecorationEx.Common import XMonad.Layout.DecorationEx.Geometry import XMonad.Layout.DecorationEx.Widgets import XMonad.Layout.DecorationEx.TextEngine -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationEx.DwmStyle -- Then edit your @layoutHook@ by adding the DwmStyle decoration to -- your layout: -- -- > myL = dwmStyleDeco shrinkText (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | Decoration geometry data type data DwmGeometry a = DwmGeometry { dwmShowForFocused :: !Bool -- ^ Whether to show decorations on focused windows , dwmHorizontalPosition :: !Rational -- ^ Horizontal position of decoration rectangle. -- 0 means place it at left corner, 1 - place it at -- right corner, @1%2@ - place it at center. , dwmDecoHeight :: !Dimension -- ^ Height of decoration rectangle , dwmDecoWidth :: !Dimension -- ^ Width of decoration rectangle } deriving (Show, Read) instance Default (DwmGeometry a) where def = DwmGeometry False 1 20 200 instance DecorationGeometry DwmGeometry Window where describeGeometry _ = "DwmStyle" pureDecoration (DwmGeometry {..}) _ stack _ (w, Rectangle x y windowWidth _) = let width = min windowWidth dwmDecoWidth halfWidth = width `div` 2 minCenterX = x + fi halfWidth maxCenterX = x + fi windowWidth - fromIntegral halfWidth centerX = round ((1 - dwmHorizontalPosition)*fi minCenterX + dwmHorizontalPosition*fi maxCenterX) :: Position decoX = centerX - fi halfWidth focusedWindow = W.focus stack isFocused = focusedWindow == w in if (not dwmShowForFocused && isFocused) || not (D.isInStack stack w) then Nothing else Just $ Rectangle decoX y width dwmDecoHeight shrinkWindow _ _ windowRect = windowRect -- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration; -- decoration placement can be adjusted. dwmStyleDecoEx :: D.Shrinker shrinker => shrinker -- ^ Strings shrinker, for example @shrinkText@ -> DwmGeometry Window -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc) -> l Window -- ^ Layout to be decorated -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window dwmStyleDecoEx shrinker geom theme = decorationEx shrinker theme TextDecoration geom -- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration; -- decoration placement is similar to DWM. dwmStyleDeco :: D.Shrinker shrinker => shrinker -- ^ Strings shrinker, for example @shrinkText@ -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc) -> l Window -- ^ Layout to be decorated -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window dwmStyleDeco shrinker = dwmStyleDecoEx shrinker def xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/Engine.hs0000644000000000000000000006232507346545000021515 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DefaultSignatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.Engine -- Description : Type class and its default implementation for window decoration engines. -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This module defines @DecorationEngine@ type class, and default implementation for it. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.Engine ( -- * DecorationEngine class DecorationEngine (..), -- * Auxiliary data types DrawData (..), DecorationLayoutState (..), -- * Re-exports from X.L.Decoration Shrinker (..), shrinkText, -- * Utility functions mkDrawData, paintDecorationSimple ) where import Control.Monad import Data.Kind import Foreign.C.Types (CInt) import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.Decoration (Shrinker (..), shrinkWhile, shrinkText) import XMonad.Layout.DraggingVisualizer (DraggingVisualizerMsg (..)) import XMonad.Layout.DecorationAddons (handleScreenCrossing) import XMonad.Util.Font import XMonad.Util.NamedWindows (getName) import XMonad.Layout.DecorationEx.Common -- | Auxiliary type for data which are passed from -- decoration layout modifier to decoration engine. data DrawData engine widget = DrawData { ddEngineState :: !(DecorationEngineState engine) -- ^ Decoration engine state , ddStyle :: !(Style (Theme engine widget)) -- ^ Graphics style of the decoration. This defines colors, fonts etc -- which are to be used for this particular window in it's current state. , ddOrigWindow :: !Window -- ^ Original window to be decorated , ddWindowTitle :: !String -- ^ Original window title (not shrinked yet) , ddDecoRect :: !Rectangle -- ^ Decoration rectangle , ddWidgets :: !(WidgetLayout widget) -- ^ Widgets to be placed on decoration , ddWidgetPlaces :: !(WidgetLayout WidgetPlace) -- ^ Places where widgets must be shown } -- | State of decoration engine data DecorationLayoutState engine = DecorationLayoutState { dsStyleState :: !(DecorationEngineState engine) -- ^ Engine-specific state , dsDecorations :: ![WindowDecoration] -- ^ Mapping between decoration windows and original windows } -- | Decoration engines type class. -- Decoration engine is responsible for drawing something inside decoration rectangle. -- It is also responsible for handling X11 events (such as clicks) which happen -- within decoration rectangle. -- Decoration rectangles are defined by DecorationGeometry implementation. class (Read (engine widget a), Show (engine widget a), Eq a, DecorationWidget widget, HasWidgets (Theme engine) widget, ClickHandler (Theme engine) widget, ThemeAttributes (Theme engine widget)) => DecorationEngine engine widget a where -- | Type of themes used by decoration engine. -- This type must be parameterized over a widget type, -- because a theme will contain a list of widgets. type Theme engine :: Type -> Type -- | Type of data used by engine as a context during painting; -- for plain X11-based implementation this is Display, Pixmap -- and GC. type DecorationPaintingContext engine -- | Type of state used by the decoration engine. -- This can contain some resources that should be initialized -- and released at time, such as X11 fonts. type DecorationEngineState engine -- | Give a name to decoration engine. describeEngine :: engine widget a -> String -- | Initialize state of the engine. initializeState :: engine widget a -- ^ Decoration engine instance -> geom a -- ^ Decoration geometry instance -> Theme engine widget -- ^ Theme to be used -> X (DecorationEngineState engine) -- | Release resources held in engine state. releaseStateResources :: engine widget a -- ^ Decoration engine instance -> DecorationEngineState engine -- ^ Engine state -> X () -- | Calculate place which will be occupied by one widget. -- NB: X coordinate of the returned rectangle will be ignored, because -- the rectangle will be moved to the right or to the left for proper alignment -- of widgets. calcWidgetPlace :: engine widget a -- ^ Decoration engine instance -> DrawData engine widget -- ^ Information about window and decoration -> widget -- ^ Widget to be placed -> X WidgetPlace -- | Place widgets along the decoration bar. placeWidgets :: Shrinker shrinker => engine widget a -- ^ Decoration engine instance -> Theme engine widget -- ^ Theme to be used -> shrinker -- ^ Strings shrinker -> DecorationEngineState engine -- ^ Current state of the engine -> Rectangle -- ^ Decoration rectangle -> Window -- ^ Original window to be decorated -> WidgetLayout widget -- ^ Widgets layout -> X (WidgetLayout WidgetPlace) placeWidgets engine theme _ decoStyle decoRect window wlayout = do let leftWidgets = wlLeft wlayout rightWidgets = wlRight wlayout centerWidgets = wlCenter wlayout dd <- mkDrawData engine theme decoStyle window decoRect let paddedDecoRect = pad (widgetsPadding theme) (ddDecoRect dd) paddedDd = dd {ddDecoRect = paddedDecoRect} rightRects <- alignRight engine paddedDd rightWidgets leftRects <- alignLeft engine paddedDd leftWidgets let wantedLeftWidgetsWidth = sum $ map (rect_width . wpRectangle) leftRects wantedRightWidgetsWidth = sum $ map (rect_width . wpRectangle) rightRects hasShrinkableOnLeft = any isShrinkable leftWidgets hasShrinkableOnRight = any isShrinkable rightWidgets decoWidth = rect_width decoRect (leftWidgetsWidth, rightWidgetsWidth) | hasShrinkableOnLeft = (min (decoWidth - wantedRightWidgetsWidth) wantedLeftWidgetsWidth, wantedRightWidgetsWidth) | hasShrinkableOnRight = (wantedLeftWidgetsWidth, min (decoWidth - wantedLeftWidgetsWidth) wantedRightWidgetsWidth) | otherwise = (wantedLeftWidgetsWidth, wantedRightWidgetsWidth) ddForCenter = paddedDd {ddDecoRect = padCenter leftWidgetsWidth rightWidgetsWidth paddedDecoRect} centerRects <- alignCenter engine ddForCenter centerWidgets let shrinkedLeftRects = packLeft (rect_x paddedDecoRect) $ shrinkPlaces leftWidgetsWidth $ zip leftRects (map isShrinkable leftWidgets) shrinkedRightRects = packRight (rect_width paddedDecoRect) $ shrinkPlaces rightWidgetsWidth $ zip rightRects (map isShrinkable rightWidgets) return $ WidgetLayout shrinkedLeftRects centerRects shrinkedRightRects where shrinkPlaces targetWidth ps = let nShrinkable = length (filter snd ps) totalUnshrinkedWidth = sum $ map (rect_width . wpRectangle . fst) $ filter (not . snd) ps shrinkedWidth = (targetWidth - totalUnshrinkedWidth) `div` fi nShrinkable resetX place = place {wpRectangle = (wpRectangle place) {rect_x = 0}} adjust (place, True) = resetX $ place {wpRectangle = (wpRectangle place) {rect_width = shrinkedWidth}} adjust (place, False) = resetX place in map adjust ps pad p (Rectangle _ _ w h) = Rectangle (fi (bxLeft p)) (fi (bxTop p)) (w - bxLeft p - bxRight p) (h - bxTop p - bxBottom p) padCenter left right (Rectangle x y w h) = Rectangle (x + fi left) y (w - left - right) h -- | Shrink window title so that it would fit in decoration. getShrinkedWindowName :: Shrinker shrinker => engine widget a -- ^ Decoration engine instance -> shrinker -- ^ Strings shrinker -> DecorationEngineState engine -- ^ State of decoration engine -> String -- ^ Original window title -> Dimension -- ^ Width of rectangle in which the title should fit -> Dimension -- ^ Height of rectangle in which the title should fit -> X String default getShrinkedWindowName :: (Shrinker shrinker, DecorationEngineState engine ~ XMonadFont) => engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String getShrinkedWindowName _ shrinker font name wh _ = do let s = shrinkIt shrinker dpy <- asks display shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy font n return $ size > fromIntegral wh) name -- | Mask of X11 events on which the decoration engine should do something. -- @exposureMask@ should be included here so that decoration engine could -- repaint decorations when they are shown on screen. -- @buttonPressMask@ should be included so that decoration engine could -- response to mouse clicks. -- Other events can be added to custom implementations of DecorationEngine. decorationXEventMask :: engine widget a -> EventMask decorationXEventMask _ = exposureMask .|. buttonPressMask -- | List of X11 window property atoms of original (client) windows, -- change of which should trigger repainting of decoration. -- For example, if @WM_NAME@ changes it means that we have to redraw -- window title. propsToRepaintDecoration :: engine widget a -> X [Atom] propsToRepaintDecoration _ = mapM getAtom ["WM_NAME", "_NET_WM_NAME", "WM_STATE", "WM_HINTS"] -- | Generic event handler, which recieves X11 events on decoration -- window. -- Default implementation handles mouse clicks and drags. decorationEventHookEx :: Shrinker shrinker => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X () decorationEventHookEx = handleMouseFocusDrag -- | Event handler for clicks on decoration window. -- This is called from default implementation of "decorationEventHookEx". -- This should return True, if the click was handled (something happened -- because of that click). If this returns False, the click can be considered -- as a beginning of mouse drag. handleDecorationClick :: engine widget a -- ^ Decoration engine instance -> Theme engine widget -- ^ Decoration theme -> Rectangle -- ^ Decoration rectangle -> [Rectangle] -- ^ Rectangles where widgets are placed -> Window -- ^ Original (client) window -> Int -- ^ Mouse click X coordinate -> Int -- ^ Mouse click Y coordinate -> Int -- ^ Mouse button number -> X Bool handleDecorationClick = decorationHandler -- | Event handler which is called during mouse dragging. -- This is called from default implementation of "decorationEventHookEx". decorationWhileDraggingHook :: engine widget a -- ^ Decoration engine instance -> CInt -- ^ Event X coordinate -> CInt -- ^ Event Y coordinate -> (Window, Rectangle) -- ^ Original window and it's rectangle -> Position -- ^ X coordinate of new pointer position during dragging -> Position -- ^ Y coordinate of new pointer position during dragging -> X () decorationWhileDraggingHook _ = handleDraggingInProgress -- | This hoook is called after a window has been dragged using the decoration. -- This is called from default implementation of "decorationEventHookEx". decorationAfterDraggingHook :: engine widget a -- ^ Decoration engine instance -> (Window, Rectangle) -- ^ Original window and its rectangle -> Window -- ^ Decoration window -> X () decorationAfterDraggingHook _ds (w, _r) decoWin = do focus w hasCrossed <- handleScreenCrossing w decoWin unless hasCrossed $ do sendMessage DraggingStopped performWindowSwitching w -- | Draw everything required on the decoration window. -- This method should draw background (flat or gradient or whatever), -- borders, and call @paintWidget@ method to draw window widgets -- (buttons and title). paintDecoration :: Shrinker shrinker => engine widget a -- ^ Decoration engine instance -> a -- ^ Decoration window -> Dimension -- ^ Decoration window width -> Dimension -- ^ Decoration window height -> shrinker -- ^ Strings shrinker instance -> DrawData engine widget -- ^ Details about what to draw -> Bool -- ^ True when this method is called during Expose event -> X () -- | Paint one widget on the decoration window. paintWidget :: Shrinker shrinker => engine widget a -- ^ Decoration engine instance -> DecorationPaintingContext engine -- ^ Decoration painting context -> WidgetPlace -- ^ Place (rectangle) where the widget should be drawn -> shrinker -- ^ Strings shrinker instance -> DrawData engine widget -- ^ Details about window decoration -> widget -- ^ Widget to be drawn -> Bool -- ^ True when this method is called during Expose event -> X () handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () handleDraggingInProgress ex ey (mainw, r) x y = do let rect = Rectangle (x - (fi ex - rect_x r)) (y - (fi ey - rect_y r)) (rect_width r) (rect_height r) sendMessage $ DraggingWindow mainw rect performWindowSwitching :: Window -> X () performWindowSwitching win = withDisplay $ \d -> do root <- asks theRoot (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root ws <- gets windowset let allWindows = W.index ws -- do a little double check to be sure when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched let newStack = W.Stack t (reverse ls) rs windows $ W.modify' $ const newStack where switchEntries a b x | x == a = b | x == b = a | otherwise = x ignoreX :: WidgetPlace -> WidgetPlace ignoreX place = place {wpRectangle = (wpRectangle place) {rect_x = 0}} alignLeft :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace] alignLeft engine dd widgets = do places <- mapM (calcWidgetPlace engine dd) widgets return $ packLeft (rect_x $ ddDecoRect dd) $ map ignoreX places packLeft :: Position -> [WidgetPlace] -> [WidgetPlace] packLeft _ [] = [] packLeft x0 (place : places) = let rect = wpRectangle place x' = x0 + rect_x rect rect' = rect {rect_x = x'} place' = place {wpRectangle = rect'} in place' : packLeft (x' + fi (rect_width rect)) places alignRight :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace] alignRight engine dd widgets = do places <- mapM (calcWidgetPlace engine dd) widgets return $ packRight (rect_width $ ddDecoRect dd) $ map ignoreX places packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace] packRight x0 places = reverse $ go x0 places where go _ [] = [] go x (place : rest) = let rect = wpRectangle place x' = x - rect_width rect rect' = rect {rect_x = fi x'} place' = place {wpRectangle = rect'} in place' : go x' rest alignCenter :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace] alignCenter engine dd widgets = do places <- alignLeft engine dd widgets let totalWidth = sum $ map (rect_width . wpRectangle) places availableWidth = fi (rect_width (ddDecoRect dd)) :: Position x0 = max 0 $ (availableWidth - fi totalWidth) `div` 2 places' = map (shift x0) places return $ pack (fi availableWidth) places' where shift x0 place = let rect = wpRectangle place rect' = rect {rect_x = rect_x rect + fi x0} in place {wpRectangle = rect'} pack _ [] = [] pack available (place : places) = let rect = wpRectangle place placeWidth = rect_width rect widthToUse = min available placeWidth remaining = available - widthToUse rect' = rect {rect_width = widthToUse} place' = place {wpRectangle = rect'} in place' : pack remaining places -- | Build an instance of 'DrawData' type. mkDrawData :: (DecorationEngine engine widget a, ThemeAttributes (Theme engine widget), HasWidgets (Theme engine) widget) => engine widget a -> Theme engine widget -- ^ Decoration theme -> DecorationEngineState engine -- ^ State of decoration engine -> Window -- ^ Original window (to be decorated) -> Rectangle -- ^ Decoration rectangle -> X (DrawData engine widget) mkDrawData _ theme decoState origWindow decoRect = do -- xmonad-contrib #809 -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@ -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is -- quadratic due to using 'init' name <- fmap (take 2048 . takeWhile (/= '\n') . show) (getName origWindow) style <- selectWindowStyle theme origWindow return $ DrawData { ddEngineState = decoState, ddStyle = style, ddOrigWindow = origWindow, ddWindowTitle = name, ddDecoRect = decoRect, ddWidgets = themeWidgets theme, ddWidgetPlaces = WidgetLayout [] [] [] } -- | Mouse focus and mouse drag are handled by the same function, this -- way we can start dragging unfocused windows too. handleMouseFocusDrag :: (DecorationEngine engine widget a, Shrinker shrinker) => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X () handleMouseFocusDrag ds theme (DecorationLayoutState {dsDecorations}) _ (ButtonEvent {ev_window, ev_x_root, ev_y_root, ev_event_type, ev_button}) | ev_event_type == buttonPress , Just (WindowDecoration {..}) <- findDecoDataByDecoWindow ev_window dsDecorations = do let decoRect@(Rectangle dx dy _ _) = fromJust wdDecoRect x = fi $ ev_x_root - fi dx y = fi $ ev_y_root - fi dy button = fi ev_button dealtWith <- handleDecorationClick ds theme decoRect (map wpRectangle wdWidgets) wdOrigWindow x y button unless dealtWith $ when (isDraggingEnabled theme button) $ mouseDrag (\dragX dragY -> focus wdOrigWindow >> decorationWhileDraggingHook ds ev_x_root ev_y_root (wdOrigWindow, wdOrigWinRect) dragX dragY) (decorationAfterDraggingHook ds (wdOrigWindow, wdOrigWinRect) ev_window) handleMouseFocusDrag _ _ _ _ _ = return () -- | Given a window and the state, if a matching decoration is in the -- state return it with its ('Maybe') 'Rectangle'. findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration findDecoDataByDecoWindow decoWin = find (\dd -> wdDecoWindow dd == Just decoWin) decorationHandler :: forall engine widget a. (DecorationEngine engine widget a, ClickHandler (Theme engine) widget) => engine widget a -> Theme engine widget -> Rectangle -> [Rectangle] -> Window -> Int -> Int -> Int -> X Bool decorationHandler _ theme _ widgetPlaces window x y button = do widgetDone <- go $ zip (widgetLayout $ themeWidgets theme) widgetPlaces if widgetDone then return True else case onDecorationClick theme button of Just cmd -> do executeWindowCommand cmd window Nothing -> return False where go :: [(widget, Rectangle)] -> X Bool go [] = return False go ((w, rect) : rest) = do if pointWithin (fi x) (fi y) rect then do executeWindowCommand (widgetCommand w button) window else go rest -- | Simple implementation of @paintDecoration@ method. -- This is used by @TextEngine@ and can be re-used by other decoration -- engines. paintDecorationSimple :: forall engine shrinker widget. (DecorationEngine engine widget Window, DecorationPaintingContext engine ~ XPaintingContext, Shrinker shrinker, Style (Theme engine widget) ~ SimpleStyle) => engine widget Window -> Window -> Dimension -> Dimension -> shrinker -> DrawData engine widget -> Bool -> X () paintDecorationSimple deco win windowWidth windowHeight shrinker dd isExpose = do dpy <- asks display let widgets = widgetLayout $ ddWidgets dd style = ddStyle dd pixmap <- io $ createPixmap dpy win windowWidth windowHeight (defaultDepthOfScreen $ defaultScreenOfDisplay dpy) gc <- io $ createGC dpy pixmap -- draw io $ setGraphicsExposures dpy gc False bgColor <- stringToPixel dpy (sBgColor style) -- we start with the border let borderWidth = sDecoBorderWidth style borderColors = sDecorationBorders style when (borderWidth > 0) $ do drawLineWith dpy pixmap gc 0 0 windowWidth borderWidth (bxTop borderColors) drawLineWith dpy pixmap gc 0 0 borderWidth windowHeight (bxLeft borderColors) drawLineWith dpy pixmap gc 0 (fi (windowHeight - borderWidth)) windowWidth borderWidth (bxBottom borderColors) drawLineWith dpy pixmap gc (fi (windowWidth - borderWidth)) 0 borderWidth windowHeight (bxRight borderColors) -- and now again io $ setForeground dpy gc bgColor io $ fillRectangle dpy pixmap gc (fi borderWidth) (fi borderWidth) (windowWidth - (borderWidth * 2)) (windowHeight - (borderWidth * 2)) -- paint strings forM_ (zip widgets $ widgetLayout $ ddWidgetPlaces dd) $ \(widget, place) -> paintWidget deco (dpy, pixmap, gc) place shrinker dd widget isExpose -- debug -- black <- stringToPixel dpy "black" -- io $ setForeground dpy gc black -- forM_ (ddWidgetPlaces dd) $ \(WidgetPlace {wpRectangle = Rectangle x y w h}) -> -- io $ drawRectangle dpy pixmap gc x y w h -- copy the pixmap over the window io $ copyArea dpy pixmap win gc 0 0 windowWidth windowHeight 0 0 -- free the pixmap and GC io $ freePixmap dpy pixmap io $ freeGC dpy gc where drawLineWith dpy pixmap gc x y w h colorName = do color <- stringToPixel dpy colorName io $ setForeground dpy gc color io $ fillRectangle dpy pixmap gc x y w h xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/Geometry.hs0000644000000000000000000000743007346545000022077 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.Geometry -- Description : Type class which is responsible for defining the placement -- of window decorations -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This module defines @DecorationGeometry@ type class, and default implementation for it. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.Geometry ( DecorationGeometry (..), DefaultGeometry (..) ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Layout.Decoration as D -- | Decoration geometry class. -- Decoration geometry is responsible for placement of window decorations: whether -- they should be on the top of the window or on the bottom, should they go for -- full window width or only be of certain width, etc. -- This does not know what will be drawn inside decorations. class (Read (geom a), Show (geom a), Eq a) => DecorationGeometry geom a where -- | Give a name to decoration geometry implementation. describeGeometry :: geom a -> String -- | Reduce original window size to make space for decoration, if necessary. shrinkWindow :: geom a -> Rectangle -> Rectangle -> Rectangle shrinkWindow _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) -- | The pure version of the main method, 'decorate'. -- The method should return a rectangle where to place window decoration, -- or 'Nothing' if this window is not to be decorated. pureDecoration :: geom a -- ^ Decoration geometry instance -> Rectangle -- ^ Screen rectangle -> W.Stack a -- ^ Current stack of windows being displayed -> [(a,Rectangle)] -- ^ Set of all windows with their corresponding rectangle -> (a,Rectangle) -- ^ Window being decorated and its rectangle -> Maybe Rectangle -- | The method should return a rectangle where to place window decoration, -- or 'Nothing' if this window is not to be decorated. decorateWindow :: geom a -- ^ Decoration geometry instance -> Rectangle -- ^ Screen rectangle -> W.Stack a -- ^ Current stack of windows being displayed -> [(a, Rectangle)] -- ^ Set of all windows with their corresponding rectangle -> (a, Rectangle) -- ^ Window being decorated and its rectangle -> X (Maybe Rectangle) decorateWindow geom r s wrs wr = return $ pureDecoration geom r s wrs wr -- | Data type for default implementation of 'DecorationGeometry'. -- This defines simple decorations: a horizontal bar at the top of each window, -- running for full width of the window. newtype DefaultGeometry a = DefaultGeometry { gDecorationHeight :: Dimension } deriving (Read, Show) instance Eq a => DecorationGeometry DefaultGeometry a where describeGeometry _ = "Default" pureDecoration (DefaultGeometry {..}) _ s _ (w, Rectangle x y windowWidth windowHeight) = if D.isInStack s w && (gDecorationHeight < windowHeight) then Just $ Rectangle x y windowWidth gDecorationHeight else Nothing instance Default (DefaultGeometry a) where def = DefaultGeometry 20 xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/LayoutModifier.hs0000644000000000000000000003770007346545000023243 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.LayoutModifier -- Description : Layout modifier which adds decorations to windows. -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- Layout modifier, which is responsible for creation of decoration rectangles -- (windows), updating and removing them when needed. It is parameterized by -- @DecorationGeometry@, which says where decorations should be placed, and by -- @DecorationEngine@, which says how decorations should look. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.LayoutModifier ( -- * Usage -- -- $usage decorationEx, DecorationEx ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Layout.WindowArranger (diff, listFromList) import XMonad.Util.Invisible import XMonad.Util.XUtils hiding (paintTextAndIcons) import XMonad.Layout.DecorationEx.Common import XMonad.Layout.DecorationEx.Engine import XMonad.Layout.DecorationEx.Geometry -- $usage -- -- This module exports @decorationEx@ function, which is a generic function for -- adding decorations to your layouts. It can be used to use different -- decoration geometries and engines in any combination. -- For most used combinations, there are convenience functions in -- "XMonad.Layout.DecorationEx.TextEngine", "XMonad.Layout.DecorationEx.TabbedGeometry", -- and "XMonad.Layout.DecorationEx.DwmGeometry". -- -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationEx.LayoutModifier -- Then edit your @layoutHook@ by adding the DwmStyle decoration to -- your layout: -- -- > myL = decorationEx shrinkText myTheme myEngine myGeometry (layoutHook def) -- > where -- > myGeometry = DefaultGeometry -- or another geometry type -- > myEngine = TextDecoration -- or another decoration engine -- > myTheme = GenericTheme {...} -- theme type should correspond to selected engine type -- > -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | The 'DecorationEx' 'LayoutModifier'. This data type is an instance -- of the 'LayoutModifier' class. This data type will be passed, -- together with a layout, to the 'ModifiedLayout' type constructor -- to modify the layout by adding decorations according to a -- 'DecorationEngine'. data DecorationEx engine widget geom shrinker a = DecorationEx (Invisible Maybe (DecorationLayoutState engine)) shrinker (Theme engine widget) (engine widget a) (geom a) deriving instance (Show (Theme engine widget), Show shrinker, Show (engine widget a), Show (geom a)) => Show (DecorationEx engine widget geom shrinker a) deriving instance (Read (Theme engine widget), Read shrinker, Read (engine widget a), Read (geom a)) => Read (DecorationEx engine widget geom shrinker a) -- | The long 'LayoutModifier' instance for the 'DecorationEx' type. -- -- In 'redoLayout' we check the state: if there is no state we -- initialize it. -- -- The state is @diff@ed against the list of windows produced by the -- underlying layout: removed windows get deleted and new ones -- decorated by 'createDecos', which will call 'decorate' to decide if -- a window must be given a 'Rectangle', in which case a decoration -- window will be created. -- -- After that we resync the updated state with the windows' list and -- then we process the resynced stated (as we do with a new state). -- -- First we map the decoration windows, we update each decoration to -- reflect any decorated window's change, and we insert, in the list -- of windows and rectangles returned by the underlying layout, the -- decoration for each window. This way xmonad will restack the -- decorations and their windows accordingly. At the end we remove -- invisible\/stacked windows. -- -- Message handling is quite simple: when needed we release the state -- component of the 'DecorationEx' 'LayoutModifier'. Otherwise we call -- 'handleEvent', which will call the appropriate 'DecorationEngine' -- methods to perform its tasks. instance (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => LayoutModifier (DecorationEx engine widget geom shrinker) Window where redoLayout (DecorationEx (I (Just decoState)) shrinker theme engine geom) _ Nothing _ = do releaseResources engine decoState return ([], Just $ DecorationEx (I Nothing) shrinker theme engine geom) redoLayout _ _ Nothing _ = return ([], Nothing) redoLayout (DecorationEx invState shrinker theme engine geom) screenRect (Just stack) srcPairs | I Nothing <- invState = initState theme engine geom shrinker screenRect stack srcPairs >>= processState | I (Just s) <- invState = do let decorations = dsDecorations s (d,a) = curry diff (getOrigWindows decorations) srcWindows toDel = todel d decorations toAdd = toadd a srcPairs deleteDecos toDel let decosToBeAdded = [WindowDecoration win rect Nothing Nothing [] | (win, rect) <- toAdd] newDecorations <- resync (dsStyleState s) (decosToBeAdded ++ del_dwrs d decorations) srcPairs processState (s {dsDecorations = newDecorations}) where srcWindows = map fst srcPairs getOrigWindows :: [WindowDecoration] -> [Window] getOrigWindows = map wdOrigWindow del_dwrs :: [Window] -> [WindowDecoration] -> [WindowDecoration] del_dwrs = listFromList wdOrigWindow notElem findDecoWindow :: Int -> [WindowDecoration] -> Maybe Window findDecoWindow i d = wdDecoWindow $ d !! i todel :: [Window] -> [WindowDecoration] -> [WindowDecoration] todel d = filter (\dd -> wdOrigWindow dd `elem` d) toadd :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)] toadd a = filter (\p -> fst p `elem` a) createDecoWindowIfNeeded :: Maybe Window -> Maybe Rectangle -> X (Maybe Window) createDecoWindowIfNeeded mbDecoWindow mbDecoRect = case (mbDecoWindow, mbDecoRect) of (Nothing, Just decoRect) -> do decoWindow <- createDecoWindow engine theme decoRect return $ Just decoWindow _ -> return mbDecoWindow resync :: DecorationEngineState engine -> [WindowDecoration] -> [(Window,Rectangle)] -> X [WindowDecoration] resync _ _ [] = return [] resync decoState dd ((window,rect):xs) = case window `elemIndex` getOrigWindows dd of Just i -> do mbDecoRect <- decorateWindow geom screenRect stack srcPairs (window,rect) widgetPlaces <- case mbDecoRect of Nothing -> return $ WidgetLayout [] [] [] Just decoRect -> placeWidgets engine theme shrinker decoState decoRect window (themeWidgets theme) mbDecoWindow <- createDecoWindowIfNeeded (findDecoWindow i dd) mbDecoRect let newDd = WindowDecoration window rect mbDecoWindow mbDecoRect (widgetLayout widgetPlaces) restDd <- resync decoState dd xs return $ newDd : restDd Nothing -> resync decoState dd xs -- We drop any windows that are *precisely* stacked underneath -- another window: these must be intended to be tabbed! removeTabbed :: [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)] removeTabbed _ [] = [] removeTabbed rs ((w,r):xs) | r `elem` rs = removeTabbed rs xs | otherwise = (w,r) : removeTabbed (r:rs) xs insertDwr :: WindowDecoration -> [(Window, Rectangle)] -> [(Window, Rectangle)] insertDwr dd wrs = case (wdDecoWindow dd, wdDecoRect dd) of (Just decoWindow, Just decoRect) -> (decoWindow, decoRect) : (wdOrigWindow dd, shrinkWindow geom decoRect (wdOrigWinRect dd)) : wrs _ -> (wdOrigWindow dd, wdOrigWinRect dd) : wrs dwrs_to_wrs :: [WindowDecoration] -> [(Window, Rectangle)] dwrs_to_wrs = removeTabbed [] . foldr insertDwr [] processState :: DecorationLayoutState engine -> X ([(Window, Rectangle)], Maybe (DecorationEx engine widget geom shrinker Window)) processState st = do let decorations = dsDecorations st showDecos decorations updateDecos engine shrinker theme (dsStyleState st) decorations return (dwrs_to_wrs decorations, Just (DecorationEx (I (Just (st {dsDecorations = decorations}))) shrinker theme engine geom)) handleMess (DecorationEx (I (Just st)) shrinker theme engine geom) m | Just Hide <- fromMessage m = do hideDecos $ dsDecorations st return Nothing -- | Just (SetTheme nt) <- fromMessage m = do -- releaseResources engine st -- let t' = themeEx nt -- return $ Just $ DecorationEx (I Nothing) shrinker t' engine | Just ReleaseResources <- fromMessage m = do releaseResources engine st return $ Just $ DecorationEx (I Nothing) shrinker theme engine geom | Just e <- fromMessage m = do decorationEventHookEx engine theme st shrinker e handleEvent engine shrinker theme st e return Nothing handleMess _ _ = return Nothing modifierDescription (DecorationEx _ _ _ engine geom) = describeEngine engine ++ describeGeometry geom -- | By default 'DecorationEx' handles 'PropertyEvent' and 'ExposeEvent' -- only. handleEvent :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationLayoutState engine -> Event -> X () handleEvent engine shrinker theme (DecorationLayoutState {..}) e | PropertyEvent {ev_window = w, ev_atom = atom} <- e , Just i <- w `elemIndex` map wdOrigWindow dsDecorations = do supportedAtoms <- propsToRepaintDecoration engine when (atom `elem` supportedAtoms) $ do -- io $ putStrLn $ "property event on " ++ show w -- ++ ": " ++ fromMaybe "" atomName updateDeco engine shrinker theme dsStyleState (dsDecorations !! i) False | ExposeEvent {ev_window = w} <- e , Just i <- w `elemIndex` mapMaybe wdDecoWindow dsDecorations = do -- io $ putStrLn $ "expose event on " ++ show w updateDeco engine shrinker theme dsStyleState (dsDecorations !! i) True handleEvent _ _ _ _ _ = return () -- | Initialize the 'DecorationState' by initializing the font -- structure and by creating the needed decorations. initState :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => Theme engine widget -> engine widget Window -> geom Window -> shrinker -> Rectangle -> W.Stack Window -> [(Window,Rectangle)] -> X (DecorationLayoutState engine) initState theme engine geom shrinker screenRect stack wrs = do styleState <- initializeState engine geom theme decorations <- createDecos theme engine geom shrinker styleState screenRect stack wrs wrs return $ DecorationLayoutState styleState decorations -- | Delete windows stored in the state and release the font structure. releaseResources :: DecorationEngine engine widget Window => engine widget Window -> DecorationLayoutState engine -> X () releaseResources engine st = do deleteDecos (dsDecorations st) releaseStateResources engine (dsStyleState st) -- | Create the decoration windows of a list of windows and their -- rectangles, by calling the 'decorate' method of the -- 'DecorationStyle' received. createDecos :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => Theme engine widget -> engine widget Window -> geom Window -> shrinker -> DecorationEngineState engine -> Rectangle -> W.Stack Window -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [WindowDecoration] createDecos theme engine geom shrinker decoState screenRect stack wrs ((w,r):xs) = do mbDecoRect <- decorateWindow geom screenRect stack wrs (w,r) case mbDecoRect of Just decoRect -> do decoWindow <- createDecoWindow engine theme decoRect widgetPlaces <- placeWidgets engine theme shrinker decoState decoRect w (themeWidgets theme) restDd <- createDecos theme engine geom shrinker decoState screenRect stack wrs xs let newDd = WindowDecoration w r (Just decoWindow) (Just decoRect) $ widgetLayout widgetPlaces return $ newDd : restDd Nothing -> do restDd <- createDecos theme engine geom shrinker decoState screenRect stack wrs xs let newDd = WindowDecoration w r Nothing Nothing [] return $ newDd : restDd createDecos _ _ _ _ _ _ _ _ [] = return [] createDecoWindow :: (DecorationEngine engine widget Window) => engine widget Window -> Theme engine widget -> Rectangle -> X Window createDecoWindow engine theme rect = do let mask = Just $ decorationXEventMask engine w <- createNewWindow rect mask (defaultBgColor theme) True d <- asks display io $ setClassHint d w (ClassHint "xmonad-decoration" "xmonad") return w showDecos :: [WindowDecoration] -> X () showDecos dd = showWindows $ mapMaybe wdDecoWindow $ filter (isJust . wdDecoRect) dd hideDecos :: [WindowDecoration] -> X () hideDecos = hideWindows . mapMaybe wdDecoWindow deleteDecos :: [WindowDecoration] -> X () deleteDecos = deleteWindows . mapMaybe wdDecoWindow updateDecos :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> [WindowDecoration] -> X () updateDecos engine shrinker theme decoState = mapM_ (\wd -> updateDeco engine shrinker theme decoState wd False) -- | Update a decoration window given a shrinker, a theme, the font -- structure and the needed 'Rectangle's updateDeco :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> WindowDecoration -> Bool -> X () updateDeco engine shrinker theme decoState wd isExpose = case (wdDecoWindow wd, wdDecoRect wd) of (Just decoWindow, Just decoRect@(Rectangle _ _ wh ht)) -> do let origWin = wdOrigWindow wd drawData <- mkDrawData engine theme decoState origWin decoRect widgetPlaces <- placeWidgets engine theme shrinker decoState decoRect (wdOrigWindow wd) (themeWidgets theme) -- io $ print widgetPlaces paintDecoration engine decoWindow wh ht shrinker (drawData {ddWidgetPlaces = widgetPlaces}) isExpose (Just decoWindow, Nothing) -> hideWindow decoWindow _ -> return () -- | Apply a DecorationEx modifier to an underlying layout decorationEx :: (DecorationEngine engine widget a, DecorationGeometry geom a, Shrinker shrinker) => shrinker -- ^ Strings shrinker, for example @shrinkText@ -> Theme engine widget -- ^ Decoration theme -> engine widget a -- ^ Decoration engine instance -> geom a -- ^ Decoration geometry instance -> l a -- ^ Underlying layout to be decorated -> ModifiedLayout (DecorationEx engine widget geom shrinker) l a decorationEx shrinker theme engine geom = ModifiedLayout (DecorationEx (I Nothing) shrinker theme engine geom) xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/TabbedGeometry.hs0000644000000000000000000001650107346545000023200 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.TabbedGeometry -- Description : Tab-based window decoration geometry -- Copyright : (c) 2007 Andrea Rossato, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This module defines window decoration geometry based on tabs. -- The tabs can follow horizontally and be placed above or below windows; -- in such case, tabs can occupy full width of the window or be aligned to -- left or right. Or tabs can go vertically near left or right side of -- the window. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.TabbedGeometry ( textTabbed, TabbedGeometry (..), HorizontalTabPlacement (..), VerticalTabPlacement (..), HorizontalTabWidth (..), HorizontalTabsAlignment (..), SingleTabMode (..) ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Prelude import XMonad.Layout.Decoration (ModifiedLayout, Shrinker (..)) import XMonad.Layout.DecorationEx.LayoutModifier import XMonad.Layout.DecorationEx.Common import XMonad.Layout.DecorationEx.Geometry import XMonad.Layout.DecorationEx.Widgets import XMonad.Layout.DecorationEx.TextEngine -- | Placement of tabs when they go horizontally: -- should they be placed above or below the window. data HorizontalTabPlacement = Top | Bottom deriving (Eq, Read, Show) -- | Placement of tabs when they go vertically: -- should they appear at left or at right side of the window. data VerticalTabPlacement = TabsAtLeft | TabsAtRight deriving (Eq, Read, Show) -- | Width of tabs when they go horizontally. data HorizontalTabWidth = AutoWidth -- ^ Define the width automatically by evenly dividing windows' width | FixedWidth !Dimension -- ^ Use fixed width of the tab deriving (Eq, Read, Show) -- | Alignment of tabs when they go horizontally. data HorizontalTabsAlignment = AlignTabsLeft | AlignTabsCenter | AlignTabsRight deriving (Eq, Read, Show) -- | What to do if there is only one tab. data SingleTabMode = ShowTab | HideTab deriving (Eq, Read, Show) data TabbedGeometry a = HorizontalTabs { showIfSingleWindow :: !SingleTabMode -- ^ What to do if there is only one tab , hTabPlacement :: !HorizontalTabPlacement -- ^ Where to place horizontal tabs , hTabAlignment :: !HorizontalTabsAlignment -- ^ How to align horizontal tabs (makes sense with fixed width of tabs). , hTabWidth :: !HorizontalTabWidth -- ^ Width of horizontal tabs , hTabHeight :: !Dimension -- ^ Height of horizontal tabs } | VerticalTabs { showIfSingleWindow :: !SingleTabMode -- ^ What to do if there is only one tab , vTabPlacement :: !VerticalTabPlacement -- ^ Where to place vertical tabs , vTabWidth :: !Dimension -- ^ Width of vertical tabs , vTabHeight :: !Dimension -- ^ Height of vertical tabs } deriving (Show, Read) instance Default (TabbedGeometry a) where def = HorizontalTabs ShowTab Top AlignTabsLeft AutoWidth 20 instance DecorationGeometry TabbedGeometry Window where describeGeometry _ = "Tabbed" pureDecoration tabs _ stack wrs (window, windowRect) = let Rectangle windowX windowY windowWidth windowHeight = windowRect -- windows that are mapped onto the same rectangle as current one are considered to -- be in one tabs group tabbedWindows = filter (`elem` map fst (filter ((==windowRect) . snd) wrs)) (W.integrate stack) mbWindowIndex = window `elemIndex` tabbedWindows numWindows = length tabbedWindows in if numWindows > 1 || (showIfSingleWindow tabs == ShowTab && numWindows > 0) then case tabs of HorizontalTabs {..} -> Just $ case hTabPlacement of Top -> Rectangle decoX windowY effectiveTabWidth hTabHeight Bottom -> Rectangle decoX (windowY + fi (windowHeight - hTabHeight)) effectiveTabWidth hTabHeight where decoX = maybe windowX tabX mbWindowIndex -- If there are too many windows or configured tab width -- is too big, then we have to switch to 'auto' mode. hTabWidth' = case hTabWidth of AutoWidth -> AutoWidth FixedWidth tabWidth | tabWidth * fi numWindows > windowWidth -> AutoWidth | otherwise -> FixedWidth tabWidth effectiveTabWidth = case hTabWidth' of AutoWidth -> fi $ maybe windowX (\i -> tabX (i+1) - tabX i) mbWindowIndex FixedWidth tabWidth -> tabWidth allTabsWidth = case hTabWidth' of AutoWidth -> fi windowWidth FixedWidth _ -> fi $ min windowWidth $ effectiveTabWidth * max 1 (fi numWindows) tabsStartX = case hTabAlignment of AlignTabsLeft -> windowX AlignTabsRight -> windowX + fi windowWidth - allTabsWidth AlignTabsCenter -> windowX + (fi windowWidth - allTabsWidth) `div` 2 -- X coordinate of i'th window in horizontal tabs layout tabX i = tabsStartX + case hTabWidth' of AutoWidth -> fi ((windowWidth * fi i) `div` max 1 (fi numWindows)) FixedWidth _ -> fi effectiveTabWidth * fi i VerticalTabs {..} -> Just $ case vTabPlacement of TabsAtLeft -> fixHeightTab windowX TabsAtRight -> fixHeightTab (windowX + fi (windowWidth - vTabWidth)) where fixHeightLoc i = windowY + fi vTabHeight * fi i fixHeightTab x = Rectangle x (maybe windowY fixHeightLoc mbWindowIndex) vTabWidth vTabHeight else Nothing shrinkWindow tabs (Rectangle _ _ dw dh) (Rectangle x y w h) = case tabs of HorizontalTabs {..} -> case hTabPlacement of Top -> Rectangle x (y + fi dh) w (h - dh) Bottom -> Rectangle x y w (h - dh) VerticalTabs {..} -> case vTabPlacement of TabsAtLeft -> Rectangle (x + fi dw) y (w - dw) h TabsAtRight -> Rectangle x y (w - dw) h -- | Add tabbed decorations (with default settings) with text-based widgets to a layout. textTabbed :: (Shrinker shrinker) => shrinker -- ^ Strings shrinker, e.g. @shrinkText@ -> ThemeEx StandardWidget -- ^ Decoration theme -> l Window -- ^ Layout to be decorated -> ModifiedLayout (DecorationEx TextDecoration StandardWidget TabbedGeometry shrinker) l Window textTabbed shrinker theme = decorationEx shrinker theme TextDecoration def xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/TextEngine.hs0000644000000000000000000001114107346545000022350 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.TextEngine -- Description : Text-based window decoration engine -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- Window decoration engine, that uses text fragments (like @"[X]"@) to indicate -- widgets (window buttons). ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.TextEngine ( textDecoration, TextDecoration (..) ) where import XMonad import XMonad.Prelude import XMonad.Layout.LayoutModifier import XMonad.Util.Font import XMonad.Layout.DecorationEx.LayoutModifier import XMonad.Layout.DecorationEx.Common import XMonad.Layout.DecorationEx.Engine import XMonad.Layout.DecorationEx.Geometry import XMonad.Layout.DecorationEx.Widgets -- | Decoration engine data type data TextDecoration widget a = TextDecoration deriving (Show, Read) instance (TextWidget widget, ClickHandler (GenericTheme SimpleStyle) widget) => DecorationEngine TextDecoration widget Window where type Theme TextDecoration = GenericTheme SimpleStyle type DecorationPaintingContext TextDecoration = XPaintingContext type DecorationEngineState TextDecoration = XMonadFont describeEngine _ = "TextDecoration" calcWidgetPlace = calcTextWidgetPlace paintWidget = paintTextWidget paintDecoration = paintDecorationSimple initializeState _ _ theme = initXMF (themeFontName theme) releaseStateResources _ = releaseXMF -- | Implementation of @paintWidget@ for decoration engines based on @TextDecoration@. paintTextWidget :: (TextWidget widget, Style (Theme engine widget) ~ SimpleStyle, DecorationPaintingContext engine ~ XPaintingContext, DecorationEngineState engine ~ XMonadFont, Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> DecorationPaintingContext engine -> WidgetPlace -> shrinker -> DrawData engine widget -> widget -> Bool -> X () paintTextWidget engine (dpy, pixmap, gc) place shrinker dd widget _ = do let style = ddStyle dd rect = wpRectangle place x = rect_x rect y = wpTextYPosition place str <- widgetString dd widget str' <- if isShrinkable widget then getShrinkedWindowName engine shrinker (ddEngineState dd) str (rect_width rect) (rect_height rect) else return str printStringXMF dpy pixmap (ddEngineState dd) gc (sTextColor style) (sTextBgColor style) x y str' -- | Implementation of @calcWidgetPlace@ for decoration engines based on @TextDecoration@. calcTextWidgetPlace :: (TextWidget widget, DecorationEngineState engine ~ XMonadFont, DecorationEngine engine widget Window) => engine widget Window -> DrawData engine widget -> widget -> X WidgetPlace calcTextWidgetPlace _ dd widget = do str <- widgetString dd widget let h = rect_height (ddDecoRect dd) font = ddEngineState dd withDisplay $ \dpy -> do width <- fi <$> textWidthXMF dpy (ddEngineState dd) str (a, d) <- textExtentsXMF font str let height = a + d y = fi $ (h - fi height) `div` 2 y0 = y + fi a rect = Rectangle 0 y width (fi height) return $ WidgetPlace y0 rect -- | Add decoration to existing layout. Widgets are indicated by text fragments, like @"[+]"@. -- Geometry is simple: a horizontal panel at the top of each window, going for the full width -- of the window. textDecoration :: (Shrinker shrinker) => shrinker -- ^ String shrinker, for example @shrinkText@ -> Theme TextDecoration StandardWidget -- ^ Decoration theme (font, colors, widgets, etc) -> l Window -- ^ Layout to be decorated -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window textDecoration shrinker theme = decorationEx shrinker theme TextDecoration def xmonad-contrib-0.18.0/XMonad/Layout/DecorationEx/Widgets.hs0000644000000000000000000001552507346545000021716 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationEx.Widgets -- Description : Definitions for decoration widgets (window buttons etc) -- Copyright : 2023 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : portnov84@rambler.ru -- Stability : unstable -- Portability : unportable -- -- This module contains data types and utilities to deal with decoration -- widgets. A widget is anything that is displayed on window decoration, -- and, optionally, can react on clicks. Examples of widgets are usual -- window buttons (minimize, maximize, close), window icon and window title. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationEx.Widgets ( -- * Data types StandardCommand (..), TextWidget (..), GenericWidget (..), StandardWidget, -- * Utility functions isWidgetChecked, -- * Presets for standard widgets titleW, toggleStickyW, minimizeW, maximizeW, closeW, dwmpromoteW, moveToNextGroupW,moveToPrevGroupW ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Actions.DwmPromote import qualified XMonad.Actions.CopyWindow as CW import qualified XMonad.Layout.Groups.Examples as Ex import XMonad.Layout.Maximize import XMonad.Actions.Minimize import XMonad.Actions.WindowMenu import XMonad.Layout.DecorationEx.Common import XMonad.Layout.DecorationEx.Engine -- | Standard window commands. -- -- One can extend this list by simply doing -- -- > data MyWindowCommand = -- > Std StandardCommand -- > | SomeFancyCommand -- -- > instance WindowCommand MyWindowCommand where ... -- -- > type MyWidget = GenericWidget MyWindowCommand -- data StandardCommand = FocusWindow -- ^ Focus the window | FocusUp -- ^ Move focus to previous window | FocusDown -- ^ Move focus to following window | MoveToNextGroup -- ^ Move the window to the next group (see "XMonad.Layout.Groups") | MoveToPrevGroup -- ^ Move the window to the previous group | DwmPromote -- ^ Execute @dwmpromote@ (see "XMonad.Actions.DwmPromote") | ToggleSticky -- ^ Make window sticky or unstick it (see "XMonad.Actions.CopyWindow") | ToggleMaximize -- ^ Maximize or restore window (see "XMonad.Layout.Maximize") | Minimize -- ^ Minimize window (see "XMonad.Actions.Minimize") | CloseWindow -- ^ Close the window | GridWindowMenu -- ^ Show window menu via "XMonad.Actions.GridSelect" (see "XMonad.Actions.WindowMenu") deriving (Eq, Show, Read) instance Default StandardCommand where def = FocusWindow instance WindowCommand StandardCommand where executeWindowCommand FocusWindow w = do focus w return False executeWindowCommand FocusUp _ = do windows W.focusUp withFocused maximizeWindowAndFocus return True executeWindowCommand FocusDown _ = do windows W.focusDown withFocused maximizeWindowAndFocus return True executeWindowCommand MoveToNextGroup w = do focus w Ex.moveToGroupDown False return True executeWindowCommand MoveToPrevGroup w = do focus w Ex.moveToGroupUp False return True executeWindowCommand CloseWindow w = do killWindow w return True executeWindowCommand DwmPromote w = do focus w dwmpromote return True executeWindowCommand ToggleSticky w = do focus w copies <- CW.wsContainingCopies if null copies then windows CW.copyToAll else CW.killAllOtherCopies return True executeWindowCommand ToggleMaximize w = do sendMessage $ maximizeRestore w focus w return True executeWindowCommand Minimize w = do minimizeWindow w return True executeWindowCommand GridWindowMenu w = do focus w windowMenu return True isCommandChecked FocusWindow _ = return False isCommandChecked DwmPromote w = do withWindowSet $ \ws -> return $ Just w == master ws where master ws = case W.integrate' $ W.stack $ W.workspace $ W.current ws of [] -> Nothing (x:_) -> Just x isCommandChecked ToggleSticky w = do ws <- gets windowset let copies = CW.copiesOfOn (Just w) (CW.taggedWindows $ W.hidden ws) return $ not $ null copies isCommandChecked _ _ = return False -- | Generic data type for decoration widgets. data GenericWidget cmd = TitleWidget -- ^ Window title (just text label) | WindowIcon { swCommand :: !cmd } -- ^ Window icon with some associated command -- | Other widgets | GenericWidget { swCheckedText :: !String -- ^ Text for checked widget state , swUncheckedText :: !String -- ^ Text for unchecked widget state , swCommand :: !cmd -- ^ Window command } deriving (Show, Read) -- | Generic widget type specialized for 'StandardCommand' type StandardWidget = GenericWidget StandardCommand instance (Default cmd, Read cmd, Show cmd, WindowCommand cmd) => DecorationWidget (GenericWidget cmd) where type WidgetCommand (GenericWidget cmd) = cmd widgetCommand TitleWidget _ = def widgetCommand w 1 = swCommand w widgetCommand _ _ = def isShrinkable TitleWidget = True isShrinkable _ = False -- | Check if the widget should be displayed in `checked' state. isWidgetChecked :: DecorationWidget widget => widget -> Window -> X Bool isWidgetChecked wdt = isCommandChecked (widgetCommand wdt 1) -- | Type class for widgets that can be displayed as -- text fragments by 'TextDecoration' engine. class DecorationWidget widget => TextWidget widget where widgetString :: DrawData engine widget -> widget -> X String instance TextWidget StandardWidget where widgetString dd TitleWidget = return $ ddWindowTitle dd widgetString _ (WindowIcon {}) = return "[*]" widgetString dd w = do checked <- isWidgetChecked w (ddOrigWindow dd) if checked then return $ swCheckedText w else return $ swUncheckedText w -- | Widget for window title titleW :: StandardWidget titleW = TitleWidget -- | Widget for ToggleSticky command. toggleStickyW :: StandardWidget toggleStickyW = GenericWidget "[S]" "[s]" ToggleSticky -- | Widget for Minimize command minimizeW :: StandardWidget minimizeW = GenericWidget "" "[_]" Minimize -- | Widget for ToggleMaximize command maximizeW :: StandardWidget maximizeW = GenericWidget "" "[O]" ToggleMaximize -- | Widget for CloseWindow command closeW :: StandardWidget closeW = GenericWidget "" "[X]" CloseWindow dwmpromoteW :: StandardWidget dwmpromoteW = GenericWidget "[M]" "[m]" DwmPromote moveToNextGroupW :: StandardWidget moveToNextGroupW = GenericWidget "" "[>]" MoveToNextGroup moveToPrevGroupW :: StandardWidget moveToPrevGroupW = GenericWidget "" "[<]" MoveToPrevGroup xmonad-contrib-0.18.0/XMonad/Layout/DecorationMadness.hs0000644000000000000000000006546207346545000021333 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationMadness -- Description : A collection of decorated layouts. -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A collection of decorated layouts: some of them may be nice, some -- usable, others just funny. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationMadness ( -- * Usage -- $usage -- * Decorated layouts based on CircleEx -- $circle circleSimpleDefault , circleDefault , circleSimpleDefaultResizable , circleDefaultResizable , circleSimpleDeco , circleSimpleDecoResizable , circleDeco , circleDecoResizable , circleSimpleDwmStyle , circleDwmStyle , circleSimpleTabbed , circleTabbed -- * Decorated layouts based on Accordion -- $accordion , accordionSimpleDefault , accordionDefault , accordionSimpleDefaultResizable , accordionDefaultResizable , accordionSimpleDeco , accordionSimpleDecoResizable , accordionDeco , accordionDecoResizable , accordionSimpleDwmStyle , accordionDwmStyle , accordionSimpleTabbed , accordionTabbed -- * Tall decorated layouts -- $tall , tallSimpleDefault , tallDefault , tallSimpleDefaultResizable , tallDefaultResizable , tallSimpleDeco , tallDeco , tallSimpleDecoResizable , tallDecoResizable , tallSimpleDwmStyle , tallDwmStyle , tallSimpleTabbed , tallTabbed -- * Mirror Tall decorated layouts -- $mirror , mirrorTallSimpleDefault , mirrorTallDefault , mirrorTallSimpleDefaultResizable , mirrorTallDefaultResizable , mirrorTallSimpleDeco , mirrorTallDeco , mirrorTallSimpleDecoResizable , mirrorTallDecoResizable , mirrorTallSimpleDwmStyle , mirrorTallDwmStyle , mirrorTallSimpleTabbed , mirrorTallTabbed -- * Floating decorated layouts -- $float , floatSimpleSimple , floatSimple , floatSimpleDefault , floatDefault , floatSimpleDwmStyle , floatDwmStyle , floatSimpleTabbed , floatTabbed , def, shrinkText ) where import XMonad import XMonad.Actions.MouseResize import XMonad.Layout.Decoration import XMonad.Layout.DwmStyle import XMonad.Layout.SimpleDecoration import XMonad.Layout.TabBarDecoration import XMonad.Layout.Accordion import XMonad.Layout.CircleEx import XMonad.Layout.WindowArranger import XMonad.Layout.SimpleFloat -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationMadness -- -- Then edit your @layoutHook@ by adding the layout you want: -- -- > main = xmonad def { layoutHook = someMadLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default theme: -- -- > myTheme = def { inactiveBorderColor = "#FF0000" -- > , activeTextColor = "#00FF00" } -- -- and -- -- > mylayout = tabbed shrinkText myTheme ||| Full ||| etc.. -- -- When a layout is resizable, this means two different things: you -- can grab a window's decoration with the pointer and move it around, -- and you can move and resize windows with the keyboard. For setting -- up the key bindings, please read the documentation of -- "XMonad.Layout.WindowArranger" -- -- The default theme can be dynamically change with the xmonad theme -- selector. See "XMonad.Prompt.Theme". For more themes, look at -- "XMonad.Util.Themes" -- $circle -- Here you will find 'CircleEx' based decorated layouts. -- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) CircleEx Window circleSimpleDefault = decoration shrinkText def DefaultDecoration circle -- | Similar to 'circleSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. circleDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) CircleEx Window circleDefault s t = decoration s t DefaultDecoration circle -- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) CircleEx Window circleSimpleDeco = decoration shrinkText def (Simple True) circle -- | Similar to 'circleSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. circleDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) CircleEx Window circleDeco s t = decoration s t (Simple True) circle -- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange circle) -- | Similar to 'circleSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange circle) -- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange circle) -- | Similar to 'circleSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange circle) -- | A 'CircleEx' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) CircleEx Window circleSimpleDwmStyle = decoration shrinkText def Dwm circle -- | Similar to 'circleSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. circleDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) CircleEx Window circleDwmStyle s t = decoration s t Dwm circle -- | A 'CircleEx' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen CircleEx) Window circleSimpleTabbed = simpleTabBar circle -- | Similar to 'circleSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. circleTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen CircleEx) Window circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) circle) -- $accordion -- Here you will find decorated layouts based on the 'Accordion' -- layout. -- | An 'Accordion' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window accordionSimpleDefault = decoration shrinkText def DefaultDecoration Accordion -- | Similar to 'accordionSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. accordionDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) Accordion Window accordionDefault s t = decoration s t DefaultDecoration Accordion -- | An 'Accordion' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window accordionSimpleDeco = decoration shrinkText def (Simple True) Accordion -- | Similar to 'accordionSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. accordionDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) Accordion Window accordionDeco s t = decoration s t (Simple True) Accordion -- | An 'Accordion' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Accordion) -- | Similar to 'accordionSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. accordionDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Accordion) -- | An 'Accordion' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Accordion) -- | Similar to 'accordionSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. accordionDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Accordion) -- | An 'Accordion' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window accordionSimpleDwmStyle = decoration shrinkText def Dwm Accordion -- | Similar to 'accordionSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. accordionDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) Accordion Window accordionDwmStyle s t = decoration s t Dwm Accordion -- | An 'Accordion' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window accordionSimpleTabbed = simpleTabBar Accordion -- | Similar to 'accordionSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. accordionTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Accordion) Window accordionTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Accordion) -- $tall -- In this section you will find decorated layouts based on the -- 'Tall' layout. tall :: Tall Window tall = Tall 1 (3/100) (1/2) -- | A 'Tall' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window tallSimpleDefault = decoration shrinkText def DefaultDecoration tall -- | Similar to 'tallSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. tallDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) Tall Window tallDefault s t = decoration s t DefaultDecoration tall -- | A 'Tall' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window tallSimpleDeco = decoration shrinkText def (Simple True) tall -- | Similar to 'tallSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. tallDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) Tall Window tallDeco s t = decoration s t (Simple True) tall -- | A 'Tall' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange tall) -- | Similar to 'tallSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. tallDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange tall) -- | A 'Tall' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange tall) -- | Similar to 'tallSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. tallDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange tall) -- | A 'Tall' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window tallSimpleDwmStyle = decoration shrinkText def Dwm tall -- | Similar to 'tallSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. tallDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) Tall Window tallDwmStyle s t = decoration s t Dwm tall -- | A 'Tall' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window tallSimpleTabbed = simpleTabBar tall -- | Similar to 'tallSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. tallTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Tall) Window tallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) tall) -- $mirror -- In this section you will find decorated layouts based on the -- 'Mirror' layout modifier applied to 'Tall'. mirrorTall :: Mirror Tall Window mirrorTall = Mirror tall -- | A 'Mirror Tall' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window mirrorTallSimpleDefault = decoration shrinkText def DefaultDecoration mirrorTall -- | Similar to 'mirrorTallSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. mirrorTallDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (Mirror Tall) Window mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall -- | A 'Mirror Tall' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window mirrorTallSimpleDeco = decoration shrinkText def (Simple True) mirrorTall -- | Similar to 'mirrorTallSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. mirrorTallDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (Mirror Tall) Window mirrorTallDeco s t = decoration s t (Simple True) mirrorTall -- | A 'Mirror Tall' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange mirrorTall) -- | Similar to 'mirrorTallSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange mirrorTall) -- | A 'Mirror Tall' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange mirrorTall) -- | Similar to 'mirrorTallSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange mirrorTall) -- | A 'Mirror Tall' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window mirrorTallSimpleDwmStyle = decoration shrinkText def Dwm mirrorTall -- | Similar to 'mirrorTallSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) (Mirror Tall) Window mirrorTallDwmStyle s t = decoration s t Dwm mirrorTall -- | A 'Mirror Tall' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window mirrorTallSimpleTabbed = simpleTabBar mirrorTall -- | Similar to 'mirrorTallSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window mirrorTallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) mirrorTall) -- $float -- Here you will find decorated layout based on the SimpleFloating -- layout -- | A simple floating layout where every window is placed according -- to the window's initial attributes. -- -- Here you can find a screen shot: -- -- floatSimpleSimple :: (Show a, Eq a) => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleSimple = simpleFloat floatSimple :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimple = simpleFloat' -- | This version is decorated with the 'DefaultDecoration' style. -- -- Here you can find a screen shot: -- -- floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleDefault = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDefault', but with the possibility of setting a -- custom shrinker and a custom theme. floatDefault :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight t)) -- | This version is decorated with the 'DwmStyle'. Note that this is -- a keyboard only floating layout. -- -- Here you can find a screen shot: -- -- floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleDwmStyle = decoration shrinkText def Dwm (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a -- custom shrinker and a custom theme. floatDwmStyle :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight t)) -- | This version is decorated with the 'TabbedDecoration' style. -- | Mouse dragging is somehow weird. -- -- Here you can find a screen shot: -- -- floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleTabbed = tabBar shrinkText def Top (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleTabbed', but with the possibility of setting a -- custom shrinker and a custom theme. floatTabbed :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatTabbed s t = tabBar s t Top (mouseResize $ windowArrangeAll $ SF (decoHeight t)) xmonad-contrib-0.18.0/XMonad/Layout/Dishes.hs0000644000000000000000000000403107346545000017131 0ustar0000000000000000{-# 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) -- -- Maintainer : Jeremy Apthorp -- Stability : unstable -- Portability : portable -- -- Dishes is a layout that stacks extra windows underneath the master -- windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.Dishes ( -- * Usage -- $usage Dishes (..) ) where import XMonad import XMonad.StackSet (integrate) import XMonad.Prelude (ap) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Dishes -- -- Then edit your @layoutHook@ by adding the Dishes layout: -- -- > myLayout = Dishes 2 (1/6) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data Dishes a = Dishes Int Rational deriving (Show, Read) instance LayoutClass Dishes a where doLayout (Dishes nmaster h) r = return . (, 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 dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle] dishes h s nmaster n = if n <= nmaster then splitHorizontally n s else ws where (m,rest) = splitVerticallyBy (1 - fromIntegral (n - nmaster) * h) s ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest xmonad-contrib-0.18.0/XMonad/Layout/DragPane.hs0000644000000000000000000001314207346545000017376 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DragPane -- Description : Split the screen either horizontally or vertically and show two windows. -- Copyright : (c) Spencer Janssen -- David Roundy , -- Andrea Rossato -- License : BSD3-style (see LICENSE) -- -- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- 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. ----------------------------------------------------------------------------- module XMonad.Layout.DragPane ( -- * Usage -- $usage dragPane , DragPane, DragType (..) ) where import XMonad import Data.Unique import qualified XMonad.StackSet as W import XMonad.Util.Invisible import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.DragPane -- -- Then edit your @layoutHook@ by adding the DragPane layout: -- -- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". halfHandleWidth :: Integral a => a halfHandleWidth = 1 handleColor :: String handleColor = "#000000" dragPane :: DragType -> Double -> Double -> DragPane a dragPane = DragPane (I Nothing) data DragPane a = DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double deriving ( Show, Read ) data DragType = Horizontal | Vertical deriving ( Show, Read ) instance LayoutClass DragPane a where doLayout d@(DragPane _ Vertical _ _) = doLay id d doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d handleMessage = handleMess data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq) instance Message SetFrac handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a)) handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x | Just e <- fromMessage x :: Maybe Event = do handleEvent d e return Nothing | Just Hide <- fromMessage x = do hideWindow win return $ Just (DragPane mb ty delta split) | Just ReleaseResources <- fromMessage x = do deleteWindow win return $ Just (DragPane (I Nothing) ty delta split) -- 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 = 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 = 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) sendMessage (SetFrac ident frac)) (return ()) handleEvent _ _ = return () doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a)) doLay mirror (DragPane mw ty delta split) r s = do let r' = mirror r (left', right') = splitHorizontallyBy split r' left = case left' of Rectangle x y w h -> mirror $ Rectangle x y (w-halfHandleWidth) h right = case right' of Rectangle x y w h -> mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h handr = case left' of Rectangle x y w h -> mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h wrs = case reverse (W.up s) of (master:_) -> [(master,left),(W.focus s,right)] [] -> case W.down s of (next:_) -> [(W.focus s,left),(next,right)] [] -> [(W.focus s, r)] if length wrs > 1 then case mw of I (Just (w,_,ident)) -> do w' <- deleteWindow w >> newDragWin handr return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) I Nothing -> do w <- newDragWin handr i <- io newUnique return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) else return (wrs, Nothing) newDragWin :: Rectangle -> X Window newDragWin r = do let mask = Just $ exposureMask .|. buttonPressMask w <- createNewWindow r mask handleColor False showWindow w d <- asks display liftIO $ lowerWindow d w return w xmonad-contrib-0.18.0/XMonad/Layout/DraggingVisualizer.hs0000644000000000000000000000411007346545000021510 0ustar0000000000000000{-# 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.DraggingVisualizer ( draggingVisualizer, DraggingVisualizerMsg (..), DraggingVisualizer, ) where import XMonad import XMonad.Layout.LayoutModifier 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 Eq instance Message DraggingVisualizerMsg instance LayoutModifier DraggingVisualizer Window where modifierDescription (DraggingVisualizer _) = "DraggingVisualizer" pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs = if draggedWin `elem` map fst wrs then (dragged : rest, Nothing) else (wrs, Just $ DraggingVisualizer Nothing) where rest = filter (\(w, _) -> w /= draggedWin) wrs pureModifier _ _ _ wrs = (wrs, Nothing) pureMess (DraggingVisualizer _) m = case fromMessage m of Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect) Just DraggingStopped -> Just $ DraggingVisualizer Nothing _ -> Nothing xmonad-contrib-0.18.0/XMonad/Layout/Drawer.hs0000644000000000000000000001236407346545000017146 0ustar0000000000000000{-# 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) -- -- Maintainer : max.rabkin@gmail.com -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.Drawer ( -- * Usage -- $usage -- * Drawers simpleDrawer , drawer -- * Placing drawers -- The drawer can be placed on any side of the screen with these functions , onLeft, onTop, onRight, onBottom , module XMonad.Util.WindowProperties , Drawer, Reflected ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties import XMonad.StackSet as S import XMonad.Layout.Reflect -- $usage -- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Layout.Drawer -- -- > myLayout = drawer `onTop` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... -- > where -- > drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat") -- > -- > main = xmonad def { layoutHook = myLayout } -- -- This will place the Rhythmbox and Xchat windows in at the top of the screen -- only when using the 'Tall' layout. See "XMonad.Util.WindowProperties" for -- more information on selecting windows. data Drawer l a = Drawer Rational Rational Property (l a) deriving (Read, Show) -- | filter : filterM :: partition : partitionM partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) partitionM _ [] = return ([], []) partitionM f (x:xs) = do b <- f x (ys, zs) <- partitionM f xs return $ if b then (x:ys, zs) else (ys, x:zs) instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where 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 (upD, upM) <- partitionM (hasProperty p) up_ (downD, downM) <- partitionM (hasProperty p) down_ b <- hasProperty p w focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset) let rectD = if b && Just w == focusedWindow then rectB else rectS let (stackD, stackM) = if b then ( Just $ stk { up=upD, down=downD } , mkStack upM downM ) else ( mkStack upD downD , Just $ stk { up=upM, down=downM } ) (winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD (winsM, u') <- runLayout (ws { stack=stackM }) rectM return (winsD ++ winsM, u') where mkStack [] [] = Nothing mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys }) 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)) } rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs) , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) } type Reflected l = ModifiedLayout Reflect l -- | Construct a drawer with a simple layout of the windows inside simpleDrawer :: 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 -> Drawer Tall a simpleDrawer rs rb p = Drawer rs rb p vertical where vertical = Tall 0 0 0 -- Export a synonym for the constructor as a Haddock workaround -- | Construct a drawer with an arbitrary layout for windows inside 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 -> Drawer l a drawer = Drawer onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a onLeft = ModifiedLayout onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a onRight d = reflectHoriz . onLeft d . reflectHoriz onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a onTop d = Mirror . onLeft d . Mirror onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a onBottom d = reflectVert . onTop d . reflectVert xmonad-contrib-0.18.0/XMonad/Layout/Dwindle.hs0000644000000000000000000002106207346545000017303 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Dwindle -- Description : Various spirally layouts. -- Copyright : (c) Norbert Zeh -- License : BSD3 -- -- Maintainer : Norbert Zeh -- Stability : experimental -- Portability : portable -- -- Three layouts: The first, 'Spiral', is a reimplementation of -- 'XMonad.Layout.Spiral.spiral' with, at least to me, more intuitive semantics. -- The second, 'Dwindle', is inspired by a similar layout in awesome and -- produces the same sequence of decreasing window sizes as Spiral but pushes -- the smallest windows into a screen corner rather than the centre. The third, -- 'Squeeze' arranges all windows in one row or in one column, with -- geometrically decreasing sizes. -- ----------------------------------------------------------------------------- module XMonad.Layout.Dwindle ( -- * Usage -- $usage Dwindle(..) , Direction2D(..) , Chirality(..) ) where import XMonad.Prelude ( unfoldr ) import XMonad import XMonad.StackSet ( integrate, Stack ) import XMonad.Util.Types ( Direction2D(..) ) -- $usage -- This module can be used as follows: -- -- > import XMonad.Layout.Dwindle -- -- Then add something like this to your layouts: -- -- > Dwindle R CW 1.5 1.1 -- -- or -- -- > Spiral L CW 1.5 1.1 -- -- or -- -- ^ Squeeze D 1.5 1.1 -- -- The first produces a layout that places the second window to the right of -- the first, the third below the second, the fourth to the right of the third, -- and so on. The first window is 1.5 times as wide as the second one, the -- second is 1.5 times as tall as the third one, and so on. Thus, the further -- down the window stack a window is, the smaller it is and the more it is -- pushed into the bottom-right corner. -- -- The second produces a layout with the same window sizes but places the second -- window to the left of the first one, the third above the second one, the -- fourth to the right of the third one, and so on. -- -- The third produces a layout that stacks windows vertically top-down with each -- window being 1.5 times as tall as the next. -- -- In all three cases, the fourth (third, in the case of 'Squeeze') parameter, -- 1.1, is the factor by which the third parameter increases or decreases in -- response to Expand or Shrink messages. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Layouts with geometrically decreasing window sizes. 'Spiral' and 'Dwindle' -- split the screen into a rectangle for the first window and a rectangle for -- the remaining windows, which is split recursively to lay out these windows. -- Both layouts alternate between horizontal and vertical splits. -- -- In each recursive step, the split 'Direction2D' determines the placement of the -- remaining windows relative to the current window: to the left, to the right, -- above or below. The split direction of the first split is determined by the -- first layout parameter. The split direction of the second step is rotated 90 -- degrees relative to the first split direction according to the second layout -- parameter of type 'Chirality'. So, if the first split is 'R' and the second -- layout parameter is 'CW', then the second split is 'D'. -- -- For the 'Spiral' layout, the same 'Chirality' is used for computing the split -- direction of each step from the split direction of the previous step. For -- example, parameters 'R' and 'CW' produces the direction sequence 'R', 'D', -- 'L', 'U', 'R', 'D', 'L', 'U', ... -- -- For the 'Dwindle' layout, the 'Chirality' alternates between 'CW' and 'CCW' in -- each step. For example, parameters 'U' and 'CCW' produce the direction -- sequence 'U', 'L', 'U', 'L', ... because 'L' is the 'CCW' rotation of 'U' and -- 'U' is the 'CW' rotation of 'L'. -- -- In each split, the current rectangle is split so that the ratio between the -- size of the rectangle allocated to the current window and the size of the -- rectangle allocated to the remaining windows is the third layout parameter. -- This ratio can be altered using 'Expand' and 'Shrink' messages. The former -- multiplies the ratio by the fourth layout parameter. The latter divides the -- ratio by this parameter. -- -- 'Squeeze' does not alternate between horizontal and vertical splits and -- simply splits in the direction given as its first argument. -- -- Parameters for both 'Dwindle' and 'Spiral': -- -- * First split direction -- -- * First split chirality -- -- * 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' -- messages -- -- The parameters for 'Squeeze' are the same, except that there is no 'Chirality' -- parameter. data Dwindle a = Dwindle !Direction2D !Chirality !Rational !Rational | Spiral !Direction2D !Chirality !Rational !Rational | Squeeze !Direction2D !Rational !Rational deriving (Read, Show) -- | Rotation between consecutive split directions data Chirality = CW | CCW deriving (Read, Show) instance LayoutClass Dwindle a where pureLayout (Dwindle dir rot ratio _) = dwindle alternate dir rot ratio pureLayout (Spiral dir rot ratio _) = dwindle rotate dir rot ratio pureLayout (Squeeze dir ratio _) = squeeze dir ratio pureMessage (Dwindle dir rot ratio delta) = fmap (\ratio' -> Dwindle dir rot ratio' delta) . changeRatio ratio delta pureMessage (Spiral dir rot ratio delta) = fmap (\ratio' -> Spiral dir rot ratio' delta) . changeRatio ratio delta pureMessage (Squeeze dir ratio delta) = fmap (\ratio' -> Squeeze dir ratio' delta) . changeRatio ratio delta changeRatio :: Rational -> Rational -> SomeMessage -> Maybe Rational changeRatio ratio delta = fmap f . fromMessage where f Expand = ratio * delta f Shrink = ratio / delta 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 (r', r'') = splitRect r ratio a (a', rt') = trans a rt squeeze :: Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)] squeeze dir ratio rect st = zip wins rects where wins = integrate st nwins = length wins sizes = take nwins $ unfoldr (\r -> Just (r * ratio, r * ratio)) 1 totals' = 0 : zipWith (+) sizes totals' totals = drop 1 totals' splits = zip (drop 1 sizes) totals ratios = reverse $ map (uncurry (/)) splits rects = genRects rect ratios genRects r [] = [r] genRects r (x:xs) = r' : genRects r'' xs where (r', r'') = splitRect r x (dirAxes dir) splitRect :: Rectangle -> Rational -> Axes -> (Rectangle, Rectangle) splitRect (Rectangle x y w h) ratio (ax, ay) = (Rectangle x' y' w' h', Rectangle x'' y'' w'' h'') where portion = ratio / (ratio + 1) w1 = (round $ fi w * portion) :: Int w2 = fi w - w1 h1 = (round $ fi h * portion) :: Int h2 = fi h - h1 x' = x + fi (negate ax * (1 - ax) * w2 `div` 2) y' = y + fi (negate ay * (1 - ay) * h2 `div` 2) w' = fi $ w1 + (1 - abs ax) * w2 h' = fi $ h1 + (1 - abs ay) * h2 x'' = x + fi (ax * (1 + ax) * w1 `div` 2) y'' = y + fi (ay * (1 + ay) * h1 `div` 2) w'' = fi $ w2 + (1 - abs ax) * w1 h'' = fi $ h2 + (1 - abs ay) * h1 fi :: (Num b, Integral a) => a -> b fi = fromIntegral type Axes = (Int, Int) type AxesGenerator = Axes -> Chirality -> (Axes, Chirality) dirAxes :: Direction2D -> Axes dirAxes L = (-1, 0) dirAxes R = ( 1, 0) dirAxes U = ( 0, -1) dirAxes D = ( 0, 1) alternate :: AxesGenerator alternate = chDir alt rotate :: AxesGenerator rotate = chDir id chDir :: (Chirality -> Chirality) -> AxesGenerator chDir f (x, y) r = (a' r, r') where a' CW = (-y, x) a' CCW = ( y, -x) r' = f r alt :: Chirality -> Chirality alt CW = CCW alt CCW = CW xmonad-contrib-0.18.0/XMonad/Layout/DwmStyle.hs0000644000000000000000000000463707346545000017476 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier for decorating windows in a dwm like style. ----------------------------------------------------------------------------- module XMonad.Layout.DwmStyle ( -- * Usage: -- $usage dwmStyle , Theme (..) , def , DwmStyle (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) ) where import XMonad import XMonad.StackSet ( Stack (..) ) import XMonad.Layout.Decoration -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.DwmStyle -- -- Then edit your @layoutHook@ by adding the DwmStyle decoration to -- your layout: -- -- > myL = dwmStyle shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. -- -- > myDWConfig = def { inactiveBorderColor = "red" -- > , inactiveTextColor = "red"} -- -- and -- -- > myL = dwmStyle shrinkText myDWConfig (layoutHook def) -- -- A complete xmonad.hs file for this would therefore be: -- -- > import XMonad -- > import XMonad.Layout.DwmStyle -- > -- > main = xmonad def { -- > layoutHook = dwmStyle shrinkText def (layoutHook def) -- > } -- -- | Add simple old dwm-style decorations to windows of a layout. dwmStyle :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration DwmStyle s) l a dwmStyle s c = decoration s c Dwm data DwmStyle a = Dwm deriving (Show, Read) instance Eq a => DecorationStyle DwmStyle a where describeDeco _ = "DwmStyle" shrink _ _ r = r pureDecoration _ wh ht _ s@(Stack fw _ _) _ (w,Rectangle x y wid _) = if w == fw || not (isInStack s w) then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) where nwh = min wid $ fi wh nx = fi x + wid - nwh xmonad-contrib-0.18.0/XMonad/Layout/FixedAspectRatio.hs0000644000000000000000000001404007346545000021111 0ustar0000000000000000{-# 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 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Yecine Megdiche -- Stability : unstable -- Portability : unportable -- -- Layout modifier for user provided per-window aspect ratios. -- ----------------------------------------------------------------------------- module XMonad.Layout.FixedAspectRatio ( -- * Usage -- $usage fixedAspectRatio , FixedAspectRatio , ManageAspectRatio(..) , doFixAspect ) where import Control.Arrow import qualified Data.Map as M import Data.Ratio import XMonad import XMonad.Actions.MessageFeedback import XMonad.Layout.Decoration import XMonad.Layout.LayoutHints -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.FixedAspectRatio -- Then add it to your layout: -- -- > myLayout = fixedAspectRatio (0.5, 0.5) $ Tall 1 (3/100) (1/2) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- Which will center the (eventually) shrinked windows in their assigned -- rectangle. -- -- For a layout modifier that automatically sets the aspect ratio -- depending on the size hints (for example for programs like mpv), -- see "XMonad.Layout.LayoutHints" -- -- See and -- "XMonad.Doc.Extending#Editing_the_layout_hook" for more info on the 'layoutHook'. -- -- You also want to add keybindings to set and clear the aspect ratio: -- -- > -- Set the aspect ratio of the focused window to 16:9 -- > ,((modm, xK_a), withFocused $ sendMessage . FixRatio (16 / 9)) -- > -- > -- Clear the aspect ratio from the focused window -- > ,((modm .|. shiftMask, xK_a), withFocused $ sendMessage . ResetRatio) -- -- There's one caveat: to keep the usage of the modifier simple, it -- doesn't remove a window from its cache automatically. Which means -- that if you close a program window that has some fixed aspect ratios -- and relaunch it, sometimes it'll still have the fixed aspect ratio. -- You can try to avoid this by changing they keybinding used to kill -- the window: -- -- > , ((modMask .|. shiftMask, xK_c), withFocused (sendMessage . ResetRatio) >> kill) -- -- See 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 and -- "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on -- customizing the manage hook. -- | Similar to 'layoutHintsWithReplacement', but relies on the user to -- provide the ratio for each window. @aspectRatio (rx, ry) layout@ will -- adapt the sizes of a layout's windows according to the provided aspect -- ratio, and position them inside their originally assigned area -- according to the @rx@ and @ry@ parameters. -- (0, 0) places the window at the top left, (1, 0) at the top right, -- (0.5, 0.5) at the center, etc. fixedAspectRatio :: (Double, Double) -> l a -> ModifiedLayout FixedAspectRatio l a fixedAspectRatio = ModifiedLayout . FixedAspectRatio mempty data FixedAspectRatio a = FixedAspectRatio (M.Map Window Rational) (Double, Double) deriving (Read, Show) instance LayoutModifier FixedAspectRatio Window where -- | Note: this resembles redoLayout from "XMonad.Layout.LayoutHints". -- The only difference is relying on user defined aspect ratios, and -- using the 'adj' function defined below instead of 'mkAdjust' pureModifier (FixedAspectRatio ratios placement) _ (Just s) xs = (xs', Nothing) where xs' = map (\x@(_, r) -> second (placeRectangle placement r) $ applyHint x) xs applyHint (win, r@(Rectangle x y w h)) = let ar = M.lookup win ratios (w', h') = maybe (w, h) (adj (w, h)) ar in (win, if isInStack s win then Rectangle x y w' h' else r) pureModifier _ _ _ xs = (xs, Nothing) handleMess (FixedAspectRatio ratios placement) mess | Just DestroyWindowEvent { ev_window = w } <- fromMessage mess = return . Just $ FixedAspectRatio (deleted w) placement | otherwise = case fromMessage mess of Just (FixRatio r w) -> return . Just $ FixedAspectRatio (inserted w r) placement Just (ResetRatio w) -> return . Just $ FixedAspectRatio (deleted w) placement Just (ToggleRatio r w) -> return . Just . flip FixedAspectRatio placement . maybe (inserted w r) (const $ deleted w) $ M.lookup w ratios _ -> return Nothing where inserted w r = M.insert w r ratios deleted w = M.delete w ratios -- | A 'ManageHook' to set the aspect ratio for newly spawned windows doFixAspect :: Rational -- ^ The aspect ratio -> ManageHook doFixAspect r = ask >>= \w -> liftX (sendMessageWithNoRefreshToCurrent (FixRatio r w)) >> mempty -- | Calculates the new width and height so they respect the -- aspect ratio. adj :: (Dimension, Dimension) -> Rational -> (Dimension, Dimension) adj (w, h) ar | ar' > ar = (ceiling $ fi h * ar, h) | otherwise = (w, ceiling $ fi w / ar) where ar' = fi w % fi h --- Message handling data ManageAspectRatio = FixRatio Rational Window -- ^ Set the aspect ratio for the window | ResetRatio Window -- ^ Remove the aspect ratio for the window | ToggleRatio Rational Window -- ^ Toggle the reatio deriving Typeable instance Message ManageAspectRatio xmonad-contrib-0.18.0/XMonad/Layout/FixedColumn.hs0000644000000000000000000000657307346545000020144 0ustar0000000000000000{-# 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 -- License : BSD3-style (as xmonad) -- -- Maintainer : Justin Bogner -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.FixedColumn ( -- * Usage -- $usage FixedColumn(..) ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.FixedColumn -- -- Then edit your @layoutHook@ by adding the FixedColumn layout: -- -- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A tiling mode based on preserving a nice fixed width -- window. Supports 'Shrink', 'Expand' and 'IncMasterN'. data FixedColumn a = FixedColumn !Int -- Number of windows in the master pane !Int -- Number to increment by when resizing !Int -- Default width of master pane !Int -- Column width for normal windows deriving (Read, Show) instance LayoutClass FixedColumn Window where doLayout (FixedColumn nmaster _ ncol fallback) r s = do 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) where ws = W.integrate s x // y = fromIntegral x / fromIntegral y pureMessage (FixedColumn nmaster delta ncol fallback) m = msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = FixedColumn nmaster delta (max 0 $ ncol - delta) fallback resize Expand = FixedColumn nmaster delta (ncol + delta) fallback incmastern (IncMasterN d) = FixedColumn (max 0 (nmaster+d)) delta ncol fallback description _ = "FixedColumn" -- | Determine the width of @w@ given that we would like it to be @n@ -- columns wide, using @inc@ as a resize increment for windows that -- don't have one widthCols :: Int -> Int -> Window -> X Int widthCols inc n w = do d <- asks display bw <- asks $ fi . borderWidth . config sh <- io $ getWMNormalHints d w let widthHint f = f sh <&> fromIntegral . fst oneCol = fromMaybe inc $ widthHint sh_resize_inc base = fromMaybe 0 $ widthHint sh_base_size return $ 2 * bw + base + n * oneCol xmonad-contrib-0.18.0/XMonad/Layout/FocusTracking.hs0000644000000000000000000000535207346545000020463 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {- | Module : XMonad.Layout.FocusTracking Description : Track focus in the tiled layer. Copyright : (c) 2010 & 2013 Adam Vogt 2011 Willem Vanlint 2018 & 2022 L.S.Leary License : BSD-style (see xmonad/LICENSE) Maintainer : @LSLeary (on github) Stability : unstable Portability : unportable FocusTracking simply holds onto the last true focus it was given and continues to use it as the focus for the transformed layout until it sees another. It can be used to improve the behaviour of a child layout that has not been given the focused window, or equivalently, that of the layout itself when a float has focus. Relevant issues: * * -------------------------------------------------------------------------------- -} module XMonad.Layout.FocusTracking ( -- * Usage -- $usage FocusTracking(..) , focusTracking ) where import XMonad.Prelude import XMonad import XMonad.Layout.LayoutModifier import XMonad.Util.Stack (findZ) import qualified XMonad.StackSet as W -- $usage -- -- To use the module, first import it: -- -- > import XMonad.Layout.FocusTracking -- -- Then, a focus-dependent layout can be made to fall back on the last focus it -- saw, for example: -- -- > main = xmonad def -- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) -- > , ... -- > } -- -- Or in a simpler case: -- -- > main = xmonad def -- > { layoutHook = myTiledLayout ||| focusTracking Full -- > , ... -- > } -- -- | A 'LayoutModifier' that remembers the last focus it saw. newtype FocusTracking a = FocusTracking (Maybe Window) deriving (Read, Show) instance LayoutModifier FocusTracking Window where modifyLayoutWithUpdate (FocusTracking mw) ws@W.Workspace{ W.stack = ms } r = do xCur <- gets (W.peek . W.view (W.tag ws) . windowset) let isF = xCur /= (W.focus <$> ms) -- use the remembered focus point when true focus differs from -- what this (sub)layout is given, which happens e.g. when true -- focus is in floating layer or when another sublayout has focus newStack | isF = (mw >>= \w -> findZ (w==) ms) <|> ms | otherwise = ms newState | isF = mw | otherwise = xCur ran <- runLayout ws{ W.stack = newStack } r return (ran, guard (newState /= mw) $> FocusTracking newState) -- | Transform a layout into one that remembers and uses the last focus it saw. focusTracking :: l a -> ModifiedLayout FocusTracking l a focusTracking = ModifiedLayout (FocusTracking Nothing) xmonad-contrib-0.18.0/XMonad/Layout/Fullscreen.hs0000644000000000000000000002445607346545000020031 0ustar0000000000000000{-# 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) -- -- Maintainer : audunskaugen@gmail.com -- Stability : unstable -- Portability : unportable -- -- Hooks for sending messages about fullscreen windows to layouts, and -- a few example layout modifier that implement fullscreen windows. ----------------------------------------------------------------------------- module XMonad.Layout.Fullscreen ( -- * Usage: -- $usage fullscreenSupport ,fullscreenSupportBorder ,fullscreenFull ,fullscreenFocus ,fullscreenFullRect ,fullscreenFocusRect ,fullscreenFloat ,fullscreenFloatRect ,fullscreenEventHook ,fullscreenManageHook ,fullscreenManageHookWith ,FullscreenMessage(..) -- * Types for reference ,FullscreenFloat, FullscreenFocus, FullscreenFull ) 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 qualified Data.Map as M import Control.Arrow (second) -- $usage -- Provides a ManageHook and an EventHook that sends layout messages -- with information about fullscreening windows. This allows layouts -- to make their own decisions about what they should to with a -- window that requests fullscreen. -- -- The module also includes a few layout modifiers as an illustration -- of how such layouts should behave. -- -- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook' -- to your config, i.e. -- -- > xmonad def { handleEventHook = fullscreenEventHook, -- > manageHook = fullscreenManageHook, -- > layoutHook = myLayouts } -- -- Now you can use layouts that respect fullscreen, for example the -- provided 'fullscreenFull': -- -- > myLayouts = fullscreenFull someLayout -- -- | Modifies your config to apply basic fullscreen support -- fullscreen -- windows when they request it. Example usage: -- -- > main = xmonad -- > $ fullscreenSupport -- > $ 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, 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. -- FullscreenChanged is sent to the current layout after one -- of the above have been sent. data FullscreenMessage = AddFullscreen Window | RemoveFullscreen Window | FullscreenChanged instance Message FullscreenMessage data FullscreenFull a = FullscreenFull W.RationalRect [a] deriving (Read, Show) data FullscreenFocus a = FullscreenFocus W.RationalRect [a] deriving (Read, Show) data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool)) deriving (Read, Show) 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 FullscreenChanged -> Just ff _ -> Nothing pureModifier (FullscreenFull frect fulls) rect _ list = (visfulls' ++ rest', Nothing) where (visfulls,rest) = partition (flip elem fulls . fst) list visfulls' = map (second $ const rect') visfulls rest' = if null visfulls' then rest else filter (not . R.supersetOf rect' . snd) rest rect' = scaleRationalRect rect frect instance LayoutModifier FullscreenFocus Window where 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 FullscreenChanged -> Just ff _ -> Nothing 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 rect' = scaleRationalRect rect frect pureModifier _ _ Nothing list = (list, Nothing) instance LayoutModifier FullscreenFloat Window where handleMess (FullscreenFloat frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> do mrect <- M.lookup win . W.floating <$> gets windowset return $ case mrect of Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls Nothing -> Nothing Just (RemoveFullscreen win) -> return $ Just $ FullscreenFloat frect $ M.adjust (second $ const False) win fulls -- Modify the floating member of the stack set directly; this is the hackish part. Just FullscreenChanged -> do st <- get let ws = windowset st flt = W.floating ws flt' = M.intersectionWith doFull fulls flt put st {windowset = ws {W.floating = M.union flt' flt}} return $ Just $ FullscreenFloat frect $ M.filter snd fulls where doFull (_, True) _ = frect doFull (rect, False) _ = rect Nothing -> return Nothing -- | Layout modifier that makes fullscreened window fill the -- entire screen. fullscreenFull :: LayoutClass l a => l a -> ModifiedLayout FullscreenFull l a fullscreenFull = fullscreenFullRect $ W.RationalRect 0 0 1 1 -- | As above, but the fullscreened window will fill the -- specified rectangle instead of the entire screen. fullscreenFullRect :: LayoutClass l a => W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a fullscreenFullRect r = ModifiedLayout $ FullscreenFull r [] -- | Layout modifier that makes the fullscreened window fill -- the entire screen only if it is currently focused. fullscreenFocus :: LayoutClass l a => l a -> ModifiedLayout FullscreenFocus l a fullscreenFocus = fullscreenFocusRect $ W.RationalRect 0 0 1 1 -- | As above, but the fullscreened window will fill the -- specified rectangle instead of the entire screen. fullscreenFocusRect :: LayoutClass l a => W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a fullscreenFocusRect r = ModifiedLayout $ FullscreenFocus r [] -- | Hackish layout modifier that makes floating fullscreened -- windows fill the entire screen. fullscreenFloat :: LayoutClass l a => l a -> ModifiedLayout FullscreenFloat l a fullscreenFloat = fullscreenFloatRect $ W.RationalRect 0 0 1 1 -- | As above, but the fullscreened window will fill the -- specified rectangle instead of the entire screen. fullscreenFloatRect :: LayoutClass l a => W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a fullscreenFloatRect r = ModifiedLayout $ FullscreenFloat r M.empty -- | The event hook required for the layout modifiers to work fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do wmstate <- getAtom "_NET_WM_STATE" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" wstate <- fromMaybe [] <$> getProp32 wmstate win let isFull = fi fullsc `elem` wstate remove = 0 add = 1 toggle = 2 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:) broadcastMessage $ AddFullscreen win sendMessage FullscreenChanged when (action == remove || (action == toggle && isFull)) $ do chWState $ delete (fi fullsc) broadcastMessage $ RemoveFullscreen win sendMessage FullscreenChanged return $ All True 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 <$> gets windowset sendMessageWithNoRefresh FullscreenChanged cw return $ All True fullscreenEventHook _ = return $ All True -- | Manage hook that sets the fullscreen property for -- windows that are initially fullscreen fullscreenManageHook :: ManageHook fullscreenManageHook = fullscreenManageHook' isFullscreen -- | A version of fullscreenManageHook that lets you specify -- your own query to decide whether a window should be fullscreen. fullscreenManageHookWith :: Query Bool -> ManageHook fullscreenManageHookWith h = fullscreenManageHook' $ isFullscreen <||> h fullscreenManageHook' :: Query Bool -> ManageHook fullscreenManageHook' isFull = isFull --> do w <- ask liftX $ do broadcastMessage $ AddFullscreen w cw <- W.workspace . W.current <$> gets windowset sendMessageWithNoRefresh FullscreenChanged cw idHook -- | Applies a pair of predicates to a pair of operands, combining them with ||. orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool orP f g (x, y) = f x || g y xmonad-contrib-0.18.0/XMonad/Layout/Gaps.hs0000644000000000000000000002043507346545000016612 0ustar0000000000000000{-# 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 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- 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. -- -- Note 1: For gaps\/space around /windows/ see "XMonad.Layout.Spacing". -- -- Note 2: "XMonad.Hooks.ManageDocks" is the preferred solution for -- leaving space for your dock-type applications (status bars, -- toolbars, docks, etc.), since it automatically sets up appropriate -- gaps, allows them to be toggled, etc. However, this module may -- still be useful in some situations where the automated approach of -- ManageDocks does not work; for example, to work with a dock-type -- application that does not properly set the STRUTS property, or to -- leave part of the screen blank which is truncated by a projector, -- and so on. ----------------------------------------------------------------------------- module XMonad.Layout.Gaps ( -- * Usage -- $usage Direction2D(..), Gaps, GapSpec, gaps, gaps', GapMessage(..), 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(..)) -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.Gaps -- -- and applying the 'gaps' modifier to your layouts as follows (for -- example): -- -- > layoutHook = gaps [(U,18), (R,23)] $ Tall 1 (3/100) (1/2) ||| Full -- leave gaps at the top and right -- -- You can additionally add some keybindings to toggle or modify the gaps, -- for example: -- -- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps -- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap -- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap -- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap -- > , ((modm .|. controlMask, xK_r), sendMessage $ ModifyGaps rotateGaps) -- rotate gaps 90 degrees clockwise -- > , ((modm .|. controlMask, xK_h), sendMessage $ weakModifyGaps halveHor) -- halve the left and right-hand gaps -- > , ((modm .|. controlMask, xK_d), sendMessage $ modifyGap (*2) L) -- double the left-hand gap -- > , ((modm .|. controlMask, xK_s), sendMessage $ setGaps [(U,18), (R,23)]) -- reset the GapSpec -- > , ((modm .|. controlMask, xK_b), sendMessage $ setGap 30 D) -- set the bottom gap to 30 -- > ] -- > where rotateGaps gs = zip (map (rotate . fst) gs) (map snd gs) -- > rotate U = R -- > rotate R = D -- > rotate D = L -- > rotate L = U -- > halveHor d i | d `elem` [L, R] = i `div` 2 -- > | otherwise = i -- -- If you want complete control over all gaps, you could include -- something like this in your keybindings, assuming in this case you -- are using 'XMonad.Util.EZConfig.mkKeymap' or -- 'XMonad.Util.EZConfig.additionalKeysP' from "XMonad.Util.EZConfig" -- for string keybinding specifications: -- -- > ++ -- > [ ("M-g " ++ f ++ " " ++ k, sendMessage $ m d) -- > | (k, d) <- [("a",L), ("s",D), ("w",U), ("d",R)] -- > , (f, m) <- [("v", ToggleGap), ("h", IncGap 10), ("f", DecGap 10)] -- > ] -- -- Given the above keybinding definition, for example, you could type -- @M-g, v, a@ to toggle the top gap. -- -- To configure gaps differently per-screen, use -- "XMonad.Layout.PerScreen" (coming soon). -- -- __Warning__: If you also use the 'avoidStruts' layout modifier, it -- must come /before/ any of these modifiers. See the documentation of -- 'avoidStruts' for details. -- | A manual gap configuration. Each side of the screen on which a -- gap is enabled is paired with a size in pixels. type GapSpec = [(Direction2D,Int)] -- | The gap state. The first component is the configuration (which -- gaps are allowed, and their current size), the second is the gaps -- which are currently active. data Gaps a = Gaps GapSpec [Direction2D] deriving (Show, Read) -- | Messages which can be sent to a gap modifier. data GapMessage = ToggleGaps -- ^ Toggle all gaps. | ToggleGap !Direction2D -- ^ Toggle a single gap. | IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels. | DecGap !Int !Direction2D -- ^ Decrease a gap. | ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily. instance Message GapMessage instance LayoutModifier Gaps a where modifyLayout g w r = runLayout w (applyGaps g r) pureMess (Gaps conf cur) m | Just ToggleGaps <- fromMessage m = Just $ Gaps conf (toggleGaps conf cur) | Just (ToggleGap d) <- fromMessage m = Just $ Gaps conf (toggleGap conf cur d) | Just (IncGap i d) <- fromMessage m = Just $ Gaps (limit . continuation (+ i ) d $ conf) cur | Just (DecGap i d) <- fromMessage m = Just $ Gaps (limit . continuation (+(-i)) d $ conf) cur | Just (ModifyGaps f) <- fromMessage m = Just $ Gaps (limit . f $ conf) cur | otherwise = Nothing -- | Modifies gaps weakly, for convenience. weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage weakModifyGaps = ModifyGaps . weakToStrong -- | Arbitrarily modify a single gap with the given function. modifyGap :: (Int -> Int) -> Direction2D -> GapMessage modifyGap f d = ModifyGaps $ continuation f d -- | Set the GapSpec. setGaps :: GapSpec -> GapMessage setGaps = ModifyGaps . const -- | Set a gap to the given value. setGap :: Int -> Direction2D -> GapMessage setGap = modifyGap . const -- | Imposes limits upon a GapSpec, ensuring gaps are at least 0. Not exposed. limit :: GapSpec -> GapSpec limit = weakToStrong $ \_ -> max 0 -- | Takes a weak gaps-modifying function f and returns a GapSpec modifying -- function. Not exposed. weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec weakToStrong f gs = zip (map fst gs) (map (uncurry f) gs) -- | Given f as a definition for the behaviour of a gaps modifying function in -- one direction d, produces a continuation of the function to the other -- directions using the identity. Not exposed. continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec continuation f d1 = weakToStrong h where h d2 | d2 == d1 = f | otherwise = id applyGaps :: Gaps a -> Rectangle -> Rectangle applyGaps gs r = foldr applyGap r (activeGaps gs) where applyGap (U,z) (Rectangle x y w h) = Rectangle x (y + fi z) w (h - fi z) applyGap (D,z) (Rectangle x y w h) = Rectangle x y w (h - fi z) applyGap (L,z) (Rectangle x y w h) = Rectangle (x + fi z) y (w - fi z) h applyGap (R,z) (Rectangle x y w h) = Rectangle x y (w - fi z) h activeGaps :: Gaps a -> GapSpec activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D] toggleGaps conf [] = map fst conf toggleGaps _ _ = [] toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D] toggleGap conf cur d | d `elem` cur = delete d cur | d `elem` map fst conf = d:cur | otherwise = cur -- | Add togglable manual gaps to a layout. gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes. -> l a -- ^ The layout to modify. -> ModifiedLayout Gaps l a gaps g = ModifiedLayout (Gaps g (map fst g)) -- | Add togglable manual gaps to a layout, explicitly specifying the initial states. gaps' :: [((Direction2D,Int),Bool)] -- ^ The gaps to allow and their initial states. -> l a -- ^ The layout to modify. -> ModifiedLayout Gaps l a gaps' g = ModifiedLayout (Gaps (map fst g) [d | ((d,_),v) <- g, v]) xmonad-contrib-0.18.0/XMonad/Layout/Grid.hs0000644000000000000000000000523507346545000016606 0ustar0000000000000000{-# 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) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A simple layout that attempts to put all windows in a square grid. -- ----------------------------------------------------------------------------- module XMonad.Layout.Grid ( -- * Usage -- $usage Grid(..), arrange, defaultRatio ) where import XMonad import XMonad.StackSet -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Grid -- -- Then edit your @layoutHook@ by adding the Grid layout: -- -- > myLayout = Grid ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- You can also specify an aspect ratio for Grid to strive for with the -- GridRatio constructor. For example, if you want Grid to try to make a grid -- four windows wide and three windows tall, you could use -- -- > myLayout = GridRatio (4/3) ||| etc. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data Grid a = Grid | GridRatio Double deriving (Read, Show) defaultRatio :: Double defaultRatio = 16/9 instance LayoutClass Grid a where pureLayout Grid r = pureLayout (GridRatio defaultRatio) r pureLayout (GridRatio d) r = arrange d r . integrate arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)] arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles where nwins = length st ncols = max 1 . min nwins . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio) mincs = max 1 $ nwins `div` ncols extrs = nwins - ncols * mincs chop :: Int -> Dimension -> [(Position, Dimension)] chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (, k) . drop 1 . reverse . take n . drop 1 . iterate (subtract k') $ m' where k :: Dimension k = m `div` fromIntegral n m' = fromIntegral m k' :: Position k' = fromIntegral k xcoords = chop ncols rw ycoords = chop mincs rh ycoords' = chop (succ mincs) rh (xbase, xext) = splitAt (ncols - extrs) xcoords rectangles = combine ycoords xbase ++ combine ycoords' xext where combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] xmonad-contrib-0.18.0/XMonad/Layout/GridVariants.hs0000644000000000000000000002513707346545000020321 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------- -- | -- Module : XMonad.Layout.GridVariants -- Description : Two grid layouts. -- Copyright : (c) Norbert Zeh -- License : BSD-style (see LICENSE) -- -- Maintainer : nzeh@cs.dal.ca -- Stability : unstable -- Portability : unportable -- -- 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. ---------------------------------------------------------------------- module XMonad.Layout.GridVariants ( -- * Usage -- $usage ChangeMasterGridGeom(..) , ChangeGridGeom(..) , Grid(..) , TallGrid(..) , SplitGrid(..) , Orientation(..) ) where import XMonad.Prelude import XMonad import qualified XMonad.StackSet as W -- $usage -- This module can be used as follows: -- -- > import XMonad.Layout.GridVariants -- -- Then add something like this to your layouts: -- -- > Grid (16/10) -- -- for a 16:10 aspect ratio grid, or -- -- > SplitGrid L 2 3 (2/3) (16/10) (5/100) -- -- for a layout with a 2x3 master grid that uses 2/3 of the screen, -- and a 16:10 aspect ratio slave grid to its right. The last -- parameter is again the percentage by which the split between master -- and slave area changes in response to Expand/Shrink messages. -- -- To be able to change the geometry of the master grid, add something -- like this to your keybindings: -- -- > ((modm .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1), -- > ((modm .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)), -- > ((modm .|. controlMask, xK_equal), sendMessage $ IncMasterRows 1), -- > ((modm .|. controlMask, xK_minus), sendMessage $ IncMasterRows (-1)) -- | Grid layout. The parameter is the desired x:y aspect ratio of windows newtype Grid a = Grid Rational deriving (Read, Show) instance LayoutClass Grid a where pureLayout (Grid aspect) rect st = zip wins rects where wins = W.integrate st nwins = length wins rects = arrangeAspectGrid rect nwins aspect pureMessage layout msg = fmap (changeGridAspect layout) (fromMessage msg) description _ = "Grid" changeGridAspect :: Grid a -> ChangeGridGeom -> Grid a changeGridAspect (Grid _) (SetGridAspect aspect) = Grid aspect changeGridAspect (Grid aspect) (ChangeGridAspect delta) = Grid (max 0.00001 (aspect + delta)) -- |Geometry change messages understood by Grid and SplitGrid data ChangeGridGeom = SetGridAspect !Rational | ChangeGridAspect !Rational instance Message ChangeGridGeom -- |SplitGrid layout. Parameters are -- -- - side where the master is -- - number of master rows -- - number of master columns -- - portion of screen used for master grid -- - x:y aspect ratio of slave windows -- - increment for resize messages data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational deriving (Read, Show) -- |Type to specify the side of the screen that holds -- the master area of a SplitGrid. data Orientation = T | B | L | R deriving (Eq, Read, Show) instance LayoutClass SplitGrid a where pureLayout (SplitGrid o mrows mcols mfrac saspect _) rect st = zip wins rects where wins = W.integrate st nwins = length wins rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect pureMessage layout msg = msum [ fmap (resizeMaster layout) (fromMessage msg) , fmap (changeMasterGrid layout) (fromMessage msg) , fmap (changeSlaveGridAspect layout) (fromMessage msg) ] description _ = "SplitGrid" -- |The geometry change message understood by the master grid data ChangeMasterGridGeom = IncMasterRows !Int -- ^Change the number of master rows | IncMasterCols !Int -- ^Change the number of master columns | 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 instance Message ChangeMasterGridGeom arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle] 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 where mwins = mrows * mcols swins = nwins - mwins mrect = Rectangle mx my mw mh srect = Rectangle sx sy sw sh (mh, sh, mw, sw) = if o `elem` [T, B] then (ceiling (fromIntegral rh * mfrac), rh - mh, rw, rw) else (rh, rh, ceiling (fromIntegral rw * mfrac), rw - mw) mx = fromIntegral rx + if o == R then fromIntegral sw else 0 my = fromIntegral ry + if o == B then fromIntegral sh else 0 sx = fromIntegral rx + if o == L then fromIntegral mw else 0 sy = fromIntegral ry + if o == T then fromIntegral mh else 0 arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle] arrangeMasterGrid rect nwins mcols = arrangeGrid rect nwins (min nwins mcols) arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle] arrangeAspectGrid rect@(Rectangle _ _ rw rh) nwins aspect = arrangeGrid rect nwins (min nwins ncols) where scr_a = fromIntegral rw / fromIntegral rh fcols = sqrt ( fromRational $ scr_a * fromIntegral nwins / aspect ) :: Double cols1 = floor fcols :: Int cols2 = ceiling fcols :: Int rows1 = ceiling ( fromIntegral nwins / fromIntegral cols1 :: Rational ) :: Int rows2 = floor ( fromIntegral nwins / fromIntegral cols2 :: Rational ) :: Int a1 = scr_a * fromIntegral rows1 / fromIntegral cols1 a2 = scr_a * fromIntegral rows2 / fromIntegral cols2 ncols | cols1 == 0 = cols2 | rows2 == 0 = cols1 | a1 / aspect < aspect / a2 = cols1 | otherwise = cols2 arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle] arrangeGrid (Rectangle rx ry rw rh) nwins ncols = [Rectangle (fromIntegral x + rx) (fromIntegral y + ry) (fromIntegral w) (fromIntegral h) | (x, y, w, h) <- rects] where nrows_in_cols = listDifference $ splitEvenly nwins ncols x_slabs = splitIntoSlabs (fromIntegral rw) ncols 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 = concat rects_in_cols splitIntoSlabs :: Int -> Int -> [(Int, Int)] splitIntoSlabs width nslabs = zip (0:xs) widths where xs = splitEvenly width nslabs widths = listDifference xs listDifference :: [Int] -> [Int] listDifference lst = [cur-pre | (cur,pre) <- zip lst (0:lst)] splitEvenly :: Int -> Int -> [Int] splitEvenly n parts = [ sz-off | (sz,off) <- zip sizes offsets] where size = ceiling ( (fromIntegral n / fromIntegral parts) :: Double ) extra = size*parts - n sizes = [i*size | i <- [1..parts]] offsets = take (fromIntegral extra) [1..] ++ [extra,extra..] resizeMaster :: SplitGrid a -> Resize -> SplitGrid a resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink = SplitGrid o mrows mcols (max 0 (mfrac - delta)) saspect delta resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand = SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta changeMasterGrid :: SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) = SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) = SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta changeMasterGrid (SplitGrid o _ mcols mfrac saspect delta) (SetMasterRows mrows) = SplitGrid o (max 0 mrows) mcols mfrac saspect delta changeMasterGrid (SplitGrid o mrows _ mfrac saspect delta) (SetMasterCols mcols) = SplitGrid o mrows (max 0 mcols) mfrac saspect delta changeMasterGrid (SplitGrid o mrows mcols _ saspect delta) (SetMasterFraction mfrac) = SplitGrid o mrows mcols mfrac saspect delta changeSlaveGridAspect :: SplitGrid a -> ChangeGridGeom -> SplitGrid a changeSlaveGridAspect (SplitGrid o mrows mcols mfrac _ delta) (SetGridAspect saspect) = SplitGrid o mrows mcols mfrac saspect delta changeSlaveGridAspect (SplitGrid o mrows mcols mfrac saspect delta) (ChangeGridAspect sdelta) = SplitGrid o mrows mcols mfrac (max 0.00001 (saspect + sdelta)) delta -- | TallGrid layout. Parameters are -- -- - number of master rows -- - number of master columns -- - portion of screen used for master grid -- - x:y aspect ratio of slave windows -- - increment for resize messages -- -- This exists mostly because it was introduced in an earlier version. -- It's a fairly thin wrapper around "SplitGrid L". data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational deriving (Read, Show) instance LayoutClass TallGrid a where pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects where wins = W.integrate st nwins = length wins 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) ] description _ = "TallGrid" tallGridAdapter :: (SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a tallGridAdapter f (TallGrid mrows mcols mfrac saspect delta) msg = TallGrid mrows' mcols' mfrac' saspect' delta' where SplitGrid _ mrows' mcols' mfrac' saspect' delta' = f (SplitGrid L mrows mcols mfrac saspect delta) msg xmonad-contrib-0.18.0/XMonad/Layout/Groups.hs0000644000000000000000000005462707346545000017211 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# 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 -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Two-level layout with windows split in individual layout groups, -- themselves managed by a user-provided layout. -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups ( -- * Usage -- $usage -- * Creation group -- * Messages , GroupsMessage(..) , ModifySpec , ModifySpecX -- ** Useful 'ModifySpec's , swapUp , swapDown , swapMaster , focusUp , focusDown , focusMaster , swapGroupUp , swapGroupDown , swapGroupMaster , focusGroupUp , focusGroupDown , focusGroupMaster , moveToGroupUp , moveToGroupDown , moveToNewGroupUp , moveToNewGroupDown , splitGroup -- * Types , Groups , Group(..) , onZipper , onLayout , WithID , sameID ) where import XMonad import XMonad.Prelude hiding (group) import qualified XMonad.StackSet as W import XMonad.Util.Stack import Control.Arrow ((>>>)) -- $usage -- This module provides a layout combinator that allows you -- to manage your windows in independent groups. You can provide -- both the layout with which to arrange the windows inside each -- group, and the layout with which the groups themselves will -- be arranged on the screen. -- -- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii" -- modules contain examples of layouts that can be defined with this -- combinator. They're also the recommended starting point -- if you are a beginner and looking for something you can use easily. -- -- One thing to note is that 'Groups'-based layout have their own -- notion of the order of windows, which is completely separate -- from XMonad's. For this reason, operations like 'XMonad.StackSet.SwapUp' -- will have no visible effect, and those like 'XMonad.StackSet.focusUp' -- will focus the windows in an unpredictable order. For a better way of -- rearranging windows and moving focus in such a layout, see the -- example 'ModifySpec's (to be passed to the 'Modify' message) provided -- by this module. -- -- If you use both 'Groups'-based and other layouts, The "XMonad.Layout.Groups.Helpers" -- module provides actions that can work correctly with both, defined using -- functions from "XMonad.Actions.MessageFeedback". -- | Create a 'Groups' layout. -- -- Note that the second parameter (the layout for arranging the -- groups) is not used on 'Windows', but on 'Group's. For this -- reason, you can only use layouts that don't specifically -- need to manage 'Window's. This is obvious, when you think -- about it. group :: l Window -> l2 (Group l Window) -> Groups l l2 Window group l l2 = Groups l l2 startingGroups (U 1 0) where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ -- * Stuff with unique keys data Uniq = U Integer Integer deriving (Eq, Show, Read) -- | From a seed, generate an infinite list of keys and a new -- seed. All keys generated with this method will be different -- provided you don't use 'gen' again with a key from the list. -- (if you need to do that, see 'split' instead) gen :: Uniq -> (Uniq, Stream Uniq) gen (U i1 i2) = (U (i1+1) i2, fmap (U i1) (fromList [i2..])) -- | Split an infinite list into two. I ended up not -- needing this, but let's keep it just in case. -- split :: [a] -> ([a], [a]) -- split as = snd $ foldr step (True, ([], [])) as -- where step a (True, (as1, as2)) = (False, (a:as1, as2)) -- step a (False, (as1, as2)) = (True, (as1, a:as2)) -- | Add a unique identity to a layout so we can -- follow it around. data WithID l a = ID { getID :: Uniq , unID :: l a} deriving (Show, Read) -- | Compare the ids of two 'WithID' values sameID :: WithID l a -> WithID l a -> Bool sameID (ID id1 _) (ID id2 _) = id1 == id2 instance Eq (WithID l a) where ID id1 _ == ID id2 _ = id1 == id2 instance LayoutClass l a => LayoutClass (WithID l) a where runLayout ws@W.Workspace { W.layout = ID id l } r = 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' description (ID _ l) = description l -- * The 'Groups' layout -- ** Datatypes -- | A group of windows and its layout algorithm. data Group l a = G { gLayout :: WithID l a , gZipper :: Zipper a } deriving (Show, Read, Eq) onLayout :: (WithID l a -> WithID l a) -> Group l a -> Group l a onLayout f g = g { gLayout = f $ gLayout g } onZipper :: (Zipper a -> Zipper a) -> Group l a -> Group l a onZipper f g = g { gZipper = f $ gZipper g } -- | The type of our layouts. data Groups l l2 a = Groups { -- | The starting layout for new groups baseLayout :: l a -- | The layout for placing each group on the screen , partitioner :: l2 (Group l a) -- | The window groups , groups :: W.Stack (Group l a) -- | A seed for generating unique ids , seed :: Uniq } deriving instance (Show a, Show (l a), Show (l2 (Group l a))) => Show (Groups l l2 a) deriving instance (Read a, Read (l a), Read (l2 (Group l a))) => Read (Groups l l2 a) -- | Messages accepted by 'Groups'-based layouts. -- All other messages are forwarded to the layout of the currently -- focused subgroup (as if they had been wrapped in 'ToFocused'). data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosing layout -- (the one that places the groups themselves) | ToGroup Int SomeMessage -- ^ Send a message to the layout for nth group -- (starting at 0) | ToFocused SomeMessage -- ^ Send a message to the layout for the focused -- group | ToAll SomeMessage -- ^ Send a message to all the sub-layouts | Refocus -- ^ Refocus the window which should be focused according -- to the layout. | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing -- of windows according to a 'ModifySpec' | ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad instance Show GroupsMessage where show (ToEnclosing _) = "ToEnclosing {...}" show (ToGroup i _) = "ToGroup "++show i++" {...}" show (ToFocused _) = "ToFocused {...}" show (ToAll _) = "ToAll {...}" show Refocus = "Refocus" show (Modify _) = "Modify {...}" show (ModifyX _) = "ModifyX {...}" instance Message GroupsMessage modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a -> Groups l l2 a modifyGroups f g = let (seed', ident :~ _) = gen (seed g) defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ in g { groups = fromMaybe defaultGroups . f . Just $ groups g , seed = seed' } modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a))) -> Groups l l2 a -> X (Groups l l2 a) modifyGroupsX f g = do let (seed', ident :~ _) = gen (seed g) defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ g' <- f . Just $ groups g return g { groups = fromMaybe defaultGroups g', seed = seed' } -- ** Readaptation -- | Adapt our groups to a new stack. -- This algorithm handles window additions and deletions correctly, -- ignores changes in window ordering, and tries to react to any -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt z g = let mf = getFocusZ z (seed', ident :~ _) = gen $ seed g g' = g { seed = seed' } in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) >>> filterKeepLast (isJust . gZipper) >>> findNewWindows (W.integrate' z) >>> addWindows (ID ident $ baseLayout g) >>> focusGroup mf >>> onFocusedZ (onZipper $ focusWindow mf) where filterKeepLast _ Nothing = Nothing 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_ (`elemZ` z) -- | Identify the windows not already in a group. findNewWindows :: Eq a => [a] -> Zipper (Group l a) -> (Zipper (Group l a), [a]) findNewWindows as gs = (gs, foldrZ_ removePresent as gs) where removePresent g = filter (not . flip elemZ (gZipper g)) -- | Add windows to the focused group. If you need to create one, -- use the given layout and an id from the given list. addWindows :: WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a) addWindows l (Nothing, as) = singletonZ $ G l (W.differentiate as) addWindows _ (z, as) = onFocusedZ (onZipper add) z where add z = foldl (flip insertUpZ) z as -- | Focus the group containing the given window focusGroup :: Eq a => Maybe a -> Zipper (Group l a) -> Zipper (Group l a) focusGroup Nothing = id focusGroup (Just a) = fromTags . map (tagBy $ elemZ a . gZipper) . W.integrate' -- | Focus the given window focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a focusWindow Nothing = id focusWindow (Just a) = fromTags . map (tagBy (==a)) . W.integrate' -- * Interface -- ** Layout instance instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) => LayoutClass (Groups l l2) Window where description (Groups _ p gs _) = s1++" by "++s2 where s1 = description $ gLayout $ W.focus gs s2 = description p runLayout ws@(W.Workspace _ _l z) r = let l = readapt z _l in do (areas, mpart') <- runLayout ws { W.layout = partitioner l , W.stack = Just $ groups l } r results <- forM areas $ \(g, r') -> runLayout ws { W.layout = gLayout g , W.stack = gZipper g } r' let hidden = map gLayout (W.integrate $ groups _l) \\ map (gLayout . fst) areas hidden' <- mapM (flip handleMessage $ SomeMessage Hide) hidden let placements = concatMap fst results newL = justMakeNew l mpart' (map snd results ++ hidden') return (placements, newL) handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm = do mp' <- handleMessage p sm' return $ maybeMakeNew l mp' [] handleMessage l@(Groups _ p gs _) sm | Just (ToAll sm') <- fromMessage sm = do mp' <- handleMessage p sm' mg's <- mapZM_ (handle sm') $ Just gs return $ maybeMakeNew l mp' $ W.integrate' mg's where handle sm (G l _) = handleMessage l sm handleMessage l sm | Just a <- fromMessage sm = let _rightType = a == Hide -- Is there a better-looking way -- of doing this? in handleMessage l $ SomeMessage $ ToAll sm handleMessage l@(Groups _ _ z _) sm = case fromMessage sm of Just (ToFocused sm') -> do mg's <- W.integrate' <$> handleOnFocused sm' z return $ maybeMakeNew l Nothing mg's Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z return $ maybeMakeNew l Nothing mg's Just (Modify spec) -> case applySpec spec l of Just l' -> refocus l' Nothing -> return Nothing Just (ModifyX spec) -> do ml' <- applySpecX spec l whenJust ml' (void . refocus) return (ml' <|> Just l) Just Refocus -> refocus l Just _ -> return Nothing Nothing -> handleMessage l $ SomeMessage (ToFocused sm) where handleOnFocused sm z = mapZM step $ Just z 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 step _ = return Nothing justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] -> Maybe (Groups l l2 a) justMakeNew g mpart' ml's = Just g { partitioner = fromMaybe (partitioner g) mpart' , groups = combine (groups g) ml's } where combine z ml's = let table = map (\(ID id a) -> (id, a)) $ catMaybes ml's in flip mapS_ z $ \(G (ID id l) ws) -> case lookup id table of Nothing -> G (ID id l) ws Just l' -> G (ID id l') ws mapS_ f = fromJust . mapZ_ f . Just maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] -> Maybe (Groups l l2 a) maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window)) refocus g = let mw = (getFocusZ . gZipper . W.focus . groups) g in g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow) -- ** ModifySpec type -- | Type of functions describing modifications to a 'Groups' layout. They -- are transformations on 'Zipper's of groups. -- -- Things you shouldn't do: -- -- * Forge new windows (they will be ignored) -- -- * Duplicate windows (whatever happens is your problem) -- -- * Remove windows (they will be added again) -- -- * Duplicate layouts (only one will be kept, the rest will -- get the base layout) -- -- Note that 'ModifySpec' is a rank-2 type (indicating that 'ModifySpec's must -- be polymorphic in the layout type), so if you define functions taking -- 'ModifySpec's as arguments, or returning them, you'll need to write a type -- signature and add @{-# LANGUAGE Rank2Types #-}@ at the beginning type ModifySpec = forall l. WithID l Window -> Zipper (Group l Window) -> Zipper (Group l Window) -- ** ModifierSpecX type -- | This is the same as 'ModifySpec', but it allows the function to use -- actions inside the 'X' monad. This is useful, for example, if the function -- has to make decisions based on the results of a 'runQuery'. type ModifySpecX = forall l. WithID l Window -> Zipper (Group l Window) -> X (Zipper (Group l Window)) -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g = let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list g' = flip modifyGroups g $ f (ID ident $ baseLayout g) >>> toTags >>> foldr (reID g) ((ids, []), []) >>> snd >>> fromTags in if groups g == groups g' then Nothing else Just g' { seed = seed' } applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window)) applySpecX f g = do let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list g' <- flip modifyGroupsX g $ f (ID ident $ baseLayout g) >>> fmap toTags >>> fmap (foldr (reID g) ((ids, []), [])) >>> fmap snd >>> fmap fromTags return $ if groups g == groups g' then Nothing else Just g' { seed = seed' } reID :: Groups l l2 Window -> Either (Group l Window) (Group l Window) -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)]) -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)]) reID g eg ((ident :~ ids, seen), egs) | myID `elem` seen = ((ids, seen), mapE_ (setID ident) eg:egs) | otherwise = ((ident :~ ids, myID:seen), eg:egs) where myID = getID $ gLayout $ fromE eg setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z -- ** Misc. ModifySpecs -- | helper onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec onFocused f _ = onFocusedZ (onZipper f) -- | Swap the focused window with the previous one. swapUp :: ModifySpec swapUp = onFocused swapUpZ -- | Swap the focused window with the next one. swapDown :: ModifySpec swapDown = onFocused swapDownZ -- | Swap the focused window with the (group's) master -- window. swapMaster :: ModifySpec swapMaster = onFocused swapMasterZ -- | Swap the focused group with the previous one. swapGroupUp :: ModifySpec swapGroupUp _ = swapUpZ -- | Swap the focused group with the next one. swapGroupDown :: ModifySpec swapGroupDown _ = swapDownZ -- | Swap the focused group with the master group. swapGroupMaster :: ModifySpec swapGroupMaster _ = swapMasterZ -- | Move focus to the previous window in the group. focusUp :: ModifySpec focusUp = onFocused focusUpZ -- | Move focus to the next window in the group. focusDown :: ModifySpec focusDown = onFocused focusDownZ -- | Move focus to the group's master window. focusMaster :: ModifySpec focusMaster = onFocused focusMasterZ -- | Move focus to the previous group. focusGroupUp :: ModifySpec focusGroupUp _ = focusUpZ -- | Move focus to the next group. focusGroupDown :: ModifySpec focusGroupDown _ = focusDownZ -- | Move focus to the master group. focusGroupMaster :: ModifySpec focusGroupMaster _ = focusMasterZ -- | helper _removeFocused :: W.Stack a -> (a, Zipper a) _removeFocused (W.Stack f (u:up) down) = (f, Just $ W.Stack u up down) _removeFocused (W.Stack f [] (d:down)) = (f, Just $ W.Stack d [] down) _removeFocused (W.Stack f [] []) = (f, Nothing) -- helper _moveToNewGroup :: WithID l Window -> W.Stack (Group l Window) -> (Group l Window -> Zipper (Group l Window) -> Zipper (Group l Window)) -> Zipper (Group l Window) _moveToNewGroup l0 s insertX | G l (Just f) <- W.focus s = let (w, f') = _removeFocused f s' = s { W.focus = G l f' } in insertX (G l0 $ singletonZ w) $ Just s' _moveToNewGroup _ s _ = Just s -- | Move the focused window to a new group before the current one. moveToNewGroupUp :: ModifySpec moveToNewGroupUp _ Nothing = Nothing moveToNewGroupUp l0 (Just s) = _moveToNewGroup l0 s insertUpZ -- | Move the focused window to a new group after the current one. moveToNewGroupDown :: ModifySpec moveToNewGroupDown _ Nothing = Nothing moveToNewGroupDown l0 (Just s) = _moveToNewGroup l0 s insertDownZ -- | Move the focused window to the previous group. -- If 'True', when in the first group, wrap around to the last one. -- If 'False', create a new group before it. moveToGroupUp :: Bool -> ModifySpec moveToGroupUp _ _ Nothing = Nothing moveToGroupUp False l0 (Just s) = if null (W.up s) then moveToNewGroupUp l0 (Just s) else moveToGroupUp True l0 (Just s) moveToGroupUp True _ (Just s@(W.Stack _ [] [])) = Just s moveToGroupUp True _ (Just s@(W.Stack (G l (Just f)) _ _)) = let (w, f') = _removeFocused f in onFocusedZ (onZipper $ insertUpZ w) $ focusUpZ $ Just s { W.focus = G l f' } moveToGroupUp True _ gs = gs -- | Move the focused window to the next group. -- If 'True', when in the last group, wrap around to the first one. -- If 'False', create a new group after it. moveToGroupDown :: Bool -> ModifySpec moveToGroupDown _ _ Nothing = Nothing moveToGroupDown False l0 (Just s) = if null (W.down s) then moveToNewGroupDown l0 (Just s) else moveToGroupDown True l0 (Just s) moveToGroupDown True _ (Just s@(W.Stack _ [] [])) = Just s moveToGroupDown True _ (Just s@(W.Stack (G l (Just f)) _ _)) = let (w, f') = _removeFocused f in onFocusedZ (onZipper $ insertUpZ w) $ focusDownZ $ Just s { W.focus = G l f' } moveToGroupDown True _ gs = gs -- | Split the focused group into two at the position of the focused window (below it, -- unless it's the last window - in that case, above it). splitGroup :: ModifySpec splitGroup _ Nothing = Nothing splitGroup l0 z@(Just s) | G l (Just ws) <- W.focus s = case ws of W.Stack _ [] [] -> z W.Stack f (u:up) [] -> let g1 = G l $ Just $ W.Stack f [] [] g2 = G l0 $ Just $ W.Stack u up [] in insertDownZ g1 $ onFocusedZ (const g2) z W.Stack f up (d:down) -> let g1 = G l $ Just $ W.Stack f up [] g2 = G l0 $ Just $ W.Stack d [] down in insertUpZ g1 $ onFocusedZ (const g2) z splitGroup _ _ = Nothing xmonad-contrib-0.18.0/XMonad/Layout/Groups/0000755000000000000000000000000007346545000016637 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Layout/Groups/Examples.hs0000644000000000000000000002110607346545000020751 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups.Examples -- Description : Example layouts for "XMonad.Layout.Groups". -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Example layouts for "XMonad.Layout.Groups". -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups.Examples ( -- * Usage -- $usage -- * Example: Row of columns -- $example1 rowOfColumns , zoomColumnIn , zoomColumnOut , zoomColumnReset , toggleColumnFull , zoomWindowIn , zoomWindowOut , zoomWindowReset , toggleWindowFull -- * Example: Tiled tab groups -- $example2 , tallTabs , mirrorTallTabs , fullTabs , TiledTabsConfig(..) , def , increaseNMasterGroups , decreaseNMasterGroups , shrinkMasterGroups , expandMasterGroups , nextOuterLayout -- * Useful re-exports and utils , module XMonad.Layout.Groups.Helpers , shrinkText , GroupEQ(..) , zoomRowG ) where import XMonad import qualified XMonad.Layout.Groups as G import XMonad.Layout.Groups.Helpers import XMonad.Layout.ZoomRow import XMonad.Layout.Tabbed import XMonad.Layout.Renamed import XMonad.Layout.Decoration import XMonad.Layout.Simplest -- $usage -- This module contains example 'G.Groups'-based layouts. -- You can either import this module directly, or look at its source -- for ideas of how "XMonad.Layout.Groups" may be used. -- -- You can use the contents of this module by adding -- -- > import XMonad.Layout.Groups.Examples -- -- to the top of your @xmonad.hs@. -- -- For more information on using any of the layouts, jump directly -- to its \"Example\" section. -- -- Whichever layout you choose to use, you will probably want to be -- able to move focus and windows between groups in a consistent -- manner. For this, you should take a look at the functions from -- the "XMonad.Layout.Groups.Helpers" module, which are all -- re-exported by this module. -- -- For more information on how to extend your layoutHook and key bindings, see -- and "XMonad.Doc.Extending". -- * Helper: ZoomRow of Group elements -- | Compare two 'Group's by comparing the ids of their layouts. data GroupEQ a = GroupEQ deriving (Show, Read) instance Eq a => EQF GroupEQ (G.Group l a) where eq _ (G.G l1 _) (G.G l2 _) = G.sameID l1 l2 zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a)) => ZoomRow GroupEQ (G.Group l a) zoomRowG = zoomRowWith GroupEQ -- * Example 1: Row of columns -- $example1 -- A layout that arranges windows in a row of columns. It uses 'ZoomRow's for -- both, allowing you to: -- -- * Freely change the proportion of the screen width allocated to each column -- -- * Freely change the proportion of a column's heigth allocated to each of its windows -- -- * Set a column to occupy the whole screen space whenever it has focus -- -- * Set a window to occupy its whole column whenever it has focus -- -- to use this layout, add 'rowOfColumns' to your layout hook, for example: -- -- > myLayout = rowOfColumns -- -- To be able to change the sizes of columns and windows, you can create key bindings -- for the relevant actions: -- -- > ((modMask, xK_minus), zoomWindowOut) -- -- and so on. rowOfColumns = G.group column zoomRowG where column = renamed [CutWordsLeft 2, PrependWords "ZoomColumn"] $ Mirror zoomRow -- | Increase the width of the focused column zoomColumnIn :: X () zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage zoomIn -- | Decrease the width of the focused column zoomColumnOut :: X () zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage zoomOut -- | Reset the width of the focused column zoomColumnReset :: X () 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 -- | Increase the heigth of the focused window zoomWindowIn :: X () zoomWindowIn = sendMessage zoomIn -- | Decrease the height of the focused window zoomWindowOut :: X () zoomWindowOut = sendMessage zoomOut -- | Reset the height of the focused window zoomWindowReset :: X () zoomWindowReset = sendMessage zoomReset -- | Toggle whether the currently focused window should -- take up the whole column whenever it has focus toggleWindowFull :: X () toggleWindowFull = sendMessage ZoomFullToggle -- * Example 2: Tabbed groups in a Tall/Full layout. -- $example2 -- A layout which arranges windows into tabbed groups, and the groups -- themselves according to XMonad's default algorithm -- (@'Tall' ||| 'Mirror' 'Tall' ||| 'Full'@). As their names -- indicate, 'tallTabs' starts as 'Tall', 'mirrorTallTabs' starts -- as 'Mirror' 'Tall' and 'fullTabs' starts as 'Full', but in any -- case you can freely switch between the three afterwards. -- -- You can use any of these three layouts by including it in your layout hook. -- You will need to provide it with a 'TiledTabsConfig' containing the size -- parameters for 'Tall' and 'Mirror' 'Tall', and the shrinker and decoration theme -- for the tabs. If you're happy with defaults, you can use 'def': -- -- > myLayout = tallTabs def -- -- To be able to increase\/decrease the number of master groups and shrink\/expand -- the master area, you can create key bindings for the relevant actions: -- -- > ((modMask, xK_h), shrinkMasterGroups) -- -- and so on. -- | Configuration data for the "tiled tab groups" layout data TiledTabsConfig s = TTC { vNMaster :: Int , vRatio :: Rational , vIncrement :: Rational , hNMaster :: Int , hRatio :: Rational , hIncrement :: Rational , tabsShrinker :: s , tabsTheme :: Theme } instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where def = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText def fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c _tabs = renamed [Replace "Tabs"] Simplest _tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l _vert c = renamed [Replace "Vertical"] $ Tall (vNMaster c) (vIncrement c) (vRatio c) _horiz c = renamed [Replace "Horizontal"] $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c) -- | Increase the number of master groups by one increaseNMasterGroups :: X () increaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN 1 -- | Decrease the number of master groups by one decreaseNMasterGroups :: X () decreaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN (-1) -- | Shrink the master area shrinkMasterGroups :: X () shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage Shrink -- | Expand the master area expandMasterGroups :: X () expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage Expand -- | Rotate the available outer layout algorithms nextOuterLayout :: X () nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage NextLayout xmonad-contrib-0.18.0/XMonad/Layout/Groups/Helpers.hs0000644000000000000000000002007307346545000020577 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE MultiParamTypeClasses, Rank2Types, ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups.Helpers -- Description : Utility functions for "XMonad.Layout.Groups". -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : stable -- Portability : unportable -- -- Utility functions for "XMonad.Layout.Groups". -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups.Helpers ( -- * Usage -- $usage -- ** Layout-generic actions swapUp , swapDown , swapMaster , focusUp , focusDown , focusMaster , toggleFocusFloat -- ** 'G.Groups'-secific actions , swapGroupUp , swapGroupDown , swapGroupMaster , focusGroupUp , focusGroupDown , focusGroupMaster , moveToGroupUp , moveToGroupDown , moveToNewGroupUp , moveToNewGroupDown , splitGroup ) where import XMonad hiding ((|||)) import qualified XMonad.StackSet as W import qualified XMonad.Layout.Groups as G import XMonad.Actions.MessageFeedback (sendMessageB) import XMonad.Prelude (unless) import qualified Data.Map as M -- $usage -- -- This module provides helpers functions for use with "XMonad.Layout.Groups"-based -- layouts. You can use its contents by adding -- -- > import XMonad.Layout.Groups.Helpers -- -- to the top of your @xmonad.hs@. -- -- "XMonad.Layout.Groups"-based layouts do not have the same notion -- of window ordering as the rest of XMonad. For this reason, the usual -- ways of reordering windows and moving focus do not work with them. -- "XMonad.Layout.Groups" provides 'Message's that can be used to obtain -- the right effect. -- -- But what if you want to use both 'G.Groups' and other layouts? -- This module provides actions that try to send 'G.GroupsMessage's, and -- fall back to the classic way if the current layout doesn't hande them. -- They are in the section called \"Layout-generic actions\". -- -- The sections \"Groups-specific actions\" contains actions that don't make -- sense for non-'G.Groups'-based layouts. These are simply wrappers around -- the equivalent 'G.GroupsMessage's, but are included so you don't have to -- write @sendMessage $ Modify $ ...@ everytime. -- -- This module exports many operations with the same names as -- 'G.ModifySpec's from "XMonad.Layout.Groups", so if you want -- to import both, we suggest to import "XMonad.Layout.Groups" -- qualified: -- -- > import qualified XMonad.Layout.Groups as G -- -- For more information on how to extend your layoutHook and key bindings, see -- and "XMonad.Doc.Extending". -- ** Layout-generic actions -- #Layout-generic actions# alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X () alt f g = alt2 (G.Modify f) $ windows g alt2 :: G.GroupsMessage -> X () -> X () alt2 m x = do b <- sendMessageB m unless b x -- | Swap the focused window with the previous one swapUp :: X () swapUp = alt G.swapUp W.swapUp -- | Swap the focused window with the next one swapDown :: X () swapDown = alt G.swapDown W.swapDown -- | Swap the focused window with the master window swapMaster :: X () swapMaster = alt G.swapMaster W.swapMaster -- | If the focused window is floating, focus the next floating -- window. otherwise, focus the next non-floating one. focusUp :: X () focusUp = ifFloat focusFloatUp focusNonFloatUp -- | If the focused window is floating, focus the next floating -- window. otherwise, focus the next non-floating one. focusDown :: X () focusDown = ifFloat focusFloatDown focusNonFloatDown -- | Move focus to the master window focusMaster :: X () focusMaster = alt G.focusMaster W.shiftMaster -- | Move focus between the floating and non-floating layers toggleFocusFloat :: X () toggleFocusFloat = ifFloat focusNonFloat focusFloatUp -- *** Floating layer helpers getFloats :: X [Window] getFloats = gets $ M.keys . W.floating . windowset getWindows :: X [Window] getWindows = gets $ W.integrate' . W.stack . W.workspace . W.current . windowset ifFloat :: X () -> X () -> X () ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats if w `elem` floats then x1 else x2 focusNonFloat :: X () focusNonFloat = alt2 G.Refocus helper where helper = withFocused $ \w -> do ws <- getWindows floats <- getFloats let (before, after) = span (/=w) ws case filter (`notElem` floats) $ after ++ before of [] -> return () w':_ -> focus w' focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'. -- if you want a non-floating one, 'not'. -> ([Window] -> [Window]) -- ^ if you want the next window, 'id'. -- if you want the previous one, 'reverse'. -> X () focusHelper f g = withFocused $ \w -> do ws <- getWindows let (before, drop 1 -> after) = span (/=w) ws let toFocus = g $ after ++ before floats <- getFloats case filter (f . flip elem floats) toFocus of [] -> return () w':_ -> focus w' focusNonFloatUp :: X () focusNonFloatUp = alt2 (G.Modify G.focusUp) $ focusHelper not reverse focusNonFloatDown :: X () focusNonFloatDown = alt2 (G.Modify G.focusDown) $ focusHelper not id focusFloatUp :: X () focusFloatUp = focusHelper id reverse focusFloatDown :: X () focusFloatDown = focusHelper id id -- ** Groups-specific actions wrap :: G.ModifySpec -> X () wrap x = sendMessage (G.Modify x) -- | Swap the focused group with the previous one swapGroupUp :: X () swapGroupUp = wrap G.swapGroupUp -- | Swap the focused group with the next one swapGroupDown :: X () swapGroupDown = wrap G.swapGroupDown -- | Swap the focused group with the master group swapGroupMaster :: X () swapGroupMaster = wrap G.swapGroupMaster -- | Move the focus to the previous group focusGroupUp :: X () focusGroupUp = wrap G.focusGroupUp -- | Move the focus to the next group focusGroupDown :: X () focusGroupDown = wrap G.focusGroupDown -- | Move the focus to the master group focusGroupMaster :: X () focusGroupMaster = wrap G.focusGroupMaster -- | Move the focused window to the previous group. The 'Bool' argument -- determines what will be done if the focused window is in the very first -- group: Wrap back to the end ('True'), or create a new group before -- it ('False'). moveToGroupUp :: Bool -> X () moveToGroupUp b = wrap (G.moveToGroupUp b) -- | Move the focused window to the next group. The 'Bool' argument -- determines what will be done if the focused window is in the very last -- group: Wrap back to the beginning ('True'), or create a new group after -- it ('False'). moveToGroupDown :: Bool -> X () moveToGroupDown b = wrap (G.moveToGroupDown b) -- | Move the focused window to a new group before the current one moveToNewGroupUp :: X () moveToNewGroupUp = wrap G.moveToNewGroupUp -- | Move the focused window to a new group after the current one moveToNewGroupDown :: X () moveToNewGroupDown = wrap G.moveToNewGroupDown -- | Split the focused group in two at the position of the focused -- window. splitGroup :: X () splitGroup = wrap G.splitGroup xmonad-contrib-0.18.0/XMonad/Layout/Groups/Wmii.hs0000644000000000000000000001071207346545000020101 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE MultiParamTypeClasses, Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups.Wmii -- Description : A wmii-like layout algorithm. -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : stable -- Portability : unportable -- -- A wmii-like layout algorithm. -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups.Wmii ( -- * Usage -- $usage wmii , zoomGroupIn , zoomGroupOut , zoomGroupReset , toggleGroupFull , groupToNextLayout , groupToFullLayout , groupToTabbedLayout , groupToVerticalLayout -- * Useful re-exports , shrinkText , def , module XMonad.Layout.Groups.Helpers ) where import XMonad import qualified XMonad.Layout.Groups as G import XMonad.Layout.Groups.Examples import XMonad.Layout.Groups.Helpers import XMonad.Layout.Tabbed import XMonad.Layout.Renamed import XMonad.Layout.MessageControl import XMonad.Layout.Simplest -- $usage -- This module provides a layout inspired by the one used by the wmii -- () window manager. -- Windows are arranged into groups in a horizontal row, and each group can lay out -- its windows -- -- * by maximizing the focused one -- -- * by tabbing them (wmii uses a stacked layout, but I'm too lazy to write it) -- -- * by arranging them in a column. -- -- As the groups are arranged in a 'ZoomRow', the relative width of each group can be -- increased or decreased at will. Groups can also be set to use the whole screen -- whenever they have focus. -- -- You can use the contents of this module by adding -- -- > import XMonad.Layout.Groups.Wmii -- -- to the top of your @xmonad.hs@, and adding 'wmii' -- (with a 'Shrinker' and decoration 'Theme' as -- parameters) to your layout hook, for example: -- -- > myLayout = wmii shrinkText def -- -- To be able to zoom in and out of groups, change their inner layout, etc., -- create key bindings for the relevant actions: -- -- > ((modMask, xK_f), toggleGroupFull) -- -- and so on. -- -- For more information on how to extend your layoutHook and key bindings, see -- and "XMonad.Doc.Extending". -- -- Finally, you will probably want to be able to move focus and windows -- between groups in a consistent fashion. For this, you should take a look -- at the "XMonad.Layout.Groups.Helpers" module, whose contents are re-exported -- by this module. -- | A layout inspired by wmii wmii s t = G.group innerLayout zoomRowG where column = renamed [Replace "Column"] $ Tall 0 (3/100) (1/2) tabs = renamed [Replace "Tabs"] Simplest innerLayout = renamed [CutWordsLeft 3] $ addTabs s t $ ignore NextLayout $ ignore (JumpToLayout "") $ unEscape $ column ||| tabs ||| Full -- | Increase the width of the focused group zoomGroupIn :: X () zoomGroupIn = zoomColumnIn -- | Decrease the size of the focused group zoomGroupOut :: X () zoomGroupOut = zoomColumnOut -- | Reset the size of the focused group to the default zoomGroupReset :: X () zoomGroupReset = zoomColumnReset -- | Toggle whether the currently focused group should be maximized -- whenever it has focus. toggleGroupFull :: X () toggleGroupFull = toggleColumnFull -- | Rotate the layouts in the focused group. groupToNextLayout :: X () groupToNextLayout = sendMessage $ escape NextLayout -- | Switch the focused group to the \"maximized\" layout. groupToFullLayout :: X () groupToFullLayout = sendMessage $ escape $ JumpToLayout "Full" -- | Switch the focused group to the \"tabbed\" layout. groupToTabbedLayout :: X () groupToTabbedLayout = sendMessage $ escape $ JumpToLayout "Tabs" -- | Switch the focused group to the \"column\" layout. groupToVerticalLayout :: X () groupToVerticalLayout = sendMessage $ escape $ JumpToLayout "Column" xmonad-contrib-0.18.0/XMonad/Layout/Hidden.hs0000644000000000000000000001451707346545000017117 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Hidden -- Description : Hide windows from layouts. -- Copyright : (c) Peter Jones 2015 -- License : BSD3-style (see LICENSE) -- -- Maintainer : pjones@devalot.com -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.Hidden ( -- * Usage -- $usage HiddenWindows , HiddenMsg (..) , hiddenWindows , hideWindow , popOldestHiddenWindow , popNewestHiddenWindow , popHiddenWindow ) where -------------------------------------------------------------------------------- import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W -------------------------------------------------------------------------------- -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Hidden -- -- Then edit your @layoutHook@ by adding the @HiddenWindows@ layout modifier: -- -- > myLayout = hiddenWindows (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key bindings, do something like: -- -- > , ((modMask, xK_backslash), withFocused hideWindow) -- > , ((modMask .|. shiftMask, xK_backslash), popOldestHiddenWindow) -- > ... -- -- For detailed instruction on editing the key bindings see: -- -- . -------------------------------------------------------------------------------- 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). | 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 (PopSpecificHiddenWindow win) <- fromMessage mess = popSpecificMsg win h | Just ReleaseResources <- fromMessage mess = doUnhook | otherwise = return Nothing where doUnhook = do mapM_ restoreWindow hidden return Nothing modifierDescription _ = "Hidden" -------------------------------------------------------------------------------- -- | Apply the @HiddenWindows@ layout modifier. hiddenWindows :: LayoutClass l Window => l Window -> ModifiedLayout HiddenWindows l Window hiddenWindows = ModifiedLayout $ HiddenWindows [] -------------------------------------------------------------------------------- -- | Remove the given window from the current layout. It is placed in -- list of hidden windows so it can be restored later. hideWindow :: Window -> X () hideWindow = sendMessage . HideWindow -------------------------------------------------------------------------------- -- | Restore a previously hidden window. Using this function will -- treat the list of hidden windows as a FIFO queue. That is, the -- first window hidden will be restored. popOldestHiddenWindow :: X () popOldestHiddenWindow = sendMessage PopOldestHiddenWindow -------------------------------------------------------------------------------- -- | Restore a previously hidden window. Using this function will -- treat the list of hidden windows as a FILO queue. That is, the -- most recently hidden window will be restored. popNewestHiddenWindow :: X () popNewestHiddenWindow = sendMessage PopNewestHiddenWindow popHiddenWindow :: Window -> X () popHiddenWindow = sendMessage . PopSpecificHiddenWindow -------------------------------------------------------------------------------- hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a)) hideWindowMsg (HiddenWindows hidden) win = do modify (\s -> s { windowset = W.delete' win $ windowset s }) return . Just . HiddenWindows $ hidden ++ [win] -------------------------------------------------------------------------------- popNewestMsg :: HiddenWindows a -> X (Maybe (HiddenWindows a)) popNewestMsg (HiddenWindows []) = return Nothing popNewestMsg (HiddenWindows hidden) = do let (win, rest) = (last hidden, init hidden) restoreWindow win return . Just . HiddenWindows $ rest -------------------------------------------------------------------------------- popOldestMsg :: HiddenWindows a -> X (Maybe (HiddenWindows a)) popOldestMsg (HiddenWindows []) = return Nothing popOldestMsg (HiddenWindows (win:rest)) = do restoreWindow win return . Just . HiddenWindows $ rest -------------------------------------------------------------------------------- popSpecificMsg :: Window -> HiddenWindows a -> X (Maybe (HiddenWindows a)) popSpecificMsg _ (HiddenWindows []) = return Nothing popSpecificMsg win (HiddenWindows hiddenWins) = if win `elem` hiddenWins then do restoreWindow win return . Just . HiddenWindows $ filter (/= win) hiddenWins else return . Just . HiddenWindows $ hiddenWins -------------------------------------------------------------------------------- restoreWindow :: Window -> X () restoreWindow = windows . W.insertUp xmonad-contrib-0.18.0/XMonad/Layout/HintedGrid.hs0000644000000000000000000001106007346545000017733 0ustar0000000000000000{-# 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) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A not so simple layout that attempts to put all windows in a square grid -- while obeying their size hints. -- ----------------------------------------------------------------------------- module XMonad.Layout.HintedGrid ( -- * Usage -- $usage Grid(..), arrange, defaultRatio ) where import Prelude hiding ((.)) import XMonad import XMonad.Prelude (replicateM, sortBy, sortOn) import XMonad.StackSet import Control.Monad.State (runState) import Data.Ord infixr 9 . (.) :: (Functor f) => (a -> b) -> f a -> f b (.) = fmap -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.HintedGrid -- -- Then edit your @layoutHook@ by adding the 'Grid' layout: -- -- > myLayout = Grid False ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- You can also specify an aspect ratio for Grid to strive for with the -- GridRatio constructor: -- -- > myLayout = GridRatio (4/3) False ||| etc. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Automatic mirroring of hinted layouts doesn't work very well, so this -- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout, -- @Grid True@ is the mirrored variant (rotated by 90 degrees). data Grid a = Grid Bool | GridRatio Double Bool deriving (Read, Show) defaultRatio :: Double defaultRatio = 16/9 instance LayoutClass Grid Window where doLayout (Grid m) r w = doLayout (GridRatio defaultRatio m) r 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 width height k adjs = let (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 where doC h _ [] = (h, []) doC h n (f : fs) = (adj :) . doC (h - h') (n - 1) fs where adj@(_, h') = f (width, h `div` n) doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle] doRect height = doR where doR _ _ [] = [] doR width n (c : cs) = let v = fromIntegral $ length c c' = doColumn (width `div` n) height v c (ws, hs) = unzip c' maxw = maximum ws height' = sum hs hbonus = height - height' hsingle = hbonus `div` v hoffset = hsingle `div` 2 width' = width - maxw ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs 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 -- | The internal function for computing the grid layout. arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)] arrange aspectRatio mirror (Rectangle rx ry rw rh) wins = do proto <- mapM mkAdjust wins let adjs = map (\f -> twist . f . twist) proto rs = arrange' aspectRatio (twist (rw, rh)) adjs rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' where twist | mirror = \(a, b) -> (b, a) | otherwise = id arrange' :: Double -> D -> [D -> D] -> [Rectangle] arrange' aspectRatio (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols) where nwindows = length adjs ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh * aspectRatio) nrows = nwindows `div` ncolumns nextras = nwindows - ncolumns * nrows (ecols, adjs') = replicateS nextras (splitAt (nrows + 1)) $ reverse adjs (cols, _) = replicateS (ncolumns - nextras) (splitAt nrows) adjs' xmonad-contrib-0.18.0/XMonad/Layout/HintedTile.hs0000644000000000000000000001215007346545000017744 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.HintedTile -- Description : A gapless tiled layout that obeys window size hints. -- Copyright : (c) Peter De Wachter -- License : BSD3-style (see LICENSE) -- -- Maintainer : Peter De Wachter -- Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- A gapless tiled layout that attempts to obey window size hints, -- rather than simply ignoring them. -- ----------------------------------------------------------------------------- module XMonad.Layout.HintedTile ( -- * Usage -- $usage HintedTile(..), Orientation(..), Alignment(..) ) where import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W import XMonad.Prelude -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.HintedTile -- -- Then edit your @layoutHook@ by adding the HintedTile layout: -- -- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc.. -- > where -- > hintedTile = HintedTile nmaster delta ratio TopLeft -- > nmaster = 1 -- > ratio = 1/2 -- > delta = 3/100 -- > main = xmonad def { layoutHook = myLayout } -- -- Because both Xmonad and Xmonad.Layout.HintedTile define Tall, -- you need to disambiguate Tall. If you are replacing the -- built-in Tall with HintedTile, change @import Xmonad@ to -- @import Xmonad hiding (Tall)@. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data HintedTile a = HintedTile { nmaster :: !Int -- ^ number of windows in the master pane , delta :: !Rational -- ^ how much to change when resizing , frac :: !Rational -- ^ ratio between master/nonmaster panes , alignment :: !Alignment -- ^ Where to place windows that are smaller -- than their preordained rectangles. , orientation :: !Orientation -- ^ Tall or Wide (mirrored) layout? } deriving ( Show, Read ) data Orientation = Wide -- ^ Lay out windows similarly to Mirror tiled. | Tall -- ^ Lay out windows similarly to tiled. deriving ( Show, Read, Eq, Ord ) data Alignment = TopLeft | Center | BottomRight deriving ( Show, Read, Eq, Ord ) instance LayoutClass HintedTile Window where 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) where w = W.integrate w' tiler masters slaves | null masters || null slaves = divide al o (masters ++ slaves) r | otherwise = split o f r (divide al o masters) (divide al o slaves) pureMessage c m = fmap resize (fromMessage m) `mplus` fmap incmastern (fromMessage m) where resize Shrink = c { frac = max 0 $ frac c - delta c } resize Expand = c { frac = min 1 $ frac c + delta c } incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } description l = show (orientation l) align :: Alignment -> Position -> Dimension -> Dimension -> Position align TopLeft p _ _ = p align Center p a b = p + fromIntegral (a - b) `div` 2 align BottomRight p a b = p + fromIntegral (a - b) -- Divide the screen vertically (horizontally) into n subrectangles divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle] divide _ _ [] _ = [] divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h] 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)) where (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) where (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]) -> (Rectangle -> [Rectangle]) -> [Rectangle] split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects where leftw = floor $ fromIntegral sw * f leftRects = left $ Rectangle sx sy leftw sh rightx = (maximum . map rect_width) leftRects rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects where toph = floor $ fromIntegral sh * f topRects = top $ Rectangle sx sy sw toph bottomy = (maximum . map rect_height) topRects bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy) xmonad-contrib-0.18.0/XMonad/Layout/IM.hs0000644000000000000000000001102007346545000016213 0ustar0000000000000000{-# 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 -- License : BSD-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- Layout modfier suitable for workspace with multi-windowed instant messenger -- (like Psi or Tkabber). -- ----------------------------------------------------------------------------- module XMonad.Layout.IM ( -- * Usage -- $usage -- * Hints -- $hints -- * TODO -- $todo Property(..), IM(..), withIM, gridIM, AddRoster, ) where import XMonad import XMonad.Layout.Grid import XMonad.Layout.LayoutModifier import XMonad.Prelude import XMonad.Util.WindowProperties import qualified XMonad.StackSet as S import Control.Arrow (first) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.IM -- > import Data.Ratio ((%)) -- -- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer -- for managing your chat windows (Grid in this example, another useful choice -- to consider is Tabbed layout). -- -- > myLayout = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- Here @1%7@ is the part of the screen which your roster will occupy, -- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster. -- -- Screenshot: -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- $hints -- -- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace". -- -- By default the roster window will appear on the left side. -- To place roster window on the right side, use @reflectHoriz@ from -- "XMonad.Layout.Reflect" module. -- $todo -- This item are questionable. Please let me know if you find them useful. -- -- * shrink\/expand -- -- | Data type for LayoutModifier which converts given layout to IM-layout -- (with dedicated space for the roster and original layout for chat windows) data AddRoster a = AddRoster Rational Property deriving (Read, Show) instance LayoutModifier AddRoster Window where modifyLayout (AddRoster ratio prop) = applyIM ratio prop modifierDescription _ = "IM" -- | Modifier which converts given layout to IM-layout (with dedicated -- space for roster and original layout for chat windows) withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a withIM ratio prop = ModifiedLayout $ AddRoster ratio prop -- | IM layout modifier applied to the Grid layout gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a gridIM ratio prop = withIM ratio prop Grid -- | Internal function for adding space for the roster specified by -- the property and running original layout for all chat windows applyIM :: (LayoutClass l Window) => Rational -> Property -> S.Workspace WorkspaceId (l Window) Window -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window)) applyIM ratio prop wksp rect = do let stack = S.stack wksp 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 (first ((w, masterRect) :) wrs) Nothing -> runLayout wksp rect -- | This is for compatibility with old configs only and will be removed in future versions! data IM a = IM Rational Property deriving (Read, Show) instance LayoutClass IM Window where description _ = "IM" doLayout (IM r prop) rect stack = do let ws = S.integrate stack let (masterRect, slaveRect) = splitHorizontallyBy r rect master <- findM (hasProperty prop) ws let positions = case master of Just w -> (w, masterRect) : arrange defaultRatio slaveRect (filter (w /=) ws) Nothing -> arrange defaultRatio rect ws return (positions, Nothing) xmonad-contrib-0.18.0/XMonad/Layout/IfMax.hs0000644000000000000000000000717607346545000016733 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, PatternGuards #-} module XMonad.Layout.IfMax ( -- * Usage -- $usage IfMax (..) , ifMax ) where import Control.Arrow ((&&&)) import qualified Data.List as L import qualified Data.Map as M 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 -- maximum N, and else will run another layout. -- -- You can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.IfMax -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = IfMax 2 Full (Tall ...) ||| ... -- -- In this example, if there are 1 or 2 windows, Full layout will be used; -- otherwise, Tall layout will be used. -- data IfMax l1 l2 w = IfMax Int (l1 w) (l2 w) deriving (Read, Show) instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1 l2) Window where runLayout (W.Workspace wname (IfMax n l1 l2) s) rect = withWindowSet $ \ws -> arrange (W.integrate' s) (M.keys . W.floating $ ws) where arrange ws fw | length (ws L.\\ fw) <= n = do (wrs, ml1') <- runLayout (W.Workspace wname l1 s) rect let l1' = fromMaybe l1 ml1' l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage Hide) return (wrs, Just $ IfMax n l1' l2') | otherwise = do (wrs, ml2') <- runLayout (W.Workspace wname l2 s) rect l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage Hide) let l2' = fromMaybe l2 ml2' return (wrs, Just $ IfMax n l1' l2') handleMessage (IfMax n l1 l2) m | Just ReleaseResources <- fromMessage m = do l1' <- handleMessage l1 (SomeMessage ReleaseResources) l2' <- handleMessage l2 (SomeMessage ReleaseResources) if isNothing l1' && isNothing l2' then return Nothing else return $ Just $ IfMax n (fromMaybe l1 l1') (fromMaybe l2 l2') handleMessage (IfMax n l1 l2) m = do (allWindows, floatingWindows) <- gets ((W.integrate' . W.stack . W.workspace . W.current &&& M.keys . W.floating) . windowset) if length (allWindows L.\\ floatingWindows) <= n then do l1' <- handleMessage l1 m return $ flip (IfMax n) l2 <$> l1' else do l2' <- handleMessage l2 m return $ IfMax n l1 <$> l2' description (IfMax n l1 l2) = "If number of windows is <= " ++ show n ++ ", then " ++ description l1 ++ ", else " ++ description l2 -- | Layout itself ifMax :: (LayoutClass l1 w, LayoutClass l2 w) => Int -- ^ Maximum number of windows for the first layout -> l1 w -- ^ First layout -> l2 w -- ^ Second layout -> IfMax l1 l2 w ifMax = IfMax xmonad-contrib-0.18.0/XMonad/Layout/ImageButtonDecoration.hs0000644000000000000000000001453707346545000022154 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : trupill@gmail.com -- Stability : unstable -- Portability : not portable -- -- 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. -- -- Note: For maximizing and minimizing to actually work, you will need -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your -- setup. See the documentation of those modules for more information. -- ----------------------------------------------------------------------------- -- This module is mostly derived from "XMonad.Layout.DecorationAddons" -- and "XMonad.Layout.ButtonDecoration" module XMonad.Layout.ImageButtonDecoration ( -- * Usage: -- $usage imageButtonDeco , defaultThemeWithImageButtons , shrinkText , CustomShrink(CustomShrink) , Shrinker , imageTitleBarButtonHandler , ImageButtonDecoration ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Util.Image import XMonad.Actions.WindowMenu import XMonad.Actions.Minimize import XMonad.Layout.Maximize -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.ImageButtonDecoration -- -- Then edit your @layoutHook@ by adding the ImageButtonDecoration to -- your layout: -- -- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- The buttons' dimension and placements buttonSize :: Int buttonSize = 10 menuButtonOffset :: Int menuButtonOffset = 4 minimizeButtonOffset :: Int minimizeButtonOffset = 32 maximizeButtonOffset :: Int maximizeButtonOffset = 18 closeButtonOffset :: Int closeButtonOffset = 4 -- The images in a 0-1 scale to make -- it easier to visualize convertToBool' :: [Int] -> [Bool] convertToBool' = map (== 1) convertToBool :: [[Int]] -> [[Bool]] convertToBool = map convertToBool' menuButton' :: [[Int]] menuButton' = [[1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1]] menuButton :: [[Bool]] menuButton = convertToBool menuButton' miniButton' :: [[Int]] miniButton' = [[0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1]] miniButton :: [[Bool]] miniButton = convertToBool miniButton' maxiButton' :: [[Int]] maxiButton' = [[1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1]] maxiButton :: [[Bool]] maxiButton = convertToBool maxiButton' closeButton' :: [[Int]] closeButton' = [[1,1,0,0,0,0,0,0,1,1], [1,1,1,0,0,0,0,1,1,1], [0,1,1,1,0,0,1,1,1,0], [0,0,1,1,1,1,1,1,0,0], [0,0,0,1,1,1,1,0,0,0], [0,0,0,1,1,1,1,0,0,0], [0,0,1,1,1,1,1,1,0,0], [0,1,1,1,0,0,1,1,1,0], [1,1,1,0,0,0,0,1,1,1], [1,1,0,0,0,0,0,0,1,1]] closeButton :: [[Bool]] closeButton = convertToBool closeButton' -- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. -- It will intercept clicks on the buttons of the decoration and invoke the associated action. -- To actually see the buttons, you will need to use a theme that includes them. -- See 'defaultThemeWithImageButtons' below. imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool imageTitleBarButtonHandler mainw distFromLeft distFromRight = do 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 defaultThemeWithImageButtons = def { windowTitleIcons = [ (menuButton, CenterLeft 3), (closeButton, CenterRight 3), (maxiButton, CenterRight 18), (miniButton, CenterRight 33) ] } imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a imageButtonDeco s c = decoration s c $ NFD True newtype ImageButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageButtonDecoration a where describeDeco _ = "ImageButtonDeco" decorationCatchClicksHook _ = imageTitleBarButtonHandler decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () xmonad-contrib-0.18.0/XMonad/Layout/IndependentScreens.hs0000644000000000000000000002741507346545000021505 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.IndependentScreens -- Description : Simulate independent sets of workspaces on each screen (dwm-like). -- Copyright : (c) 2009 Daniel Wagner -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- 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. ----------------------------------------------------------------------------- module XMonad.Layout.IndependentScreens ( -- * Usage -- $usage VirtualWorkspace, PhysicalWorkspace, VirtualWindowSpace, PhysicalWindowSpace, workspaces', 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, ) where import Control.Arrow ((***)) import Graphics.X11.Xinerama import XMonad import XMonad.Hooks.StatusBar.PP import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.IndependentScreens -- -- You can define your workspaces by calling @withScreens@: -- -- > myConfig = def { workspaces = withScreens 2 ["web", "email", "irc"] } -- -- This will create \"physical\" workspaces with distinct internal names for -- each (screen, virtual workspace) pair. -- -- Then edit any keybindings that use the list of workspaces or refer -- to specific workspace names. In the default configuration, only -- the keybindings for changing workspace do this: -- -- > 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] -- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] -- -- This should change to -- -- > 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] -- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] -- -- In particular, the analogue of @XMonad.workspaces@ is -- @workspaces'@, and you can use @onCurrentScreen@ to convert functions -- of virtual workspaces to functions of physical workspaces, which work -- by marshalling the virtual workspace name and the currently focused -- screen into a physical workspace name. -- -- A complete example abusing many of the functions below is available in the -- configuration. type VirtualWorkspace = WorkspaceId type PhysicalWorkspace = WorkspaceId -- | A 'WindowSpace' whose tags are 'PhysicalWorkspace's. type PhysicalWindowSpace = WindowSpace -- | A 'WindowSpace' whose tags are 'VirtualWorkspace's. type VirtualWindowSpace = WindowSpace -- $converting -- You shouldn't need to use the functions below very much. They are used -- internally. However, in some cases, they may be useful, and so are exported -- just in case. In general, the \"marshall\" functions convert the convenient -- form (like \"web\") you would like to use in your configuration file to the -- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly, -- the \"unmarshall\" functions convert in the other direction. marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace marshall (S sc) vws = show sc ++ '_':vws unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace) unmarshallS :: PhysicalWorkspace -> ScreenId unmarshallW :: PhysicalWorkspace -> VirtualWorkspace unmarshall = ((S . read) *** drop 1) . break (=='_') unmarshallS = fst . unmarshall unmarshallW = snd . unmarshall -- | Get a list of all the virtual workspace names. workspaces' :: XConfig l -> [VirtualWorkspace] 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 = concatMap (`withScreen` vws) [0..n-1] -- | 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 WindowScreen screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws) -- | Focus a window, switching workspace on the correct Xinerama screen if neccessary. focusWindow' :: Window -> WindowSet -> WindowSet focusWindow' window ws | Just window == W.peek ws = ws | otherwise = case W.findTag window ws of Just tag -> W.focusWindow window $ focusScreen (unmarshallS tag) ws Nothing -> ws -- | 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 -- > nScreens <- countScreens -- > xmonad $ def { -- > ... -- > workspaces = withScreens nScreens (workspaces def), -- > ... -- > } -- countScreens :: (MonadIO m, Integral i) => m i countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay -- | 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 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". -- -- 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 { 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 -- bit hacky, so beware: the 'ppOutput' field of the input will not be invoked -- if either of the following conditions is met: -- -- 1. The 'ppSort' of the input returns an empty list (when not given one). -- -- 2. The 'ppOrder' of the input returns the exact string @\"\\0\"@. -- -- For example, you can use this to create a pipe which tracks the title of the -- window currently focused on a given screen (even if the screen is not -- current) by doing something like this: -- -- > ppFocus s = whenCurrentOn s def -- > { ppOrder = \(_:_:title:_) -> [title] -- > , ppOutput = appendFile ("focus" ++ show s) . (++ "\n") -- > } -- -- Sequence a few of these pretty-printers to get a log hook that keeps each -- screen's title up-to-date. whenCurrentOn :: ScreenId -> PP -> PP whenCurrentOn s pp = pp { ppSort = do 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 } -- | 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 -- 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 vScreens = map unmarshallWindowSpace . workspacesOn s pScreens = map (marshallWindowSpace s) -- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'. marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace -- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'. unmarshallWindowSpace :: WindowSpace -> WindowSpace marshallWindowSpace s ws = ws { W.tag = marshall s (W.tag ws) } unmarshallWindowSpace ws = ws { W.tag = unmarshallW (W.tag ws) } xmonad-contrib-0.18.0/XMonad/Layout/LayoutBuilder.hs0000644000000000000000000005402707346545000020510 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutBuilder -- Description : Send a number of windows to one rectangle and the rest to another. -- -- Copyright : (c) 2009 Anders Engstrom , -- 2011 Ilya Portnov , -- 2015 Peter Jones -- -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom , -- Ilya Portnov , -- Peter Jones -- -- Stability : unstable -- Portability : unportable -- -- A layout combinator that sends a specified number of windows to one rectangle -- and the rest to another. Each of these rectangles are given a layout that -- is used within them. This can be chained to provide an arbitrary number of -- rectangles. The layout combinator allows overlapping rectangles, but such -- layouts does not work well together with hinting -- ("XMonad.Layout.LayoutHints", "XMonad.Layout.HintedGrid" etc.) -- ----------------------------------------------------------------------------- module XMonad.Layout.LayoutBuilder ( -- * Usage -- $usage layoutN, layoutR, layoutP, layoutAll, -- * Selecting Windows -- $selectWin Predicate (..), Proxy(..), -- * Messages IncLayoutN (..), -- * Utilities SubMeasure (..), SubBox (..), absBox, relBox, LayoutB, LayoutN, ) where import Data.Maybe (maybeToList) import XMonad import XMonad.Prelude (foldM, (<|>), isJust, fromMaybe, isNothing, listToMaybe) import qualified XMonad.StackSet as W import XMonad.Util.Stack (zipperFocusedAtFirstOf) import XMonad.Util.WindowProperties -------------------------------------------------------------------------------- -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutBuilder -- -- Then edit your @layoutHook@ by adding something like: -- -- > myLayout = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed) -- > $ (layoutAll (relBox 0.5 0 1 1) $ simpleTabbed) -- > ) ||| -- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0.01 0.5) -- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0.01 0.5) -- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0.01 0.5) -- > ) ||| -- > ( (layoutN 1 (absBox (-512-200) 0 512 0) (Just $ relBox 0 0 1 1) $ simpleTabbed) -- > $ (layoutN 1 (absBox (-200) 0 0 0) Nothing $ simpleTabbed) -- > $ (layoutAll (absBox 0 0 (-512-200) 0) $ simpleTabbed) -- > ) ||| -- > ( (layoutN 1 (absBox 10 0 0 (-10)) Nothing $ Tall 0 0.01 0.5) -- > $ (layoutN 1 (absBox 0 0 200 0) Nothing $ Tall 0 0.01 0.5) -- > $ (layoutAll (absBox 10 10 0 0) $ Tall 2 0.01 0.5) -- > ) ||| Full ||| etc... -- > main = xmonad def { layoutHook = myLayout } -- -- This will produce a layout similar to DragPane, but with the possibility to have multiple windows in the left half -- and tabs that show the available windows. It will also produce a layout similar to ThreeColMid and a special layout -- created for use with a 80 columns wide Emacs window, its sidebar and a tabbed area for all other windows. -- -- The final layout is for applications that use a toolbar in a separate window, shown on a low resolution screen. It has -- a master area that cover almost the whole screen. It leaves 10 px to the left and 10 px at the bottom. To the left -- the toolbar is located and can be accessed by focusing this area. It is actually 200 px wide, but usually below the -- other windows. Similarly all other windows are tiled, but behind the master window and can be accessed by moving the -- mouse to the bottom of the screen. Everything can also be accessed by the standard focus changing key bindings. -- -- This module can be used to create many different custom layouts, but there are limitations. The primary limitation -- can be observed in the second and third example when there are only two columns with windows in them. The leftmost -- area is left blank. These blank areas can be avoided by placing the rectangles appropriately. -- -- These examples require "XMonad.Layout.Tabbed". -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may wish to add the following keybindings: -- -- > , ((modm .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1)) -- > , ((modm .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1) -- -- For detailed instruction on editing the key binding see: -- -- . -------------------------------------------------------------------------------- -- $selectWin -- -- 'Predicate' exists because layouts are required to be serializable, and -- "XMonad.Util.WindowProperties" is not sufficient (for example it does not -- allow using regular expressions). -- -- compare "XMonad.Util.Invisible" -- | Type class for predicates. This enables us to manage not only Windows, -- but any objects, for which instance Predicate is defined. -- -- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras class Predicate p w where alwaysTrue :: Proxy w -> p -- ^ A predicate that is always True. checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate instance Predicate () a where alwaysTrue _ = () checkPredicate _ _ = return True instance Predicate Property Window where alwaysTrue _ = Const True checkPredicate = hasProperty -------------------------------------------------------------------------------- -- | Contains no actual data, but is needed to help select the correct instance -- of 'Predicate' data Proxy a = Proxy -------------------------------------------------------------------------------- -- | Information about how to split windows between layouts. data Limit p = LimitN Int -- ^ See: 'layoutN'. | LimitR (Rational, Rational) -- ^ See: 'layoutR'. | LimitP p -- ^ See: 'layoutP'. deriving (Show, Read) -------------------------------------------------------------------------------- -- | Use one layout in the specified area for a number of windows and -- possibly let another layout handle the rest. data LayoutB l1 l2 p a = LayoutB { subFocus :: Maybe a -- ^ The focused window in this layout. , nextFocus :: Maybe a -- ^ The focused window in the next layout. , limit :: Limit p -- ^ How to split windows between layouts. , box :: SubBox -- ^ Normal size of layout. , mbox :: Maybe SubBox -- ^ Size of layout when handling all windows. , sub :: l1 a -- ^ The layout to use in this box. , next :: Maybe (l2 a) -- ^ The next layout in the chain. } deriving (Show, Read) -------------------------------------------------------------------------------- -- | A variant of 'LayoutB' that can't use 'layoutP'. For backwards -- compatibility with previous versions of LayoutBuilder. type LayoutN l1 l2 a = LayoutB l1 l2 () a -------------------------------------------------------------------------------- -- | Use the specified layout in the described area for N windows and -- send the rest of the windows to the next layout in the chain. It -- is possible to supply an alternative area that will then be used -- instead, if there are no windows to send to the next layout. layoutN :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) => Int -- ^ The number of windows to handle -> SubBox -- ^ The box to place the windows in -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left -> l1 a -- ^ The layout to use in the specified area -> LayoutB l2 l3 p a -- ^ Where to send the remaining windows -> LayoutB l1 (LayoutB l2 l3 p) () a -- ^ The resulting layout layoutN num box mbox sub next = LayoutB Nothing Nothing (LimitN num) box mbox sub (Just next) -- | As layoutN, but the number of windows is given relative to the total number of windows remaining to be handled. The first -- argument is how much to change the ratio when using IncLayoutN, and the second is the initial ratio. layoutR :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) => Rational -- ^ How much to change the ratio with each IncLayoutN -> Rational -- ^ The ratio of the remaining windows to handle -> SubBox -- ^ The box to place the windows in -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left -> l1 a -- ^ The layout to use in the specified area -> LayoutB l2 l3 p a -- ^ Where to send the remaining windows -> LayoutB l1 (LayoutB l2 l3 p) p a -- ^ The resulting layout layoutR numdiff num box mbox sub next = LayoutB Nothing Nothing (LimitR (numdiff,num)) box mbox sub (Just next) -------------------------------------------------------------------------------- -- | Use the specified layout in the described area windows that match -- given predicate and send the rest of the windows to the next layout -- in the chain. It is possible to supply an alternative area that -- will then be used instead, if there are no windows to send to the -- next layout. layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a, Predicate p' a) => p -- ^ The predicate to use -> SubBox -- ^ The box to place the windows in -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left -> l1 a -- ^ The layout to use in the specified area -> LayoutB l2 l3 p' a -- ^ Where to send the remaining windows -> LayoutB l1 (LayoutB l2 l3 p') p a -- ^ The resulting layout layoutP prop box mbox sub next = LayoutB Nothing Nothing (LimitP prop) box mbox sub (Just next) -------------------------------------------------------------------------------- -- | Use the specified layout in the described area for all remaining windows. layoutAll :: (Read a, Eq a, LayoutClass l1 a) => SubBox -- ^ The box to place the windows in -> l1 a -- ^ The layout to use in the specified area -> LayoutB l1 Full () a -- ^ The resulting layout layoutAll box sub = LayoutB Nothing Nothing (LimitR (0,1)) box Nothing sub Nothing -------------------------------------------------------------------------------- -- | Change the number of windows handled by the focused layout. newtype IncLayoutN = IncLayoutN Int instance Message IncLayoutN -------------------------------------------------------------------------------- -- | The absolute or relative measures used to describe the area a layout should be placed in. For negative absolute values -- the total remaining space will be added. For sizes, the remaining space will also be added for zeroes. Relative values -- are applied on the remaining space after the top-left corner of the box have been removed. data SubMeasure = Abs Int | Rel Rational deriving (Show,Read) -------------------------------------------------------------------------------- -- | A box to place a layout in. The stored values are xpos, ypos, width and height. data SubBox = SubBox SubMeasure SubMeasure SubMeasure SubMeasure deriving (Show,Read) -------------------------------------------------------------------------------- -- | Create a box with only absolute measurements. If the values are negative, the total remaining space will be added. For -- sizes it will also be added for zeroes. absBox :: Int -- ^ Absolute X-Position -> Int -- ^ Absolute Y-Position -> Int -- ^ Absolute width -> Int -- ^ Absolute height -> SubBox -- ^ The resulting 'SubBox' describing the area absBox x y w h = SubBox (Abs x) (Abs y) (Abs w) (Abs h) -------------------------------------------------------------------------------- -- | Create a box with only relative measurements. relBox :: Rational -- ^ Relative X-Position with respect to the surrounding area -> Rational -- ^ Relative Y-Position with respect to the surrounding area -> Rational -- ^ Relative width with respect to the remaining width -> Rational -- ^ Relative height with respect to the remaining height -> SubBox -- ^ The resulting 'SubBox' describing the area relBox x y w h = SubBox (Rel x) (Rel y) (Rel w) (Rel h) -------------------------------------------------------------------------------- instance ( LayoutClass l1 a, LayoutClass l2 a , Read a, Show a, Show p, Typeable p, Eq a, Typeable a, Predicate p a ) => LayoutClass (LayoutB l1 l2 p) a where -- | Update window locations. runLayout (W.Workspace _ LayoutB {..} s) rect = do (subs, nexts, subFocus', nextFocus') <- splitStack s limit subFocus nextFocus let selBox = if isJust nextFocus' then box else fromMaybe box mbox (sublist, sub', schange) <- handle sub subs (calcArea selBox rect) (nextlist, next', nchange) <- case next of Nothing -> return ([], Nothing, False) Just n -> do (res, l, ch) <- handle n nexts rect return (res, Just l, ch) let newlist = if length (maybe [] W.up s) < length (W.integrate' subs) then sublist++nextlist else nextlist++sublist newstate = if subFocus' /= subFocus || nextFocus' /= nextFocus || schange || nchange then Just $ LayoutB subFocus' nextFocus' limit box mbox sub' next' else Nothing return (newlist, newstate) where handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r return (res, fromMaybe l ml, isNothing ml) -- | Propagate messages. handleMessage l m | Just (IncLayoutN n) <- fromMessage m = incLayoutN l m n | Just (IncMasterN _) <- fromMessage m = sendFocus l m | Just Shrink <- fromMessage m = sendFocus l m | Just Expand <- fromMessage m = sendFocus l m | otherwise = sendBoth l m -- | Descriptive name for layout. description layout = case layout of (LayoutB _ _ _ _ _ sub Nothing) -> "layoutAll " ++ description sub (LayoutB _ _ (LimitN _) _ _ sub (Just next)) -> "layoutN " ++ description sub ++ " " ++ description next (LayoutB _ _ (LimitR _) _ _ sub (Just next)) -> "layoutR " ++ description sub ++ " " ++ description next (LayoutB _ _ (LimitP _) _ _ sub (Just next)) -> "layoutP " ++ description sub ++ " " ++ description next -------------------------------------------------------------------------------- -- | Increase the number of windows allowed in the focused layout. incLayoutN :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> Int -> X (Maybe (LayoutB l1 l2 p a)) incLayoutN layout@LayoutB {..} message n = do incThis <- isFocus subFocus if incThis then return $ Just layout { limit = newLimit } else sendNext layout message where newLimit = case limit of LimitN oldnum -> LimitN (max 1 $ oldnum + n) LimitR (diff, oldnum) -> LimitR (diff, min 1 $ max 0 $ oldnum + fromIntegral n * diff) LimitP _ -> limit -------------------------------------------------------------------------------- sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a)) sendSub (LayoutB subFocus nextFocus num box mbox sub next) m = do sub' <- handleMessage sub m return $ if isJust sub' then Just $ LayoutB subFocus nextFocus num box mbox (fromMaybe sub sub') next else Nothing -------------------------------------------------------------------------------- sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a)) sendBoth l@(LayoutB _ _ _ _ _ _ Nothing) m = sendSub l m sendBoth (LayoutB subFocus nextFocus num box mbox sub (Just next)) m = do sub' <- handleMessage sub m next' <- handleMessage next m return $ if isJust sub' || isJust next' then Just $ LayoutB subFocus nextFocus num box mbox (fromMaybe sub sub') (next' <|> Just next) else Nothing -------------------------------------------------------------------------------- sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a)) sendNext (LayoutB _ _ _ _ _ _ Nothing) _ = return Nothing sendNext (LayoutB subFocus nextFocus num box mbox sub (Just next)) m = do next' <- handleMessage next m return $ if isJust next' then Just $ LayoutB subFocus nextFocus num box mbox sub next' else Nothing -------------------------------------------------------------------------------- sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a)) sendFocus l@(LayoutB subFocus _ _ _ _ _ _) m = do foc <- isFocus subFocus if foc then sendSub l m else sendNext l m -------------------------------------------------------------------------------- -- | 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 <$> gets windowset return $ maybe False (\s -> show w == show (W.focus s)) ms -------------------------------------------------------------------------------- calcNum :: Int -> Limit p -> Int calcNum tot num = max 1 $ case num of LimitN i -> i LimitR (_,r) -> ceiling $ r * fromIntegral tot LimitP _ -> 1 -------------------------------------------------------------------------------- -- | Split given list of objects (i.e. windows) using predicate. splitBy :: (Predicate p a) => p -> [a] -> X ([a], [a]) splitBy prop = foldM step ([], []) where step (good, bad) w = do ok <- checkPredicate prop w return $ if ok then (w:good, bad) else (good, w:bad) -------------------------------------------------------------------------------- splitStack :: forall a p. (Eq a, Predicate p a) => Maybe (W.Stack a) -- ^ Window set. -> Limit p -- ^ How to split the stack. -> Maybe a -- ^ The window that was focused in this layout. -> Maybe a -- ^ The window that was focused in the next layout. -> X (Maybe (W.Stack a), Maybe (W.Stack a), Maybe a, Maybe a) splitStack Nothing _ _ _ = return (Nothing, Nothing, Nothing, Nothing) splitStack (Just s) limit subFocus nextFocus = case limit of LimitN _ -> splitN LimitR _ -> splitN LimitP prop -> splitP prop where ws = W.integrate s n = calcNum (length ws) limit subl = take n ws nextl = drop n ws subFocus' xs = foc xs subFocus nextFocus' xs = foc xs nextFocus -- Pick a new focused window if necessary. foc :: [a] -> Maybe a -> Maybe a foc [] _ = Nothing foc l f | W.focus s `elem` l = Just (W.focus s) | maybe False (`elem` l) f = f | otherwise = listToMaybe l -- Split based on max number of windows. splitN = return ( differentiate' (subFocus' subl) subl , differentiate' (nextFocus' nextl) nextl , subFocus' subl , nextFocus' nextl ) -- Split based on a predicate. splitP prop = do (this, other) <- splitBy prop ws return ( differentiate' (subFocus' this) this , differentiate' (nextFocus' other) other , subFocus' this , nextFocus' other ) -------------------------------------------------------------------------------- calcArea :: SubBox -> Rectangle -> Rectangle calcArea (SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' where xpos' = calc False xpos $ rect_width rect ypos' = calc False ypos $ rect_height rect width' = calc True width $ rect_width rect - xpos' height' = calc True height $ rect_height rect - ypos' calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ case val of Rel v -> floor $ v * fromIntegral tot Abs v -> if v<0 || (zneg && v==0) then fromIntegral tot + v else v -------------------------------------------------------------------------------- differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) differentiate' = zipperFocusedAtFirstOf . maybeToList xmonad-contrib-0.18.0/XMonad/Layout/LayoutCombinators.hs0000644000000000000000000001474407346545000021404 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutCombinators -- Description : Easily combine multiple layouts into one composite layout. -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : portable -- -- The "XMonad.Layout.LayoutCombinators" module provides combinators -- for easily combining multiple layouts into one composite layout. ----------------------------------------------------------------------------- module XMonad.Layout.LayoutCombinators ( -- * Usage -- $usage -- * Layout combinators -- $combine -- ** Combinators using DragPane vertical -- $dpv (*||*), (**||*),(***||*),(****||*),(***||**),(****||***) , (***||****),(*||****),(**||***),(*||***),(*||**) -- ** Combinators using DragPane horizontal -- $dph , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***) , (***//****),(*//****),(**//***),(*//***),(*//**) -- ** Combinators using Tall (vertical) -- $tv , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***) , (***|****),(*|****),(**|***),(*|***),(*|**) -- ** Combinators using Mirror Tall (horizontal) -- $mth , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***) , (***/****),(*/****),(**/***),(*/***),(*/**) -- * Re-exports for backwards compatibility , (|||) , JumpToLayout(..) , NewSelect ) where import XMonad import XMonad.Layout.Combo import XMonad.Layout.DragPane -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutCombinators -- -- Then edit your @layoutHook@ to use the new layout combinators. For -- example: -- -- > myLayout = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the @layoutHook@ see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- $combine -- Each of the following combinators combines two layouts into a -- single composite layout by splitting the screen into two regions, -- one governed by each layout. Asterisks in the combinator names -- denote the relative amount of screen space given to the respective -- layouts. For example, the '***||*' combinator gives three times as -- much space to the left-hand layout as to the right-hand layout. infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**, *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**, *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** , */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */** -- $dpv -- These combinators combine two layouts using "XMonad.Layout.DragPane" in -- vertical mode. (*||*),(**||*),(***||*),(****||*), (***||**),(****||***), (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a (*||*) = combineTwo (dragPane Vertical 0.1 (1/2)) (**||*) = combineTwo (dragPane Vertical 0.1 (2/3)) (***||*) = combineTwo (dragPane Vertical 0.1 (3/4)) (****||*) = combineTwo (dragPane Vertical 0.1 (4/5)) (***||**) = combineTwo (dragPane Vertical 0.1 (3/5)) (****||***) = combineTwo (dragPane Vertical 0.1 (4/7)) (***||****) = combineTwo (dragPane Vertical 0.1 (3/7)) (*||****) = combineTwo (dragPane Vertical 0.1 (1/5)) (**||***) = combineTwo (dragPane Vertical 0.1 (2/5)) (*||***) = combineTwo (dragPane Vertical 0.1 (1/4)) (*||**) = combineTwo (dragPane Vertical 0.1 (1/3)) -- $dph -- These combinators combine two layouts using "XMonad.Layout.DragPane" in -- horizontal mode. (*//*),(**//*),(***//*),(****//*), (***//**),(****//***), (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a (*//*) = combineTwo (dragPane Horizontal 0.1 (1/2)) (**//*) = combineTwo (dragPane Horizontal 0.1 (2/3)) (***//*) = combineTwo (dragPane Horizontal 0.1 (3/4)) (****//*) = combineTwo (dragPane Horizontal 0.1 (4/5)) (***//**) = combineTwo (dragPane Horizontal 0.1 (3/5)) (****//***) = combineTwo (dragPane Horizontal 0.1 (4/7)) (***//****) = combineTwo (dragPane Horizontal 0.1 (3/7)) (*//****) = combineTwo (dragPane Horizontal 0.1 (1/5)) (**//***) = combineTwo (dragPane Horizontal 0.1 (2/5)) (*//***) = combineTwo (dragPane Horizontal 0.1 (1/4)) (*//**) = combineTwo (dragPane Horizontal 0.1 (1/3)) -- $tv -- These combinators combine two layouts vertically using @Tall@. (*|*),(**|*),(***|*),(****|*), (***|**),(****|***), (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a (*|*) = combineTwo (Tall 1 0.1 (1/2)) (**|*) = combineTwo (Tall 1 0.1 (2/3)) (***|*) = combineTwo (Tall 1 0.1 (3/4)) (****|*) = combineTwo (Tall 1 0.1 (4/5)) (***|**) = combineTwo (Tall 1 0.1 (3/5)) (****|***) = combineTwo (Tall 1 0.1 (4/7)) (***|****) = combineTwo (Tall 1 0.1 (3/7)) (*|****) = combineTwo (Tall 1 0.1 (1/5)) (**|***) = combineTwo (Tall 1 0.1 (2/5)) (*|***) = combineTwo (Tall 1 0.1 (1/4)) (*|**) = combineTwo (Tall 1 0.1 (1/3)) -- $mth -- These combinators combine two layouts horizontally using @Mirror -- Tall@. (*/*),(**/*),(***/*),(****/*), (***/**),(****/***), (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a (*/*) = combineTwo (Mirror $ Tall 1 0.1 (1/2)) (**/*) = combineTwo (Mirror $ Tall 1 0.1 (2/3)) (***/*) = combineTwo (Mirror $ Tall 1 0.1 (3/4)) (****/*) = combineTwo (Mirror $ Tall 1 0.1 (4/5)) (***/**) = combineTwo (Mirror $ Tall 1 0.1 (3/5)) (****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7)) (***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7)) (*/****) = combineTwo (Mirror $ Tall 1 0.1 (1/5)) (**/***) = combineTwo (Mirror $ Tall 1 0.1 (2/5)) (*/***) = combineTwo (Mirror $ Tall 1 0.1 (1/4)) (*/**) = combineTwo (Mirror $ Tall 1 0.1 (1/3)) type NewSelect = Choose {-# DEPRECATED NewSelect "Use 'Choose' instead." #-} xmonad-contrib-0.18.0/XMonad/Layout/LayoutHints.hs0000644000000000000000000002642007346545000020203 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ParallelListComp, PatternGuards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutHints -- Description : Make layouts respect size hints. -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Make layouts respect size hints. ----------------------------------------------------------------------------- module XMonad.Layout.LayoutHints ( -- * usage -- $usage layoutHints , layoutHintsWithPlacement , layoutHintsToCenter , LayoutHints , LayoutHintsToCenter , hintsEventHook -- * For developers , placeRectangle ) where import XMonad(LayoutClass(runLayout), mkAdjust, Window, Dimension, Position, Rectangle(Rectangle), D, X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS, (<&&>), io, applySizeHints, whenX, isClient, withDisplay, getWMNormalHints, WindowAttributes(..)) import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.Decoration(isInStack) import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(modifyLayout, redoLayout, modifierDescription)) import XMonad.Util.Types(Direction2D(..)) import Control.Arrow(Arrow((***), first, second)) import Data.Set (Set) import qualified Data.Set as Set -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutHints -- -- Then edit your @layoutHook@ by adding the 'layoutHints' layout modifier -- to some layout: -- -- > myLayout = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- Or, to center the adapted window in its available area: -- -- > myLayout = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) -- > ||| Full ||| etc.. -- -- Or, to make a reasonable attempt to eliminate gaps between windows: -- -- > myLayout = layoutHintsToCenter (Tall 1 (3/100) (1/2)) -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- To make XMonad reflect changes in window hints immediately, add -- 'hintsEventHook' to your 'handleEventHook'. -- -- > myHandleEventHook = hintsEventHook <> ... -- > -- > main = xmonad def { handleEventHook = myHandleEventHook -- > , ... } layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a layoutHints = ModifiedLayout (LayoutHints (0, 0)) -- | @layoutHintsWithPlacement (rx, ry) layout@ will adapt the sizes of a layout's -- windows according to their size hints, 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. layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) -> l a -> ModifiedLayout LayoutHints l a layoutHintsWithPlacement rs = ModifiedLayout (LayoutHints rs) -- | @layoutHintsToCenter layout@ applies hints, sliding the window to the -- center of the screen and expanding its neighbors to fill the gaps. Windows -- are never expanded in a way that increases overlap. -- -- @layoutHintsToCenter@ only makes one pass at resizing the neighbors of -- hinted windows, so with some layouts (ex. the arrangement with two 'Mirror' -- 'Tall' stacked vertically), @layoutHintsToCenter@ may leave some gaps. -- Simple layouts like 'Tall' are unaffected. layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a layoutHintsToCenter = ModifiedLayout LayoutHintsToCenter newtype LayoutHints a = LayoutHints (Double, Double) deriving (Read, Show) instance LayoutModifier LayoutHints Window where modifierDescription _ = "Hinted" redoLayout _ _ Nothing xs = return (xs, Nothing) redoLayout (LayoutHints al) _ (Just s) xs = do xs' <- mapM (\x@(_, r) -> second (placeRectangle al r) <$> applyHint x) xs return (xs', Nothing) where applyHint (w,r@(Rectangle a b c d)) = do adj <- mkAdjust w let (c',d') = adj (c,d) return (w, if isInStack s w then Rectangle a b c' d' else r) -- | @placeRectangle (rx, ry) r0 r@ will return a new rectangle with the same dimensions -- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see -- 'layoutHintsWithPlacement'). placeRectangle :: RealFrac r => (r, r) -> Rectangle -> Rectangle -> Rectangle placeRectangle (rx, ry) (Rectangle x0 y0 w h) (Rectangle _ _ dx dy) = Rectangle (align x0 dx w rx) (align y0 dy h ry) dx dy where align :: RealFrac r => Position -> Dimension -> Dimension -> r -> Position align z0 dz d r = z0 + truncate (fromIntegral (d - dz) * r) fitting :: [Rectangle] -> Int fitting rects = sum $ do r <- rects return $ length $ filter (touching r) rects applyOrder :: Rectangle -> [((Window, Rectangle),t)] -> [[((Window, Rectangle),t)]] applyOrder root wrs = do -- perhaps it would just be better to take all permutations, or apply the -- resizing multiple times f <- [maximum, minimum, sum, sum . map sq] return $ sortBy (compare `on` (f . distance)) wrs where distFC = uncurry ((+) `on` sq) . pairWise (-) (center root) distance = map distFC . corners . snd . fst pairWise f (a,b) (c,d) = (f a c, f b d) sq = join (*) data LayoutHintsToCenter a = LayoutHintsToCenter deriving (Read, Show) instance LayoutModifier LayoutHintsToCenter Window where modifyLayout _ ws@(W.Workspace _ _ Nothing) r = runLayout ws r modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do (arrs,ol) <- runLayout ws r (, 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 _ _ [] = [] applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) = let (c',d') = adj (c,d) redr = placeRectangle (centerPlacement root lrect :: (Double,Double)) lrect $ if isInStack s w then Rectangle a b c' d' else lrect ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d') growOther' = growOther ds lrect (freeDirs root lrect) mapSnd f = map (first $ second f) next = applyHints s root $ mapSnd growOther' xs in (w,redr):next growOther :: (Position, Position) -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle growOther ds lrect fds r | dirs <- flipDir <$> Set.toList (Set.intersection adj fds) , not $ any (uncurry opposite) $ cross dirs = foldr (`grow` ds) r dirs | otherwise = r where adj = adjacent lrect r cross xs = [ (a,b) | a <- xs, b <- xs ] flipDir :: Direction2D -> Direction2D flipDir d = case d of { L -> R; U -> D; R -> L; D -> U } opposite :: Direction2D -> Direction2D -> Bool opposite x y = flipDir x == y -- | Leave the opposite edges where they were grow :: Direction2D -> (Position,Position) -> Rectangle -> Rectangle grow L (px,_ ) (Rectangle x y w h) = Rectangle (x-px) y (w+fromIntegral px) h grow U (_ ,py) (Rectangle x y w h) = Rectangle x (y-py) w (h+fromIntegral py) grow R (px,_ ) (Rectangle x y w h) = Rectangle x y (w+fromIntegral px) h 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 [ (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 | ((w,x),(y,z)) <- edge $ delay 2 $ corners r2 | dir <- [U,R,D,L]] where edge (x:xs) = zip (x:xs) (xs ++ [x]) edge [] = [] delay n xs = drop n xs ++ take n xs allEq = all (uncurry (==)) . edge -- | in what direction is the second window from the first that can expand if the -- first is shrunk, assuming that the root window is fully covered: -- one direction for a common edge -- two directions for a common corner adjacent :: Rectangle -> Rectangle -> Set Direction2D adjacent = comparingEdges (all . onClosedInterval) -- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y touching :: Rectangle -> Rectangle -> Bool touching a b = not . Set.null $ comparingEdges c a b where c x y = any (onClosedInterval x) y || any (onClosedInterval y) x onClosedInterval :: Ord a => [a] -> a -> Bool onClosedInterval bds x = minimum bds <= x && maximum bds >= x -- | starting top left going clockwise corners :: Rectangle -> [(Position, Position)] corners (Rectangle x y w h) = [(x,y) ,(x+fromIntegral w, y) ,(x+fromIntegral w, y+fromIntegral h) ,(x, y+fromIntegral h)] center :: Rectangle -> (Position, Position) center (Rectangle x y w h) = (avg x w, avg y h) where avg a b = a + fromIntegral b `div` 2 centerPlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) centerPlacement = centerPlacement' clamp where clamp n = case signum n of 0 -> 0.5 1 -> 1 _ -> 0 freeDirs :: Rectangle -> Rectangle -> Set Direction2D freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) . centerPlacement' signum root where lr 1 = [L] lr (-1) = [R] lr _ = [L,R] ud 1 = [U] ud (-1) = [D] ud _ = [U,D] centerPlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) centerPlacement' cf root assigned = (cf $ cx - cwx, cf $ cy - cwy) where (cx,cy) = center root (cwx,cwy) = center assigned -- | 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 } | t == propertyNotify && a == wM_NORMAL_HINTS = do whenX (isClient w <&&> hintsMismatch w) refresh return (All True) hintsEventHook _ = return (All True) -- | True if the window's current size does not satisfy its size hints. hintsMismatch :: Window -> X Bool hintsMismatch w = safeGetWindowAttributes w >>= \case Nothing -> pure False Just wa -> do sh <- withDisplay $ \d -> io (getWMNormalHints d w) let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa) return $ dim /= applySizeHints 0 sh dim xmonad-contrib-0.18.0/XMonad/Layout/LayoutModifier.hs0000644000000000000000000003100707346545000020651 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutModifier -- Description : A module for writing layout modifiers. -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : portable -- -- 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! ----------------------------------------------------------------------------- module XMonad.Layout.LayoutModifier ( -- * Usage -- $usage -- * The 'LayoutModifier' class LayoutModifier(..), ModifiedLayout(..) ) where import XMonad.Prelude import XMonad import XMonad.StackSet ( Stack, Workspace (..) ) -- $usage -- -- The 'LayoutModifier' class is provided to help extension developers -- write easy layout modifiers. End users won't find much of interest -- here. =) -- -- To write a layout modifier using the 'LayoutModifier' class, define -- a data type to represent the layout modification (storing any -- necessary state), define an instance of 'LayoutModifier', and -- export an appropriate function for applying the modifier. For example: -- -- > data MyModifier a = MyModifier MyState -- > deriving (Show, Read) -- > -- > instance LayoutModifier MyModifier a where -- > -- override whatever methods from LayoutModifier you like -- > -- > modify :: l a -> ModifiedLayout MyModifier l a -- > modify = ModifiedLayout (MyModifier initialState) -- -- When defining an instance of 'LayoutModifier', you are free to -- override as many or as few of the methods as you see fit. See the -- documentation below for specific information about the effect of -- overriding each method. Every method has a default implementation; -- an instance of 'LayoutModifier' which did not provide a non-default -- implementation of any of the methods would simply act as the -- identity on any layouts to which it is applied. -- -- For more specific usage examples, see -- -- * "XMonad.Layout.WorkspaceDir" -- -- * "XMonad.Layout.Magnifier" -- -- * "XMonad.Layout.NoBorders" -- -- * "XMonad.Layout.Reflect" -- -- * "XMonad.Layout.Renamed" -- -- * "XMonad.Layout.WindowNavigation" -- -- and several others. You probably want to start by looking at some -- of the above examples; the documentation below is detailed but -- possibly confusing, and in many cases the creation of a -- 'LayoutModifier' is actually quite simple. -- -- /Important note/: because of the way the 'LayoutModifier' class is -- intended to be used, by overriding any of its methods and keeping -- default implementations for all the others, 'LayoutModifier' -- methods should never be called explicitly. It is likely that such -- explicit calls will not have the intended effect. Rather, the -- 'LayoutModifier' methods should only be called indirectly through -- the 'LayoutClass' instance for 'ModifiedLayout', since it is this -- instance that defines the semantics of overriding the various -- 'LayoutModifier' methods. class (Show (m a), Read (m a)) => LayoutModifier m a where -- | 'modifyLayout' allows you to intercept a call to 'runLayout' -- /before/ it is called on the underlying layout, in order to -- perform some effect in the X monad, and\/or modify some of -- the parameters before passing them on to the 'runLayout' -- method of the underlying layout. -- -- The default implementation of 'modifyLayout' simply calls -- 'runLayout' on the underlying layout. modifyLayout :: (LayoutClass l a) => m a -- ^ the layout modifier -> Workspace WorkspaceId (l a) a -- ^ current workspace -> Rectangle -- ^ screen rectangle -> X ([(a, Rectangle)], Maybe (l a)) modifyLayout _ = runLayout -- | Similar to 'modifyLayout', but this function also allows you -- update the state of your layout modifier(the second value in the -- outer tuple). -- -- If both 'modifyLayoutWithUpdate' and 'redoLayout' return a -- modified state of the layout modifier, 'redoLayout' takes -- precedence. If this function returns a modified state, this -- state will internally be used in the subsequent call to -- 'redoLayout' as well. modifyLayoutWithUpdate :: (LayoutClass l a) => m a -> Workspace WorkspaceId (l a) a -> Rectangle -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a)) 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 -- the layout modifier state in some way (by returning @Just -- nm@, where @nm@ is a new modifier). In all cases, the -- underlying layout will also receive the message as usual, -- after the message has been processed by 'handleMess'. -- -- If you wish to possibly modify a message before it reaches -- the underlying layout, you should use -- 'handleMessOrMaybeModifyIt' instead. If you do not need to -- modify messages or have access to the X monad, you should use -- 'pureMess' instead. -- -- The default implementation of 'handleMess' calls 'unhook' -- when receiving a 'Hide' or 'ReleaseResources' method (after -- which it returns @Nothing@), and otherwise passes the message -- on to 'pureMess'. handleMess :: m a -> SomeMessage -> X (Maybe (m a)) handleMess m mess | Just Hide <- fromMessage mess = doUnhook | Just ReleaseResources <- fromMessage mess = doUnhook | otherwise = return $ pureMess m mess where doUnhook = do unhook m; return Nothing -- | 'handleMessOrMaybeModifyIt' allows you to intercept messages -- sent to the underlying layout, in order to have an effect in -- the X monad, alter the layout modifier state, or produce a -- modified message to be passed on to the underlying layout. -- -- The default implementation of 'handleMessOrMaybeModifyIt' -- 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 <$> mm') -- | 'pureMess' allows you to spy on messages sent to the -- underlying layout, in order to possibly change the layout -- modifier state. -- -- The default implementation of 'pureMess' ignores messages -- sent to it, and returns @Nothing@ (causing the layout -- modifier to remain unchanged). pureMess :: m a -> SomeMessage -> Maybe (m a) pureMess _ _ = Nothing -- | 'redoLayout' allows you to intercept a call to 'runLayout' on -- workspaces with at least one window, /after/ it is called on -- the underlying layout, in order to perform some effect in the -- X monad, possibly return a new layout modifier, and\/or -- modify the results of 'runLayout' before returning them. -- -- If you don't need access to the X monad, use 'pureModifier' -- instead. Also, if the behavior you need can be cleanly -- separated into an effect in the X monad, followed by a pure -- transformation of the results of 'runLayout', you should -- consider implementing 'hook' and 'pureModifier' instead of -- 'redoLayout'. -- -- On empty workspaces, the Stack is Nothing. -- -- The default implementation of 'redoLayout' calls 'hook' and -- then 'pureModifier'. redoLayout :: m a -- ^ the layout modifier -> Rectangle -- ^ screen rectangle -> Maybe (Stack a) -- ^ current window stack -> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned -- by the underlying layout -> X ([(a, Rectangle)], Maybe (m a)) redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs -- | 'pureModifier' allows you to intercept a call to 'runLayout' -- /after/ it is called on the underlying layout, in order to -- modify the list of window\/rectangle pairings it has returned, -- and\/or return a new layout modifier. -- -- The default implementation of 'pureModifier' returns the -- window rectangles unmodified. pureModifier :: m a -- ^ the layout modifier -> Rectangle -- ^ screen rectangle -> Maybe (Stack a) -- ^ current window stack -> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned -- by the underlying layout -> ([(a, Rectangle)], Maybe (m a)) pureModifier _ _ _ wrs = (wrs, Nothing) -- | 'hook' is called by the default implementation of -- 'redoLayout', and as such represents an X action which is to -- be run each time 'runLayout' is called on the underlying -- layout, /after/ 'runLayout' has completed. Of course, if you -- override 'redoLayout', then 'hook' will not be called unless -- you explicitly call it. -- -- The default implementation of 'hook' is @return ()@ (i.e., it -- has no effect). hook :: m a -> X () hook _ = return () -- | 'unhook' is called by the default implementation of -- 'handleMess' upon receiving a 'Hide' or a 'ReleaseResources' -- message. -- -- The default implementation, of course, does nothing. unhook :: m a -> X () unhook _ = return () -- | 'modifierDescription' is used to give a String description to -- this layout modifier. It is the empty string by default; you -- 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.StatusBar" user). modifierDescription :: m a -> String modifierDescription = const "" -- | 'modifyDescription' gives a String description for the entire -- layout (modifier + underlying layout). By default, it is -- derived from the concatenation of the 'modifierDescription' -- with the 'description' of the underlying layout, with a -- \"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 `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, 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 (fromMaybe m mm') r ms ws let ml'' = case mm'' `mplus` mm' of Just m' -> Just $ ModifiedLayout m' $ fromMaybe l ml' Nothing -> ModifiedLayout m <$> ml' return (ws', ml'') handleMessage (ModifiedLayout m l) mess = do mm' <- handleMessOrMaybeModifyIt m mess ml' <- case mm' of Just (Right mess') -> handleMessage l mess' _ -> handleMessage l mess return $ case mm' of 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 ) xmonad-contrib-0.18.0/XMonad/Layout/LayoutScreens.hs0000644000000000000000000001121507346545000020514 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutScreens -- Description : A layout to divide a single screen into multiple screens. -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Divide a single screen into multiple screens. ----------------------------------------------------------------------------- module XMonad.Layout.LayoutScreens ( -- * Usage -- $usage layoutScreens, layoutSplitScreen, fixedLayout, FixedLayout, ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage -- This module allows you to pretend that you have more than one screen by -- dividing a single screen into multiple screens that xmonad will treat as -- separate screens. This should definitely be useful for testing the -- behavior of xmonad under Xinerama, and it's possible that it'd also be -- handy for use as an actual user interface, if you've got a very large -- screen and long for greater flexibility (e.g. being able to see your -- email window at all times, a crude mimic of sticky windows). -- -- You can use this module with the following in your -- @xmonad.hs@ file: -- -- > import XMonad.Layout.LayoutScreens -- > import XMonad.Layout.TwoPane -- -- Then add some keybindings; for example: -- -- > , ((modm .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5)) -- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- Another example use would be to handle a scenario where xrandr didn't -- work properly (e.g. a VNC X server in my case) and you want to be able -- to resize your screen (e.g. to match the size of a remote VNC client): -- -- > import XMonad.Layout.LayoutScreens -- -- > , ((modm .|. shiftMask, xK_space), -- > layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) -- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- For detailed instructions on editing your key bindings, see -- . -- | Modify all screens. layoutScreens :: LayoutClass l Int => Int -> l Int -> X () layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens." layoutScreens nscr l = asks theRoot >>= \w -> withDisplay $ \d -> withWindowAttributes d w $ \attrs -> do let rtrect = windowRectangle attrs (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } -> let x = W.workspace v (xs, ys) = splitAt (nscr - 1) $ map W.workspace vs ++ hs (notEmpty -> s :| ss) = map snd wss in ws { W.current = W.Screen x 0 (SD s) , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss , W.hidden = ys } -- | Modify current screen. layoutSplitScreen :: LayoutClass l Int => Int -> l Int -> X () layoutSplitScreen nscr _ | nscr < 1 = trace $ "Can't layoutSplitScreen with only " ++ show nscr ++ " screens." layoutSplitScreen nscr l = do rect <- gets $ screenRect . W.screenDetail . W.current . windowset (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect windows $ \ws@W.StackSet{ W.current = c, W.visible = vs, W.hidden = hs } -> let x = W.workspace c (xs, ys) = splitAt (nscr - 1) hs (notEmpty -> s :| ss) = map snd wss in ws { W.current = W.Screen x (W.screen c) (SD s) , W.visible = zipWith3 W.Screen xs [(W.screen c+1) ..] (map SD ss) ++ 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 } windowRectangle :: WindowAttributes -> Rectangle windowRectangle a = Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a) (fromIntegral $ wa_width a) (fromIntegral $ wa_height a) newtype FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show) instance LayoutClass FixedLayout a where doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing) fixedLayout :: [Rectangle] -> FixedLayout a fixedLayout = FixedLayout xmonad-contrib-0.18.0/XMonad/Layout/LimitWindows.hs0000644000000000000000000001347707346545000020361 0ustar0000000000000000{-# 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) -- -- Maintainer : vogt.adam@gmail.com -- Stability : unstable -- Portability : unportable -- -- A layout modifier that limits the number of windows that can be shown. -- See "XMonad.Layout.Minimize" for manually setting hidden windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.LimitWindows ( -- * Usage -- $usage -- * Layout Modifiers limitWindows,limitSlice,limitSelect, -- * Change the number of windows increaseLimit,decreaseLimit,setLimit, #ifdef TESTING -- * For tests select,update,Selection(..),updateAndSelect, #endif -- * Types LimitWindows, Selection, ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Prelude (fromJust, guard, (<=<)) import qualified XMonad.StackSet as W -- $usage -- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Layout.LimitWindows -- -- > myLayout = limitWindows 6 $ Tall 1 0.03 0.5 ||| Full ||| RandomOtherLayout... -- > main = xmonad def { layoutHook = myLayout } -- -- You may also be interested in dynamically changing the number dynamically, -- by binding keys to the 'increaseLimit', 'decreaseLimit', or 'setLimit' -- actions. -- -- For detailed instructions on editing your key bindings, see -- . -- -- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip -- the hidden windows. increaseLimit :: X () increaseLimit = sendMessage $ LimitChange succ decreaseLimit :: X () decreaseLimit = sendMessage . LimitChange $ max 1 . pred setLimit :: Int -> X () setLimit tgt = sendMessage . LimitChange $ const tgt -- | Only display the first @n@ windows. limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a limitWindows n = ModifiedLayout (LimitWindows FirstN n) -- | Only display @n@ windows around the focused window. This makes sense with -- layouts that arrange windows linearily, like "XMonad.Layout.Accordion". limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a limitSlice n = ModifiedLayout (LimitWindows Slice n) -- | Only display the first @m@ windows and @r@ others. -- The @IncMasterN@ message will change @m@, as well as passing it onto the -- underlying layout. limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a limitSelect m r = ModifiedLayout Sel{ nMaster=m, start=m, nRest=r } data LimitWindows a = LimitWindows SliceStyle Int deriving (Read,Show) data SliceStyle = FirstN | Slice deriving (Read,Show) newtype LimitChange = LimitChange { unLC :: Int -> Int } instance Message LimitChange instance LayoutModifier LimitWindows a where pureMess (LimitWindows s n) = fmap (LimitWindows s) . pos <=< (`app` n) . unLC <=< fromMessage where pos x = guard (x>=1) >> return x app f x = guard (f x /= x) >> return (f x) modifyLayout (LimitWindows style n) ws = runLayout ws { W.stack = f n <$> W.stack ws } where f = case style of FirstN -> firstN Slice -> slice firstN :: Int -> W.Stack a -> W.Stack a firstN n st = upfocus $ fromJust $ W.differentiate $ take (max 1 n) $ W.integrate st where upfocus = foldr (.) id $ replicate (length (W.up st)) W.focusDown' -- | A non-wrapping, fixed-size slice of a stack around the focused element slice :: Int -> W.Stack t -> W.Stack t slice n (W.Stack f u d) = W.Stack f (take (nu + unusedD) u) (take (nd + unusedU) d) where unusedD = max 0 $ nd - length d unusedU = max 0 $ nu - length u nd = div (n - 1) 2 nu = uncurry (+) $ divMod (n - 1) 2 data Selection a = Sel { nMaster :: Int, start :: Int, nRest :: Int } deriving (Read, Show, Eq) instance LayoutModifier Selection a where modifyLayout s w = runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) pureModifier sel _ stk wins = (wins, update sel <$> stk) pureMess sel m | Just f <- unLC <$> fromMessage m = Just $ sel { nRest = max 0 (f (nMaster sel + nRest sel) - nMaster sel) } | Just (IncMasterN n) <- fromMessage m = Just $ sel { nMaster = max 0 (nMaster sel + n) } | otherwise = Nothing select :: Selection l -> W.Stack a -> W.Stack a select s stk | lups < nMaster s = stk { W.down=take (nMaster s - lups - 1) downs ++ (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 } where downs = W.down stk ups = reverse $ W.up stk lups = length ups 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 | otherwise = start s `min` lups `max` (lups - nRest s + 1) `min` (lups + ldown - nRest s + 1) `max` nMaster s where lups = length $ W.up stk ldown = length $ W.down stk update :: Selection l -> W.Stack a -> Selection a update sel stk = sel { start=updateStart sel stk } updateAndSelect :: Selection l -> W.Stack a -> W.Stack a updateAndSelect sel stk = select (update sel stk) stk xmonad-contrib-0.18.0/XMonad/Layout/MagicFocus.hs0000644000000000000000000001002107346545000017726 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MagicFocus -- Description : Automagically put the focused window in the master area. -- Copyright : (c) Peter De Wachter -- License : BSD -- -- Maintainer : Peter De Wachter -- Stability : unstable -- Portability : unportable -- -- Automagically put the focused window in the master area. ----------------------------------------------------------------------------- module XMonad.Layout.MagicFocus (-- * Usage -- $usage magicFocus, promoteWarp, promoteWarp', followOnlyIf, disableFollowOnWS, MagicFocus, ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Actions.UpdatePointer (updatePointer) import XMonad.Prelude(All(..)) import qualified Data.Map as M -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MagicFocus -- -- Then edit your @layoutHook@ by adding the magicFocus layout -- modifier: -- -- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout, -- > handleEventHook = promoteWarp } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Create a new layout which automagically puts the focused window -- in the master area. magicFocus :: l a -> ModifiedLayout MagicFocus l a magicFocus = ModifiedLayout MagicFocus data MagicFocus a = MagicFocus deriving (Show, Read) instance LayoutModifier MagicFocus Window where modifyLayout MagicFocus (W.Workspace i l s) = runLayout (W.Workspace i l (s >>= Just . shift)) shift :: (Eq a) => W.Stack a -> W.Stack a shift (W.Stack f u d) = W.Stack f [] (reverse u ++ d) -- | An eventHook that overrides the normal focusFollowsMouse. When the mouse -- it moved to another window, that window is replaced as the master, and the -- mouse is warped to inside the new master. -- -- It prevents infinite loops when focusFollowsMouse is true (the default), and -- MagicFocus is in use when changing focus with the mouse. -- -- This eventHook does nothing when there are floating windows on the current -- workspace. promoteWarp :: Event -> X All promoteWarp = promoteWarp' (0.5, 0.5) (0.85, 0.85) -- | 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} | t == enterNotify && ev_mode e == notifyNormal = do ws <- gets windowset let foc = W.peek ws st = W.integrate' . W.stack . W.workspace $ W.current ws wsFloats = M.filterWithKey (\k _ -> k `elem` st) $ W.floating ws if Just w /= foc && M.null wsFloats then do windows (W.swapMaster . W.focusWindow w) updatePointer refPos ratio return $ All False else return $ All True promoteWarp' _ _ _ = return $ All True -- | Another event hook to override the focusFollowsMouse and make the pointer -- only follow if a given condition is satisfied. This could be used to disable -- 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} | 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) <$> gets (W.currentTag . windowset) xmonad-contrib-0.18.0/XMonad/Layout/Magnifier.hs0000644000000000000000000002667507346545000017635 0ustar0000000000000000{-# 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- This is a layout modifier that will make a layout change 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) -- ----------------------------------------------------------------------------- module XMonad.Layout.Magnifier ( -- * Usage -- $usage -- * General combinators magnify, magnifyxy, -- * Magnify Everything magnifier, magnifierOff, magnifiercz, magnifierczOff, magnifierxy, magnifierxyOff, maxMagnifierOff, maximizeVertical, -- * Don't Magnify the Master Window magnifier', magnifiercz', magnifierczOff', magnifierxy', magnifierxyOff', -- * Messages and Types MagnifyMsg (..), MagnifyThis(..), Magnifier, ) where import Numeric.Natural (Natural) import XMonad import XMonad.Prelude (bool, fi) import XMonad.Layout.LayoutModifier import XMonad.StackSet -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Magnifier -- -- Then edit your @layoutHook@ by e.g. adding the 'magnifier' layout -- modifier to some layout: -- -- > myLayout = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- By default 'magnifier' increases the focused window's size by @1.5@. -- -- You can also use @'magnifiercz' 1.2@ or @'magnifierxy' 1 1000@ to use -- a custom level of magnification. You can even make the focused window -- smaller for a pop in effect. There's also the possibility of starting -- out not magnifying anything at all ('magnifierOff'); see below for -- ways to toggle this on while in use. -- -- 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 -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 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) -- > , ((modm .|. controlMask , xK_o ), sendMessage ToggleOff ) -- > , ((modm .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) -- > , ((modm .|. controlMask , xK_m ), sendMessage Toggle ) -- -- Note that a few other extension modules, such as -- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also -- define a message named 'Toggle'. To avoid conflicts when using -- these modules together, you can import Magnifier qualified, like -- this: -- -- > import qualified XMonad.Layout.Magnifier as Mag -- -- and then prefix @Mag@ to the front of everything from this module, -- like @Mag.Toggle@, @Mag.magnifier@, and so on. -- -- For detailed instruction on editing the key binding see -- . -- | Add magnification capabilities to a certain layout. -- -- For example, to re-create 'magnifiercz' 1.3', you would do -- -- >>> magnify 1.3 (NoMaster 1) True -- magnify :: Rational -- ^ Amount to magnify both directions -> MagnifyThis -- ^ What to magnify -> Bool -- ^ Whether magnification should start out on -- (@True@) or off (@False@) -> l a -- ^ Input layout -> ModifiedLayout Magnifier l a magnify cz = magnifyxy cz cz -- | Like 'magnify', but with the ability to specify different amounts -- of horizontal and vertical magnification. -- -- >>> magnifyxy 1.3 1.6 (NoMaster 1) True magnifyxy :: Rational -- ^ Amount to magnify horizontally -> Rational -- ^ Amount to magnify vertically -> MagnifyThis -- ^ What to magnify -> Bool -- ^ Whether magnification should start out on -- (@True@) or off (@False@) -> l a -- ^ Input layout -> ModifiedLayout Magnifier l a magnifyxy cx cy mt start = ModifiedLayout $ Mag 1 (fromRational cx, fromRational cy) (bool Off On start) mt -- | Increase the size of the window that has focus magnifier :: l a -> ModifiedLayout Magnifier l a magnifier = 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 = 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' = 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 = magnify cz (NoMaster 1) True -- | Increase the size of the window that has focus by a custom zoom in -- both directions. magnifierxy :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a magnifierxy cx cy = magnifyxy cx cy (AllWins 1) True -- | Like 'magnifierxy', but default to @Off@. magnifierxyOff :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a magnifierxyOff cx cy = magnifyxy cx cy (AllWins 1) False -- | Increase the size of the window that has focus by a custom zoom in -- both directions, unless it is one of the master windows. magnifierxy' :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a magnifierxy' cx cy = magnifyxy cx cy (NoMaster 1) True -- | Like 'magnifierxy'', but defaults to @Off@. magnifierxyOff' :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a magnifierxyOff' cx cy = magnifyxy cx cy (NoMaster 1) False -- | Magnifier that defaults to Off magnifierOff :: l a -> ModifiedLayout Magnifier l a magnifierOff = magnifierczOff 1.5 -- | A magnifier that greatly magnifies the focused window; defaults to -- @Off@. maxMagnifierOff :: l a -> ModifiedLayout Magnifier l a maxMagnifierOff = magnifierczOff 1000 -- | Like 'magnifiercz', but default to @Off@. magnifierczOff :: Rational -> l a -> ModifiedLayout Magnifier l a magnifierczOff cz = magnify cz (AllWins 1) False -- | Like 'magnifiercz'', but default to @Off@. magnifierczOff' :: Rational -> l a -> ModifiedLayout Magnifier l a magnifierczOff' cz = magnify cz (NoMaster 1) False -- | A magnifier that greatly magnifies just the vertical direction; -- defaults to @Off@. maximizeVertical :: l a -> ModifiedLayout Magnifier l a maximizeVertical = ModifiedLayout (Mag 1 (1, 1000) Off (AllWins 1)) data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle instance Message MagnifyMsg -- | 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) -- | 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 _ _ 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) 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 handleMess _ _ = return Nothing 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)) unlessMaster :: Int -> NewLayout a -> NewLayout a unlessMaster n mainmod r s wrs = if null (drop (n-1) (up s)) then return (wrs, Nothing) else mainmod r s wrs 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)] | 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' where x' = x - fromIntegral (w' - w) `div` 2 y' = y - fromIntegral (h' - h) `div` 2 w' = round $ fromIntegral w * zoomx h' = round $ fromIntegral h * zoomy 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)) w' = min sw w h' = min sh h xmonad-contrib-0.18.0/XMonad/Layout/Master.hs0000644000000000000000000001206007346545000017146 0ustar0000000000000000{-# 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) -- -- Maintainer : Ismael Carnales -- Stability : unstable -- Portability : unportable -- -- Layout modfier that adds a master window to another layout. ----------------------------------------------------------------------------- module XMonad.Layout.Master ( -- * Usage -- $usage mastered, fixMastered, multimastered, AddMaster, ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import Control.Arrow (first) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Master -- -- Then edit your @layoutHook@ and add the Master modifier to the layout that -- you prefer. -- -- > mastered (1/100) (1/2) $ Grid -- -- Or if you prefer to have a master with fixed width: -- -- > fixMastered (1/100) (1/2) $ Grid -- -- Or if you want multiple (here two) master windows from the beginning: -- -- > multimastered 2 (1/100) (1/2) $ Grid -- -- This will use the left half of your screen for a master window and let -- Grid manage the right half. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Like 'XMonad.Layout.Tall', 'withMaster' supports the -- 'XMonad.Layout.Shrink' and XMonad.Layout.Expand' messages. -- | Data type for LayoutModifier which converts given layout to a mastered -- layout data AddMaster a = AddMaster Int Rational Rational deriving (Show, Read) multimastered :: (LayoutClass l a) => Int -- ^ @k@, number of master windows -> Rational -- ^ @delta@, the ratio of the screen to resize by -> Rational -- ^ @frac@, what portion of the screen to use for the master window -> l a -- ^ the layout to be modified -> ModifiedLayout AddMaster l a multimastered k delta frac = ModifiedLayout $ AddMaster k delta frac mastered :: (LayoutClass l a) => Rational -- ^ @delta@, the ratio of the screen to resize by -> 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 = multimastered 1 instance LayoutModifier AddMaster Window where modifyLayout (AddMaster k delta frac) = applyMaster False k delta frac modifierDescription _ = "Mastered" pureMess (AddMaster k delta frac) m | Just Shrink <- fromMessage m = Just $ AddMaster k delta (frac-delta) | Just Expand <- fromMessage m = Just $ AddMaster k delta (frac+delta) | Just (IncMasterN d) <- fromMessage m = Just $ AddMaster (max 1 (k+d)) delta frac pureMess _ _ = Nothing 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 = fmap FixMaster (pureMess a m) fixMastered :: (LayoutClass l a) => Rational -- ^ @delta@, the ratio of the screen to resize by -> Rational -- ^ @frac@, what portion of the screen to use for the master window -> l a -- ^ the layout to be modified -> ModifiedLayout FixMaster l a fixMastered delta frac = ModifiedLayout . FixMaster $ AddMaster 1 delta frac -- | Internal function for adding a master window and let the modified -- layout handle the rest of the windows applyMaster :: (LayoutClass l Window) => Bool -> Int -> Rational -> Rational -> S.Workspace WorkspaceId (l Window) Window -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window)) applyMaster f k _ frac wksp rect = do let st= S.stack wksp let ws = S.integrate' st let n = length ws + fromEnum f if n > 1 then 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 (`notElem` m) wrs <- runLayout (wksp {S.stack = nst}) sr return (first (divideCol mr m ++) wrs) else runLayout wksp rect -- | Shift rectangle down shiftD :: Position -> Rectangle -> Rectangle shiftD s (Rectangle x y w h) = Rectangle x (y+s) w h -- | Divide rectangle between windows divideCol :: Rectangle -> [a] -> [(a, Rectangle)] divideCol (Rectangle x y w h) ws = zip ws rects where n = length ws oneH = fromIntegral h `div` n oneRect = Rectangle x y w (fromIntegral oneH) rects = take n $ iterate (shiftD (fromIntegral oneH)) oneRect xmonad-contrib-0.18.0/XMonad/Layout/Maximize.hs0000644000000000000000000000755707346545000017515 0ustar0000000000000000{-# 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) -- -- Maintainer : xmonad#jwebb,sygneca,com -- Stability : unstable -- Portability : unportable -- -- Temporarily yanks the focused window out of the layout to mostly fill -- the screen. -- ----------------------------------------------------------------------------- module XMonad.Layout.Maximize ( -- * Usage -- $usage maximize, maximizeWithPadding, maximizeRestore, Maximize, MaximizeRestore, ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import XMonad.Prelude ( partition ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Maximize -- -- Then edit your @layoutHook@ by adding the Maximize layout modifier: -- -- > myLayout = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- -- Or, if you want to control the amount of padding placed around the -- maximized window: -- -- > myLayout = maximizeWithPadding 10 (Tall 1 (3/100) (1/2)) ||| Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key-bindings, do something like: -- -- > , ((modm, xK_backslash), withFocused (sendMessage . maximizeRestore)) -- > ... -- -- For detailed instruction on editing the key binding see: -- -- . data Maximize a = Maximize Dimension (Maybe Window) deriving ( Read, Show ) maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window maximize = ModifiedLayout $ Maximize 25 Nothing -- | Like 'maximize', but allows you to specify the amount of padding -- placed around the maximized window. maximizeWithPadding :: LayoutClass l Window => Dimension -> l Window -> ModifiedLayout Maximize l Window maximizeWithPadding padding = ModifiedLayout $ Maximize padding Nothing newtype MaximizeRestore = MaximizeRestore Window deriving ( Eq ) instance Message MaximizeRestore maximizeRestore :: Window -> MaximizeRestore maximizeRestore = MaximizeRestore instance LayoutModifier Maximize Window where modifierDescription (Maximize _ _) = "Maximize" pureModifier (Maximize padding (Just target)) rect (Just (S.Stack focused _ _)) wrs = if focused == target then (maxed ++ rest, Nothing) else (rest ++ maxed, lay) where (toMax, rest) = partition (\(w, _) -> w == target) wrs maxed = map (\(w, _) -> (w, maxRect)) toMax maxRect = Rectangle (rect_x rect + fromIntegral padding) (rect_y rect + fromIntegral padding) (rect_width rect - padding * 2) (rect_height rect - padding * 2) lay | null maxed = Just (Maximize padding Nothing) | otherwise = Nothing pureModifier _ _ _ wrs = (wrs, Nothing) pureMess (Maximize padding mw) m = case fromMessage m of Just (MaximizeRestore w) -> case mw of 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 _ -> Nothing -- vim: sw=4:et xmonad-contrib-0.18.0/XMonad/Layout/MessageControl.hs0000644000000000000000000001000307346545000020633 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MessageControl -- Description : Message escaping and filtering facilities. -- Copyright : (c) 2008 Quentin Moser -- License : BSD3 -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Provides message \"escaping\" and filtering facilities which -- help control complex nested layouts. ----------------------------------------------------------------------------- module XMonad.Layout.MessageControl ( -- * Usage -- $usage Ignore() , ignore , UnEscape() , unEscape , EscapedMessage(Escape) , escape ) where import XMonad.Core (Message, SomeMessage(..) , fromMessage, LayoutClass(..)) import XMonad.StackSet (Workspace(..)) import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) import Control.Arrow (second) -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.MessageEscape -- -- Then, if you use a modified layout where the modifier would intercept -- a message, but you'd want to be able to send it to the inner layout -- only, add the 'unEscape' modifier to the inner layout like so: -- -- > import XMonad.Layout.Master (mastered) -- > import XMonad.Layout.Tabbed (simpleTabbed) -- > -- > myLayout = Tall ||| unEscape (mastered 0.01 0.5 $ Full ||| simpleTabbed) -- -- you can now send a message to the inner layout with -- @sendMessage $ escape message@, e.g. -- -- > -- Change the inner layout -- > ((modm .|. controlMask, xK_space), sendMessage $ escape NextLayout) -- -- If you want unescaped messages to be handled /only/ by the enclosing -- layout, use the 'ignore' modifier: -- -- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $ -- > unEscape $ mastered 0.01 0.5 -- > $ Full ||| simpleTabbed) -- -- | the Ignore layout modifier. Prevents its inner layout from receiving -- messages of a certain type. 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 } handleMessage l@(I l') sm = case fromMessageAs sm l of Just _ -> return Nothing Nothing -> (I <$>) <$> handleMessage l' sm where fromMessageAs :: Message m' => SomeMessage -> Ignore m' l w -> Maybe m' fromMessageAs a _ = fromMessage a description (I l) = "Ignore "++description l -- | the UnEscape layout modifier. Listens to 'EscapedMessage's and sends -- their nested message to the inner layout. data UnEscape w = UE deriving (Show, Read) instance LayoutModifier UnEscape a where handleMessOrMaybeModifyIt _ mess = return $ case fromMessage mess of Just (Escape mess') -> Just $ Right mess' Nothing -> Nothing -- | Data type for an escaped message. Send with 'escape'. newtype EscapedMessage = Escape SomeMessage instance Message EscapedMessage -- | Creates an 'EscapedMessage'. escape :: Message m => m -> EscapedMessage escape = Escape . SomeMessage -- | Applies the UnEscape layout modifier to a layout. unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w 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 _ = I xmonad-contrib-0.18.0/XMonad/Layout/Minimize.hs0000644000000000000000000000552707346545000017506 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Makes it possible to minimize windows, temporarily removing them -- from the layout until they are restored. -- ----------------------------------------------------------------------------- module XMonad.Layout.Minimize ( -- * Usage -- $usage Minimize, minimize, ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.Minimize (Minimized(..)) import XMonad.Layout.LayoutModifier import XMonad.Layout.BoringWindows as BW import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Minimize -- -- Then edit your @layoutHook@ by adding the Minimize layout modifier: -- -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- The module is designed to work together with "XMonad.Layout.BoringWindows" so -- that minimized windows will be skipped over when switching the focused window with -- the keyboard. Include 'BW.boringWindows' in your layout hook and see the -- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings. -- -- See "XMonad.Actions.Minimize" for possible actions for minimizing/restoring windows -- -- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize -- and restore windows from your taskbar. data Minimize a = Minimize deriving ( Read, Show ) minimize :: l Window -> ModifiedLayout Minimize l Window minimize = ModifiedLayout Minimize instance LayoutModifier Minimize Window where modifierDescription _ = "Minimize" modifyLayout Minimize wksp rect = do minimized <- XS.gets minimizedStack let stack = W.stack wksp filtStack = stack >>= W.filter (`notElem` minimized) runLayout (wksp {W.stack = filtStack}) rect handleMess Minimize m | Just BW.UpdateBoring <- fromMessage m = do minimized <- XS.gets minimizedStack ws <- gets (W.workspace . W.current . windowset) flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized return Nothing | otherwise = return Nothing xmonad-contrib-0.18.0/XMonad/Layout/Monitor.hs0000644000000000000000000001424107346545000017345 0ustar0000000000000000{-# 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) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- Layout modifier for displaying some window (monitor) above other windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.Monitor ( -- * Usage -- $usage -- * Hints and issues -- $hints Monitor(..), monitor, Property(..), MonitorMessage(..), doHideIgnore, manageMonitor -- * TODO -- $todo ) 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) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Monitor -- -- Define 'Monitor' record. 'monitor' can be used as a template. At least 'prop' -- and 'rect' should be set here. Also consider setting 'persistent' to True. -- -- Minimal example: -- -- > myMonitor = monitor -- > { prop = ClassName "SomeClass" -- > , rect = Rectangle 0 0 40 20 -- rectangle 40x20 in upper left corner -- > } -- -- More interesting example: -- -- > clock = monitor { -- > -- Cairo-clock creates 2 windows with the same classname, thus also using title -- > prop = ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock" -- > -- rectangle 150x150 in lower right corner, assuming 1280x800 resolution -- > , rect = Rectangle (1280-150) (800-150) 150 150 -- > -- avoid flickering -- > , persistent = True -- > -- make the window transparent -- > , opacity = 0.6 -- > -- hide on start -- > , visible = False -- > -- assign it a name to be able to toggle it independently of others -- > , name = "clock" -- > } -- -- Add ManageHook to de-manage monitor windows and apply opacity settings. -- -- > manageHook = myManageHook <> manageMonitor clock -- -- Apply layout modifier. -- -- > myLayout = ModifiedLayout clock $ tall ||| Full ||| ... -- -- After that, if there exists a window with specified properties, it will be -- displayed on top of all /tiled/ (not floated) windows on specified -- position. -- -- It's also useful to add some keybinding to toggle monitor visibility: -- -- > , ((mod1Mask, xK_u ), broadcastMessage ToggleMonitor >> refresh) -- -- Screenshot: data Monitor a = Monitor { prop :: Property -- ^ property which uniquely identifies monitor window , rect :: Rectangle -- ^ specifies where to put monitor , visible :: Bool -- ^ is it visible by default? , name :: String -- ^ name of monitor (useful when we have many of them) , persistent :: Bool -- ^ is it shown on all layouts? , opacity :: Rational -- ^ opacity level } deriving (Read, Show) -- | Template for 'Monitor' record. At least 'prop' and 'rect' should be -- redefined. Default settings: 'visible' is 'True', 'persistent' is 'False'. monitor :: Monitor a monitor = Monitor { prop = Const False , rect = Rectangle 0 0 0 0 , visible = True , name = "" , persistent = False , opacity = 1 } -- | Messages without names affect all monitors. Messages with names affect only -- monitors whose names match. data MonitorMessage = ToggleMonitor | ShowMonitor | HideMonitor | ToggleMonitorNamed String | ShowMonitorNamed String | HideMonitorNamed String deriving (Read,Show,Eq) instance Message MonitorMessage withMonitor :: Property -> a -> (Window -> X a) -> X a withMonitor p a fn = do monitorWindows <- allWithProperty p case monitorWindows of [] -> return a w:_ -> fn w instance LayoutModifier Monitor Window where redoLayout mon _ _ rects = withMonitor (prop mon) (rects, Nothing) $ \w -> if visible mon then do tileWindow w (rect mon) reveal w return ((w,rect mon):rects, Nothing) else do hide w return (rects, Nothing) handleMess mon mess | Just ToggleMonitor <- fromMessage mess = return $ Just $ mon { visible = not $ visible mon } | Just (ToggleMonitorNamed n) <- fromMessage mess = return $ if name mon == n then Just $ mon { visible = not $ visible mon } else Nothing | Just ShowMonitor <- fromMessage mess = return $ Just $ mon { visible = True } | Just (ShowMonitorNamed n) <- fromMessage mess = return $ if name mon == n then Just $ mon { visible = True } else Nothing | Just HideMonitor <- fromMessage mess = return $ Just $ mon { visible = False } | Just (HideMonitorNamed n) <- fromMessage mess = return $ if name mon == n then Just $ mon { visible = False } else Nothing | Just Hide <- fromMessage mess = do unless (persistent mon) $ withMonitor (prop mon) () hide; return Nothing | otherwise = return Nothing -- | ManageHook which demanages monitor window and applies opacity settings. manageMonitor :: Monitor a -> ManageHook manageMonitor mon = propertyToQuery (prop mon) --> do w <- ask liftX $ setOpacity w $ opacity mon if persistent mon then doIgnore else doHideIgnore -- $hints -- - This module assumes that there is only one window satisfying property exists. -- -- - If your monitor is available on /all/ layouts, set -- 'persistent' to 'True' to avoid unnecessary -- flickering. You can still toggle monitor with a keybinding. -- -- - You can use several monitors with nested modifiers. Give them names --- to be able to toggle them independently. -- -- - You can display monitor only on specific workspaces with -- "XMonad.Layout.PerWorkspace". -- $todo -- - make Monitor remember the window it manages -- -- - specify position relative to the screen xmonad-contrib-0.18.0/XMonad/Layout/Mosaic.hs0000644000000000000000000001671507346545000017141 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Mosaic -- Description : Give each window a specified amount of screen space relative to the others. -- Copyright : (c) 2009 Adam Vogt, 2007 James Webb -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adamgmail.com -- Stability : unstable -- Portability : unportable -- -- Based on MosaicAlt, but aspect ratio messages always change the aspect -- ratios, and rearranging the window stack changes the window sizes. -- ----------------------------------------------------------------------------- module XMonad.Layout.Mosaic ( -- * Usage -- $usage Aspect(..) ,mosaic ,changeMaster ,changeFocused ,Mosaic ) where import Prelude hiding (sum) 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) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Mosaic -- -- Then edit your @layoutHook@ by adding the Mosaic layout: -- -- > myLayout = mosaic 2 [3,2] ||| Full ||| etc.. -- > main = xmonad $ def { layoutHook = myLayout } -- -- Unfortunately, infinite lists break serialization, so don't use them. And if -- the list is too short, it is extended with @++ repeat 1@, which covers the -- main use case. -- -- To change the choice in aspect ratio and the relative sizes of windows, add -- to your keybindings: -- -- > , ((modm, xK_a), sendMessage Taller) -- > , ((modm, xK_z), sendMessage Wider) -- -- > , ((modm, xK_r), sendMessage Reset) -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data Aspect = Taller | Wider | Reset | SlopeMod ([Rational] -> [Rational]) instance Message Aspect -- | The relative magnitudes (the sign is ignored) of the rational numbers in -- the second argument determine the relative areas that the windows receive. -- The first number represents the size of the master window, the second is for -- the next window in the stack, and so on. -- -- The list is extended with @++ repeat 1@, so @mosaic 1.5 []@ is like a -- resizable grid. -- -- The first parameter is the multiplicative factor to use when responding to -- the 'Expand' message. mosaic :: Rational -> [Rational] -> Mosaic a mosaic = Mosaic Nothing data Mosaic a = -- | True to override the aspect, current index, maximum index Mosaic (Maybe(Bool,Rational,Int)) Rational [Rational] deriving (Read,Show) instance LayoutClass Mosaic a where description = const "Mosaic" pureMessage (Mosaic Nothing _ _) _ = Nothing pureMessage (Mosaic (Just(_,ix,mix)) delta ss) ms = fromMessage ms >>= ixMod where ixMod Taller | round ix >= mix = Nothing | otherwise = Just $ Mosaic (Just(False,succ ix,mix)) delta ss ixMod Wider | round ix <= (0::Integer) = Nothing | otherwise = Just $ Mosaic (Just(False,pred ix,mix)) delta ss ixMod Reset = Just $ Mosaic Nothing delta ss ixMod (SlopeMod f) = Just $ Mosaic (Just(False,ix,mix)) delta (f ss) handleMessage l@(Mosaic _ delta _) ms | Just Expand <- fromMessage ms = changeFocused (*delta) >> return Nothing | Just Shrink <- fromMessage ms = changeFocused (/delta) >> return Nothing | otherwise = return $ pureMessage l ms doLayout (Mosaic state delta ss) r st = let ssExt = zipWith const (ss ++ repeat 1) $ W.integrate st rects = splits r ssExt nls = length rects fi = fromIntegral 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) 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 in return (zip (W.integrate st) rect, Just $ Mosaic state' delta ss') zipRemain :: [a] -> [b] -> Maybe (Either [a] [b]) zipRemain (_:xs) (_:ys) = zipRemain xs ys zipRemain [] [] = Nothing zipRemain [] y = Just (Right y) zipRemain x [] = Just (Left x) -- | These sample functions are meant to be applied to the list of window sizes -- through the 'SlopeMod' message. changeMaster :: (Rational -> Rational) -> X () changeMaster = sendMessage . SlopeMod . onHead -- | Apply a function to the Rational that represents the currently focused -- window. -- -- 'Expand' and 'Shrink' messages are responded to with @changeFocused -- (*delta)@ or @changeFocused (delta/)@ where @delta@ is the first argument to -- 'mosaic'. -- -- This is exported because other functions (ex. @const 1@, @(+1)@) may be -- useful to apply to the current area. changeFocused :: (Rational -> Rational) -> X () changeFocused f = withWindowSet $ sendMessage . SlopeMod . maybe id (mulIx . length . W.up) . W.stack . W.workspace . W.current where mulIx i = uncurry (++) . second (onHead f) . splitAt i onHead :: (a -> a) -> [a] -> [a] onHead f = uncurry (++) . first (fmap f) . splitAt 1 splits :: Rectangle -> [Rational] -> [[Rectangle]] splits rect = map (reverse . map snd . sortBy (compare `on` fst)) . splitsL rect . makeTree snd . zip [1..] . normalize . reverse . map abs splitsL :: Rectangle -> Tree (Int,Rational) -> [[(Int,Rectangle)]] splitsL _rect Empty = [] splitsL rect (Leaf (x,_)) = [[(x,rect)]] splitsL rect (Branch l r) = do let mkSplit f = f ((sumSnd l /) $ sumSnd l + sumSnd r) rect sumSnd = sum . fmap snd (rl,rr) <- map mkSplit [splitVerticallyBy,splitHorizontallyBy] splitsL rl l `interleave` splitsL rr r -- like zipWith (++), but when one list is shorter, its elements are duplicated -- so that they match interleave :: [[a]] -> [[a]] -> [[a]] interleave xs ys | lx > ly = zc xs (extend lx ys) | otherwise = zc (extend ly xs) ys where lx = length xs ly = length ys zc = zipWith (++) extend :: Int -> [a] -> [a] extend n pat = do (p,e) <- zip pat $ replicate m True ++ repeat False [p | e] ++ replicate d p where (d,m) = n `divMod` length pat normalize :: Fractional a => [a] -> [a] normalize x = let s = sum x in map (/s) x data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty deriving (Functor, Show, Foldable) instance Semigroup (Tree a) where Empty <> x = x x <> Empty = x x <> y = Branch x y instance Monoid (Tree a) where mempty = Empty makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree _ [] = Empty makeTree _ [x] = Leaf x makeTree f xs = Branch (makeTree f a) (makeTree f b) where ((a,b),_) = foldr go (([],[]),(0,0)) xs go n ((ls,rs),(l,r)) | l > r = ((ls,n:rs),(l,f n+r)) | otherwise = ((n:ls,rs),(f n+l,r)) xmonad-contrib-0.18.0/XMonad/Layout/MosaicAlt.hs0000644000000000000000000001526707346545000017603 0ustar0000000000000000{-# 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) -- -- Maintainer : xmonad#jwebb,sygneca,com -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.MosaicAlt ( -- * Usage: -- $usage MosaicAlt(..) , shrinkWindowAlt , expandWindowAlt , tallWindowAlt , wideWindowAlt , resetAlt , Params, Param , HandleWindowAlt ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M import XMonad.Prelude ( sortBy ) import Data.Ratio -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MosaicAlt -- > import qualified Data.Map as M -- -- Then edit your @layoutHook@ by adding the MosaicAlt layout: -- -- > myLayout = MosaicAlt M.empty ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key-bindings, do something like: -- -- > , ((modm .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt)) -- > , ((modm .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt)) -- > , ((modm .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt)) -- > , ((modm .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt)) -- > , ((modm .|. controlMask, xK_space), sendMessage resetAlt) -- > ... -- -- For detailed instruction on editing the key binding see: -- -- . data HandleWindowAlt = ShrinkWindowAlt Window | ExpandWindowAlt Window | TallWindowAlt Window | WideWindowAlt Window | ResetAlt deriving ( Eq ) instance Message HandleWindowAlt shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt shrinkWindowAlt = ShrinkWindowAlt expandWindowAlt = ExpandWindowAlt tallWindowAlt = TallWindowAlt wideWindowAlt = WideWindowAlt resetAlt :: HandleWindowAlt resetAlt = ResetAlt data Param = Param { area, aspect :: Rational } deriving ( Show, Read ) type Params = M.Map Window Param newtype MosaicAlt a = MosaicAlt Params deriving ( Show, Read ) instance LayoutClass MosaicAlt Window where description _ = "MosaicAlt" doLayout (MosaicAlt params) rect stack = 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 handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1 Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1 Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4) Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4) Just ResetAlt -> Just $ MosaicAlt M.empty _ -> Nothing -- Change requested params for a window. alter :: Params -> Window -> Rational -> Rational -> Params alter params win arDelta asDelta = case M.lookup win params of Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params -- Layout algorithm entry point. arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)] arrange rect stack params = r where (_, r) = findSplits 3 rect tree params tree = makeTree (sortBy areaCompare wins) params wins = reverse (W.up stack) ++ W.focus stack : W.down stack areaCompare a b = or1 b `compare` or1 a or1 w = maybe 1 area $ M.lookup w params -- Recursively group windows into a binary tree. Aim to balance the tree -- according to the total requested area in each branch. data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None makeTree :: [Window] -> Params -> Tree makeTree wins params = case wins of [] -> None [x] -> Leaf x _ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params) where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins -- Split a list of windows in half by area. areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational)) areaSplit params = gather [] 0 [] 0 where gather a aa b ba (r : rs) = if aa <= ba then gather (r : a) (aa + or1 r) b ba rs else gather a aa (r : b) (ba + or1 r) rs gather a aa b ba [] = ((reverse a, aa), (b, ba)) or1 w = maybe 1 area $ M.lookup w params -- Figure out which ways to split the space, by exhaustive search. -- Complexity is quadratic in the number of windows. findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)]) findSplits _ _ None _ = (0, []) findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)]) findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params = if hBadness < vBadness then (hBadness, hList) else (vBadness, vList) where (hBadness, hList) = trySplit splitHorizontallyBy (vBadness, vList) = trySplit splitVerticallyBy trySplit splitBy = (aBadness + bBadness, aList ++ bList) where (aBadness, aList) = findSplits (depth - 1) aRect aTree params (bBadness, bList) = findSplits (depth - 1) bRect bTree params (aRect, bRect) = splitBy ratio rect ratio = aArea / (aArea + bArea) -- Decide how much we like this rectangle. aspectBadness :: Rectangle -> Window -> Params -> Double 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 a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params) w = fromIntegral $ rect_width rect h = fromIntegral $ rect_height rect -- vim: sw=4:et xmonad-contrib-0.18.0/XMonad/Layout/MouseResizableTile.hs0000644000000000000000000004032107346545000021463 0ustar0000000000000000{-# 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option -- to use the mouse to adjust the layout. -- ----------------------------------------------------------------------------- module XMonad.Layout.MouseResizableTile ( -- * Usage -- $usage mouseResizableTile, mouseResizableTileMirrored, MRTMessage (ShrinkSlave, ExpandSlave, SetMasterFraction, SetLeftSlaveFraction, SetRightSlaveFraction), -- * Parameters -- $mrtParameters nmaster, masterFrac, slaveFrac, fracIncrement, isMirrored, draggerType, DraggerType (..), MouseResizableTile, ) where import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Util.XUtils import Graphics.X11 as X -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MouseResizableTile -- -- Then edit your @layoutHook@ by adding the MouseResizableTile layout. -- Either in its normal form or the mirrored version. (The mirror layout modifier -- will not work correctly here because of the use of the mouse.) -- -- > myLayout = mouseResizableTile ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to add the following key bindings: -- -- > , ((modm, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area -- > , ((modm, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area -- -- For detailed instruction on editing the key binding see: -- -- . -- $mrtParameters -- The following functions are also labels for updating the @data@ (whose -- representation is otherwise hidden) produced by 'mouseResizableTile'. -- -- Usage: -- -- > myLayout = mouseResizableTile{ masterFrac = 0.7, -- > fracIncrement = 0.05, -- > draggerType = BordersDragger } -- > ||| etc.. data MRTMessage = SetMasterFraction Rational | SetLeftSlaveFraction Int Rational | SetRightSlaveFraction Int Rational | ShrinkSlave | ExpandSlave instance Message MRTMessage data DraggerInfo = MasterDragger Position Rational | LeftSlaveDragger Position Rational Int | RightSlaveDragger Position Rational Int deriving (Show, Read) type DraggerWithRect = (Rectangle, Glyph, DraggerInfo) type DraggerWithWin = (Window, DraggerInfo) -- | Specifies the size of the clickable area between windows. data DraggerType = FixedDragger { gapWidth :: Dimension -- ^ width of a gap between windows , draggerWidth :: Dimension -- ^ width of the dragger itself -- (will overlap windows if greater than gap) } | BordersDragger -- ^ no gaps, draggers overlap window borders deriving (Show, Read) type DraggerGeometry = (Position, Dimension, Position, Dimension) data MouseResizableTile a = MRT { nmaster :: Int, -- ^ Get/set the number of windows in -- master pane (default: 1). masterFrac :: Rational, -- ^ Get/set the proportion of screen -- occupied by master pane (default: 1/2). slaveFrac :: Rational, -- ^ Get/set the proportion of remaining -- space in a column occupied by a slave -- window (default: 1/2). fracIncrement :: Rational, -- ^ Get/set the increment used when -- modifying masterFrac/slaveFrac by the -- Shrink, Expand, etc. messages (default: -- 3/100). leftFracs :: [Rational], rightFracs :: [Rational], draggers :: [DraggerWithWin], draggerType :: DraggerType, -- ^ Get/set dragger and gap dimensions -- (default: FixedDragger 6 6). focusPos :: Int, numWindows :: Int, isMirrored :: Bool -- ^ Get/set whether the layout is -- mirrored (default: False). } deriving (Show, Read) mouseResizableTile :: MouseResizableTile a mouseResizableTile = MRT 1 0.5 0.5 0.03 [] [] [] (FixedDragger 6 6) 0 0 False -- | May be removed in favor of @mouseResizableTile { isMirrored = True }@ mouseResizableTileMirrored :: MouseResizableTile a mouseResizableTileMirrored = mouseResizableTile { isMirrored = True } instance LayoutClass MouseResizableTile Window where doLayout st sr (W.Stack w l r) = do drg <- draggerGeometry $ draggerType st let wins = reverse l ++ w : r num = length wins sr' = mirrorAdjust sr (mirrorRect sr) (rects, preparedDraggers) = tile (nmaster st) (masterFrac st) (leftFracs st ++ repeat (slaveFrac st)) (rightFracs st ++ repeat (slaveFrac st)) sr' num drg rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects mapM_ deleteDragger $ draggers st (draggerWrs, newDraggers) <- mapAndUnzipM (createDragger sr . adjustForMirror (isMirrored st)) preparedDraggers return (draggerWrs ++ zip wins rects', Just $ st { draggers = newDraggers, focusPos = length l, numWindows = length wins }) where mirrorAdjust a b = if isMirrored st then b else a handleMessage st m | Just (IncMasterN d) <- fromMessage m = return $ Just $ st { nmaster = max 0 (nmaster st + d) } | Just Shrink <- fromMessage m = return $ Just $ st { masterFrac = max 0 (masterFrac st - fracIncrement st) } | Just Expand <- fromMessage m = return $ Just $ st { masterFrac = min 1 (masterFrac st + fracIncrement st) } | Just ShrinkSlave <- fromMessage m = return $ Just $ modifySlave st (- fracIncrement st) | Just ExpandSlave <- fromMessage m = return $ Just $ modifySlave st (fracIncrement st) | Just (SetMasterFraction f) <- fromMessage m = return $ Just $ st { masterFrac = max 0 (min 1 f) } | Just (SetLeftSlaveFraction pos f) <- fromMessage m = return $ Just $ st { leftFracs = replaceAtPos (slaveFrac st) (leftFracs st) pos (max 0 (min 1 f)) } | Just (SetRightSlaveFraction pos f) <- fromMessage m = return $ Just $ st { rightFracs = replaceAtPos (slaveFrac st) (rightFracs st) pos (max 0 (min 1 f)) } | Just e <- fromMessage m :: Maybe Event = handleResize (draggers st) (isMirrored st) e >> return Nothing | Just Hide <- fromMessage m = releaseResources >> return (Just $ st { draggers = [] }) | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ st { draggers = [] }) where releaseResources = mapM_ deleteDragger $ draggers st handleMessage _ _ = return Nothing description st = mirror "MouseResizableTile" where mirror = if isMirrored st then ("Mirror " ++) else id draggerGeometry :: DraggerType -> X DraggerGeometry draggerGeometry (FixedDragger g d) = return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d) draggerGeometry BordersDragger = do 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 then xC_sb_v_double_arrow else xC_sb_h_double_arrow modifySlave :: MouseResizableTile a -> Rational -> MouseResizableTile a modifySlave st delta = let pos = focusPos st num = numWindows st nmaster' = nmaster st leftFracs' = leftFracs st rightFracs' = rightFracs st slFrac = slaveFrac st draggersLeft = nmaster' - 1 draggersRight = (num - nmaster') - 1 in if pos < nmaster' then if draggersLeft > 0 then let draggerPos = min (draggersLeft - 1) pos oldFraction = (leftFracs' ++ repeat slFrac) !! draggerPos in st { leftFracs = replaceAtPos slFrac leftFracs' draggerPos (max 0 (min 1 (oldFraction + delta))) } else st else if draggersRight > 0 then let draggerPos = min (draggersRight - 1) (pos - nmaster') oldFraction = (rightFracs' ++ repeat slFrac) !! draggerPos in st { rightFracs = replaceAtPos slFrac rightFracs' draggerPos (max 0 (min 1 (oldFraction + delta))) } else st replaceAtPos :: (Num t, Eq t) => Rational -> [Rational] -> t -> Rational -> [Rational] replaceAtPos _ [] 0 x' = [x'] replaceAtPos d [] pos x' = d : replaceAtPos d [] (pos - 1) x' replaceAtPos _ (_:xs) 0 x' = x' : xs replaceAtPos d (x:xs) pos x' = x : replaceAtPos d xs (pos -1 ) x' 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) within :: (Ord a) => a -> a -> a -> a within low high a = max low $ min high a tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect]) tile nmaster' masterFrac' leftFracs' rightFracs' sr num drg | num <= nmaster' = splitVertically (take (num - 1) leftFracs') sr True 0 drg | nmaster' == 0 = splitVertically (take (num - 1) rightFracs') sr False 0 drg | otherwise = (leftRects ++ rightRects, masterDragger : leftDraggers ++ rightDraggers) where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr drg (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0 drg (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0 drg splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect]) splitVertically [] r _ _ _ = ([r], []) splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num drg@(drOff, drSz, drOff2, drSz2) = let nextRect = Rectangle sx sy sw $ smallh - div drSz 2 (otherRects, otherDragger) = splitVertically fx (Rectangle sx (sy + fromIntegral smallh + drOff) sw (sh - smallh - div drSz 2)) isLeft (num + 1) drg draggerRect = Rectangle sx (sy + fromIntegral smallh - drOff2) sw drSz2 draggerInfo = if isLeft then LeftSlaveDragger sy (fromIntegral sh) num else RightSlaveDragger sy (fromIntegral sh) num nextDragger = (draggerRect, xC_sb_v_double_arrow, draggerInfo) in (nextRect : otherRects, nextDragger : otherDragger) where smallh = floor $ fromIntegral sh * f splitHorizontallyBy :: RealFrac r => r -> Rectangle -> DraggerGeometry -> ((Rectangle, Rectangle), DraggerWithRect) splitHorizontallyBy f (Rectangle sx sy sw sh) (drOff, drSz, drOff2, drSz2) = ((leftHalf, rightHalf), (draggerRect, xC_sb_h_double_arrow, draggerInfo)) where leftw = floor $ fromIntegral sw * f leftHalf = Rectangle sx sy (leftw - drSz `div` 2) sh rightHalf = Rectangle (sx + fromIntegral leftw + drOff) sy (sw - fromIntegral leftw - drSz `div` 2) sh draggerRect = Rectangle (sx + fromIntegral leftw - drOff2) sy drSz2 sh draggerInfo = MasterDragger sx (fromIntegral sw) createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin) createDragger sr (draggerRect, draggerCursor, draggerInfo) = do let draggerRect' = sanitizeRectangle sr draggerRect draggerWin <- createInputWindow draggerCursor draggerRect' return ((draggerWin, draggerRect'), (draggerWin, draggerInfo)) deleteDragger :: DraggerWithWin -> X () deleteDragger (draggerWin, _) = deleteWindow draggerWin handleResize :: [DraggerWithWin] -> Bool -> Event -> X () handleResize draggers' isM ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress, Just x <- lookup ew draggers' = case x of MasterDragger lb r -> mouseDrag' id lb r SetMasterFraction LeftSlaveDragger lb r num -> mouseDrag' flip lb r (SetLeftSlaveFraction num) RightSlaveDragger lb r num -> mouseDrag' flip lb r (SetRightSlaveFraction num) where chooseAxis isM' axis1 axis2 = if isM' then axis2 else axis1 mouseDrag' flp lowerBound range msg = flip mouseDrag (return ()) $ \x y -> do let axis = flp (chooseAxis isM) x y fraction = fromIntegral (axis - lowerBound) / range sendMessage (msg fraction) handleResize _ _ _ = return () createInputWindow :: Glyph -> Rectangle -> X Window createInputWindow cursorGlyph r = withDisplay $ \d -> do win <- mkInputWindow d r io $ selectInput d win (exposureMask .|. buttonPressMask) cursor <- io $ createFontCursor d cursorGlyph io $ defineCursor d win cursor io $ freeCursor d cursor showWindow win return win mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do rw <- asks theRoot let screen = defaultScreenOfDisplay d visual = defaultVisualOfScreen screen attrmask = cWOverrideRedirect io $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes xmonad-contrib-0.18.0/XMonad/Layout/MultiColumns.hs0000644000000000000000000001451407346545000020354 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MultiColumns -- Description : A layout that tiles windows in a growing number of columns. -- Copyright : (c) Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- This layout tiles windows in a growing number of columns. The number of -- windows in each column can be controlled by messages. ----------------------------------------------------------------------------- module XMonad.Layout.MultiColumns ( -- * Usage -- $usage multiCol, MultiCol, ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Prelude -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MultiColumns -- -- Then edit your @layoutHook@ by adding the multiCol layout: -- -- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc.. -- > main = xmonad def { layoutHook = myLayouts } -- -- Or alternatively: -- -- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc.. -- > main = xmonad def { layoutHook = myLayouts } -- -- The maximum number of windows in a column can be controlled using the -- IncMasterN messages and the column containing the focused window will be -- modified. If the value is 0, all remaining windows will be placed in that -- column when all columns before that has been filled. -- -- The size can be set to between 1 and -0.5. If the value is positive, the -- master column will be of that size. The rest of the screen is split among -- the other columns. But if the size is negative, it instead indicates the -- size of all non-master columns and the master column will cover the rest of -- the screen. If the master column would become smaller than the other -- columns, the screen is instead split equally among all columns. Therefore, -- if equal size among all columns are desired, set the size to -0.5. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Layout constructor. multiCol :: [Int] -- ^ Windows in each column, starting with master. Set to 0 to catch the rest. -> Int -- ^ Default value for all following columns. -> Rational -- ^ How much to change size each time. -> Rational -- ^ Initial size of master area, or column area if the size is negative. -> MultiCol a multiCol n defn ds s = MultiCol (map (max 0) n) (max 0 defn) ds s 0 data MultiCol a = MultiCol { multiColNWin :: ![Int] , multiColDefWin :: !Int , multiColDeltaSize :: !Rational , multiColSize :: !Rational , multiColActive :: !Int } deriving (Show,Read,Eq) instance LayoutClass MultiCol a where doLayout l r s = return (combine s rlist, resl) where rlist = doL (multiColNWin l') (multiColSize l') r wlen wlen = length $ W.integrate s -- Make sure the list of columns is big enough and update active column nw = multiColNWin l ++ repeat (multiColDefWin l) l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw , multiColActive = getCol (length $ W.up s) nw } -- Only return new layout if it has been modified resl = if l'==l then Nothing else Just l' combine (W.Stack foc left right) rs = zip (foc : reverse left ++ right) $ raiseFocused (length left) rs handleMessage l m = return $ msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = l { multiColSize = max (-0.5) $ s-ds } resize Expand = l { multiColSize = min 1 $ s+ds } incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ drop 1 r } where newval = max 0 $ maybe 0 (x +) (listToMaybe r) r = drop a n n = multiColNWin l ds = multiColDeltaSize l s = multiColSize l a = multiColActive l description _ = "MultiCol" raiseFocused :: Int -> [a] -> [a] raiseFocused n xs = actual ++ before ++ after where (before,rest) = splitAt n xs (actual,after) = splitAt 1 rest -- | Get which column a window is in, starting at 0. getCol :: Int -> [Int] -> Int getCol w (n:ns) = if n<1 || w < n then 0 else 1 + getCol (w-n) ns -- Should never occur... getCol _ _ = -1 doL :: [Int] -> Rational -> Rectangle -> Int -> [Rectangle] doL nwin s r n = rlist where -- Number of columns to tile ncol = getCol (n-1) nwin + 1 -- Compute the actual size size = floor $ abs s * fromIntegral (rect_width r) -- Extract all but last column to tile c = take (ncol-1) nwin -- Compute number of windows in last column and add it to the others col = c ++ [n-sum c] -- Compute width of columns 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 accumEx a (x:xs) = a:accumEx (a+x) xs accumEx _ _ = [] -- 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 splitVertically col cr xmonad-contrib-0.18.0/XMonad/Layout/MultiDishes.hs0000644000000000000000000000622107346545000020147 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : Nathan Fairhurst -- Stability : unstable -- Portability : portable -- -- MultiDishes is a layout that stacks groups of extra windows underneath -- the master windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.MultiDishes ( -- * Usage -- $usage MultiDishes (..) ) where import XMonad import XMonad.StackSet (integrate) import XMonad.Prelude (ap) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MultiDishes -- -- Then edit your @layoutHook@ by adding the MultiDishes layout: -- -- > myLayout = MultiDishes 2 3 (1/6) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- This is based on the Layout Dishes, but accepts another parameter for -- the maximum number of dishes allowed within a stack. -- -- > MultiDishes x 1 y -- is equivalent to -- > Dishes x y -- -- The stack with the fewest dishes is always on top, so 4 windows -- with the layout `MultiDishes 1 2 (1/5)` would look like this: -- -- > _________ -- > | | -- > | M | -- > |_______| -- > |_______| -- > |___|___| -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read) instance LayoutClass MultiDishes a where pureLayout (MultiDishes nmaster dishesPerStack h) r = ap zip (multiDishes h r nmaster dishesPerStack . length) . integrate pureMessage (MultiDishes nmaster dishesPerStack h) m = fmap incmastern (fromMessage m) where incmastern (IncMasterN d) = MultiDishes (max 0 (nmaster+d)) dishesPerStack h multiDishes :: Rational -> Rectangle -> Int -> Int -> Int -> [Rectangle] multiDishes h s nmaster dishesPerStack n = if n <= nmaster then splitHorizontally n s else ws where (filledDishStackCount, remainder) = (n - nmaster) `quotRem` max 1 dishesPerStack (firstDepth, dishStackCount) = if remainder == 0 then (dishesPerStack, filledDishStackCount) else (remainder, filledDishStackCount + 1) (masterRect, dishesRect) = splitVerticallyBy (1 - fromIntegral dishStackCount * h) s dishStackRects = splitVertically dishStackCount dishesRect allDishRects = case dishStackRects of (firstStack:bottomDishStacks) -> splitHorizontally firstDepth firstStack ++ (bottomDishStacks >>= splitHorizontally dishesPerStack) [] -> [] ws = splitHorizontally nmaster masterRect ++ allDishRects xmonad-contrib-0.18.0/XMonad/Layout/MultiToggle.hs0000644000000000000000000002016507346545000020154 0ustar0000000000000000{-# 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) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- 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\"). module XMonad.Layout.MultiToggle ( -- * Usage -- $usage Transformer(..), Toggle(..), (??), EOT(..), single, mkToggle, mkToggle1, isToggleActive, HList, HCons, MultiToggle, ) where import XMonad import XMonad.Prelude hiding (find) import XMonad.StackSet (Workspace(..)) import Control.Arrow import Data.IORef import Data.Typeable -- $usage -- The basic idea is to have a base layout and a set of layout transformers, -- of which at most one is active at any time. Enabling another transformer -- first disables any currently active transformer; i.e. it works like a -- group of radio buttons. -- -- To use this module, you need some data types which represent -- transformers; for some commonly used transformers (including -- MIRROR, NOBORDERS, and FULL used in the examples below) you can -- simply import "XMonad.Layout.MultiToggle.Instances". -- -- Somewhere else in your file you probably have a definition of @layout@; -- the default looks like this: -- -- > layout = tiled ||| Mirror tiled ||| Full -- -- After changing this to -- -- > layout = mkToggle (single MIRROR) (tiled ||| Full) -- -- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation: -- -- > ... -- > , ((modm, xK_x ), sendMessage $ Toggle MIRROR) -- > ... -- -- (That should be part of your key bindings.) When you press @mod-x@, the -- active layout is mirrored. Another @mod-x@ and it's back to normal. -- -- It's also possible to stack @MultiToggle@s. For example: -- -- @ -- layout = id -- . 'XMonad.Layout.NoBorders.smartBorders' -- . mkToggle (NOBORDERS ?? FULL ?? EOT) -- . mkToggle (single MIRROR) -- $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle' -- @ -- -- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily -- maximize windows, in addition to being able to rotate layouts and remove -- window borders. -- -- You can also define your own transformers by creating a data type -- which is an instance of the 'Transformer' class. For example, here -- is the definition of @MIRROR@: -- -- > 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 -- TypeSynonymInstances, MultiParamTypeClasses \#-}@ at the -- beginning of your file. -- | A class to identify custom transformers (and look up transforming -- functions by type). class (Eq t, Typeable t) => Transformer t a | t -> a where transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b data EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a) unEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b unEL (EL x _) k = k x deEL :: (LayoutClass l a) => EL l a -> l a deEL (EL x det) = det x transform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a transform' t (EL l det) = transform t l (\l' det' -> EL l' (det . det')) -- | Toggle the specified layout transformer. data Toggle a = forall t. (Transformer t a) => Toggle t instance (Typeable a) => Message (Toggle a) data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts deriving (Read, Show) data MultiToggle ts l a = MultiToggle{ currLayout :: EL l a, currIndex :: Maybe Int, transformers :: ts } expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a expand (MultiToggleS b i ts) = resolve ts (fromMaybe (-1) i) id (\x mt -> let g = transform' x in mt{ currLayout = g $ currLayout mt } ) (MultiToggle (EL b id) i ts) collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a collapse mt = MultiToggleS (deEL (currLayout mt)) (currIndex mt) (transformers mt) instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where readsPrec p s = map (first expand) $ readsPrec p s instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where showsPrec p = showsPrec p . collapse -- | Construct a @MultiToggle@ layout from a transformer table and a base -- layout. mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a mkToggle ts l = MultiToggle (EL l id) Nothing ts -- | Construct a @MultiToggle@ layout from a single transformer and a base -- layout. mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a mkToggle1 t = mkToggle (single t) -- | Marks the end of a transformer list. data EOT = EOT deriving (Read, Show) data HCons a b = HCons a b deriving (Read, Show) infixr 0 ?? -- | Prepend an element to a heterogeneous list. Used to build transformer -- tables for 'mkToggle'. (??) :: a -> b -> HCons a b (??) = HCons -- | Construct a singleton transformer table. single :: a -> HCons a EOT single = (?? EOT) class HList c a where find :: (Transformer t a) => c -> t -> Maybe Int resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b instance HList EOT w where find EOT _ = Nothing resolve EOT _ d _ = d instance (Transformer a w, HList b w) => HList (HCons a b) w where find (HCons x xs) t | t `geq` x = Just 0 | otherwise = fmap succ (find xs t) resolve (HCons x xs) n d k = case n `compare` 0 of LT -> d EQ -> k x GT -> resolve xs (pred n) d k geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool geq a b = Just a == cast b 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 $ (\x -> mt { currLayout = EL x det })) <$> runLayout (Workspace i l s) r handleMessage mt m | Just (Toggle t) <- fromMessage m , i@(Just _) <- find (transformers mt) t = case currLayout mt of EL l det -> do 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 | 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 (\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-contrib-0.18.0/XMonad/Layout/MultiToggle/0000755000000000000000000000000007346545000017614 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Layout/MultiToggle/Instances.hs0000644000000000000000000000277107346545000022106 0ustar0000000000000000{-# 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) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Some convenient common instances of the -- 'XMonad.Layout.MultiToggle.Transformer' class, for use with -- "XMonad.Layout.MultiToggle". module XMonad.Layout.MultiToggle.Instances ( StdTransformers(..) ) where import XMonad.Layout.MultiToggle import XMonad import XMonad.Layout.NoBorders import XMonad.Layout.LayoutModifier data StdTransformers = FULL -- ^ switch to Full layout | NBFULL -- ^ switch to Full with no borders | MIRROR -- ^ Mirror the current layout. | NOBORDERS -- ^ Remove borders. | SMARTBORDERS -- ^ Apply smart borders. deriving (Read, Show, Eq) instance Transformer StdTransformers Window where transform FULL x k = k Full (const x) transform NBFULL x k = k (noBorders Full) (const x) transform MIRROR x k = k (Mirror x) (\(Mirror x') -> x') transform NOBORDERS x k = k (noBorders x) (\(ModifiedLayout _ x') -> x') transform SMARTBORDERS x k = k (smartBorders x) (\(ModifiedLayout _ x') -> x') xmonad-contrib-0.18.0/XMonad/Layout/MultiToggle/TabBarDecoration.hs0000644000000000000000000000307207346545000023315 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MultiToggle.TabBarDecoration -- Copyright : (c) 2018 Lucian Poston -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Provides a simple transformer for use with "XMonad.Layout.MultiToggle" to -- dynamically toggle "XMonad.Layout.TabBarDecoration". ----------------------------------------------------------------------------- module XMonad.Layout.MultiToggle.TabBarDecoration ( SimpleTabBar(..) ) where import XMonad.Layout.MultiToggle import XMonad import XMonad.Layout.LayoutModifier import XMonad.Layout.TabBarDecoration -- $usage -- To use this module with "XMonad.Layout.MultiToggle", add the @SIMPLETABBAR@ -- to your layout For example, from a basic layout like -- -- > layout = tiled ||| Full -- -- Add @SIMPLETABBAR@ by changing it this to -- -- > layout = mkToggle (single SIMPLETABBAR) (tiled ||| Full) -- -- You can now dynamically toggle the 'XMonad.Layout.TabBarDecoration' -- transformation by adding a key binding such as @mod-x@ as follows. -- -- > ... -- > , ((modm, xK_x ), sendMessage $ Toggle SIMPLETABBAR) -- > ... -- | Transformer for "XMonad.Layout.TabBarDecoration". data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq) instance Transformer SimpleTabBar Window where transform _ x k = k (simpleTabBar x) (\(ModifiedLayout _ (ModifiedLayout _ x')) -> x') xmonad-contrib-0.18.0/XMonad/Layout/Named.hs0000644000000000000000000000315407346545000016743 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Named -- Description : Assign a name to a given layout. -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- A module for assigning a name to a given layout. Deprecated, use -- "XMonad.Layout.Renamed" instead. -- ----------------------------------------------------------------------------- module XMonad.Layout.Named {-# DEPRECATED "Use XMonad.Layout.Renamed instead" #-} ( -- * Usage -- $usage named, nameTail ) where import XMonad.Layout.LayoutModifier import XMonad.Layout.Renamed -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Named -- -- Then edit your @layoutHook@ by adding the Named layout modifier -- to some layout: -- -- > myLayout = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Note that this module has been deprecated and may be removed in a future -- release, please use "XMonad.Layout.Renamed" instead. -- | (Deprecated) Remove the first word of the name. nameTail :: l a -> ModifiedLayout Rename l a nameTail = renamed [CutWordsLeft 1] xmonad-contrib-0.18.0/XMonad/Layout/NoBorders.hs0000644000000000000000000003617407346545000017624 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {-# 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 -- 2018 Yclept Nemo -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.NoBorders ( -- * Usage -- $usage noBorders , smartBorders , withBorder , lessBorders , hasBorder , SetsAmbiguous(..) , Ambiguity(..) , With(..) , BorderMessage (..), borderEventHook , SmartBorder, WithBorder, ConfigurableBorder ) 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 qualified Data.Map as M -- $usage -- You can use this module with the following in your xmonad.hs file: -- -- > import XMonad.Layout.NoBorders -- -- and modify the layouts to call noBorders on the layouts you want to lack -- borders: -- -- > layoutHook = ... ||| noBorders Full ||| ... -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- todo, use an InvisibleList. data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show ) instance LayoutModifier WithBorder Window where unhook (WithBorder _ s) = asks (borderWidth . config) >>= setBorders s redoLayout (WithBorder n s) _ _ wrs = do asks (borderWidth . config) >>= setBorders (s \\ ws) setBorders ws n return (wrs, Just $ WithBorder n ws) where ws = map fst wrs -- | Removes all window borders from the specified layout. noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window noBorders = withBorder 0 -- | Forces a layout to use the specified border width. 'noBorders' is -- equivalent to @'withBorder' 0@. withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a withBorder b = ModifiedLayout $ WithBorder b [] setBorders :: [Window] -> Dimension -> X () setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws singleton :: [a] -> Bool singleton = null . drop 1 type SmartBorder = ConfigurableBorder Ambiguity -- | Removes the borders from a window under one of the following conditions: -- -- * There is only one screen and only one window. In this case it's obvious -- that it has the focus, so no border is needed. -- -- * A floating window covers the entire screen (e.g. mplayer). -- smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a smartBorders = lessBorders Never -- | Apply a datatype that has a SetsAmbiguous instance to provide a list of -- windows that should not have borders. -- -- This gives flexibility over when borders should be drawn, in particular with -- xinerama setups: 'Ambiguity' has a number of useful 'SetsAmbiguous' -- instances lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) => p -> l a -> ModifiedLayout (ConfigurableBorder p) l a lessBorders amb = ModifiedLayout (ConfigurableBorder amb [] [] []) -- | 'ManageHook' for sending 'HasBorder' messages: -- -- > title =? "foo" --> hasBorder True -- -- There is no equivalent for 'ResetBorder'. hasBorder :: Bool -> ManageHook hasBorder b = ask >>= \w -> liftX (broadcastMessage $ HasBorder b w) >> idHook data BorderMessage = HasBorder Bool Window -- ^ If @True@, never remove the border from the specified window. If -- @False@, always remove the border from the specified window. | ResetBorder Window -- ^ Reset the effects of any 'HasBorder' messages on the specified -- window. instance Message BorderMessage data ConfigurableBorder p w = ConfigurableBorder { _generateHidden :: p -- ^ Generates a list of windows without borders. Uses 'SetsAmbiguous' -- to filter the current layout. , alwaysHidden :: [w] -- ^ Windows that never have borders. This list is added to the result -- of 'generateHidden'. , neverHidden :: [w] -- ^ Windows that always have borders - i.e. ignored by this module. -- This list is subtraced from 'alwaysHidden' and so has higher -- precendence. , currentHidden :: [w] -- ^ The current set of windows without borders, i.e. the state. } deriving (Read, Show) -- | Only necessary with 'BorderMessage' - remove non-existent windows from the -- 'alwaysHidden' or 'neverHidden' lists. borderEventHook :: Event -> X All borderEventHook DestroyWindowEvent{ ev_window = w } = do broadcastMessage $ ResetBorder w return $ All True borderEventHook _ = return $ All True instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do let gh' wset = let lh = hiddens gh wset lr mst wrs in return $ (ah `union` lh) \\ nh ch' <- withWindowSet gh' asks (borderWidth . config) >>= setBorders (ch \\ ch') setBorders ch' 0 return (wrs, Just $ cb { currentHidden = ch' }) pureMess cb@(ConfigurableBorder gh ah nh ch) m | 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) <*> consNewIf nh b <*> pure ch | Just (ResetBorder w) <- fromMessage m = let delete' e l = if e `elem` l then (True,delete e l) else (False,l) (da,ah') = delete' w ah (dn,nh') = delete' w nh in if da || dn then Just cb { alwaysHidden = ah', neverHidden = nh' } else Nothing | otherwise = Nothing -- | SetsAmbiguous allows custom actions to generate lists of windows that -- should not have borders drawn through 'ConfigurableBorder' -- -- To add your own (though perhaps those options would better belong as an -- additional constructor to 'Ambiguity'), you can add the following function. -- Note that @lr@, the parameter representing the 'Rectangle' of the parent -- layout, was added to 'hiddens' in 0.14. Update your instance accordingly. -- -- > data MyAmbiguity = MyAmbiguity deriving (Read, Show) -- -- > instance SetsAmbiguous MyAmbiguity where -- > hiddens _ wset lr mst wrs = otherHiddens Screen \\ otherHiddens OnlyScreenFloat -- > where otherHiddens p = hiddens p wset lr mst wrs -- -- The above example is redundant, because you can have the same result with: -- -- > layoutHook = lessBorders (Combine Difference Screen OnlyScreenFloat) (Tall 1 0.5 0.03 ||| ... ) -- -- To get the same result as 'smartBorders': -- -- > layoutHook = lessBorders Never (Tall 1 0.5 0.03 ||| ...) -- -- This indirect method is required to keep the 'Read' and 'Show' for -- ConfigurableBorder so that xmonad can serialize state. class SetsAmbiguous p where hiddens :: p -> WindowSet -> Rectangle -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window] -- Quick overview since the documentation lacks clarity: -- * Overall stacking order = -- tiled stacking order ++ floating stacking order -- Where tiled windows are (obviously) stacked below floating windows. -- * Tiled stacking order = -- [(window, Rectangle] order -- Given by 'XMonad.Core.LayoutClass' where earlier entries are stacked -- higher. -- * Floating stacking order = -- focus order -- Given by the workspace stack where a higher focus corresponds to a higher -- stacking position. -- -- Integrating a stack returns a list in order of [highest...lowest]. -- -- 'XMonad.Core.LayoutClass' is given a stack with all floating windows removed -- and returns a list (in stack order) of only the visible tiled windows, while -- the workspace stack contains all windows (visible/hidden, floating/tiled) in -- focus order. The StackSet 'floating' field maps all floating windows across -- all workspaces to relative rectangles - without the associated screen. -- -- 'XMonad.Operations.windows' gets the windowset from the state, mutates it, -- then updates the state before calling 'runLayout' with the new windowset - -- excluding any floating windows. Aside from the filtering, the stack received -- by the layout should be identical to the one received from 'withWindowSet'. instance SetsAmbiguous Ambiguity where hiddens amb wset lr mst wrs | Combine Union a b <- amb = on union next a b | Combine Difference a b <- amb = on (\\) next a b | Combine Intersection a b <- amb = on intersect next a b | otherwise = tiled ms ++ floating where next p = hiddens p wset lr mst wrs screens = [ scr | scr <- W.screens wset , case amb of Never -> True _ -> not $ null $ integrate scr , not . R.empty . screenRect $ 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 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.integrate' . W.stack . W.workspace $ scr Just wr <- [M.lookup w (W.floating wset)] return (w,scaleRationalRect sr wr) 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] in lr == wr1 && (not . or) vu OnlyLayoutFloat -> lr == wr1 OnlyFloat -> True _ -> wr1 `R.supersetOf` sr return w1 ms = filter (`elem` W.integrate' mst) $ map fst wrs tiled [w] | Screen <- amb = [w] | OnlyScreenFloat <- amb = [] | OnlyLayoutFloat <- amb = [] | OnlyFloat <- amb = [] | OnlyLayoutFloatBelow <- amb = [] | OtherIndicated <- amb , let nonF = map integrate $ W.current wset : W.visible wset , length (concat nonF) > length wrs , singleton $ filter (1==) $ map length nonF = [w] | singleton screens = [w] tiled _ = [] integrate y = W.integrate' . W.stack $ W.workspace y -- | In order of increasing ambiguity (less borders more frequently), where -- subsequent constructors add additional cases where borders are not drawn -- than their predecessors. These behaviors make most sense with with multiple -- screens: for single screens, 'Never' or 'smartBorders' makes more sense. data Ambiguity = Combine With Ambiguity Ambiguity -- ^ This constructor is used to combine the borderless windows -- provided by the SetsAmbiguous instances from two other 'Ambiguity' -- data types. | OnlyLayoutFloatBelow -- ^ Like 'OnlyLayoutFloat', but only removes borders if no window -- stacked below remains visible. Considers all floating windows on the -- current screen and all visible tiled windows of the child layout. If -- any such window (that is stacked below) shows in any gap between the -- parent layout rectangle and the physical screen, the border will -- remain drawn. | 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 -- ^ 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. deriving (Read, Show) -- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two -- lists should be combined. data With = Union -- ^ uses 'Data.List.union' | Difference -- ^ uses 'Data.List.\\' | Intersection -- ^ uses 'Data.List.intersect' deriving (Read, Show) xmonad-contrib-0.18.0/XMonad/Layout/NoFrillsDecoration.hs0000644000000000000000000000333607346545000021461 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.NoFrillsDecoration -- Description : Most basic version of decoration for windows. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.NoFrillsDecoration ( -- * Usage: -- $usage noFrillsDeco , module XMonad.Layout.SimpleDecoration , NoFrillsDecoration ) where import XMonad.Layout.Decoration import XMonad.Layout.SimpleDecoration -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.NoFrillsDecoration -- -- Then edit your @layoutHook@ by adding the NoFrillsDecoration to -- your layout: -- -- > myL = noFrillsDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- | Add very simple decorations to windows of a layout. noFrillsDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration NoFrillsDecoration s) l a noFrillsDeco s c = decoration s c $ NFD True newtype NoFrillsDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle NoFrillsDecoration a where describeDeco _ = "NoFrillsDeco" xmonad-contrib-0.18.0/XMonad/Layout/OnHost.hs0000644000000000000000000001566107346545000017137 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.OnHost -- Description : Use layouts and apply layout modifiers selectively, depending on the host. -- Copyright : (c) Brandon S Allbery, Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- 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. ----------------------------------------------------------------------------- module XMonad.Layout.OnHost (-- * Usage -- $usage OnHost ,onHost ,onHosts ,modHost ,modHosts ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import Data.Maybe (fromMaybe) import System.Posix.Env (getEnv) -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.OnHost -- -- and modifying your 'layoutHook' as follows (for example): -- -- > layoutHook = modHost "baz" m1 $ -- apply layout modifier m1 to all layouts on host "baz" -- > onHost "foo" l1 $ -- layout l1 will be used on host "foo". -- > onHosts ["bar","quux"] l2 $ -- layout l2 will be used on hosts "bar" and "quux". -- > l3 -- layout l3 will be used on all other hosts. -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText -- def ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. -- -- In another scenario, suppose you wanted to have layouts A, B, and C -- available on all hosts, except that on host foo you want -- layout D instead of C. You could do that as follows: -- -- > layoutHook = A ||| B ||| onHost "foo" D C -- -- Note that we rely on '$HOST' being set in the environment, as is true on most -- modern systems; if it's not, you may want to use a wrapper around xmonad or -- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'. -- This is to avoid dragging in the network package as an xmonad dependency. -- If '$HOST' is not defined, it will behave as if the host name never matches. -- -- Also note that '$HOST' is usually a fully qualified domain name, not a short name. -- If you use a short name, this code will try to truncate $HOST to match; this may -- prove too magical, though, and may change in the future. -- | Specify one layout to use on a particular host, and another -- to use on all others. The second layout can be another call to -- '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 -> OnHost l1 l2 a onHost host = onHosts [host] -- | Specify one layout to use on a particular set of hosts, and -- 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 -> OnHost l1 l2 a onHosts hosts = OnHost hosts False -- | Specify a layout modifier to apply on a particular host; layouts -- on all other hosts will remain unmodified. modHost :: (LayoutClass l a) => String -- ^ name of the host to match -> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching host -> l a -- ^ the base layout -> OnHost (ModifiedLayout lm l) l a modHost host = modHosts [host] -- | Specify a layout modifier to apply on a particular set of -- hosts; layouts on all other hosts will remain -- unmodified. modHosts :: (LayoutClass l a) => [String] -- ^ names of the hosts to match -> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching hosts -> l a -- ^ the base layout -> OnHost (ModifiedLayout lm l) l a modHosts hosts f l = OnHost hosts False (f l) l -- | Structure for representing a host-specific layout along with -- a layout for all other hosts. We store the names of hosts -- to be matched, and the two layouts. We save the layout choice in -- the Bool, to be used to implement description. data OnHost l1 l2 a = OnHost [String] Bool (l1 a) (l2 a) deriving (Read, Show) instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do h <- io $ getEnv "HOST" if maybe False (`elemFQDN` hosts) h then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewOnHostT p mlt') else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewOnHostF p mlt') handleMessage (OnHost hosts bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf) | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts bool lt) description (OnHost _ True l1 _) = description l1 description (OnHost _ _ _ l2) = description l2 -- | Construct new OnHost values with possibly modified layouts. mkNewOnHostT :: OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a mkNewOnHostT (OnHost hosts _ lt lf) mlt' = (\lt' -> OnHost hosts True lt' lf) $ fromMaybe lt mlt' mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a mkNewOnHostF (OnHost hosts _ lt 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. elemFQDN :: String -> [String] -> Bool elemFQDN _ [] = False elemFQDN h0 (h:hs) | h0 `eqFQDN` h = True | otherwise = elemFQDN h0 hs -- | String equality, possibly truncating one side at a dot. eqFQDN :: String -> String -> Bool eqFQDN a b | '.' `elem` a && '.' `elem` b = a == b | '.' `elem` a = takeWhile (/= '.') a == b | '.' `elem` b = a == takeWhile (/= '.') b | otherwise = a == b xmonad-contrib-0.18.0/XMonad/Layout/OneBig.hs0000644000000000000000000001141607346545000017062 0ustar0000000000000000{-# 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) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top -- ----------------------------------------------------------------------------- module XMonad.Layout.OneBig ( -- * Usage -- $usage OneBig (..) ) where import XMonad import qualified XMonad.StackSet as W -- $usage -- This module defines layout named OneBig. It places one (master) -- window at top left, and other (slave) windows at right and at -- bottom of master. It tries to give equal space for each slave -- window. -- -- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.OneBig -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = OneBig (3/4) (3/4) ||| ... -- -- In this example, master window will occupy 3/4 of screen width and -- 3/4 of screen height. -- | Data type for layout data OneBig a = OneBig Float Float deriving (Read,Show) instance LayoutClass OneBig a where pureLayout = oneBigLayout pureMessage = oneBigMessage -- | Processes Shrink/Expand messages oneBigMessage :: OneBig a -> SomeMessage -> Maybe (OneBig a) oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m) where resize Shrink = OneBig (cx-delta) (cy-delta) resize Expand = OneBig (cx+delta) (cy+delta) delta = 3/100 -- | Main layout function oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)] oneBigLayout (OneBig cx cy) rect stack = let ws = W.integrate stack n = length ws in case ws of [] -> [] (master : other) -> [(master,masterRect)] ++ divideBottom bottomRect bottomWs ++ divideRight rightRect rightWs where ht (Rectangle _ _ _ hh) = hh wd (Rectangle _ _ ww _) = ww h' = round (fromIntegral (ht rect)*cy) w = wd rect m = calcBottomWs n w h' bottomWs = take m other rightWs = drop m other masterRect = cmaster n m cx cy rect bottomRect = cbottom cy rect rightRect = cright cx cy rect -- | Calculate how many windows must be placed at bottom calcBottomWs :: Int -> Dimension -> Dimension -> Int calcBottomWs n w h' = case n of 1 -> 0 2 -> 1 3 -> 2 4 -> 2 _ -> 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 round (fromIntegral sw*cx) else sw h = if n > 1 then round (fromIntegral sh*cy) else sh -- | Calculate rectangle for bottom windows 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) -- | 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) h = round (fromIntegral sh*cy) -- | Divide bottom rectangle between windows divideBottom :: Rectangle -> [a] -> [(a, Rectangle)] divideBottom (Rectangle x y w h) ws = zip ws rects where n = length ws oneW = fromIntegral w `div` n oneRect = Rectangle x y (fromIntegral oneW) h rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect -- | 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 where n = length ws oneH = fromIntegral h `div` n oneRect = Rectangle x y w (fromIntegral oneH) rects = take n $ iterate (shiftB (fromIntegral oneH)) oneRect -- | Shift rectangle right shiftR :: Position -> Rectangle -> Rectangle shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h -- | Shift rectangle bottom shiftB :: Position -> Rectangle -> Rectangle shiftB s (Rectangle x y w h) = Rectangle x (y+s) w h xmonad-contrib-0.18.0/XMonad/Layout/PerScreen.hs0000644000000000000000000000564107346545000017610 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.PerScreen -- Description : Configure layouts based on the width of your screen. -- Copyright : (c) Edward Z. Yang -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- 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. ----------------------------------------------------------------------------- module XMonad.Layout.PerScreen ( -- * Usage -- $usage PerScreen, ifWider ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Prelude (fromMaybe) -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.PerScreen -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = ifWider 1280 (Tall 1 (3/100) (1/2) ||| Full) Full -- -- Replace any of the layouts with any arbitrarily complicated layout. -- ifWider can also be used inside other layout combinators. 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 -> PerScreen l1 l2 a ifWider w = PerScreen w False data PerScreen l1 l2 a = PerScreen Dimension Bool (l1 a) (l2 a) deriving (Read, Show) -- | Construct new PerScreen values with possibly modified layouts. mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) -> PerScreen l1 l2 a mkNewPerScreenT (PerScreen w _ lt lf) mlt' = (\lt' -> PerScreen w True lt' lf) $ fromMaybe lt mlt' mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) -> PerScreen l1 l2 a mkNewPerScreenF (PerScreen w _ lt 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 | rect_width r > w = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewPerScreenT p mlt') | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewPerScreenF p mlt') 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) (return . Just . PerScreen w bool lt) description (PerScreen _ True l1 _) = description l1 description (PerScreen _ _ _ l2) = description l2 xmonad-contrib-0.18.0/XMonad/Layout/PerWorkspace.hs0000644000000000000000000001340407346545000020323 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.PerWorkspace -- Description : Use layouts and apply layout modifiers selectively. -- Copyright : (c) Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Configure layouts on a per-workspace basis: use layouts and apply -- layout modifiers selectively, depending on the workspace. ----------------------------------------------------------------------------- module XMonad.Layout.PerWorkspace ( -- * Usage -- $usage PerWorkspace, onWorkspace, onWorkspaces, modWorkspace, modWorkspaces ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Prelude (fromMaybe) -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.PerWorkspace -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = modWorkspace "baz" m1 $ -- apply layout modifier m1 to all layouts on workspace "baz" -- > onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo". -- > onWorkspaces ["bar","6"] l2 $ -- layout l2 will be used on workspaces "bar" and "6". -- > l3 -- layout l3 will be used on all other workspaces. -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText -- def ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. (In fact, @m1@ can be any -- function @(LayoutClass l a, LayoutClass l' a) => l a -> l' a@.) -- -- In another scenario, suppose you wanted to have layouts A, B, and C -- available on all workspaces, except that on workspace foo you want -- layout D instead of C. You could do that as follows: -- -- > layoutHook = A ||| B ||| onWorkspace "foo" D C -- | Specify one layout to use on a particular workspace, and another -- to use on all others. The second layout can be another call to -- '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 -> PerWorkspace l1 l2 a onWorkspace wsId = onWorkspaces [wsId] -- | Specify one layout to use on a particular set of workspaces, and -- 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 -> PerWorkspace l1 l2 a onWorkspaces wsIds = modWorkspaces wsIds . const -- | Specify a layout modifier to apply to a particular workspace; layouts -- on all other workspaces will remain unmodified. modWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) => WorkspaceId -- ^ tag of the workspace to match -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspace -> l2 a -- ^ the base layout -> PerWorkspace l1 l2 a modWorkspace wsId = modWorkspaces [wsId] -- | Specify a layout modifier to apply to a particular set of -- workspaces; layouts on all other workspaces will remain -- unmodified. modWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) => [WorkspaceId] -- ^ tags of the workspaces to match -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspaces -> l2 a -- ^ the base layout -> PerWorkspace l1 l2 a modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l -- | Structure for representing a workspace-specific layout along with -- a layout for all other workspaces. We store the tags of workspaces -- to be matched, and the two layouts. We save the layout choice in -- the Bool, to be used to implement description. data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] Bool (l1 a) (l2 a) deriving (Read, Show) instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r | i `elem` wsIds = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewPerWorkspaceT p mlt') | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewPerWorkspaceF p mlt') 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) (return . Just . PerWorkspace wsIds bool lt) description (PerWorkspace _ True l1 _) = description l1 description (PerWorkspace _ _ _ l2) = description l2 -- | Construct new PerWorkspace values with possibly modified layouts. mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) -> PerWorkspace l1 l2 a mkNewPerWorkspaceT (PerWorkspace wsIds _ lt lf) mlt' = (\lt' -> PerWorkspace wsIds True lt' lf) $ fromMaybe lt mlt' mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> PerWorkspace l1 l2 a mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' = PerWorkspace wsIds False lt $ fromMaybe lf mlf' xmonad-contrib-0.18.0/XMonad/Layout/PositionStoreFloat.hs0000644000000000000000000000735007346545000021530 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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). -- ----------------------------------------------------------------------------- module XMonad.Layout.PositionStoreFloat ( -- * Usage -- $usage positionStoreFloat, PositionStoreFloat ) where import XMonad import XMonad.Util.PositionStore import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Prelude (fromMaybe, isJust, nub, when) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.PositionStoreFloat -- > import XMonad.Layout.NoFrillsDecoration -- > import XMonad.Layout.BorderResize -- -- Then edit your @layoutHook@ by adding the PositionStoreFloat layout. -- Below is a suggestion which uses the mentioned NoFrillsDecoration and -- BorderResize: -- -- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc.. -- > where floatingDeco l = noFrillsDeco shrinkText def l -- > main = xmonad def { layoutHook = myLayouts } -- -- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how -- to add the support hooks. positionStoreFloat :: PositionStoreFloat a positionStoreFloat = PSF (Nothing, []) 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 posStore <- getPosStore let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r) let focused = case maybeChange of Nothing -> (w, pSQ posStore w sr) Just changedRect -> (w, changedRect) let wrs' = focused : wrs let paintOrder' = nub (w : paintOrder) when (isJust maybeChange) $ updatePositionStore focused sr return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder')) where 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) | otherwise = Nothing updatePositionStore :: (Window, Rectangle) -> Rectangle -> X () updatePositionStore (w, rect) sr = modifyPosStore (\ps -> posStoreInsert ps w rect sr) reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order = 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 Just result -> [(e, result)] Nothing -> [] xmonad-contrib-0.18.0/XMonad/Layout/Reflect.hs0000644000000000000000000000752307346545000017307 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Reflect -- Description : Reflect a layout horizontally or vertically. -- Copyright : (c) Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Reflect a layout horizontally or vertically. ----------------------------------------------------------------------------- module XMonad.Layout.Reflect ( -- * Usage -- $usage reflectHoriz, reflectVert, REFLECTX(..), REFLECTY(..), Reflect ) where import XMonad.Prelude (fi) import Graphics.X11 (Rectangle(..), Window) import Control.Arrow (second) import XMonad.Layout.LayoutModifier import XMonad.Layout.MultiToggle -- $usage -- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.Reflect -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = reflectHoriz $ Tall 1 (3/100) (1/2) -- put master pane on the right -- -- 'reflectHoriz' and 'reflectVert' can be applied to any sort of -- layout (including Mirrored layouts) and will simply flip the -- physical layout of the windows vertically or horizontally. -- -- "XMonad.Layout.MultiToggle" transformers are also provided for -- toggling layouts between reflected\/non-reflected with a keybinding. -- To use this feature, you will also need to import the MultiToggle -- module: -- -- > import XMonad.Layout.MultiToggle -- -- Next, add one or more toggles to your layout. For example, to allow -- separate toggling of both vertical and horizontal reflection: -- -- > layoutHook = mkToggle (single REFLECTX) $ -- > mkToggle (single REFLECTY) $ -- > (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use -- -- Finally, add some keybindings to do the toggling, for example: -- -- > , ((modm .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX) -- > , ((modm .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY) -- -- | Apply a horizontal reflection (left \<--\> right) to a -- layout. reflectHoriz :: l a -> ModifiedLayout Reflect l a reflectHoriz = ModifiedLayout (Reflect Horiz) -- | Apply a vertical reflection (top \<--\> bottom) to a -- layout. reflectVert :: l a -> ModifiedLayout Reflect l a reflectVert = ModifiedLayout (Reflect Vert) data ReflectDir = Horiz | Vert deriving (Read, Show) -- | Given an axis of reflection and the enclosing rectangle which -- contains all the laid out windows, transform a rectangle -- representing a window into its flipped counterpart. reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle reflectRect Horiz (Rectangle sx _ sw _) (Rectangle rx ry rw rh) = Rectangle (2*sx + fi sw - rx - fi rw) ry rw rh reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) = Rectangle rx (2*sy + fi sh - ry - fi rh) rw rh newtype Reflect a = Reflect ReflectDir deriving (Show, Read) instance LayoutModifier Reflect a where -- reflect all the generated Rectangles. pureModifier (Reflect d) r _ wrs = (map (second $ reflectRect d r) wrs, Just $ Reflect d) modifierDescription (Reflect d) = "Reflect" ++ xy where xy = case d of { Horiz -> "X" ; Vert -> "Y" } -------- instances for MultiToggle ------------------ 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') instance Transformer REFLECTY Window where transform REFLECTY x k = k (reflectVert x) (\(ModifiedLayout _ x') -> x') xmonad-contrib-0.18.0/XMonad/Layout/Renamed.hs0000644000000000000000000000645407346545000017300 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups -- Description : Modify the description of a layout in a flexible way. -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Layout modifier that can modify the description of its underlying -- layout on a (hopefully) flexible way. -- ----------------------------------------------------------------------------- module XMonad.Layout.Renamed ( -- * Usage -- $usage renamed , named , Rename(..) ) where import XMonad import XMonad.Layout.LayoutModifier -- $usage -- You can use this module by adding -- -- > import XMonad.Layout.Renamed -- -- to your @xmonad.hs@. -- -- You can then use 'renamed' to modify the description of your -- layouts. For example: -- -- > myLayout = renamed [PrependWords "Awesome"] $ tiled ||| Mirror tiled ||| Full -- | Apply a list of 'Rename' values to a layout, from left to right. renamed :: [Rename a] -> l a -> ModifiedLayout Rename l a renamed = ModifiedLayout . Chain -- | Rename a layout. (Convenience alias for @renamed [Replace s]@.) named :: String -> l a -> ModifiedLayout Rename l a named s = renamed [Replace s] -- | The available renaming operations data Rename a = CutLeft Int -- ^ Remove a number of characters from the left | CutRight Int -- ^ Remove a number of characters from the right | Append String -- ^ Add a string on the right | 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 -- necessary | Replace String -- ^ Replace with another string | Chain [Rename a] -- ^ Apply a list of modifications in left-to-right order deriving (Show, Read, Eq) apply :: Rename a -> String -> String apply (CutLeft i) s = drop i s apply (CutRight i) s = take (length s - i) s 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 (.) . apply) id rs instance LayoutModifier Rename a where modifyDescription r l = apply r (description l) xmonad-contrib-0.18.0/XMonad/Layout/ResizableThreeColumns.hs0000644000000000000000000001516607346545000022176 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ResizableThreeColumns -- Description : Like "XMonad.Layout.ThreeColumns", but allows resizing. -- Copyright : (c) Sam Tay -- License : BSD3-style (see LICENSE) -- -- Maintainer : ? -- Stability : unstable -- Portability : unportable -- -- A layout similar to tall but with three columns. With 2560x1600 pixels this -- layout can be used for a huge main window and up to six reasonable sized -- resizable stack windows. ----------------------------------------------------------------------------- module XMonad.Layout.ResizableThreeColumns ( -- * Usage -- $usage ResizableThreeCol(..), MirrorResize(..) ) where import XMonad hiding (splitVertically) import XMonad.Prelude import XMonad.Layout.ResizableTile(MirrorResize(..)) import qualified XMonad.StackSet as W import qualified Data.Map as M import Data.Ratio -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ResizableThreeColumns -- -- Then edit your @layoutHook@ by adding the ResizableThreeCol layout: -- -- > myLayout = ResizableThreeCol 1 (3/100) (1/2) [] ||| ResizableThreeColMid 1 (3/100) (1/2) [] ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- The first argument specifies how many windows initially appear in the main -- window. The second argument argument specifies the amount to resize while -- resizing and the third argument specifies the initial size of the columns. -- A positive size designates the fraction of the screen that the main window -- should occupy, but if the size is negative the absolute value designates the -- fraction a stack column should occupy. If both stack columns are visible, -- they always occupy the same amount of space. -- -- You may also want to add the following key bindings: -- -- > , ((modm, xK_a), sendMessage MirrorShrink) -- > , ((modm, xK_z), sendMessage MirrorExpand) -- -- The ResizableThreeColMid variant places the main window between the stack columns. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Arguments are nmaster, delta, fraction data ResizableThreeCol a = ResizableThreeColMid { threeColNMaster :: !Int , threeColDelta :: !Rational , threeColFrac :: !Rational , threeColSlaves :: [Rational] } | ResizableThreeCol { threeColNMaster :: !Int , threeColDelta :: !Rational , threeColFrac :: !Rational , threeColSlaves :: [Rational] } deriving (Show,Read) instance LayoutClass ResizableThreeCol a where doLayout (ResizableThreeCol n _ f mf) r = doL False n f mf r doLayout (ResizableThreeColMid n _ f mf) r = doL True n f mf r handleMessage l m = do ms <- W.stack . W.workspace . W.current <$> gets windowset fs <- M.keys . W.floating <$> gets windowset return $ do s <- ms -- make sure current stack isn't floating guard (W.focus s `notElem` fs) -- remove floating windows from stack let s' = s { W.up = W.up s \\ fs, W.down = W.down s \\ fs } -- handle messages msum [ fmap resize (fromMessage m) , fmap (mresize s') (fromMessage m) , fmap incmastern (fromMessage m) ] where resize Shrink = l { threeColFrac = max (-0.5) $ frac-delta } resize Expand = l { threeColFrac = min 1 $ frac+delta } mresize s MirrorShrink = mresize' s delta mresize s MirrorExpand = mresize' s (negate delta) mresize' s delt = let up = length $ W.up s down = length $ W.down s total = up + down + 1 pos = if up == nmaster - 1 -- upper right || up == total - 1 -- upper left || up `elem` [down, down + 1] -- lower right then up - 1 else up mfrac' = modifymfrac (mfrac ++ repeat 1) delt pos in l { threeColSlaves = take total mfrac'} modifymfrac [] _ _ = [] modifymfrac (f:fx) d n | n == 0 = f+d : fx | otherwise = f : modifymfrac fx d (n-1) incmastern (IncMasterN x) = l { threeColNMaster = max 0 (nmaster+x) } nmaster = threeColNMaster l delta = threeColDelta l frac = threeColFrac l mfrac = threeColSlaves l description _ = "ResizableThreeCol" doL :: Bool -> Int -> Rational -> [Rational] -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (layout a)) doL middle nmaster f mf r = return . (, Nothing) . ap zip (tile3 middle f (mf ++ repeat 1) r nmaster . length) . W.integrate -- | tile3. Compute window positions using 3 panes tile3 :: Bool -> Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] tile3 middle f mf r nmaster n | n <= nmaster || nmaster == 0 = splitVertically mf n r | n <= nmaster+1 = splitVertically mf nmaster s1 ++ splitVertically (drop nmaster mf) (n-nmaster) s2 | otherwise = concat [ splitVertically mf nmaster r1 , splitVertically (drop nmaster mf) nstack1 r2 , splitVertically (drop (nmaster + nstack1) mf) nstack2 r3 ] where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r nstack = n - nmaster nstack1 = ceiling (nstack % 2) nstack2 = nstack - nstack1 splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] splitVertically [] _ r = [r] splitVertically _ n r | n < 2 = [r] splitVertically (f:fx) n (Rectangle sx sy sw sh) = let smallh = min sh (floor $ fi (sh `div` fi n) * f) in Rectangle sx sy sw smallh : splitVertically fx (n-1) (Rectangle sx (sy+fi smallh) sw (sh-smallh)) split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) split3HorizontallyBy middle f (Rectangle sx sy sw sh) = if middle then ( Rectangle (sx + fromIntegral r3w) sy r1w sh , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh , Rectangle sx sy r3w sh ) else ( Rectangle sx sy r1w sh , Rectangle (sx + fromIntegral r1w) sy r2w sh , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh ) where r1w = ceiling $ fromIntegral sw * f r2w = ceiling $ (sw - r1w) % 2 r3w = sw - r1w - r2w xmonad-contrib-0.18.0/XMonad/Layout/ResizableTile.hs0000644000000000000000000001271607346545000020461 0ustar0000000000000000{-# 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 -- License : BSD-style (see LICENSE) -- -- Maintainer : MATSUYAMA Tomohiro -- Stability : unstable -- Portability : unportable -- -- More useful tiled layout that allows you to change a width\/height of window. -- ----------------------------------------------------------------------------- module XMonad.Layout.ResizableTile ( -- * Usage -- $usage ResizableTall(..), MirrorResize(..) ) where import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import XMonad.Prelude import qualified XMonad.StackSet as W import qualified Data.Map as M -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ResizableTile -- -- Then edit your @layoutHook@ by adding the ResizableTile layout: -- -- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to add the following key bindings: -- -- > , ((modm, xK_a), sendMessage MirrorShrink) -- > , ((modm, xK_z), sendMessage MirrorExpand) -- -- For detailed instruction on editing the key binding see: -- -- . data MirrorResize = MirrorShrink | MirrorExpand instance Message MirrorResize data ResizableTall a = ResizableTall { _nmaster :: Int -- ^ number of master windows , _delta :: Rational -- ^ change when resizing by 'Shrink', 'Expand', -- 'MirrorShrink', 'MirrorExpand' , _frac :: Rational -- ^ width of master , _slaves :: [Rational] -- ^ fraction to multiply the window -- height that would be given when divided equally. -- -- slave windows are assigned their modified -- heights in order, from top to bottom -- -- unspecified values are replaced by 1 } deriving (Show, Read) instance LayoutClass ResizableTall a where doLayout (ResizableTall nmaster _ frac mfrac) r = 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 <$> gets windowset fs <- M.keys . W.floating <$> gets windowset return $ ms >>= unfloat fs >>= handleMesg where handleMesg s = msum [fmap resize (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 }) 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 (negate delta) mresize' s d = let n = length $ W.up s 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' modifymfrac [] _ _ = [] modifymfrac (f:fx) d n | n == 0 = f+d : fx | otherwise = f : modifymfrac fx d (n-1) incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac description _ = "ResizableTall" tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] tile f mf r nmaster n = if n <= nmaster || nmaster == 0 then splitVertically mf n r else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns where (r1,r2) = splitHorizontallyBy f r 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) = Rectangle sx sy sw smallh : splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) where smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) --hmm, this is a fold or map. splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) splitHorizontallyBy f (Rectangle sx sy sw sh) = ( Rectangle sx sy leftw sh , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh) where leftw = floor $ fromIntegral sw * f xmonad-contrib-0.18.0/XMonad/Layout/ResizeScreen.hs0000644000000000000000000000562107346545000020321 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout transformer to have a layout respect a given screen -- geometry. Mostly used with "XMonad.Layout.Decoration" (the -- Horizontal and the Vertical version will react to SetTheme and -- change their dimension accordingly. ----------------------------------------------------------------------------- module XMonad.Layout.ResizeScreen ( -- * Usage: -- $usage resizeHorizontal, resizeVertical , resizeHorizontalRight, resizeVerticalBottom , withNewRectangle , ResizeScreen (..) , ResizeMode ) where import XMonad import XMonad.Layout.Decoration -- $usage -- You can use this module by importing it into your -- @xmonad.hs@ file: -- -- > import XMonad.Layout.ResizeScreen -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = resizeHorizontal 40 Full -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeHorizontal i = ModifiedLayout (ResizeScreen L i) resizeVertical :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeVertical i = ModifiedLayout (ResizeScreen T i) resizeHorizontalRight :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeHorizontalRight i = ModifiedLayout (ResizeScreen R i) resizeVerticalBottom :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeVerticalBottom i = ModifiedLayout (ResizeScreen B i) withNewRectangle :: Rectangle -> l a -> ModifiedLayout ResizeScreen l a withNewRectangle r = ModifiedLayout (WithNewScreen r) data ResizeScreen a = ResizeScreen ResizeMode Int | WithNewScreen Rectangle deriving (Read, Show) data ResizeMode = T | B | L | R deriving (Read, Show) instance LayoutModifier ResizeScreen a where 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 where resize = runLayout ws pureMess (ResizeScreen d _) m | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t) pureMess _ _ = Nothing xmonad-contrib-0.18.0/XMonad/Layout/Roledex.hs0000644000000000000000000000516607346545000017326 0ustar0000000000000000{-# 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 -- -- Maintainer : tim.thelion@gmail.com -- Stability : unstable -- Portability : unportable -- -- This is a completely pointless layout which acts like Microsoft's Flip 3D ----------------------------------------------------------------------------- module XMonad.Layout.Roledex ( -- * Usage -- $usage -- * Screenshots -- $screenshot Roledex(Roledex)) where import XMonad import qualified XMonad.StackSet as W import Data.Ratio -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Roledex -- -- Then edit your @layoutHook@ by adding the Roledex layout: -- -- > myLayout = Roledex ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- $screenshot -- <> data Roledex a = Roledex deriving ( Show, Read ) instance LayoutClass Roledex Window where doLayout _ = roledexLayout 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) ,Nothing) where ups = W.up ws dns = W.down ws c = length ups + length dns rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) gw = div' (w - rw) (fromIntegral c) where (Rectangle _ _ w _) = sc (Rectangle _ _ rw _) = rect gh = div' (h - rh) (fromIntegral c) where (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 tops = map f $ cd c (length dns) 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 else [] div' :: Integral a => a -> a -> a div' _ 0 = 0 div' n o = div n o xmonad-contrib-0.18.0/XMonad/Layout/ShowWName.hs0000644000000000000000000000772707346545000017601 0ustar0000000000000000{-# 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- This is a layout modifier that will show the workspace name ----------------------------------------------------------------------------- module XMonad.Layout.ShowWName ( -- * Usage -- $usage showWName , showWName' , def , SWNConfig(..) , ShowWName ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import XMonad.Util.Font import XMonad.Util.Timer import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.ShowWName -- > myLayout = layoutHook def -- > main = xmonad def { layoutHook = showWName myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A layout modifier to show the workspace name when switching showWName :: l a -> ModifiedLayout ShowWName l a showWName = ModifiedLayout (SWN True def Nothing) -- | A layout modifier to show the workspace name when switching. It -- is possible to provide a custom configuration. showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a showWName' c = ModifiedLayout (SWN True c Nothing) type ShowWNState = Maybe (TimerId, Window) data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show) data SWNConfig = SWNC { swn_font :: String -- ^ Font name , swn_bgcolor :: String -- ^ Background color , swn_color :: String -- ^ String color , swn_fade :: Rational -- ^ Time in seconds of the name visibility } deriving (Read, Show) 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 } instance LayoutModifier ShowWName a where redoLayout sn r _ = doShow sn r handleMess (SWN _ c (Just (i,w))) m | Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing) | Just Hide <- fromMessage m = do deleteWindow w return . Just $ SWN True c Nothing handleMess (SWN _ c s) m | Just Hide <- fromMessage m = return . Just $ SWN True c s | otherwise = return Nothing doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a)) doShow (SWN True c (Just (_,w))) r wrs = deleteWindow w >> flashName c r wrs doShow (SWN True c Nothing ) r wrs = flashName c r wrs doShow (SWN False _ _ ) _ wrs = return (wrs, Nothing) flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a)) flashName c (Rectangle sx sy wh ht) wrs = do d <- asks display n <- withWindowSet (return . S.currentTag) f <- initXMF (swn_font c) 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 x = fi sx + (fi wh - width + 2) `div` 2 w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True showWindow w paintAndWrite w f (fi width) (fi hight) 0 (swn_bgcolor c) "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n] releaseXMF f i <- startTimer (swn_fade c) return (wrs, Just $ SWN False c $ Just (i,w)) xmonad-contrib-0.18.0/XMonad/Layout/SideBorderDecoration.hs0000644000000000000000000001416407346545000021754 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SideBorderDecoration -- Description : Configure the border position around windows. -- Copyright : (c) 2018 L. S. Leary -- 2022 Tony Zorman -- License : BSD3 -- Maintainer : Tony Zorman -- -- This module allows for having a configurable border position around -- windows; i.e., it can move the border to any cardinal direction. -- -------------------------------------------------------------------- module XMonad.Layout.SideBorderDecoration ( -- * Usage -- $usage sideBorder, -- * Border configuration SideBorderConfig (..), def, -- * Re-exports Direction2D (..), -- * Lower-level hooks sideBorderLayout, ) where import qualified XMonad.StackSet as W import XMonad import XMonad.Layout.Decoration import XMonad.StackSet (Stack) import XMonad.Util.Types {- $usage To use this module, first import it into your configuration file: > import XMonad.Layout.SideBorderDecoration You can now add the 'sideBorder' combinator to your configuration: > main :: IO () > main = xmonad > $ … > $ sideBorder mySideBorderConfig > $ def { … } > where > mySideBorderConfig :: SideBorderConfig > mySideBorderConfig = def > { sbSide = D > , sbActiveColor = "#ff0000" > , sbInactiveColor = "#ffaaaa" > , sbSize = 5 > } or, alternatively, > main :: IO () > main = xmonad > $ … > $ sideBorder def{ sbSide = D, sbActiveColor = "#ff000", … } > $ def { … } See 'SideBorderConfig' for the different size and colour options. The following is a fully-functional, minimal configuration example: > import XMonad > import XMonad.Layout.SideBorderDecoration > > main :: IO () > main = xmonad $ sideBorder def $ def This would result in the following border being displayed: <> -} ----------------------------------------------------------------------- -- Configuration -- | Configuring how the border looks like. data SideBorderConfig = SideBorderConfig { sbSide :: !Direction2D -- ^ Which side to have the border on. , sbActiveColor :: !String -- ^ Active border colour. , sbInactiveColor :: !String -- ^ Inactive border colour. , sbSize :: !Dimension -- ^ Size of the border. This will be the height if 'sbSide' is 'U' -- or 'D' and the width if it is 'L' or 'R'. } instance Default SideBorderConfig where def :: SideBorderConfig def = SideBorderConfig { sbSide = D , sbActiveColor = "#ff0000" , sbInactiveColor = "#ffaaaa" , sbSize = 5 } ----------------------------------------------------------------------- -- User-facing -- | Move the default XMonad border to any of the four cardinal -- directions. -- -- Note that this function should only be applied once to your -- configuration and should /not/ be combined with 'sideBorderLayout'. sideBorder :: SideBorderConfig -> XConfig l -> XConfig (SideBorder l) sideBorder sbc cfg = cfg{ layoutHook = sideBorderLayout sbc (layoutHook cfg) , borderWidth = 0 } -- | Layout hook to only enable the side border for some layouts. For -- example: -- -- > myLayout = Full ||| sideBorderLayout def tall ||| somethingElse -- -- Note that, unlike 'sideBorder', this does /not/ disable the normal -- border in XMonad, you will have to do this yourself. Remove this -- function from your layout hook and use 'sideBorder' if you want a -- side border in every layout (do not use the two functions together). sideBorderLayout :: Eq a => SideBorderConfig -> l a -> SideBorder l a sideBorderLayout SideBorderConfig{ sbSide, sbActiveColor, sbInactiveColor, sbSize } = decoration BorderShrinker theme (SideBorderDecoration sbSide) where theme :: Theme theme = deco { activeColor = sbActiveColor , inactiveColor = sbInactiveColor } where deco | sbSide `elem` [U, D] = def{ decoHeight = sbSize } | otherwise = def{ decoWidth = sbSize } ----------------------------------------------------------------------- -- Decoration newtype SideBorderDecoration a = SideBorderDecoration Direction2D deriving (Show, Read) type SideBorder = ModifiedLayout (Decoration SideBorderDecoration BorderShrinker) instance Eq a => DecorationStyle SideBorderDecoration a where shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle shrink dec (Rectangle _ _ dw dh) (Rectangle x y w h) = case dec of SideBorderDecoration U -> Rectangle x (y + fi dh) w (h - dh) SideBorderDecoration R -> Rectangle x y (w - dw) h SideBorderDecoration D -> Rectangle x y w (h - dh) SideBorderDecoration L -> Rectangle (x + fi dw) y (w - dw) h pureDecoration :: SideBorderDecoration a -> Dimension -> Dimension -> Rectangle -> Stack a -> [(a, Rectangle)] -> (a, Rectangle) -> Maybe Rectangle pureDecoration dec dw dh _ st _ (win, Rectangle x y w h) | win `elem` W.integrate st && dw < w && dh < h = Just $ case dec of SideBorderDecoration U -> Rectangle x y w dh SideBorderDecoration R -> Rectangle (x + fi (w - dw)) y dw h SideBorderDecoration D -> Rectangle x (y + fi (h - dh)) w dh SideBorderDecoration L -> Rectangle x y dw h | otherwise = Nothing ----------------------------------------------------------------------- -- Shrinker -- | Kill all text. data BorderShrinker = BorderShrinker instance Show BorderShrinker where show :: BorderShrinker -> String show _ = "" instance Read BorderShrinker where readsPrec :: Int -> ReadS BorderShrinker readsPrec _ s = [(BorderShrinker, s)] instance Shrinker BorderShrinker where shrinkIt :: BorderShrinker -> String -> [String] shrinkIt _ _ = [""] xmonad-contrib-0.18.0/XMonad/Layout/SimpleDecoration.hs0000644000000000000000000000470507346545000021163 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.SimpleDecoration ( -- * Usage: -- $usage simpleDeco , Theme (..) , def , SimpleDecoration (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) ) where import XMonad import XMonad.Layout.Decoration -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.SimpleDecoration -- -- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to -- your layout: -- -- > myL = simpleDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. -- -- > mySDConfig = def { inactiveBorderColor = "red" -- > , inactiveTextColor = "red"} -- -- and -- -- > myL = simpleDeco shrinkText mySDConfig (layoutHook def) -- | Add simple decorations to windows of a layout. simpleDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a simpleDeco s c = decoration s c $ Simple True newtype SimpleDecoration a = Simple Bool deriving (Show, Read) instance Eq a => DecorationStyle SimpleDecoration a where describeDeco _ = "Simple" shrink (Simple b) (Rectangle _ _ _ dh) r@(Rectangle x y w h) = if b then Rectangle x (y + fi dh) w (h - dh) else r pureDecoration (Simple b) wh ht _ s _ (w,Rectangle x y wid _) = if isInStack s w then if b then Just $ Rectangle x y nwh ht else Just $ Rectangle x (y - fi ht) nwh ht else Nothing where nwh = min wid wh xmonad-contrib-0.18.0/XMonad/Layout/SimpleFloat.hs0000644000000000000000000000562507346545000020143 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SimpleFloat -- Description : A basic floating layout. -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A basic floating layout. ----------------------------------------------------------------------------- module XMonad.Layout.SimpleFloat ( -- * Usage: -- $usage simpleFloat , simpleFloat' , SimpleDecoration (..) , SimpleFloat (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Actions.MouseResize import XMonad.Layout.Decoration import XMonad.Layout.SimpleDecoration import XMonad.Layout.WindowArranger -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.SimpleFloat -- -- Then edit your @layoutHook@ by adding the SimpleFloat layout: -- -- > myLayout = simpleFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A simple floating layout where every window is placed according -- to the window's initial attributes. -- -- This version is decorated with the 'SimpleDecoration' style. simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat = decoration shrinkText def (Simple False) (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'simpleFloat', but with the possibility of setting a -- custom shrinker and a custom theme. simpleFloat' :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c)) 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 wrs <- mapM (getSize i sc) (w : reverse l ++ r) return (wrs, Nothing) getSize :: Dimension -> Rectangle -> Window -> X (Window,Rectangle) getSize i (Rectangle rx ry _ _) w = do d <- asks display bw <- asks (borderWidth . config) wa <- io $ getWindowAttributes d w 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) return (w, Rectangle x y wh ht) xmonad-contrib-0.18.0/XMonad/Layout/Simplest.hs0000644000000000000000000000254107346545000017516 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Simplest -- Description : A very simple layout. -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A very simple layout. The simplest, afaik. ----------------------------------------------------------------------------- module XMonad.Layout.Simplest ( -- * Usage: -- $usage Simplest (..) ) where import XMonad import qualified XMonad.StackSet as S -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.Simplest -- -- Then edit your @layoutHook@ by adding the Simplest layout: -- -- > myLayout = Simplest ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data Simplest a = Simplest deriving (Show, Read) instance LayoutClass Simplest a where pureLayout Simplest rec (S.Stack w l r) = map (, rec) (w : reverse l ++ r) xmonad-contrib-0.18.0/XMonad/Layout/SimplestFloat.hs0000644000000000000000000000426407346545000020510 0ustar0000000000000000{-# 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) -- -- Maintainer : joamaki@gmail.com -- Stability : unstable -- Portability : unportable -- -- A basic floating layout like SimpleFloat but without the decoration. ----------------------------------------------------------------------------- module XMonad.Layout.SimplestFloat ( -- * Usage: -- $usage simplestFloat , SimplestFloat ) where import XMonad.Prelude (fi) import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Layout.LayoutModifier -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.SimplestFloat -- -- Then edit your @layoutHook@ by adding the SimplestFloat layout: -- -- > myLayout = simplestFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A simple floating layout where every window is placed according -- to the window's initial attributes. simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a simplestFloat = windowArrangeAll SF data SimplestFloat a = SF deriving (Show, Read) instance LayoutClass SimplestFloat Window where doLayout SF sc (S.Stack w l r) = (, Nothing) <$> mapM (getSize sc) (w : reverse l ++ r) description _ = "SimplestFloat" getSize :: Rectangle -> Window -> X (Window,Rectangle) getSize (Rectangle rx ry _ _) w = do d <- asks display bw <- asks (borderWidth . config) 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) return (w, Rectangle x y wh ht) xmonad-contrib-0.18.0/XMonad/Layout/SortedLayout.hs0000644000000000000000000000621707346545000020360 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : kurto@mac.com -- Stability : unstable -- Portability : unportable -- -- A 'LayoutModifier' that sorts the windows in another layout, given 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. ----------------------------------------------------------------------------- module XMonad.Layout.SortedLayout ( -- *Usage: -- $usage sorted , Property(..) ) where import XMonad import XMonad.Prelude hiding (Const) import XMonad.Layout.LayoutModifier import XMonad.StackSet as W import XMonad.Util.WindowProperties -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.SortedLayout -- -- Then edit your @layoutHook@ to sort another layout (in this case, 'XMonad.Layout.Grid.Grid'): -- -- > myLayout = sorted [ClassName "Firefox", ClassName "URxvt"] Grid -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Modify a layout using a list of properties to sort its windows. sorted :: [Property] -> l a -> ModifiedLayout SortedLayout l a sorted props = ModifiedLayout . SortedLayout $ props ++ [Const True] data WindowDescriptor = WindowDescriptor { wdSeqn :: !Integer , wdProp :: !Property , wdId :: !Window } deriving (Show, Read) instance Eq WindowDescriptor where (==) a b = wdId a == wdId b instance Ord WindowDescriptor where compare a b = compare (wdSeqn a) (wdSeqn b) newtype SortedLayout a = SortedLayout [Property] deriving (Show, Read) instance LayoutModifier SortedLayout Window where modifyLayout (SortedLayout props) = sortLayout props modifierDescription _ = "Sorted" findMatchingWindows :: Integer -> Property -> [Window] -> X [WindowDescriptor] findMatchingWindows seqn prop wids = fmap (fmap (WindowDescriptor seqn prop)) matching where matching = filterM (hasProperty prop) wids sortLayout :: (LayoutClass l Window) => [Property] -> W.Workspace WorkspaceId (l Window) Window -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window)) sortLayout props (W.Workspace w l r) rect = do let wids = W.integrate' r sortedWids <- map wdId . nub . sort . concat <$> zipWithM (\s p -> findMatchingWindows s p wids) [0..] props let sr = W.differentiate sortedWids runLayout (W.Workspace w l sr) rect xmonad-contrib-0.18.0/XMonad/Layout/Spacing.hs0000644000000000000000000003734207346545000017311 0ustar0000000000000000{-# 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) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Add a configurable amount of space around windows. -- -- Note: For space\/gaps along edges of the /screen/ see "XMonad.Layout.Gaps". ----------------------------------------------------------------------------- module XMonad.Layout.Spacing ( -- * Usage -- $usage Spacing (..) , spacingRaw , spacing, spacingWithEdge , smartSpacing, smartSpacingWithEdge -- * Modify Spacing , SpacingModifier (..) , setSmartSpacing , setScreenSpacing, setScreenSpacingEnabled , setWindowSpacing, setWindowSpacingEnabled , toggleSmartSpacing , toggleScreenSpacingEnabled , toggleWindowSpacingEnabled , setScreenWindowSpacing , incWindowSpacing, incScreenSpacing , decWindowSpacing, decScreenSpacing , incScreenWindowSpacing, decScreenWindowSpacing -- * Modify Borders , Border (..) , borderMap, borderIncrementBy ) where import XMonad import XMonad.StackSet as W import qualified XMonad.Util.Rectangle as R import XMonad.Layout.LayoutModifier import XMonad.Actions.MessageFeedback -- $usage -- You can use this module by importing it into your @xmonad.hs@ -- file: -- -- > import XMonad.Layout.Spacing -- -- and, for example, modifying your @layoutHook@ as follows: -- -- > main :: IO () -- > main = xmonad $ def -- > { layoutHook = spacingWithEdge 10 $ myLayoutHook -- > } -- > -- > myLayoutHook = Full ||| ... -- -- The above would add a 10 pixel gap around windows on all sides, as -- well as add the same amount of spacing around the edges of the -- screen. If you only want to add spacing around windows, you can use -- 'spacing' instead. -- -- There is also the 'spacingRaw' command, for more fine-grained -- control. For example: -- -- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True -- > $ myLayoutHook -- -- Breaking this down, the above would do the following: -- -- - @True@: Enable the 'smartBorder' to not apply borders when there -- is only one window. -- -- - @(Border 0 10 10 10)@: Add a 'screenBorder' of 10 pixels in every -- direction but the top. -- -- - @True@: Enable the 'screenBorder'. -- -- - @(Border 10 10 10 10)@: Add a 'windowBorder' of 10 pixels in -- every direction. -- -- - @True@: Enable the 'windowBorder'. -- -- __Warning__: If you also use the 'avoidStruts' layout modifier, it -- must come /before/ any of these modifiers. See the documentation of -- 'avoidStruts' for details. -- | Represent the borders of a rectangle. data Border = Border { top :: Integer , bottom :: Integer , right :: Integer , left :: Integer } deriving (Show,Read) -- | A 'LayoutModifier' providing customizable screen and window borders. -- Borders are clamped to @[0,Infinity]@ before being applied. data Spacing a = Spacing { smartBorder :: Bool -- ^ When @True@ borders are not applied if -- there fewer than two windows. , screenBorder :: Border -- ^ The screen border. , screenBorderEnabled :: Bool -- ^ Is the screen border enabled? , windowBorder :: Border -- ^ The window borders. , windowBorderEnabled :: Bool -- ^ Is the window border enabled? } deriving (Show,Read) instance Eq a => LayoutModifier Spacing a where -- This is a bit of a chicken-and-egg problem - the visible window list has -- yet to be generated. Several workarounds to incorporate the screen -- border: -- 1. Call 'runLayout' twice, with/without the screen border. Since layouts -- run arbitrary X actions, this breaks an important underlying -- assumption. Also, doesn't really solve the chicken-egg problem. -- 2. Create the screen border after and if the child layout returns more -- than one window. Unfortunately this breaks the window ratios -- presented by the child layout, another important assumption. -- 3. Create the screen border before, and remove it after and if the child -- layout returns fewer than two visible windows. This is somewhat hacky -- but probably the best option. Could significantly modify the child -- layout if it would have returned more than one window given the space -- of the screen border, but this is the underlying chicken-egg problem, -- and some concession must be made: -- * no border -> multiple windows -- * border -> single window -- Also slightly breaks layouts that expect to present absolutely-sized -- windows; a single window will be scaled up by the border size. -- Overall these are trivial assumptions. -- -- Note #1: the original code counted the windows of the 'Workspace' stack, -- and so generated incorrect results even for the builtin 'Full' layout. -- Even though most likely true, it isn't guaranteed that a layout will -- never return windows not in the stack, specifically that an empty stack -- will lead to 0 visible windows and a stack with a single window will -- lead to 0-1 visible windows (see 'XMonad.Layout.Decoration'). So as much -- as I would like to pass a rectangle without screen borders to the child -- layout when appropriate (per the original approach), I can't. Since the -- screen border is always present whether displayed or not, child layouts -- can't depend on an accurate layout rectangle. -- -- Note #2: If there are fewer than two stack windows displayed, the stack -- window (if present) is scaled up while the non-stack windows are moved a -- border-dependent amount based on their quadrant. So a non-stack window -- in the top-left quadrant will be moved using only the border's top and -- left components. Originally I was going to use an edge-attachment -- algorithm, but this is much simpler and covers most cases. Edge -- attachment would have scaled non-stack windows, but most non-stack -- windows are created by XMonad and therefore cannot be scaled. I suggest -- this layout be disabled for any incompatible child layouts. modifyLayout (Spacing _b _sb False _wb _wbe) wsp lr = runLayout wsp lr modifyLayout (Spacing b sb _sbe _wb _wbe) wsp lr = do let sb1 = borderClampGTZero sb lr' = withBorder' sb1 2 lr sb2 = toBorder lr' lr (wrs,ml) <- runLayout wsp lr' let ff (w,wr) (i,ps) = if w `elem` (W.integrate' . W.stack $ wsp) then let wr' = withBorder' sb2 2 wr in (i+1,(w,wr'):ps) else let wr' = moveByQuadrant lr wr sb2 in (i,(w,wr'):ps) (c,wrs') = foldr ff (0::Integer,[]) wrs return $ if c <= 1 && b then (wrs',ml) else (wrs,ml) where moveByQuadrant :: Rectangle -> Rectangle -> Border -> Rectangle 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) dy = orderSelect (compare mcy rcy) (bt,0,negate bb) in mr { rect_x = x + fromIntegral dx, rect_y = y + fromIntegral dy } -- This is run after 'modifyLayout' but receives the original stack, not -- one possibly modified by the child layout. Does not remove borders from -- windows not in the stack, i.e. decorations generated by -- 'XMonad.Layout.Decorations'. pureModifier (Spacing _b _sb _sbe _wb False) _lr _mst wrs = (wrs, Nothing) pureModifier (Spacing b _sb _sbe wb _wbe) _lr mst wrs = let wb' = borderClampGTZero wb ff p@(w,wr) (i,ps) = if w `elem` W.integrate' mst then let wr' = withBorder' wb' 2 wr in (i+1,(w,wr'):ps) else (i,p:ps) (c,wrs') = foldr ff (0::Integer,[]) wrs in if c <= 1 && b then (wrs, Nothing) else (wrs', Nothing) pureMess s@(Spacing b sb sbe wb wbe) m | Just (ModifySmartBorder f) <- fromMessage m = Just $ s { smartBorder = f b } | Just (ModifyScreenBorder f) <- fromMessage m = Just $ s { screenBorder = f sb } | Just (ModifyScreenBorderEnabled f) <- fromMessage m = Just $ s { screenBorderEnabled = f sbe } | Just (ModifyWindowBorder f) <- fromMessage m = Just $ s { windowBorder = f wb } | Just (ModifyWindowBorderEnabled f) <- fromMessage m = Just $ s { windowBorderEnabled = f wbe } | otherwise = Nothing modifierDescription Spacing {} = "Spacing" -- | Generate the 'ModifiedLayout', exposing all initial state of 'Spacing'. spacingRaw :: Bool -- ^ The 'smartBorder'. -> Border -- ^ The 'screenBorder'. -> Bool -- ^ The 'screenBorderEnabled'. -> Border -- ^ The 'windowBorder'. -> Bool -- ^ The 'windowBorderEnabled'. -> l a -> ModifiedLayout Spacing l a spacingRaw b sb sbe wb wbe = ModifiedLayout (Spacing b sb sbe wb wbe) -- | Messages to alter the state of 'Spacing' using the endomorphic function -- arguments. data SpacingModifier = ModifySmartBorder (Bool -> Bool) | ModifyScreenBorder (Border -> Border) | ModifyScreenBorderEnabled (Bool -> Bool) | ModifyWindowBorder (Border -> Border) | ModifyWindowBorderEnabled (Bool -> Bool) instance Message SpacingModifier -- | Set 'smartBorder' to the given 'Bool'. setSmartSpacing :: Bool -> X () setSmartSpacing = sendMessage . ModifySmartBorder . const -- | Set 'screenBorder' to the given 'Border'. setScreenSpacing :: Border -> X () setScreenSpacing = sendMessage . ModifyScreenBorder . const -- | Set 'screenBorderEnabled' to the given 'Bool'. setScreenSpacingEnabled :: Bool -> X () setScreenSpacingEnabled = sendMessage . ModifyScreenBorderEnabled . const -- | Set 'windowBorder' to the given 'Border'. setWindowSpacing :: Border -> X () setWindowSpacing = sendMessage . ModifyWindowBorder . const -- | Set 'windowBorderEnabled' to the given 'Bool'. setWindowSpacingEnabled :: Bool -> X () setWindowSpacingEnabled = sendMessage . ModifyWindowBorderEnabled . const -- | Toggle 'smartBorder'. toggleSmartSpacing :: X () toggleSmartSpacing = sendMessage $ ModifySmartBorder not -- | Toggle 'screenBorderEnabled'. toggleScreenSpacingEnabled :: X () toggleScreenSpacingEnabled = sendMessage $ ModifyScreenBorderEnabled not -- | Toggle 'windowBorderEnabled'. toggleWindowSpacingEnabled :: X () toggleWindowSpacingEnabled = sendMessage $ ModifyWindowBorderEnabled not -- | Set all borders to a uniform size; see 'setWindowSpacing' and -- 'setScreenSpacing'. setScreenWindowSpacing :: Integer -> X () setScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder] . flip id . const . uniformBorder -- | Increment the borders of 'windowBorder' using 'borderIncrementBy', which -- preserves border ratios during clamping. incWindowSpacing :: Integer -> X () incWindowSpacing = sendMessage . ModifyWindowBorder . borderIncrementBy -- | Increment the borders of 'screenBorder' using 'borderIncrementBy'. incScreenSpacing :: Integer -> X () incScreenSpacing = sendMessage . ModifyScreenBorder . borderIncrementBy -- | Inverse of 'incWindowSpacing', equivalent to applying 'negate'. decWindowSpacing :: Integer -> X () decWindowSpacing = incWindowSpacing . negate -- | Inverse of 'incScreenSpacing'. decScreenSpacing :: Integer -> X () decScreenSpacing = incScreenSpacing . negate -- | Increment both screen and window borders; see 'incWindowSpacing' and -- 'incScreenSpacing'. incScreenWindowSpacing :: Integer -> X () incScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder] . flip id . borderIncrementBy -- | Inverse of 'incScreenWindowSpacing'. decScreenWindowSpacing :: Integer -> X () decScreenWindowSpacing = incScreenWindowSpacing . negate -- | Construct a uniform 'Border'. That is, having equal individual borders. uniformBorder :: Integer -> Border uniformBorder i = Border i i i i -- | Map a function over a 'Border'. That is, over the four individual borders. borderMap :: (Integer -> Integer) -> Border -> Border borderMap f (Border t b r l) = Border (f t) (f b) (f r) (f l) -- | Clamp borders to within @[0,Infinity]@. borderClampGTZero :: Border -> Border borderClampGTZero = borderMap (max 0) -- | Change the border spacing by the provided amount, adjusted so that at -- least one border field is @>=0@. borderIncrementBy :: Integer -> Border -> Border borderIncrementBy i (Border t b r l) = let bl = [t,b,r,l] o = maximum bl o' = max i $ negate o in Border (t + o') (b + o') (r + o') (l + o') -- | Interface to 'XMonad.Util.Rectangle.withBorder'. withBorder' :: Border -> Integer -> Rectangle -> Rectangle withBorder' (Border t b r l) = R.withBorder t b r l -- | Return the border necessary to derive the second rectangle from the first. -- Since 'R.withBorder' may scale the borders to stay within rectangle bounds, -- it is not an invertible operation, i.e. applying a negated border may not -- return the original rectangle. Use this instead. toBorder :: Rectangle -> Rectangle -> Border toBorder r1 r2 = let R.PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = R.pixelsToCoordinates r1 R.PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = R.pixelsToCoordinates r2 l = r2_x1 - r1_x1 r = r1_x2 - r2_x2 t = r2_y1 - r1_y1 b = r1_y2 - r2_y2 in Border t b r l -- | Given an ordering and a three-tuple, return the first tuple entry if 'LT', -- second if 'EQ' and third if 'GT'. orderSelect :: Ordering -> (a,a,a) -> a orderSelect o (lt,eq,gt) = case o of LT -> lt EQ -> eq GT -> gt ----------------------------------------------------------------------------- -- Backwards Compatibility: ----------------------------------------------------------------------------- -- | Surround all windows by a certain number of pixels of blank space. See -- 'spacingRaw'. spacing :: Int -> l a -> ModifiedLayout Spacing l a spacing i = spacingRaw False (uniformBorder 0) False (uniformBorder i') True where i' = fromIntegral i -- | Surround all windows by a certain number of pixels of blank space, and -- additionally adds the same amount of spacing around the edge of the screen. -- See 'spacingRaw'. spacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a spacingWithEdge i = spacingRaw False (uniformBorder i') True (uniformBorder i') True where i' = fromIntegral i -- | Surrounds all windows with blank space, except when the window is the only -- visible window on the current workspace. See 'spacingRaw'. smartSpacing :: Int -> l a -> ModifiedLayout Spacing l a smartSpacing i = spacingRaw True (uniformBorder 0) False (uniformBorder i') True where i' = fromIntegral i -- | Surrounds all windows with blank space, and adds the same amount of -- spacing around the edge of the screen, except when the window is the only -- visible window on the current workspace. See 'spacingRaw'. smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True where i' = fromIntegral i xmonad-contrib-0.18.0/XMonad/Layout/Spiral.hs0000644000000000000000000001162207346545000017150 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Spiral -- Description : A spiral tiling layout. -- Copyright : (c) Joe Thornber -- License : BSD3-style (see LICENSE) -- -- Maintainer : Joe Thornber -- Stability : stable -- Portability : portable -- -- A spiral tiling layout. -- ----------------------------------------------------------------------------- module XMonad.Layout.Spiral ( -- * Usage -- $usage spiral , spiralWithDir , Rotation (..) , Direction (..) , SpiralWithDir ) where import Data.Ratio import XMonad hiding ( Rotation ) import XMonad.StackSet ( integrate ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Spiral -- -- Then edit your @layoutHook@ by adding the Spiral layout: -- -- > myLayout = spiral (6/7) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". fibs :: [Integer] fibs = 1 : 1 : zipWith (+) fibs (drop 1 fibs) mkRatios :: [Integer] -> [Rational] mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs) mkRatios _ = [] data Rotation = CW | CCW deriving (Read, Show) data Direction = East | South | West | North deriving (Eq, Enum, Read, Show) blend :: Rational -> [Rational] -> [Rational] blend scale ratios = zipWith (+) ratios scaleFactors where len = length ratios step = (scale - (1 % 1)) / fromIntegral len scaleFactors = map (* step) . reverse . take len $ [0..] -- | A spiral layout. The parameter controls the size ratio between -- successive windows in the spiral. Sensible values range from 0 -- up to the aspect ratio of your monitor (often 4\/3). -- -- By default, the spiral is counterclockwise, starting to the east. -- See also 'spiralWithDir'. spiral :: Rational -> SpiralWithDir a spiral = spiralWithDir East CW -- | Create a spiral layout, specifying the starting cardinal direction, -- the spiral direction (clockwise or counterclockwise), and the -- size ratio. spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a spiralWithDir = SpiralWithDir data SpiralWithDir a = SpiralWithDir Direction Rotation Rational deriving ( Read, Show ) instance LayoutClass SpiralWithDir a where pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects where ws = integrate stack ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ drop 1 fibs rects = divideRects (zip ratios dirs) sc dirs = dropWhile (/= dir) $ case rot of CW -> cycle [East .. North] CCW -> cycle [North, West, South, East] handleMessage (SpiralWithDir dir rot scale) = return . fmap resize . fromMessage where resize Expand = spiralWithDir dir rot $ (21 % 20) * scale resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale description _ = "Spiral" -- This will produce one more rectangle than there are splits details 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 -- It's much simpler if we work with all Integers and convert to -- Rectangle at the end. data Rect = Rect Integer Integer Integer Integer fromRect :: Rect -> Rectangle fromRect (Rect x y w h) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) toRect :: Rectangle -> Rect toRect (Rectangle x y w h) = Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle) divideRect r d rect = let (r1, r2) = divideRect' r d $ toRect rect in (fromRect r1, fromRect r2) divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect) divideRect' ratio dir (Rect x y w h) = case dir of East -> let (w1, w2) = chop ratio w in (Rect x y w1 h, Rect (x + w1) y w2 h) South -> let (h1, h2) = chop ratio h in (Rect x y w h1, Rect x (y + h1) w h2) West -> let (w1, w2) = chop (1 - ratio) w in (Rect (x + w1) y w2 h, Rect x y w1 h) 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 (f, n - f) xmonad-contrib-0.18.0/XMonad/Layout/Square.hs0000644000000000000000000000425107346545000017156 0ustar0000000000000000{-# 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 -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- 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). -- ----------------------------------------------------------------------------- module XMonad.Layout.Square ( -- * Usage -- $usage Square(..) ) where import XMonad import XMonad.StackSet ( integrate ) -- $usage -- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Layout.Square -- -- An example layout using square together with "XMonad.Layout.Combo" -- to make the very last area square: -- -- > , combo (combo (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) -- > [(twoPane 0.03 0.2,1),(combo [(twoPane 0.03 0.8,1),(square,1)] -- > [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] -- For detailed instructions on editing your key bindings, see -- . data Square a = Square deriving ( Read, Show ) instance LayoutClass Square a where pureLayout Square r s = arrange (integrate s) where arrange ws@(_:_) = map (, rest) (init ws) ++ [(last ws,sq)] arrange [] = [] -- actually, this is an impossible case (rest, sq) = splitSquare r splitSquare :: Rectangle -> (Rectangle, Rectangle) splitSquare (Rectangle x y w h) | w > h = (Rectangle x y (w - h) h, Rectangle (x+fromIntegral (w-h)) y h h) | otherwise = (Rectangle x y w (h-w), Rectangle x (y+fromIntegral (h-w)) w w) xmonad-contrib-0.18.0/XMonad/Layout/StackTile.hs0000644000000000000000000000462707346545000017610 0ustar0000000000000000{-# 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 -- License : BSD-style (see LICENSE) -- -- Maintainer : Rickard Gustafsson -- Stability : unstable -- Portability : unportable -- -- A stacking layout, like dishes but with the ability to resize master pane. -- Mostly useful on small screens. -- ----------------------------------------------------------------------------- module XMonad.Layout.StackTile ( -- * Usage -- $usage StackTile(..) ) where import XMonad hiding (tile) import qualified XMonad.StackSet as W import XMonad.Prelude -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.StackTile -- -- Then edit your @layoutHook@ by adding the StackTile layout: -- -- > myLayout = StackTile 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read) instance LayoutClass StackTile a where pureLayout (StackTile nmaster _ frac) r s = zip ws rs where ws = W.integrate s rs = tile frac r nmaster (length ws) pureMessage (StackTile nmaster delta frac) m = msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = StackTile nmaster delta (max 0 $ frac-delta) resize Expand = StackTile nmaster delta (min 1 $ frac+delta) incmastern (IncMasterN d) = StackTile (max 0 (nmaster+d)) delta frac description _ = "StackTile" tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle] tile f r nmaster n = if n <= nmaster || nmaster == 0 then splitHorizontally n r else splitHorizontally nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns where (r1,r2) = splitVerticallyBy f r xmonad-contrib-0.18.0/XMonad/Layout/StateFull.hs0000644000000000000000000000421107346545000017615 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} -------------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.StateFull -- Description : The StateFull Layout & FocusTracking Layout Transformer -- Copyright : (c) 2018 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Maintainer : L. S. Leary -- Stability : unstable -- Portability : unportable -- -- Provides StateFull: a stateful form of Full that does not misbehave when -- floats are focused, and the FocusTracking layout transformer by means of -- which StateFull is implemented. FocusTracking simply holds onto the last -- true focus it was given and continues to use it as the focus for the -- transformed layout until it sees another. It can be used to improve the -- behaviour of a child layout that has not been given the focused window. -------------------------------------------------------------------------------- module XMonad.Layout.StateFull {-# DEPRECATED "Use X.L.TrackFloating." #-} ( -- * Usage -- $Usage pattern StateFull, StateFull, FocusTracking, F.focusTracking ) where import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.Layout.FocusTracking as F -- $Usage -- -- To use it, first you need to: -- -- > import XMonad.Layout.StateFull -- -- Then to toggle your tiled layout with @StateFull@, you can do: -- -- > main = xmonad def { layoutHook = someTiledLayout ||| StateFull } -- -- Or, some child layout that depends on focus information can be made to fall -- back on the last focus it had: -- -- > main = xmonad def -- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) } -- | The @FocusTracking@ type for which the @LayoutClass@ instance is provided. type FocusTracking = ModifiedLayout F.FocusTracking -- | A type synonym to match the @StateFull@ pattern synonym. type StateFull = FocusTracking Full -- | A pattern synonym for the primary use case of the @FocusTracking@ -- transformer; using @Full@. pattern StateFull :: StateFull a pattern StateFull = ModifiedLayout (F.FocusTracking Nothing) Full xmonad-contrib-0.18.0/XMonad/Layout/Stoppable.hs0000644000000000000000000001213407346545000017646 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Stoppable -- Description : A layout modifier to stop all non-visible processes. -- Copyright : (c) Anton Vorontsov 2014 -- License : BSD-style (as xmonad) -- -- Maintainer : Anton Vorontsov -- Stability : unstable -- Portability : unportable -- -- 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. -- -- Note that the stopped application won't be able to communicate with X11 -- clipboard. For this, the module actually stops applications after a -- certain delay, giving a chance for a user to complete copy-paste -- sequence. By default, the delay equals to 15 seconds, it is -- configurable via 'Stoppable' constructor. -- -- The stoppable modifier prepends a mark (by default equals to -- \"Stoppable\") to the layout description (alternatively, you can choose -- your own mark and use it with 'Stoppable' constructor). The stoppable -- layout (identified by a mark) spans to multiple workspaces, letting you -- to create groups of stoppable workspaces that only stop processes when -- none of the workspaces are visible, and conversely, unfreezing all -- processes even if one of the stoppable workspaces are visible. -- -- To stop the process we use signals, which works for most cases. For -- processes that tinker with signal handling (debuggers), another -- (Linux-centric) approach may be used. See -- -- -- * Note -- This module doesn't work on programs that do fancy things with processes -- (such as Chromium) and programs that do not set _NET_WM_PID. ----------------------------------------------------------------------------- module XMonad.Layout.Stoppable ( -- $usage Stoppable(..) , stoppable ) where import XMonad import XMonad.Prelude import XMonad.Actions.WithAll import XMonad.Util.WindowProperties import XMonad.Util.RemoteWindows import XMonad.Util.Timer import XMonad.StackSet hiding (filter) import XMonad.Layout.LayoutModifier import System.Posix.Signals -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Layout.Stoppable -- > -- > main = xmonad def -- > { layoutHook = layoutHook def ||| stoppable (layoutHook def) } -- -- Note that the module has to distinguish between local and remote -- proccesses, which means that it needs to know the hostname, so it looks -- for environment variables (e.g. HOST). -- -- Environment variables will work for most cases, but won't work if the -- hostname changes. To cover dynamic hostnames case, in addition to -- layoutHook you have to provide manageHook from -- "XMonad.Util.RemoteWindows" module. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". signalWindow :: Signal -> Window -> X () signalWindow s w = do pid <- getProp32s "_NET_WM_PID" w io $ (signalProcess s . fromIntegral) `mapM_` fromMaybe [] pid signalLocalWindow :: Signal -> Window -> X () signalLocalWindow s w = isLocalWindow w >>= flip when (signalWindow s w) withAllOn :: (a -> X ()) -> Workspace i l a -> X () withAllOn f wspc = f `mapM_` integrate' (stack wspc) withAllFiltered :: (Workspace i l a -> Bool) -> [Workspace i l a] -> (a -> X ()) -> X () withAllFiltered p wspcs f = withAllOn f `mapM_` filter p wspcs sigStoppableWorkspacesHook :: String -> X () sigStoppableWorkspacesHook k = do ws <- gets windowset withAllFiltered isStoppable (hidden ws) (signalLocalWindow sigSTOP) where isStoppable ws = k `elem` words (description $ layout ws) -- | Data type for ModifiedLayout. The constructor lets you to specify a -- custom mark/description modifier and a delay. You can also use -- 'stoppable' helper function. data Stoppable a = Stoppable { mark :: String , delay :: Rational , timer :: Maybe TimerId } deriving (Show,Read) instance LayoutModifier Stoppable Window where modifierDescription = mark hook _ = withAll $ signalLocalWindow sigCONT handleMess (Stoppable m _ (Just tid)) msg | Just ev <- fromMessage msg = handleTimer tid ev run where run = sigStoppableWorkspacesHook m >> return Nothing handleMess (Stoppable m d _) msg | Just Hide <- fromMessage msg = Just . Stoppable m d . Just <$> startTimer d | otherwise = return Nothing -- | Convert a layout to a stoppable layout using the default mark -- (\"Stoppable\") and a delay of 15 seconds. stoppable :: l a -> ModifiedLayout Stoppable l a stoppable = ModifiedLayout (Stoppable "Stoppable" 15 Nothing) xmonad-contrib-0.18.0/XMonad/Layout/SubLayouts.hs0000644000000000000000000005251707346545000020040 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ParallelListComp #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SubLayouts -- Description : A layout combinator that allows layouts to be nested. -- Copyright : (c) 2009 Adam Vogt -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adam@gmail.com -- Stability : unstable -- Portability : unportable -- -- A layout combinator that allows layouts to be nested. -- ----------------------------------------------------------------------------- module XMonad.Layout.SubLayouts ( -- * Usage -- $usage subLayout, subTabbed, pushGroup, pullGroup, pushWindow, pullWindow, onGroup, toSubl, mergeDir, GroupMsg(..), Broadcast(..), defaultSublMap, Sublayout, -- * Screenshots -- $screenshots -- * Todo -- $todo ) where import XMonad.Layout.Decoration(Decoration, DefaultShrinker) import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, redoLayout), ModifiedLayout(..)) import XMonad.Layout.Simplest(Simplest(..)) import XMonad.Layout.Tabbed(shrinkText, TabbedDecoration, addTabs) import XMonad.Layout.WindowNavigation(Navigate(Apply)) import XMonad.Util.Invisible(Invisible(..)) import XMonad.Util.Types(Direction2D(..)) import XMonad hiding (def) import XMonad.Prelude import Control.Arrow(Arrow(second, (&&&))) 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 -- -- <> -- -- Larger version: -- $todo -- /Issue 288/ -- -- "XMonad.Layout.ResizableTile" assumes that its environment -- contains only the windows it is running: sublayouts are currently run with -- the stack containing only the windows passed to it in its environment, but -- any changes that the layout makes are not merged back. -- -- Should the behavior be made optional? -- -- /Features/ -- -- * suggested managehooks for merging specific windows, or the apropriate -- layout based hack to find out the number of groups currently showed, but -- the size of current window groups is not available (outside of this -- growing module) -- -- /SimpleTabbed as a SubLayout/ -- -- 'subTabbed' works well, but it would be more uniform to avoid the use of -- addTabs, with the sublayout being Simplest (but -- 'XMonad.Layout.Tabbed.simpleTabbed' is this...). The only thing to be -- gained by fixing this issue is the ability to mix and match decoration -- styles. Better compatibility with some other layouts of which I am not -- aware could be another benefit. -- -- 'simpleTabbed' (and other decorated layouts) fail horribly when used as -- subLayouts: -- -- * decorations stick around: layout is run after being told to Hide -- -- * mouse events do not change focus: the group-ungroup does not respect -- the focus changes it wants? -- -- * sending ReleaseResources before running it makes xmonad very slow, and -- still leaves borders sticking around -- -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.SubLayouts -- > import XMonad.Layout.WindowNavigation -- -- Using "XMonad.Layout.BoringWindows" is optional and it allows you to add a -- keybinding to skip over the non-visible windows. -- -- > import XMonad.Layout.BoringWindows -- -- Then edit your @layoutHook@ by adding the 'subTabbed' layout modifier: -- -- > myLayout = windowNavigation $ subTabbed $ boringWindows $ -- > Tall 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- "XMonad.Layout.WindowNavigation" is used to specify which windows to merge, -- and it is not integrated into the modifier because it can be configured, and -- works best as the outer modifier. -- -- Then to your keybindings add: -- -- > , ((modm .|. controlMask, xK_h), sendMessage $ pullGroup L) -- > , ((modm .|. controlMask, xK_l), sendMessage $ pullGroup R) -- > , ((modm .|. controlMask, xK_k), sendMessage $ pullGroup U) -- > , ((modm .|. controlMask, xK_j), sendMessage $ pullGroup D) -- > -- > , ((modm .|. controlMask, xK_m), withFocused (sendMessage . MergeAll)) -- > , ((modm .|. controlMask, xK_u), withFocused (sendMessage . UnMerge)) -- > -- > , ((modm .|. controlMask, xK_period), onGroup W.focusUp') -- > , ((modm .|. controlMask, xK_comma), onGroup W.focusDown') -- -- These additional keybindings require the optional -- "XMonad.Layout.BoringWindows" layoutModifier. The focus will skip over the -- windows that are not focused in each sublayout. -- -- > , ((modm, xK_j), focusDown) -- > , ((modm, xK_k), focusUp) -- -- A 'submap' can be used to make modifying the sublayouts using 'onGroup' and -- 'toSubl' simpler: -- -- > ,((modm, xK_s), submap $ defaultSublMap conf) -- -- /NOTE:/ is there some reason that @asks config >>= submap . defaultSublMap@ -- could not be used in the keybinding instead? It avoids having to explicitly -- pass the conf. -- -- For more detailed instructions, see -- -- and "XMonad.Doc.Extending#Editing_the_layout_hook". -- | The main layout modifier arguments: -- -- @subLayout advanceInnerLayouts innerLayout outerLayout@ -- -- [@advanceInnerLayouts@] When a new group at index @n@ in the outer layout -- is created (even with one element), the @innerLayout@ is used as the -- layout within that group after being advanced with @advanceInnerLayouts !! -- n@ 'NextLayout' messages. If there is no corresponding element in the -- @advanceInnerLayouts@ list, then @innerLayout@ is not given any 'NextLayout' -- messages. -- -- [@innerLayout@] The single layout given to be run as a sublayout. -- -- [@outerLayout@] The layout that determines the rectangles given to each -- group. -- -- Ex. The second group is 'Tall', the third is 'XMonad.Layout.CircleEx.circle', -- all others are tabbed with: -- -- > myLayout = addTabs shrinkText def -- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| circle) -- > $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a 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) => l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) (ModifiedLayout (Sublayout Simplest) l) a subTabbed x = addTabs shrinkText X.def $ subLayout [] Simplest x -- | @defaultSublMap@ is an attempt to create a set of keybindings like the -- 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 [((modm, xK_space), toSubl NextLayout), ((modm, xK_j), onGroup W.focusDown'), ((modm, xK_k), onGroup W.focusUp'), ((modm, xK_h), toSubl Shrink), ((modm, xK_l), toSubl Expand), ((modm, xK_Tab), onGroup W.focusDown'), ((modm .|. shiftMask, xK_Tab), onGroup W.focusUp'), ((modm, xK_m), onGroup focusMaster'), ((modm, xK_comma), toSubl $ IncMasterN 1), ((modm, xK_period), toSubl $ IncMasterN (-1)), ((modm, xK_Return), onGroup swapMaster') ] where -- should these go into XMonad.StackSet? focusMaster' st = let (notEmpty -> f :| fs) = W.integrate st in W.Stack f [] fs swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d data Sublayout l a = Sublayout { delayMess :: Invisible [] (SomeMessage,a) -- ^ messages are handled when running the layout, -- not in the handleMessage, I'm not sure that this -- is necessary , def :: ([Int], l a) -- ^ how many NextLayout messages to send to newly -- populated layouts. If there is no corresponding -- index, then don't send any. , subls :: [(l a,W.Stack a)] -- ^ The sublayouts and the stacks they manage } deriving (Read,Show) -- | Groups assumes this invariant: -- M.keys gs == map W.focus (M.elems gs) (ignoring order) -- All windows in the workspace are in the Map -- -- The keys are visible windows, the rest are hidden. -- -- 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 = UnMerge a -- ^ free the focused window from its tab stack | UnMergeAll a -- ^ separate the focused group into singleton groups | Merge a a -- ^ merge the first group into the second group | MergeAll a -- ^ make one large group, keeping the parameter focused | Migrate a a -- ^ used to the window named in the first argument to the -- second argument's group, this may be replaced by a -- combination of 'UnMerge' and 'Merge' | WithGroup (W.Stack a -> X (W.Stack a)) a | SubMessage SomeMessage a -- ^ the sublayout with the given window will get the message -- | 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 = WithGroup g where g cs = do let onlyOthers = W.filter (`notElem` W.integrate cs) (`whenJust` sendMessage . Merge (W.focus cs) . W.focus . f) . (onlyOthers =<<) =<< currentStack return cs newtype Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts instance Message Broadcast instance Typeable a => Message (GroupMsg a) -- | @pullGroup@, @pushGroup@ allow you to merge windows or groups inheriting -- the position of the current window (pull) or the other window (push). -- -- @pushWindow@ and @pullWindow@ move individual windows between groups. They -- are less effective at preserving window positions. pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate pullGroup = mergeNav (\o c -> sendMessage $ Merge o c) pushGroup = mergeNav (\o c -> sendMessage $ Merge c o) pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c) pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o) mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate 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. onGroup :: (W.Stack Window -> W.Stack Window) -> X () onGroup f = withFocused (sendMessage . WithGroup (return . f)) -- | Send a message to the currently focused sublayout. toSubl :: (Message a) => a -> X () toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m)) instance forall l. (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where modifyLayout Sublayout{ subls = osls } (W.Workspace i la st) r = do let gs' = updateGroup st $ toGroups osls st' = W.filter (`elem` M.keys gs') =<< st updateWs gs' oldStack <- 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 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) newL rect n ol isNew sst = do orgStack <- currentStack let handle l (y,_) | not isNew = fromMaybe l <$> handleMessage l y | otherwise = return l kms = filter ((`elem` M.keys gs') . snd) ms setStack sst nl <- foldM handle ol $ filter ((`elem` W.integrate' sst) . snd) kms result <- runLayout (W.Workspace n nl sst) rect setStack orgStack -- FIXME: merge back reordering, deletions? return $ fromMaybe nl `second` result (urls,ssts) = unzip [ (newL gr i l isNew sst, sst) | (isNew,(l,_st)) <- sls | i <- map show [ 0 :: Int .. ] | (k,gr) <- arrs, let sst = M.lookup k gs' ] arrs' <- sequence urls sls' <- return . Sublayout (I []) defl . map snd <$> fromGroups defl st gs' [ (l,s) | (_,l) <- arrs' | (Just s) <- ssts ] return (concatMap fst arrs', sls') handleMess (Sublayout (I ms) defl sls) m | Just (SubMessage sm w) <- fromMessage m = return $ Just $ Sublayout (I ((sm,w):ms)) defl sls | Just (Broadcast sm) <- fromMessage m = do ms' <- fmap (map (sm,) . W.integrate') currentStack return $ if null ms' then Nothing else Just $ Sublayout (I $ ms' ++ ms) defl sls | Just B.UpdateBoring <- fromMessage m = do let bs = concatMap unfocused $ M.elems gs ws <- gets (W.workspace . W.current . windowset) flip sendMessageWithNoRefresh ws $ B.Replace "Sublayouts" bs return Nothing | Just (WithGroup f w) <- fromMessage m , Just g <- M.lookup w gs = do g' <- f g let gs' = M.insert (W.focus g') g' $ M.delete (W.focus g) gs when (gs' /= gs) $ updateWs gs' when (w /= W.focus g') $ windows (W.focusWindow $ W.focus g') return Nothing | Just (MergeAll w) <- fromMessage m = let gs' = fmap (M.singleton w) $ (focusWindow' w =<<) $ W.differentiate $ concatMap W.integrate $ M.elems gs in maybe (return Nothing) fgs gs' | Just (UnMergeAll w) <- fromMessage m = let ws = concatMap W.integrate $ M.elems gs _ = w :: Window mkSingleton f = M.singleton f (W.Stack f [] []) in fgs $ M.unions $ map mkSingleton ws | Just (Merge x y) <- fromMessage m , Just (W.Stack _ xb xn) <- findGroup x , Just yst <- findGroup y = let zs = W.Stack x xb (xn ++ W.integrate yst) in fgs $ M.insert x zs $ M.delete (W.focus yst) gs | Just (UnMerge x) <- fromMessage m = fgs . M.fromList . map (W.focus &&& id) . M.elems $ M.mapMaybe (W.filter (x/=)) gs -- XXX sometimes this migrates an incorrect window, why? | Just (Migrate x y) <- fromMessage m , Just xst <- findGroup x , Just (W.Stack yf yu yd) <- findGroup y = let zs = W.Stack x (yf:yu) yd nxsAdd = maybe id (\e -> M.insert (W.focus e) e) $ W.filter (x/=) xst in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs | otherwise = join <$> traverse catchLayoutMess (fromMessage m) where gs = toGroups sls fgs gs' = do st <- currentStack Just . Sublayout (I ms) defl . map snd <$> fromGroups defl st gs' sls findGroup z = mplus (M.lookup z gs) $ listToMaybe $ M.elems $ M.filter ((z `elem`) . W.integrate) gs catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window)) catchLayoutMess x = do let m' = x `asTypeOf` (undefined :: LayoutMessages) ms' <- map (SomeMessage m',) . W.integrate' <$> currentStack return $ do guard $ not $ null ms' Just $ Sublayout (I $ ms' ++ ms) defl sls currentStack :: X (Maybe (W.Stack Window)) currentStack = gets (W.stack . W.workspace . W.current . windowset) -- | update Group to follow changes in the workspace updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a updateGroup Nothing _ = mempty updateGroup (Just st) gs = fromGroupStack (toGroupStack gs st) -- | rearrange the windowset to put the groups of tabs next to each other, so -- that the stack of tabs stays put. updateWs :: Groups Window -> X () updateWs = windowsMaybe . updateWs' updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet updateWs' gs ws = do w <- W.stack . W.workspace . W.current $ ws let w' = flattenGroupStack . toGroupStack gs $ w guard $ w /= w' pure $ W.modify' (const w') ws -- | Flatten a stack of stacks. flattenGroupStack :: GroupStack a -> W.Stack a flattenGroupStack (W.Stack (W.Stack f lf rf) ls rs) = let l = lf ++ concatMap (reverse . W.integrate) ls r = rf ++ concatMap W.integrate rs in W.Stack f l r -- | Extract Groups from a stack of stacks. fromGroupStack :: (Ord a) => GroupStack a -> Groups a fromGroupStack = M.fromList . map (W.focus &&& id) . W.integrate -- | Arrange a stack of windows into a stack of stacks, according to (possibly -- outdated) Groups. -- -- Assumes that the groups are disjoint and there are no duplicates in the -- stack; will result in additional duplicates otherwise. This is a reasonable -- assumption—the rest of xmonad will mishave too—but it isn't checked -- anywhere and there had been bugs breaking this assumption in the past. toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a toGroupStack gs st@(W.Stack f ls rs) = W.Stack (fromJust (lu f)) (mapMaybe lu ls) (mapMaybe lu rs) where wset = S.fromList (W.integrate st) dead = W.filter (`S.member` wset) -- drop dead windows or entire groups refocus s | f `elem` W.integrate s -- sync focus/order of current group = W.filter (`elem` W.integrate s) st | otherwise = pure s gs' = mapGroups (refocus <=< dead) gs gset = S.fromList . concatMap W.integrate . M.elems $ gs' -- after refocus, f is either the focused window of some group, or not in -- gs' at all, so `lu f` is never Nothing lu w | w `S.member` gset = w `M.lookup` gs' | otherwise = Just (W.Stack w [] []) -- singleton groups for new wins mapGroups :: (Ord a) => (W.Stack a -> Maybe (W.Stack a)) -> Groups a -> Groups a mapGroups f = M.fromList . map (W.focus &&& id) . mapMaybe f . M.elems -- | focusWindow'. focus an element of a stack, is Nothing if that element is -- absent. See also 'W.focusWindow' focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a) focusWindow' w st = do guard $ w `elem` W.integrate st return $ until ((w ==) . W.focus) W.focusDown' st -- update only when Just windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X () windowsMaybe f = do xst <- get ws <- gets windowset let up fws = put xst { windowset = fws } maybe (return ()) up $ f ws unfocused :: W.Stack a -> [a] unfocused x = W.up x ++ W.down x toGroups :: (Ord a) => [(a1, W.Stack a)] -> Map a (W.Stack a) toGroups ws = M.fromList . map (W.focus &&& id) . nubBy (on (==) W.focus) $ map snd ws -- | restore the default layout for each group. It needs the X monad to switch -- the default layout to a specific one (handleMessage NextLayout) fromGroups :: (LayoutClass layout a, Ord k) => ([Int], layout a) -> Maybe (W.Stack k) -> Groups k -> [(layout a, b)] -> X [(Bool,(layout a, W.Stack k))] fromGroups (skips,defl) st gs sls = do defls <- mapM (iterateM nextL defl !!) skips return $ fromGroups' defl defls st gs (map fst sls) where nextL l = fromMaybe l <$> handleMessage l (SomeMessage NextLayout) iterateM f = iterate (>>= f) . return fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a] -> [(Bool,(a, W.Stack k))] fromGroups' defl defls st gs sls = [ (isNew,fromMaybe2 (dl, single w) (l, M.lookup w gs)) | l <- map Just sls ++ repeat Nothing, let isNew = isNothing l | dl <- defls ++ repeat defl | w <- W.integrate' $ W.filter (`notElem` unfocs) =<< st ] where unfocs = unfocused =<< M.elems gs single w = W.Stack w [] [] fromMaybe2 (a,b) (x,y) = (fromMaybe a x, fromMaybe b y) -- this would be much cleaner with some kind of data-accessor setStack :: Maybe (W.Stack Window) -> X () setStack x = modify (\s -> s { windowset = (windowset s) { W.current = (W.current $ windowset s) { W.workspace = (W.workspace $ W.current $ windowset s) { W.stack = x }}}}) xmonad-contrib-0.18.0/XMonad/Layout/TabBarDecoration.hs0000644000000000000000000000617207346545000021065 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier to add a bar of tabs to your layouts. ----------------------------------------------------------------------------- module XMonad.Layout.TabBarDecoration ( -- * Usage -- $usage simpleTabBar, tabBar , def, shrinkText , TabBarDecoration (..), XPPosition (..) , module XMonad.Layout.ResizeScreen ) where import XMonad.Prelude import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.Decoration import XMonad.Layout.ResizeScreen import XMonad.Prompt ( XPPosition (..) ) -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.TabBarDecoration -- -- Then edit your @layoutHook@ by adding the layout you want: -- -- > main = xmonad def { layoutHook = simpleTabBar $ layoutHook def} -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 'tabBar' will give you the possibility of setting a custom shrinker -- and a custom theme. -- -- The deafult theme can be dynamically change with the xmonad theme -- selector. See "XMonad.Prompt.Theme". For more themse, look at -- "XMonad.Util.Themes" -- | Add, on the top of the screen, a simple bar of tabs to a given -- | layout, with the default theme and the default shrinker. simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen l) a simpleTabBar = decoration shrinkText def (TabBar Top) . resizeVertical 20 -- | Same of 'simpleTabBar', but with the possibility of setting a -- custom shrinker, a custom theme and the position: 'Top' or -- 'Bottom'. 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) newtype TabBarDecoration a = TabBar XPPosition deriving (Read, Show) instance Eq a => DecorationStyle TabBarDecoration a where describeDeco _ = "TabBar" shrink _ _ r = r decorationCatchClicksHook _ mainw _ _ = focus mainw >> return True pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) = if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing where wrs = S.integrate s loc i = (wh * fi i) `div` max 1 (fi $ length wrs) wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` wrs 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-contrib-0.18.0/XMonad/Layout/Tabbed.hs0000644000000000000000000002356007346545000017103 0ustar0000000000000000{-# 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A tabbed layout for the Xmonad Window Manager -- ----------------------------------------------------------------------------- module XMonad.Layout.Tabbed ( -- * Usage: -- $usage simpleTabbed, tabbed, addTabs , simpleTabbedAlways, tabbedAlways, addTabsAlways , simpleTabbedBottom, tabbedBottom, addTabsBottom , simpleTabbedLeft, tabbedLeft, addTabsLeft , simpleTabbedRight, tabbedRight, addTabsRight , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways , simpleTabbedLeftAlways, tabbedLeftAlways, addTabsLeftAlways , simpleTabbedRightAlways, tabbedRightAlways, addTabsRightAlways , Theme (..) , def , TabbedDecoration (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) , TabbarShown, Direction2D(..) ) where import XMonad.Prelude import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.Decoration import XMonad.Layout.Simplest ( Simplest(Simplest) ) import XMonad.Util.Types (Direction2D(..)) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Tabbed -- -- Then edit your @layoutHook@ by adding the Tabbed layout: -- -- > myLayout = simpleTabbed ||| Full ||| etc.. -- -- or, if you want a specific theme for you tabbed layout: -- -- > myLayout = tabbed shrinkText def ||| Full ||| etc.. -- -- and then: -- -- > main = xmonad def { layoutHook = myLayout } -- -- This layout has hardcoded behaviour for mouse clicks on tab decorations: -- Left click on the tab switches focus to that window. -- Middle click on the tab closes the window. -- -- The default Tabbar behaviour is to hide it when only one window is open -- on the workspace. To have it always shown, use one of the layouts or -- modifiers ending in @Always@. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. -- -- > myTabConfig = def { inactiveBorderColor = "#FF0000" -- > , activeTextColor = "#00FF00"} -- -- and -- -- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. -- Layouts -- | A tabbed layout with the default xmonad Theme. -- -- This is a minimal working configuration: -- -- > import XMonad -- > import XMonad.Layout.Tabbed -- > main = xmonad def { layoutHook = simpleTabbed } simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbed = tabbed shrinkText def simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedAlways = tabbedAlways shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedBottom = tabbedBottom shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def -- | A side-tabbed layout with the default xmonad Theme. 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) Simplest Window simpleTabbedLeftAlways = tabbedLeftAlways shrinkText def simpleTabbedRightAlways = tabbedRightAlways shrinkText def -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. tabbed :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbed s c = addTabs s c Simplest tabbedAlways :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedAlways s c = addTabsAlways s c Simplest -- | A layout decorated with tabs at the bottom and the possibility to set a custom -- shrinker and theme. tabbedBottom :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedBottom s c = addTabsBottom s c Simplest tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedBottomAlways s c = addTabsBottomAlways s c Simplest -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. tabbedLeft, tabbedRight :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedLeft s c = addTabsLeft s c Simplest tabbedRight s c = addTabsRight s c Simplest -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. tabbedLeftAlways, tabbedRightAlways :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedLeftAlways s c = addTabsLeftAlways s c Simplest tabbedRightAlways s c = addTabsRightAlways s c Simplest -- Layout Modifiers -- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout. addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabs = createTabs WhenPlural U addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsAlways = createTabs Always U -- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout. addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsBottom = createTabs WhenPlural D addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsBottomAlways = createTabs Always D -- | A layout modifier that uses the provided shrinker and theme to add tabs to the side of any layout. addTabsRight, addTabsLeft :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsRight = createTabs WhenPlural R addTabsLeft = createTabs WhenPlural L addTabsRightAlways, addTabsLeftAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsRightAlways = createTabs Always R addTabsLeftAlways = createTabs Always L -- Tab creation abstractions. Internal use only. -- Create tabbar when required at the given location with the given -- shrinker and theme to the supplied layout. 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 = decoration tx th (Tabbed loc sh) data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq) data TabbedDecoration a = Tabbed Direction2D TabbarShown deriving (Read, Show) instance Eq a => DecorationStyle TabbedDecoration a where describeDeco (Tabbed U _ ) = "Tabbed" describeDeco (Tabbed D _ ) = "Tabbed Bottom" describeDeco (Tabbed L _ ) = "Tabbed Left" describeDeco (Tabbed R _ ) = "Tabbed Right" decorationEventHook _ ds ButtonEvent { ev_window = ew , ev_event_type = et , ev_button = eb } | et == buttonPress , Just ((w,_),_) <- findWindowByDecoration ew ds = if eb == button2 then killWindow w else focus w decorationEventHook _ _ _ = return () pureDecoration (Tabbed lc sh) wt ht _ s wrs (w,r@(Rectangle x y wh hh)) = if (sh == Always && numWindows > 0) || numWindows > 1 then Just $ case lc of U -> upperTab D -> lowerTab L -> leftTab R -> rightTab else Nothing where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s) 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 n k h = maybe k (loc k h) $ w `elemIndex` ws nx = n x wh upperTab = Rectangle nx y wid (fi ht) lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht) fixHeightLoc i = y + fi ht * fi i fixHeightTab k = Rectangle k (maybe y fixHeightLoc $ w `elemIndex` ws) (fi wt) (fi ht) rightTab = fixHeightTab (x + fi (wh - wt)) leftTab = fixHeightTab x numWindows = length ws shrink (Tabbed loc _ ) (Rectangle _ _ dw dh) (Rectangle x y w h) = case loc of U -> Rectangle x (y + fi dh) w (h - dh) D -> Rectangle x y w (h - dh) L -> Rectangle (x + fi dw) y (w - dw) h R -> Rectangle x y (w - dw) h xmonad-contrib-0.18.0/XMonad/Layout/TallMastersCombo.hs0000644000000000000000000005465107346545000021142 0ustar0000000000000000-- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} --------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TallMastersCombo -- Description : A version of @Tall@ with two permanent master windows. -- Copyright : (c) 2019 Ningji Wei -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ningji Wei -- Stability : unstable -- Portability : unportable -- -- A layout combinator that support Shrink, Expand, and IncMasterN just as the -- 'Tall' layout, and also support operations of two master windows: -- a main master, which is the original master window; -- a sub master, the first window of the second pane. -- This combinator can be nested, and has a good support for using -- "XMonad.Layout.Tabbed" as a sublayout. -- ----------------------------------------------------------------------------- module XMonad.Layout.TallMastersCombo ( -- * Usage -- $usage tmsCombineTwoDefault, tmsCombineTwo, TMSCombineTwo (..), RowsOrColumns (..), (|||), -- * Messages SwitchOrientation (..), SwapSubMaster (..), FocusSubMaster (..), FocusedNextLayout (..), ChangeFocus (..), -- * Utilities ChooseWrapper (..), swapWindow, focusWindow, handleMessages ) where import XMonad hiding (focus, (|||)) import qualified XMonad.Layout as LL import XMonad.Layout.Decoration import XMonad.Layout.Simplest (Simplest (..)) import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe) import XMonad.StackSet (Stack (..), Workspace (..), integrate') import qualified XMonad.StackSet as W import XMonad.Util.Stack (zipperFocusedAtFirstOf) --------------------------------------------------------------------------------- -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.TallMastersCombo -- -- and make sure the Choose layout operator (|||) is hidden by adding the followings: -- -- > import XMonad hiding ((|||)) -- > import XMonad.Layout hiding ((|||)) -- -- then, add something like -- -- > tmsCombineTwoDefault (Tall 0 (3/100) 0) simpleTabbed -- -- This will make the 'Tall' layout as the master pane, and 'simpleTabbed' layout as the second pane. -- You can shrink, expand, and increase more windows to the master pane just like using the -- 'Tall' layout. -- -- To swap and/or focus the sub master window (the first window in the second pane), you can add -- the following key bindings -- -- > , ((modm .|. shiftMask, m), sendMessage $ FocusSubMaster) -- > , ((modm .|. shiftMask, xK_Return), sendMessage $ SwapSubMaster) -- -- In each pane, you can use multiple layouts with the '(|||)' combinator provided by this module, -- and switch between them with the 'FocusedNextLayout' message. Below is one example -- -- > layout1 = Simplest ||| Tabbed -- > layout2 = Full ||| Tabbed ||| (RowsOrColumns True) -- > myLayout = tmsCombineTwoDefault layout1 layout2 -- -- then add the following key binding, -- -- > , ((modm, w), sendMessage $ FocusedNextLayout) -- -- Now, pressing this key will toggle the multiple layouts in the currently focused pane. -- -- You can mirror this layout with the default 'Mirror' key binding. But to have a more natural -- behaviors, you can use the 'SwitchOrientation' message: -- -- > , ((modm, xK_space), sendMessage $ SwitchOrientation) -- -- This will not mirror the tabbed decoration, and will keep sub-layouts that made by TallMastersCombo -- and RowsOrColumns display in natural orientations. -- -- To merge layouts more flexibly, you can use 'tmsCombineTwo' instead. -- -- > tmsCombineTwo False 1 (3/100) (1/3) Simplest simpleTabbed -- -- This creates a vertical merged layout with 1 window in the master pane, and the master pane shrinks -- and expands with a step of (3\/100), and occupies (1\/3) of the screen. -- -- Each sub-layout have a focused window. To rotate between the focused windows across all the -- sub-layouts, using the following messages: -- -- > , ((modm .|. mod1, j), sendMessage $ NextFocus) -- > , ((modm .|. mod1, k), sendMessage $ PrevFocus) -- -- this let you jump to the focused window in the next/previous sub-layout. -- -- -- Finally, this combinator can be nested. Here is one example, -- -- @ -- subLayout = tmsCombineTwo False 1 (3\/100) (1\/2) Simplest simpleTabbed -- layout1 = simpleTabbed ||| subLayout -- layout2 = subLayout ||| simpleTabbed ||| (RowsOrColumns True) -- baseLayout = tmsCombineTwoDefault layout1 layout2 -- -- mylayouts = smartBorders $ -- avoidStruts $ -- mkToggle (FULL ?? EOT) $ -- baseLayout -- @ -- -- this is a realization of the cool idea from -- -- -- -- and is more flexible. -- -- | A simple layout that arranges windows in a row or a column with equal sizes. -- It can switch between row mode and column mode by listening to the message 'SwitchOrientation'. newtype RowsOrColumns a = RowsOrColumns { rowMode :: Bool -- ^ arrange windows in rows or columns } deriving (Show, Read) instance LayoutClass RowsOrColumns a where description (RowsOrColumns rows) = if rows then "Rows" else "Columns" pureLayout (RowsOrColumns rows) r s = zip ws rs where ws = W.integrate s len = length ws rs = if rows then splitVertically len r else splitHorizontally len r pureMessage RowsOrColumns{} m | Just Row <- fromMessage m = Just $ RowsOrColumns True | Just Col <- fromMessage m = Just $ RowsOrColumns False | otherwise = Nothing data TMSCombineTwo l1 l2 a = TMSCombineTwo { focusLst :: [a] , ws1 :: [a] , ws2 :: [a] , rowMod :: Bool -- ^ merge two layouts in a column or a row , nMaster :: !Int -- ^ number of windows in the master pane , rationInc :: !Rational -- ^ percent of screen to increment by when resizing panes , tallComboRatio :: !Rational -- ^ default proportion of screen occupied by master pane , layoutFst :: l1 a -- ^ layout for the master pane , layoutSnd :: l2 a -- ^ layout for the second pane } deriving (Show, Read) -- | Combine two layouts l1 l2 with default behaviors. tmsCombineTwoDefault :: (LayoutClass l1 Window, LayoutClass l2 Window) => l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window tmsCombineTwoDefault = TMSCombineTwo [] [] [] True 1 (3/100) (1/2) -- | A more flexible way of merging two layouts. User can specify if merge them vertical or horizontal, -- the number of windows in the first pane (master pane), the shink and expand increment, and the proportion -- occupied by the master pane. tmsCombineTwo :: (LayoutClass l1 Window, LayoutClass l2 Window) => Bool -> Int -> Rational -> Rational -> l1 Window -> l2 Window -> TMSCombineTwo l1 l2 Window tmsCombineTwo = TMSCombineTwo [] [] [] data Orientation = Row | Col deriving (Read, Show) instance Message Orientation -- | A message that switches the orientation of TallMasterCombo layout and the RowsOrColumns layout. -- This is similar to the 'Mirror' message, but 'Mirror' cannot apply to hidden layouts, and when 'Mirror' -- applies to the 'XMonad.Layout.Tabbed' decoration, it will also mirror the tabs, which may lead to unintended -- visualizations. The 'SwitchOrientation' message refreshes layouts according to the orientation of the parent layout, -- and will not affect the 'XMonad.Layout.Tabbed' decoration. data SwitchOrientation = SwitchOrientation deriving (Read, Show) instance Message SwitchOrientation -- | This message swaps the current focused window with the sub master window (first window in the second pane). data SwapSubMaster = SwapSubMaster deriving (Read, Show) instance Message SwapSubMaster -- | This message changes the focus to the sub master window (first window in the second pane). data FocusSubMaster = FocusSubMaster deriving (Read, Show) instance Message FocusSubMaster -- | This message triggers the 'NextLayout' message in the pane that contains the focused window. data FocusedNextLayout = FocusedNextLayout deriving (Read, Show) instance Message FocusedNextLayout -- | This is a message for changing to the previous or next focused window across all the sub-layouts. data ChangeFocus = NextFocus | PrevFocus deriving (Read, Show) instance Message ChangeFocus -- instance (Typeable l1, Typeable l2, LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombineTwo l1 l2) Window where description _ = "TallMasters" runLayout (Workspace wid (TMSCombineTwo f _ _ vsp nmaster delta frac layout1 layout2) s) r = let (s1,s2,frac',slst1,slst2) = splitStack f nmaster frac s (r1, r2) = if vsp then splitHorizontallyBy frac' r else splitVerticallyBy frac' r in do (ws , ml ) <- runLayout (Workspace wid layout1 s1) r1 (ws', ml') <- runLayout (Workspace wid layout2 s2) r2 let newlayout1 = fromMaybe layout1 ml newlayout2 = fromMaybe layout2 ml' (f1, _) = getFocused newlayout1 s1 (f2, _) = getFocused newlayout2 s2 fnew = f1 ++ f2 return (ws++ws', Just $ TMSCombineTwo fnew slst1 slst2 vsp nmaster delta frac newlayout1 newlayout2) handleMessage i@(TMSCombineTwo f w1 w2 vsp nmaster delta frac layout1 layout2) m -- messages that only traverse one level | Just Shrink <- fromMessage m = return . Just $ TMSCombineTwo f w1 w2 vsp nmaster delta (max 0 $ frac-delta) layout1 layout2 | Just Expand <- fromMessage m = return . Just $ TMSCombineTwo f w1 w2 vsp nmaster delta (min 1 $ frac+delta) layout1 layout2 | Just (IncMasterN d) <- fromMessage m = let w = w1++w2 nmasterNew = min (max 0 (nmaster+d)) (length w) (w1',w2') = splitAt nmasterNew w in return . Just $ TMSCombineTwo f w1' w2' vsp nmasterNew delta frac layout1 layout2 | Just SwitchOrientation <- fromMessage m = let m1 = if vsp then SomeMessage Col else SomeMessage Row in do mlayout1 <- handleMessage layout1 m1 mlayout2 <- handleMessage layout2 m1 return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 (not vsp) nmaster delta frac layout1 layout2) True | Just SwapSubMaster <- fromMessage m = -- first get the submaster window let subMaster = listToMaybe w2 in case subMaster of Just mw -> do windows $ W.modify' $ swapWindow mw return Nothing Nothing -> return Nothing | Just FocusSubMaster <- fromMessage m = -- first get the submaster window let subMaster = listToMaybe w2 in case subMaster of Just mw -> do windows $ W.modify' $ focusWindow mw return Nothing Nothing -> return Nothing | Just NextFocus <- fromMessage m = do -- All toggle message is passed to the sublayout with focused window mst <- gets (W.stack . W.workspace . W.current . windowset) let nextw = adjFocus f mst True case nextw of Nothing -> return Nothing Just w -> do windows $ W.modify' $ focusWindow w return Nothing | Just PrevFocus <- fromMessage m = do -- All toggle message is passed to the sublayout with focused window mst <- gets (W.stack . W.workspace . W.current . windowset) let prevw = adjFocus f mst False case prevw of Nothing -> return Nothing Just w -> do windows $ W.modify' $ focusWindow w return Nothing -- messages that traverse recursively | Just Row <- fromMessage m = do mlayout1 <- handleMessage layout1 (SomeMessage Col) mlayout2 <- handleMessage layout2 (SomeMessage Col) return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 False nmaster delta frac layout1 layout2) True | Just Col <- fromMessage m = do mlayout1 <- handleMessage layout1 (SomeMessage Row) mlayout2 <- handleMessage layout2 (SomeMessage Row) return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 True nmaster delta frac layout1 layout2) True | Just FocusedNextLayout <- fromMessage m = do -- All toggle message is passed to the sublayout with focused window mst <- gets (W.stack . W.workspace . W.current . windowset) let focId = findFocused mst w1 w2 m1 = if vsp then SomeMessage Row else SomeMessage Col if focId == 1 then do mlay1 <- handleMessages layout1 [SomeMessage NextLayout, m1] let mlay2 = Nothing return $ mergeSubLayouts mlay1 mlay2 i True else do let mlay1 = Nothing mlay2 <- handleMessages layout2 [SomeMessage NextLayout, m1] return $ mergeSubLayouts mlay1 mlay2 i True | otherwise = do mlayout1 <- handleMessage layout1 m mlayout2 <- handleMessage layout2 m return $ mergeSubLayouts mlayout1 mlayout2 i False -- | Swap a given window with the focused window. swapWindow :: (Eq a) => a -> Stack a -> Stack a swapWindow w (Stack foc upLst downLst) | (us, d:ds) <- break (== w) downLst = Stack foc (reverse us ++ d : upLst) ds | (ds, u:us) <- break (== w) upLst = Stack foc us (reverse ds ++ u : downLst) | otherwise = Stack foc upLst downLst -- | Focus a given window. focusWindow :: (Eq a) => a -> Stack a -> Stack a focusWindow w s = if w `elem` up s then focusSubMasterU w s else focusSubMasterD w s where focusSubMasterU win i@(Stack foc (l:ls) rs) | foc == win = i | l == win = news | otherwise = focusSubMasterU win news where news = Stack l ls (foc : rs) focusSubMasterU _ (Stack foc [] rs) = Stack foc [] rs focusSubMasterD win i@(Stack foc ls (r:rs)) | foc == win = i | r == win = news | otherwise = focusSubMasterD win news where news = Stack r (foc : ls) rs focusSubMasterD _ (Stack foc ls []) = Stack foc ls [] -- | Merge two Maybe sublayouts. mergeSubLayouts :: Maybe (l1 a) -- ^ Left layout -> Maybe (l2 a) -- ^ Right layout -> TMSCombineTwo l1 l2 a -- ^ How to combine the layouts -> Bool -- ^ Return a 'Just' no matter what -> Maybe (TMSCombineTwo l1 l2 a) mergeSubLayouts ml1 ml2 (TMSCombineTwo f w1 w2 vsp nmaster delta frac l1 l2) alwaysReturn | alwaysReturn = Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (fromMaybe l1 ml1) (fromMaybe l2 ml2) | isJust ml1 || isJust ml2 = Just $ TMSCombineTwo f w1 w2 vsp nmaster delta frac (fromMaybe l1 ml1) (fromMaybe l2 ml2) | otherwise = Nothing findFocused :: (Eq a) => Maybe (Stack a) -> [a] -> [a] -> Int findFocused mst w1 w2 = case mst of Nothing -> 1 Just st -> if foc `elem` w1 then 1 else if foc `elem` w2 then 2 else 1 where foc = W.focus st -- | Handle a list of messages one by one, then return the last refreshed layout. handleMessages :: (LayoutClass l a) => l a -> [SomeMessage] -> X (Maybe (l a)) handleMessages l = foldM handleMaybeMsg (Just l) handleMaybeMsg :: (LayoutClass l a) => Maybe (l a) -> SomeMessage -> X (Maybe (l a)) handleMaybeMsg ml m = case ml of Just l -> do res <- handleMessage l m return $ elseOr (Just l) res Nothing -> return Nothing -- function for splitting given stack for TallMastersCombo Layouts splitStack :: (Eq a) => [a] -> Int -> Rational -> Maybe (Stack a) -> (Maybe (Stack a), Maybe (Stack a), Rational, [a], [a]) splitStack f nmaster frac s = let slst = integrate' s f' = case s of (Just s') -> focus s':delete (focus s') f Nothing -> f snum = length slst (slst1, slst2) = splitAt nmaster slst s0 = zipperFocusedAtFirstOf f' slst s1' = zipperFocusedAtFirstOf f' slst1 s2' = zipperFocusedAtFirstOf f' slst2 (s1,s2,frac') | nmaster == 0 = (Nothing,s0,0) | nmaster >= snum = (s0,Nothing,1) | otherwise = (s1',s2',frac) in (s1,s2,frac',slst1,slst2) -- find adjacent window of the current focus window type Next = Bool adjFocus :: (Eq a) => [a] -> Maybe (Stack a) -> Next -> Maybe a adjFocus ws ms next = case ms of Nothing -> Nothing Just s -> let searchLst = if next then down s ++ reverse (up s) else up s ++ reverse (down s) in find (`elem` ws) searchLst -- right biased maybe merge elseOr :: Maybe a -> Maybe a -> Maybe a elseOr x y = case y of Just _ -> y Nothing -> x ----------------- All the rest are for changing focus functionality ------------------- -- | A wrapper for Choose, for monitoring the current active layout. This is because -- the original Choose layout does not export the data constructor. data LR = L | R deriving (Show, Read, Eq) data ChooseWrapper l r a = ChooseWrapper LR (l a) (r a) (Choose l r a) deriving (Show, Read) data NextNoWrap = NextNoWrap deriving (Eq, Show) instance Message NextNoWrap handle :: (LayoutClass l a, Message m) => l a -> m -> X (Maybe (l a)) handle l m = handleMessage l (SomeMessage m) data End = End | NoEnd instance (GetFocused l a, GetFocused r a) => LayoutClass (ChooseWrapper l r) a where description (ChooseWrapper _ _ _ lr) = description lr runLayout (Workspace wid (ChooseWrapper d l r lr) s) rec = do let (l', r') = case d of L -> (savFocused l s, r) R -> (l, savFocused r s) (ws, ml0) <- runLayout (Workspace wid lr s) rec let l1 = case ml0 of Just l0 -> Just $ ChooseWrapper d l' r' l0 Nothing -> Nothing return (ws,l1) handleMessage c@(ChooseWrapper d l r lr) m | Just NextLayout <- fromMessage m = do mlr' <- handleMessage lr m mlrf <- handle c NextNoWrap fstf <- handle c FirstLayout let mlf = elseOr fstf mlrf (d',l',r') = case mlf of Just (ChooseWrapper d0 l0 r0 _) -> (d0,l0,r0) Nothing -> (d,l,r) case mlr' of Just lrt -> return $ Just $ ChooseWrapper d' l' r' lrt Nothing -> return Nothing | Just NextNoWrap <- fromMessage m = do mlr' <- handleMessage lr m (d',l',r', end) <- case d of L -> do ml <- handle l NextNoWrap case ml of Just l0 -> return (L, l0, r, NoEnd) Nothing -> do mr <- handle r FirstLayout case mr of Just r0 -> return (R, l, r0, NoEnd) Nothing -> return (R, l, r, NoEnd) R -> do mr <- handle r NextNoWrap case mr of Just r0 -> return (R, l, r0, NoEnd) Nothing -> return (d, l, r, End) case mlr' of Just lrt -> return $ Just $ ChooseWrapper d' l' r' lrt Nothing -> case end of NoEnd -> return $ Just $ ChooseWrapper d' l' r' lr End -> return Nothing | Just FirstLayout <- fromMessage m = do mlr' <- handleMessage lr m (d',l',r') <- do ml <- handle l FirstLayout case ml of Just l0 -> return (L,l0,r) Nothing -> return (L,l,r) case mlr' of Just lrt -> return $ Just $ ChooseWrapper d' l' r' lrt Nothing -> return $ Just $ ChooseWrapper d' l' r' lr | otherwise = do mlr' <- handleMessage lr m case mlr' of Just lrt -> return $ Just $ ChooseWrapper d l r lrt Nothing -> return Nothing -- | This is same as the Choose combination operator. (|||) :: l a -> r a -> ChooseWrapper l r a (|||) l r = ChooseWrapper L l r (l LL.||| r) -- a subclass of layout, which contain extra method to return focused window in sub-layouts class (LayoutClass l a) => GetFocused l a where getFocused :: l a -> Maybe (Stack a) -> ([a], String) getFocused _ ms = case ms of (Just s) -> ([focus s], "Base") Nothing -> ([], "Base") savFocused :: l a -> Maybe (Stack a) -> l a savFocused l _ = l instance (GetFocused l Window, GetFocused r Window) => GetFocused (TMSCombineTwo l r) Window where getFocused (TMSCombineTwo f _ _ _ nmaster _ frac lay1 lay2) s = let (s1,s2,_,_,_) = splitStack f nmaster frac s (f1, str1) = getFocused lay1 s1 (f2, str2) = getFocused lay2 s2 in (f1 ++ f2, "TMS: " ++ show f ++ "::" ++ str1 ++ "--" ++ str2) savFocused i@(TMSCombineTwo f _ _ _ nmaster _ frac lay1 lay2) s = let (s1,s2,_,_,_) = splitStack f nmaster frac s (f', _) = getFocused i s lay1' = savFocused lay1 s1 lay2' = savFocused lay2 s2 in i {focusLst = f', layoutFst=lay1', layoutSnd=lay2'} instance (GetFocused l a, GetFocused r a) => GetFocused (ChooseWrapper l r) a where getFocused (ChooseWrapper d l r _) s = case d of L -> getFocused l s R -> getFocused r s savFocused (ChooseWrapper d l r lr) s = let (l', r') = case d of L -> (savFocused l s, r) R -> (l, savFocused r s) in ChooseWrapper d l' r' lr instance (Typeable a) => GetFocused Simplest a instance (Typeable a) => GetFocused RowsOrColumns a instance (Typeable a) => GetFocused Full a instance (Typeable a) => GetFocused Tall a instance (Typeable l, Typeable a, Typeable m, LayoutModifier m a, LayoutClass l a) => GetFocused (ModifiedLayout m l) a xmonad-contrib-0.18.0/XMonad/Layout/ThreeColumns.hs0000644000000000000000000001112507346545000020324 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ThreeColumns -- Description : A layout similar to @Tall@, but with three columns. -- Copyright : (c) Kai Grossjohann -- 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 -- slave windows. ----------------------------------------------------------------------------- module XMonad.Layout.ThreeColumns ( -- * Usage -- $usage -- * Screenshots -- $screenshot ThreeCol(..) ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import Data.Ratio -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ThreeColumns -- -- Then edit your @layoutHook@ by adding the ThreeCol layout: -- -- > myLayout = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- The first argument specifies how many windows initially appear in the main -- window. The second argument argument specifies the amount to resize while -- resizing and the third argument specifies the initial size of the columns. -- A positive size designates the fraction of the screen that the main window -- should occupy, but if the size is negative the absolute value designates the -- fraction a stack column should occupy. If both stack columns are visible, -- they always occupy the same amount of space. -- -- The ThreeColMid variant places the main window between the stack columns. -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- $screenshot -- <> -- | Arguments are nmaster, delta, fraction data ThreeCol a = ThreeColMid { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational} | ThreeCol { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational} deriving (Show,Read) instance LayoutClass ThreeCol a where pureLayout (ThreeCol n _ f) r = doL False n f r pureLayout (ThreeColMid n _ f) r = doL True n f r handleMessage l m = return $ msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = l { threeColFrac = max (-0.5) $ f-d } resize Expand = l { threeColFrac = min 1 $ f+d } incmastern (IncMasterN x) = l { threeColNMaster = max 0 (n+x) } n = threeColNMaster l d = threeColDelta l f = threeColFrac l description _ = "ThreeCol" doL :: Bool-> Int-> Rational-> Rectangle-> W.Stack a-> [(a, Rectangle)] doL m n f r = ap zip (tile3 m f r n . length) . W.integrate -- | tile3. Compute window positions using 3 panes tile3 :: Bool -> Rational -> Rectangle -> Int -> Int -> [Rectangle] tile3 middle f r nmaster n | n <= nmaster || nmaster == 0 = splitVertically n r | n <= nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2 | 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 nslave1 = ceiling (nslave % 2) nslave2 = n - nmaster - nslave1 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 sy r3w sh , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w 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-contrib-0.18.0/XMonad/Layout/ToggleLayouts.hs0000644000000000000000000001112107346545000020512 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ToggleLayouts -- Description : A module to toggle between two layouts. -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : portable -- -- A module to toggle between two layouts. ----------------------------------------------------------------------------- module XMonad.Layout.ToggleLayouts ( -- * Usage -- $usage toggleLayouts, ToggleLayout(..), ToggleLayouts ) where import XMonad import XMonad.Prelude (fromMaybe) import XMonad.StackSet (Workspace (..)) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ToggleLayouts -- -- Then edit your @layoutHook@ by adding the ToggleLayouts layout: -- -- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- To toggle between layouts add a key binding like -- -- > , ((modm .|. controlMask, xK_space), sendMessage ToggleLayout) -- -- or a key binding like -- -- > , ((modm .|. controlMask, xK_space), sendMessage (Toggle "Full")) -- -- For detailed instruction on editing the key binding see: -- -- . data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show) 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 toggleLayouts = ToggleLayouts False instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where runLayout (Workspace i (ToggleLayouts True lt lf) ms) r = do (ws,mlt') <- runLayout (Workspace i lt ms) r 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 (ToggleLayouts False lt) mlf') description (ToggleLayouts True lt _) = description lt description (ToggleLayouts False _ lf) = description lf handleMessage (ToggleLayouts bool lt lf) m | Just ReleaseResources <- fromMessage m = do mlf' <- handleMessage lf m mlt' <- handleMessage lt m return $ case (mlt',mlf') of (Nothing ,Nothing ) -> Nothing (Just lt',Nothing ) -> Just $ ToggleLayouts bool lt' lf (Nothing ,Just lf') -> Just $ ToggleLayouts bool lt lf' (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' = 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' = 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' = 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' = fromMaybe lf mlf' return $ Just $ ToggleLayouts True lt lf' | otherwise = do mlf' <- handleMessage lf m return $ fmap (ToggleLayouts False lt) mlf' xmonad-contrib-0.18.0/XMonad/Layout/TrackFloating.hs0000644000000000000000000000743707346545000020457 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {- | Module : XMonad.Layout.TrackFloating Description : Let focused tiles track focused floats Copyright : (c) 2010 & 2013 Adam Vogt 2011 Willem Vanlint License : BSD-style (see xmonad/LICENSE) Maintainer : vogt.adam@gmail.com Stability : unstable Portability : unportable Provides layout modifier 'UseTransientFor': when a float has focus and is @WM_TRANSIENT_FOR@ a tile, run the underlying layout as if that tile had focus. -} module XMonad.Layout.TrackFloating (-- * Usage -- $usage -- ** For other layout modifiers -- $layoutModifier trackFloating, useTransientFor, -- ** Exported types TrackFloating, UseTransientFor, ) where import XMonad.Prelude import XMonad import XMonad.Layout.LayoutModifier import XMonad.Layout.FocusTracking import XMonad.Util.Stack (findZ) import qualified XMonad.StackSet as W import qualified Data.Traversable as T {-# DEPRECATED TrackFloating "Use X.L.FocusTracking.FocusTracking." #-} type TrackFloating = FocusTracking {- | When focus is on the tiled layer, the underlying layout is run with focus on the window named by the WM_TRANSIENT_FOR property on the floating window. -} useTransientFor :: l a -> ModifiedLayout UseTransientFor l a useTransientFor = 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 . W.view (W.tag ws) . windowset) d <- asks display 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 = (parent >>= \p -> findZ (p==) ms) <|> ms } r m' <- gets (W.peek . windowset) when (m' == parent) $ -- layout changed the windowset, so don't clobber it whenJust m $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) } return result {- $usage Apply to your layout in a config like: > main = xmonad (def{ > layoutHook = trackFloating (useTransientFor > (noBorders Full ||| Tall 1 0.3 0.5)), > ... > }) 'useTransientFor' and 'trackFloating' can be enabled independently. For example when the floating window sets @WM_TRANSIENT_FOR@, such as libreoffice's file->preferences window, @optionA@ will have the last-focused window magnified while @optionB@ will result magnify the window that opened the preferences window regardless of which tiled window was focused before. > import XMonad.Layout.Magnifier > import XMonad.Layout.TrackFloating > > underlyingLayout = magnifier (Tall 1 0.3 0.5) > > optionA = trackFloating underlyingLayout > optionB = trackFloating (useTransientFor underlyingLayout) -} {- | Runs another layout with a remembered focus, provided: * the subset of windows doesn't include the focus in XState * it was previously run with a subset that included the XState focus * the remembered focus hasn't since been killed -} {-# DEPRECATED trackFloating "Use X.L.FocusTracking.focusTracking." #-} trackFloating :: l a -> ModifiedLayout TrackFloating l a trackFloating = focusTracking {- $layoutModifier It also corrects focus issues for full-like layouts inside other layout modifiers: > import XMonad.Layout.IM > import XMonad.Layout.Tabbed > import XMonad.Layout.TrackFloating > import XMonad.Layout.Reflect > gimpLayout = withIM 0.11 (Role "gimp-toolbox") $ reflectHoriz > $ withIM 0.15 (Role "gimp-dock") (trackFloating simpleTabbed) Interactions with some layout modifiers (ex. decorations, minimizing) are unknown but likely unpleasant. -} xmonad-contrib-0.18.0/XMonad/Layout/TwoPane.hs0000644000000000000000000000461107346545000017273 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TwoPane -- Description : A layout that splits the screen horizontally and shows two windows. -- Copyright : (c) Spencer Janssen -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.TwoPane ( -- * Usage -- $usage TwoPane (..) ) where import XMonad hiding (focus) import XMonad.StackSet ( focus, up, down) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.TwoPane -- -- Then edit your @layoutHook@ by adding the TwoPane layout: -- -- > myLayout = TwoPane (3/100) (1/2) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data TwoPane a = TwoPane Rational Rational deriving ( Show, Read ) instance LayoutClass TwoPane a where doLayout (TwoPane _ split) r s = return (arrange r s,Nothing) where arrange rect st = case reverse (up st) of (master:_) -> [(master,left),(focus st,right)] [] -> case down st of (next:_) -> [(focus st,left),(next,right)] [] -> [(focus st, rect)] where (left, right) = splitHorizontallyBy split rect handleMessage (TwoPane delta split) x = return $ case fromMessage x of Just Shrink -> Just (TwoPane delta (max 0 (split - delta))) Just Expand -> Just (TwoPane delta (min 1 (split + delta))) _ -> Nothing description _ = "TwoPane" xmonad-contrib-0.18.0/XMonad/Layout/TwoPanePersistent.hs0000644000000000000000000000720707346545000021360 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TwoPanePersistent -- Description : "XMonad.Layout.TwoPane" with a persistent stack window. -- Copyright : (c) Chayanon Wichitrnithed -- License : BSD3-style (see LICENSE) -- -- Maintainer : Chayanon Wichitrnithed -- Stability : unstable -- Portability : unportable -- -- This layout is the same as "XMonad.Layout.TwoPane" except that it keeps track of the slave window -- that is alongside the master pane. In other words, it prevents the slave pane -- from changing after the focus goes back to the master pane. ----------------------------------------------------------------------------- module XMonad.Layout.TwoPanePersistent ( -- * Usage -- $usage TwoPanePersistent(..) ) where import XMonad.StackSet (focus, up, down, Stack, Stack(..)) import XMonad hiding (focus) -- $usage -- Import the module in @xmonad.hs@: -- -- > import XMonad.Layout.TwoPanePersistent -- -- Then add the layout to the @layoutHook@: -- -- > myLayout = TwoPanePersistent Nothing (3/100) (1/2) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } data TwoPanePersistent a = TwoPanePersistent { slaveWin :: Maybe a -- ^ slave window; if 'Nothing' or not in the current workspace, -- the window below the master will go into the slave pane , dFrac :: Rational -- ^ shrink/expand size , mFrac :: Rational -- ^ initial master size } deriving (Show, Read) instance (Show a, Eq a) => LayoutClass TwoPanePersistent a where doLayout l r s = case reverse (up s) of -- master is focused [] -> return $ focusedMaster l s r -- slave is focused (master:_) -> return $ focusedSlave l s r master pureMessage (TwoPanePersistent w delta split) x = case fromMessage x of Just Shrink -> Just (TwoPanePersistent w delta (max 0 (split - delta))) Just Expand -> Just (TwoPanePersistent w delta (min 1 (split + delta))) _ -> Nothing description _ = "TwoPanePersistent" ---------------------------------------------------------------------------------------- focusedMaster :: (Eq a) => TwoPanePersistent a -> Stack a -> Rectangle -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) ) focusedMaster (TwoPanePersistent w delta split) s r = let (left, right) = splitHorizontallyBy split r in case down s of -- there exist windows below the master (next:_) -> let nextSlave = ( [(focus s, left), (next, right)] , Just $ TwoPanePersistent (Just next) delta split ) in case w of -- if retains state, preserve the layout Just win -> if win `elem` down s && (focus s /= win) then ( [(focus s, left), (win, right)] , Just $ TwoPanePersistent w delta split ) else nextSlave -- if no previous state, default to the next slave window Nothing -> nextSlave -- the master is the only window [] -> ( [(focus s, r)] , Just $ TwoPanePersistent Nothing delta split ) focusedSlave :: TwoPanePersistent a -> Stack a -> Rectangle -> a -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) ) focusedSlave (TwoPanePersistent _ delta split) s r m = ( [(m, left), (focus s, right)] , Just $ TwoPanePersistent (Just $ focus s) delta split ) where (left, right) = splitHorizontallyBy split r xmonad-contrib-0.18.0/XMonad/Layout/VoidBorders.hs0000644000000000000000000000624307346545000020143 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.VoidBorders -- Description : Set borders to 0 for all windows in the workspace. -- Copyright : Wilson Sales -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Modifies a layout to set borders to 0 for all windows in the workspace. -- -- Unlike "XMonad.Layout.NoBorders", the 'voidBorders' modifier will not -- restore the window border if the windows are moved to a different workspace -- or the layout is changed. There is, however, a companion 'normalBorders' -- modifier which explicitly restores the border. -- -- This modifier's primary use is to eliminate the "border flash" you get -- while switching workspaces with the "XMonad.Layout.NoBorders" modifier. -- ----------------------------------------------------------------------------- module XMonad.Layout.VoidBorders ( -- * Usage -- $usage voidBorders , normalBorders ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.StackSet (integrate) -- $usage -- You can use this module with the following in your @xmonad.hs@ -- file: -- -- > import XMonad.Layout.VoidBorders -- -- and modify the layouts to call 'voidBorders' on the layouts you want to -- remove borders from windows, and 'normalBorders' on the layouts you want -- to keep borders for: -- -- > layoutHook = ... ||| voidBorders Full ||| normalBorders Tall ... -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". data VoidBorders a = VoidBorders deriving (Read, Show) instance LayoutModifier VoidBorders Window where modifierDescription = const "VoidBorders" redoLayout VoidBorders _ Nothing wrs = return (wrs, Nothing) redoLayout VoidBorders _ (Just s) wrs = do mapM_ setZeroBorder $ integrate s return (wrs, Nothing) voidBorders :: l Window -> ModifiedLayout VoidBorders l Window voidBorders = ModifiedLayout VoidBorders data NormalBorders a = NormalBorders deriving (Read, Show) instance LayoutModifier NormalBorders Window where modifierDescription = const "NormalBorders" redoLayout NormalBorders _ Nothing wrs = return (wrs, Nothing) redoLayout NormalBorders _ (Just s) wrs = do mapM_ resetBorders $ integrate s return (wrs, Nothing) normalBorders :: l Window -> ModifiedLayout NormalBorders l Window normalBorders = ModifiedLayout NormalBorders -- | Sets border width to 0 for every window from the specified layout. setZeroBorder :: Window -> X () setZeroBorder w = setBorders w 0 -- | Resets the border to the value read from the current configuration. resetBorders :: Window -> X () resetBorders w = asks (borderWidth . config) >>= setBorders w setBorders :: Window -> Dimension -> X () setBorders w bw = withDisplay $ \d -> io $ setWindowBorderWidth d w bw xmonad-contrib-0.18.0/XMonad/Layout/WindowArranger.hs0000644000000000000000000002226107346545000020650 0ustar0000000000000000{-# 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- This is a pure layout modifier that will let you move and resize -- windows with the keyboard in any layout. ----------------------------------------------------------------------------- module XMonad.Layout.WindowArranger ( -- * Usage -- $usage windowArrange , windowArrangeAll , WindowArrangerMsg (..) , WindowArranger , memberFromList , listFromList , diff ) where import XMonad import XMonad.Prelude import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import Control.Arrow ((***), (>>>), (&&&), first) -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.WindowArranger -- > myLayout = layoutHook def -- > main = xmonad def { layoutHook = windowArrange myLayout } -- -- or -- -- > main = xmonad def { layoutHook = windowArrangeAll myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to define some key binding to move or resize -- windows. These are good defaults: -- -- > , ((modm .|. controlMask , xK_s ), sendMessage Arrange ) -- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange ) -- > , ((modm .|. controlMask , xK_Left ), sendMessage (MoveLeft 1)) -- > , ((modm .|. controlMask , xK_Right), sendMessage (MoveRight 1)) -- > , ((modm .|. controlMask , xK_Down ), sendMessage (MoveDown 1)) -- > , ((modm .|. controlMask , xK_Up ), sendMessage (MoveUp 1)) -- > , ((modm .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1)) -- > , ((modm .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1)) -- > , ((modm .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1)) -- > , ((modm .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1)) -- -- For detailed instructions on editing your key bindings, see -- . -- | A layout modifier to float the windows in a workspace windowArrange :: l a -> ModifiedLayout WindowArranger l a windowArrange = ModifiedLayout (WA True False []) -- | A layout modifier to float all the windows in a workspace windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a windowArrangeAll = ModifiedLayout (WA True True []) data WindowArrangerMsg = DeArrange | Arrange | IncreaseLeft Int | IncreaseRight Int | IncreaseUp Int | IncreaseDown Int | DecreaseLeft Int | DecreaseRight Int | DecreaseUp Int | DecreaseDown Int | MoveLeft Int | MoveRight Int | MoveUp Int | MoveDown Int | SetGeometry Rectangle instance Message WindowArrangerMsg data ArrangedWindow a = WR (a, Rectangle) | AWR (a, Rectangle) deriving (Read, Show) type ArrangeAll = Bool data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show) instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where pureModifier (WA True b []) _ (Just _) wrs = arrangeWindows b wrs pureModifier (WA True b awrs) _ (Just (S.Stack w _ _)) wrs = curry process wrs awrs where wins = map fst *** map awrWin update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++) process = wins &&& id >>> first diff >>> uncurry update >>> replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True b pureModifier _ _ _ wrs = (wrs, Nothing) pureMess (WA True b (wr:wrs)) m -- increase the window's size | Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (w + fi i) h | Just (IncreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y (w + fi i) h | Just (IncreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w (h + fi i) | Just (IncreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (h + fi i) -- decrease the window's size | Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y (chk w i) h | Just (DecreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (chk w i) h | Just (DecreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (chk h i) | Just (DecreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w (chk h i) --move the window around | Just (MoveRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y w h | Just (MoveLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y w h | Just (MoveUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w h | Just (MoveDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w h where res wi x y w h = Just . WA True b $ AWR (wi,Rectangle x y w h):wrs fm = fromMessage m fa = fromAWR wr chk x y = fi $ max 1 (fi x - y) pureMess (WA t b (wr:wrs)) m | Just (SetGeometry r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b $ AWR (w,r):wrs pureMess (WA _ b l) m | Just DeArrange <- fromMessage m = Just $ WA False b l | Just Arrange <- fromMessage m = Just $ WA True b l | otherwise = Nothing arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a)) arrangeWindows b wrs = (wrs, Just $ WA True b (map t wrs)) where t = if b then AWR else WR fromAWR :: ArrangedWindow a -> (a, Rectangle) fromAWR (WR x) = x fromAWR (AWR x) = x awrWin :: ArrangedWindow a -> a awrWin = fst . fromAWR getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a] getAWR = memberFromList awrWin (==) getWR :: Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)] getWR = memberFromList fst (==) mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a] 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] removeAWRs = listFromList awrWin notElem putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a] putOnTop w awrs = awr ++ nawrs where awr = getAWR w awrs nawrs = filter ((/=w) . awrWin) awrs replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a] 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 Nothing -> x:xs | otherwise = x:xs -- | Given a function to be applied to each member of a list, and a -- function to check a condition by processing this transformed member -- with the members of a list, you get the list of members that -- satisfy the condition. listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b] listFromList f g l = foldr (h l) [] where h x y ys = if g (f y) x then y:ys else ys -- | Given a function to be applied to each member of ta list, and a -- function to check a condition by processing this transformed member -- with something, you get the first member that satisfy the condition, -- or an empty list. memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b] memberFromList f g l = foldr (h l) [] where h x y ys = if g (f y) x then [y] else ys -- | Get the list of elements to be deleted and the list of elements to -- be added to the first list in order to get the second list. diff :: Eq a => ([a],[a]) -> ([a],[a]) diff (x,y) = (x \\ y, y \\ x) xmonad-contrib-0.18.0/XMonad/Layout/WindowNavigation.hs0000644000000000000000000002707607346545000021217 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowNavigation -- Description : A layout modifier to allow easy navigation of a workspace. -- Copyright : (c) 2007 David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- WindowNavigation is an extension to allow easy navigation of a workspace. -- ----------------------------------------------------------------------------- module XMonad.Layout.WindowNavigation ( -- * Usage -- $usage windowNavigation, configurableNavigation, Navigate(..), Direction2D(..), MoveWindowToWindow(..), WNConfig, navigateColor, navigateBrightness, noNavigateBorders, def, WindowNavigation, ) where import XMonad.Prelude ( nub, sortBy, (\\) ) import XMonad hiding (Point) import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Util.Invisible import XMonad.Util.Types (Direction2D(..)) import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.WindowNavigation -- -- Then edit your 'layoutHook' by adding the WindowNavigation layout modifier -- to some layout: -- -- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the 'layoutHook' see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In keybindings: -- -- > , ((modm, xK_Right), sendMessage $ Go R) -- > , ((modm, xK_Left ), sendMessage $ Go L) -- > , ((modm, xK_Up ), sendMessage $ Go U) -- > , ((modm, xK_Down ), sendMessage $ Go D) -- > , ((modm .|. controlMask, xK_Right), sendMessage $ Swap R) -- > , ((modm .|. controlMask, xK_Left ), sendMessage $ Swap L) -- > , ((modm .|. controlMask, xK_Up ), sendMessage $ Swap U) -- > , ((modm .|. controlMask, xK_Down ), sendMessage $ Swap D) -- -- For detailed instruction on editing the key binding see: -- -- . 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 instance Message Navigate -- | Used with 'configurableNavigation' to specify how to show reachable windows' -- borders. You cannot create 'WNConfig' values directly; use 'def' or one of the following -- three functions to create one. -- -- 'def', and 'windowNavigation', uses the focused border color at 40% brightness, as if -- you had specified -- -- > configurableNavigation (navigateBrightness 0.4) data WNConfig = WNC { brightness :: Maybe Double -- Indicates a fraction of the focus color. , upColor :: String , downColor :: String , leftColor :: String , rightColor :: String } deriving (Show, Read) -- | Don't use window borders for navigation. noNavigateBorders :: WNConfig noNavigateBorders = def {brightness = Just 0} -- | Indicate reachable windows by drawing their borders in the specified color. navigateColor :: String -> WNConfig navigateColor c = WNC Nothing c c c c -- | Indicate reachable windows by drawing their borders in the active border color, with -- the specified brightness. navigateBrightness :: Double -> WNConfig navigateBrightness f = def { brightness = Just $ max 0 $ min 1 f } instance Default WNConfig where def = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" data NavigationState a = NS Point [(a,Rectangle)] data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a windowNavigation = ModifiedLayout (WindowNavigation def (I Nothing)) configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing)) instance LayoutModifier WindowNavigation Window where redoLayout (WindowNavigation conf (I st)) rscr (Just s) origwrs = do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask [uc,dc,lc,rc] <- case brightness conf of Just frac -> do myc <- averagePixels fbc nbc frac return [myc,myc,myc,myc] Nothing -> mapM (stringToPixel dpy) [upColor conf, downColor conf, leftColor conf, rightColor conf] let dirc U = uc dirc D = dc dirc L = lc dirc R = rc let w = W.focus s r = case filter ((==w).fst) origwrs of ((_,x):_) -> x [] -> rscr pt = case st of Just (NS ptold _) | ptold `inrect` r -> ptold _ -> center r existing_wins = W.integrate s wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $ filter ((/=w) . fst) origwrs wnavigable = nub $ concatMap (\d -> take 1 $ navigable d pt wrs) [U,D,R,L] wnavigablec = nub $ concatMap (\d -> map (\(win,_) -> (win,dirc d)) $ take 1 $ navigable d pt wrs) [U,D,R,L] wothers = case st of Just (NS _ wo) -> map fst wo _ -> [] mapM_ (sc nbc) (wothers \\ map fst wnavigable) mapM_ (\(win,c) -> sc c win) wnavigablec return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) redoLayout _ _ _ origwrs = return (origwrs, Nothing) handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m | Just (Go d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,r):_) -> do modify focusWindowHere return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS (centerd d pt r) wrs where focusWindowHere :: XState -> XState focusWindowHere s | Just w == W.peek (windowset s) = s | has w $ W.stack $ W.workspace $ W.current $ windowset s = s { windowset = until ((Just w ==) . W.peek) W.focusUp $ windowset s } | otherwise = s has _ Nothing = False has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) | Just (Swap d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st swapw y x | x == w = y | x == y = w | otherwise = x unint f xs = case span (/= f) xs of (u,_:dn) -> W.Stack { W.focus = f , W.up = reverse u , W.down = dn } _ -> W.Stack { W.focus = f , W.down = xs , W.up = [] } windows $ W.modify' swap return Nothing | Just (Move d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset) return $ do st <- mst Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w | Just (Apply f d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,_):_) -> f w >> return Nothing | Just Hide <- fromMessage m = do XConf { normalBorder = nbc } <- ask mapM_ (sc nbc . fst) wrs return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt [] | Just ReleaseResources <- fromMessage m = handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) handleMessOrMaybeModifyIt _ _ = return Nothing navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable d pt = sortby d . filter (inr d pt . snd) sc :: Pixel -> Window -> X () sc c win = withDisplay $ \dpy -> do colorName <- io (pixelToString dpy c) setWindowBorderWithFallback dpy win colorName c center :: Rectangle -> Point center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) centerd :: Direction2D -> Point -> Rectangle -> Point centerd d (P xx yy) (Rectangle x y w h) | d == U || d == D = P xx (fromIntegral y + fromIntegral h/2) | otherwise = P (fromIntegral x + fromIntegral w/2) yy inr :: Direction2D -> Point -> Rectangle -> Bool inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && y < fromIntegral yr + fromIntegral h inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && y > fromIntegral yr inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && a < fromIntegral b inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && a > fromIntegral b + fromIntegral c inrect :: Point -> Rectangle -> Bool inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && y > fromIntegral b && y < fromIntegral b + fromIntegral h sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x) data Point = P Double Double xmonad-contrib-0.18.0/XMonad/Layout/WindowSwitcherDecoration.hs0000644000000000000000000001443107346545000022707 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowSwitcherDecoration -- Description : Switch the position of windows by dragging them onto each other. -- Copyright : (c) Jan Vornberger 2009 -- Alejandro Serrano 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A decoration that allows to switch the position of windows by dragging -- them onto each other. -- ----------------------------------------------------------------------------- module XMonad.Layout.WindowSwitcherDecoration ( -- * Usage: -- $usage windowSwitcherDecoration, windowSwitcherDecorationWithButtons, windowSwitcherDecorationWithImageButtons, WindowSwitcherDecoration, ImageWindowSwitcherDecoration, ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Layout.ImageButtonDecoration import XMonad.Layout.DraggingVisualizer import qualified XMonad.StackSet as S import XMonad.Prelude import Foreign.C.Types(CInt) -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Layout.WindowSwitcherDecoration -- > import XMonad.Layout.DraggingVisualizer -- -- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to -- your layout: -- -- > myL = windowSwitcherDecoration shrinkText def (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- There is also a version of the decoration that contains buttons like -- "XMonad.Layout.ButtonDecoration". To use that version, you will need to -- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@ -- in the following way: -- -- > import XMonad.Layout.DecorationAddons -- > -- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- Additionaly, there is a version of the decoration that contains image buttons like -- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to -- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@ -- in the following way: -- -- > import XMonad.Layout.ImageButtonDecoration -- > -- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a windowSwitcherDecoration s c = decoration s c $ WSD False windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True newtype WindowSwitcherDecoration a = WSD Bool deriving (Show, Read) instance Eq a => DecorationStyle WindowSwitcherDecoration a where describeDeco _ = "WindowSwitcherDeco" decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons then titleBarButtonHandler mainw dFL dFR else return False decorationWhileDraggingHook _ = handleTiledDraggingInProgress decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage DraggingStopped performWindowSwitching mainw -- Note: the image button code is duplicated from the above -- because the title bar handle is different windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True newtype ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where describeDeco _ = "ImageWindowSwitcherDeco" decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons then imageTitleBarButtonHandler mainw dFL dFR else return False decorationWhileDraggingHook _ = handleTiledDraggingInProgress decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage DraggingStopped performWindowSwitching mainw handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () handleTiledDraggingInProgress ex ey (mainw, r) x y = do let rect = Rectangle (x - (fi ex - rect_x r)) (y - (fi ey - rect_y r)) (rect_width r) (rect_height r) sendMessage $ DraggingWindow mainw rect performWindowSwitching :: Window -> X () performWindowSwitching win = withDisplay $ \d -> do root <- asks theRoot (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root ws <- gets windowset let allWindows = S.index ws -- do a little double check to be sure when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched let newStack = S.Stack t (reverse ls) rs windows $ S.modify' $ const newStack where switchEntries a b x | x == a = b | x == b = a | otherwise = x xmonad-contrib-0.18.0/XMonad/Layout/WorkspaceDir.hs0000644000000000000000000000717007346545000020316 0ustar0000000000000000{-# 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 -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Layout.WorkspaceDir ( -- * Usage -- $usage workspaceDir, changeDir, WorkspaceDir, Chdir(Chdir), ) where import System.Directory ( setCurrentDirectory, getCurrentDirectory ) import XMonad.Prelude ( when ) import XMonad hiding ( focus ) import XMonad.Prompt ( XPConfig ) import XMonad.Prompt.Directory ( directoryPrompt ) import XMonad.Layout.LayoutModifier import XMonad.StackSet ( tag, currentTag ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.WorkspaceDir -- -- Then edit your @layoutHook@ by adding the Workspace layout modifier -- to some layout: -- -- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- WorkspaceDir provides also a prompt. To use it you need to import -- "XMonad.Prompt" and add something like this to your key bindings: -- -- > , ((modm .|. shiftMask, xK_x ), changeDir def) -- -- If you prefer a prompt with case-insensitive completion: -- -- > , ((modm .|. shiftMask, xK_x ), -- changeDir def {complCaseSensitivity = CaseInSensitive}) -- -- For detailed instruction on editing the key binding see: -- -- . newtype Chdir = Chdir String instance Message Chdir newtype WorkspaceDir a = WorkspaceDir String deriving ( Read, Show ) instance LayoutModifier WorkspaceDir Window where modifyLayout (WorkspaceDir d) w r = do tc <- gets (currentTag.windowset) when (tc == tag w) $ scd d runLayout w r handleMess (WorkspaceDir _) m | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd return $ Just $ WorkspaceDir wd' | otherwise = return Nothing workspaceDir :: LayoutClass l a => String -> l a -> ModifiedLayout WorkspaceDir l a workspaceDir s = ModifiedLayout (WorkspaceDir s) cleanDir :: String -> X String cleanDir x = scd x >> io getCurrentDirectory scd :: String -> X () scd x = catchIO $ setCurrentDirectory x changeDir :: XPConfig -> X () changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir) xmonad-contrib-0.18.0/XMonad/Layout/ZoomRow.hs0000644000000000000000000002372607346545000017342 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses , PatternGuards, ExistentialQuantification , FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ZoomRow -- Description : Row layout with individually resizable elements. -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Row layout with individually resizable elements. -- ----------------------------------------------------------------------------- module XMonad.Layout.ZoomRow ( -- * Usage -- $usage ZoomRow -- * Creation , zoomRow -- * Messages , ZoomMessage(..) , zoomIn , zoomOut , zoomReset -- * Use with non-'Eq' elements -- $noneq , zoomRowWith , EQF(..) , ClassEQ(..) ) where import XMonad import XMonad.Prelude (fromMaybe, fi) import qualified XMonad.StackSet as W import XMonad.Util.Stack import Control.Arrow (second) -- $usage -- This module provides a layout which places all windows in a single -- row; the size occupied by each individual window can be increased -- and decreased, and a window can be set to use the whole available -- space whenever it has focus. -- -- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ZoomRow -- -- and using 'zoomRow' somewhere in your 'layoutHook', for example: -- -- > myLayout = zoomRow ||| Mirror zoomRow -- -- To be able to resize windows, you can create keybindings to send -- the relevant 'ZoomMessage's: -- -- > -- Increase the size occupied by the focused window -- > , ((modMask .|. shifMask, xK_minus), sendMessage zoomIn) -- > -- Decrease the size occupied by the focused window -- > , ((modMayk , xK_minus), sendMessage zoomOut) -- > -- Reset the size occupied by the focused window -- > , ((modMask , xK_equal), sendMessage zoomReset) -- > -- (Un)Maximize the focused window -- > , ((modMask , xK_f ), sendMessage ToggleZoomFull) -- -- For more information on editing your layoutHook and key bindings, -- see -- and "XMonad.Doc.Extending". -- * Creation functions -- | 'ZoomRow' layout for laying out elements which are instances of -- 'Eq'. Perfect for 'Window's. zoomRow :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a zoomRow = ZC ClassEQ emptyZ -- $noneq -- Haskell's 'Eq' class is usually concerned with structural equality, whereas -- what this layout really wants is for its elements to have a unique identity, -- even across changes. There are cases (such as, importantly, 'Window's) where -- the 'Eq' instance for a type actually does that, but if you want to lay -- out something more exotic than windows and your 'Eq' means something else, -- you can use the following. -- | ZoomRow layout with a custom equality predicate. It should -- of course satisfy the laws for 'Eq', and you should also make -- sure that the layout never has to handle two \"equal\" elements -- at the same time (it won't do any huge damage, but might behave -- a bit strangely). zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a) => f a -> ZoomRow f a zoomRowWith f = ZC f emptyZ -- * The datatypes -- | A layout that arranges its windows in a horizontal row, -- and allows to change the relative size of each element -- independently. data ZoomRow f a = ZC { zoomEq :: f a -- ^ Function to compare elements for -- equality, a real Eq instance might -- not be what you want in some cases , zoomRatios :: Zipper (Elt a) -- ^ Element specs. The zipper is so we -- know what the focus is when we handle -- a message } deriving (Show, Read, Eq) -- | Class for equivalence relations. Must be transitive, reflexive. class EQF f a where eq :: f a -> a -> a -> Bool -- | To use the usual '==': data ClassEQ a = ClassEQ deriving (Show, Read, Eq) instance Eq a => EQF ClassEQ a where eq _ a b = a == b -- | Size specification for an element. data Elt a = E { elt :: a -- ^ The element , ratio :: Rational -- ^ Its size ratio , full :: Bool -- ^ Whether it should occupy all the -- available space when it has focus. } deriving (Show, Read, Eq) -- * Helpers getRatio :: Elt a -> (a, Rational) getRatio (E a r _) = (a,r) lookupBy :: (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a) lookupBy _ _ [] = Nothing lookupBy f a (E a' r b : _) | f a a' = Just $ E a r b lookupBy f a (_:es) = lookupBy f a es setFocus :: Zipper a -> a -> Zipper a setFocus Nothing a = Just $ W.Stack a [] [] setFocus (Just s) a = Just s { W.focus = a } -- * Messages -- | The type of messages accepted by a 'ZoomRow' layout data ZoomMessage = Zoom Rational -- ^ Multiply the focused window's size factor -- by the given number. | ZoomTo Rational -- ^ Set the focused window's size factor to the -- given number. | ZoomFull Bool -- ^ Set whether the focused window should occupy -- all available space when it has focus | ZoomFullToggle -- ^ Toggle whether the focused window should -- occupy all available space when it has focus deriving (Show) instance Message ZoomMessage -- | Increase the size of the focused window. -- Defined as @Zoom 1.5@ zoomIn :: ZoomMessage zoomIn = Zoom 1.5 -- | Decrease the size of the focused window. -- Defined as @Zoom (2/3)@ zoomOut :: ZoomMessage zoomOut = Zoom $ 2/3 -- | Reset the size of the focused window. -- Defined as @ZoomTo 1@ zoomReset :: ZoomMessage zoomReset = ZoomTo 1 -- * LayoutClass instance 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 then " (Max)" else "" emptyLayout (ZC _ Nothing) _ = return ([], Nothing) emptyLayout (ZC f _) _ = return ([], Just $ ZC f Nothing) doLayout (ZC f zelts) r@(Rectangle _ _ w _) s = let elts = W.integrate' zelts zelts' = mapZ_ (\a -> fromMaybe (E a 1 False) $ lookupBy (eq f) a elts) $ Just s elts' = W.integrate' zelts' maybeL' = if zelts `noChange` zelts' then Nothing else Just $ ZC f zelts' total = sum $ map ratio elts' widths = map (second ((* fi w) . (/total)) . getRatio) elts' in case getFocusZ zelts' of Just (E a _ True) -> return ([(a, r)], maybeL') _ -> return (makeRects r widths, maybeL') where makeRects :: Rectangle -> [(a, Rational)] -> [(a, Rectangle)] makeRects r pairs = let as = map fst pairs widths = map snd pairs discreteWidths = snd $ foldr discretize (0, []) widths rectangles = snd $ foldr makeRect (r, []) discreteWidths in zip as rectangles -- | Make a new rectangle by substracting the given width from the available -- space (from the right, since this is a foldr) makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle]) makeRect w (Rectangle x y w0 h, rs) = ( Rectangle x y (w0-w) h , Rectangle (x+fi w0-fi w) y w h : rs ) -- | Round a list of fractions in a way that maintains the total. -- If you know a better way to do this I'm very interested. discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension]) discretize r (carry, ds) = let (d, carry') = properFraction $ carry+r in (carry', d:ds) noChange z1 z2 = toTags z1 `helper` toTags z2 where helper [] [] = True 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) pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm , Just (E a r True) <- getFocusZ zelts = Just $ ZC f $ setFocus zelts $ E a r False pureMessage (ZC f zelts) sm | Just (ZoomFull True) <- fromMessage sm , Just (E a r False) <- getFocusZ zelts = Just $ ZC f $ setFocus zelts $ E a r True pureMessage (ZC f zelts) sm | Just (E a r b) <- getFocusZ zelts = case fromMessage sm of Just (Zoom r') -> Just $ ZC f $ setFocus zelts $ E a (r*r') b Just (ZoomTo r') -> Just $ ZC f $ setFocus zelts $ E a r' b Just ZoomFullToggle -> pureMessage (ZC f zelts) $ SomeMessage $ ZoomFull $ not b _ -> Nothing pureMessage _ _ = Nothing xmonad-contrib-0.18.0/XMonad/Prelude.hs0000644000000000000000000003463307346545000016050 0ustar0000000000000000{-# OPTIONS_GHC -Wno-dodgy-imports #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Prelude -- Description : Utility functions and re-exports. -- Copyright : (c) 2021 Tony Zorman -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tony Zorman -- -- Utility functions and re-exports for a more ergonomic developing -- experience. Users themselves will not find much use here. -- -------------------------------------------------------------------- module XMonad.Prelude ( module Exports, fi, chunksOf, (.:), (!?), NonEmpty((:|)), notEmpty, safeGetWindowAttributes, mkAbsolutePath, findM, -- * Keys keyToString, keymaskToString, cleanKeyMask, regularKeys, allSpecialKeys, specialKeys, multimediaKeys, functionKeys, WindowScreen, -- * Infinite streams Stream(..), (+~), cycleS, takeS, toList, fromList, ) where import Foreign (alloca, peek) import XMonad import Control.Applicative as Exports import Control.Monad as Exports import Data.Bool as Exports import Data.Char as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports import Data.Functor as Exports hiding (unzip) import Data.List as Exports hiding ((!?)) import Data.Maybe as Exports import Data.Monoid as Exports import Data.Traversable as Exports import qualified Data.Map.Strict as Map import Control.Arrow ((&&&), first) import Control.Exception (SomeException, handle) import Data.Bifunctor (bimap) import Data.Bits import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Tuple (swap) import GHC.Exts (IsList(..)) import GHC.Stack import System.Directory (getHomeDirectory) import System.Environment (getEnv) import qualified XMonad.StackSet as W -- | Short for 'fromIntegral'. fi :: (Integral a, Num b) => a -> b fi = fromIntegral -- | Given a maximum length, splits a list into sublists -- -- >>> chunksOf 5 (take 30 $ repeat 'a') -- ["aaaaa","aaaaa","aaaaa","aaaaa","aaaaa","aaaaa"] chunksOf :: Int -> [a] -> [[a]] chunksOf _ [] = [] chunksOf i xs = chunk : chunksOf i rest where !(chunk, rest) = splitAt i xs -- | Safe version of '(!!)'. (!?) :: [a] -> Int -> Maybe a (!?) xs n | n < 0 = Nothing | otherwise = listToMaybe $ drop n xs -- | Multivariable composition. -- -- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d) (.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b (.:) = (.) . (.) -- | Like 'find', but takes a monadic function instead; retains the -- short-circuiting behaviour of the non-monadic version. -- -- For example, -- -- > findM (\a -> putStr (show a <> " ") >> pure False) [1..10] -- -- would print "1 2 3 4 5 6 7 8 9 10" and return @Nothing@, while -- -- > findM (\a -> putStr (show a <> " ") >> pure True) [1..10] -- -- would print @"1"@ and return @Just 1@. findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing) -- | 'Data.List.NonEmpty.fromList' with a better error message. Useful to -- silence GHC's Pattern match(es) are non-exhaustive warning in places where -- the programmer knows it's always non-empty, but it's infeasible to express -- that in the type system. notEmpty :: HasCallStack => [a] -> NonEmpty a notEmpty [] = error "unexpected empty list" notEmpty (x:xs) = x :| xs -- | A safe version of 'Graphics.X11.Xlib.Extras.getWindowAttributes'. safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes) safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p -> xGetWindowAttributes dpy w p >>= \case 0 -> pure Nothing _ -> Just <$> peek p -- | (Naïvely) turn a relative path into an absolute one. -- -- * If the path starts with @\/@, do nothing. -- -- * If it starts with @~\/@, replace that with the actual home -- * directory. -- -- * If it starts with @$@, read the name of an environment -- * variable and replace it with the contents of that. -- -- * Otherwise, prepend the home directory and @\/@ to the path. mkAbsolutePath :: MonadIO m => FilePath -> m FilePath mkAbsolutePath ps = do home <- io getHomeDirectory case ps of '/' : _ -> pure ps '~' : '/' : _ -> pure (home <> drop 1 ps) '$' : _ -> let (v,ps') = span (`elem` ("_"<>['A'..'Z']<>['a'..'z']<>['0'..'9'])) (drop 1 ps) in io ((\(_ :: SomeException) -> pure "") `handle` getEnv v) Exports.<&> (<> ps') _ -> pure (home <> ('/' : ps)) {-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-} {-# SPECIALISE mkAbsolutePath :: FilePath -> X FilePath #-} ----------------------------------------------------------------------- -- Keys -- | Convert a modifier mask into a useful string. keymaskToString :: KeyMask -- ^ Num lock mask -> KeyMask -- ^ Modifier mask -> String keymaskToString numLockMask msk = concat . reverse . fst . foldr go ([], msk) $ masks where masks :: [(KeyMask, String)] masks = map (\m -> (m, show m)) [0 .. toEnum (finiteBitSize msk - 1)] ++ [ (numLockMask, "num-" ) , (lockMask, "lock-") , (controlMask, "C-" ) , (shiftMask, "S-" ) , (mod5Mask, "M5-" ) , (mod4Mask, "M4-" ) , (mod3Mask, "M3-" ) , (mod2Mask, "M2-" ) , (mod1Mask, "M1-" ) ] go :: (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask) go (m, s) a@(ss, v) | v == 0 = a | v .&. m == m = (s : ss, v .&. complement m) | otherwise = a -- | Convert a full key combination; i.e., a 'KeyMask' and 'KeySym' -- pair, into a string. keyToString :: (KeyMask, KeySym) -> String keyToString = uncurry (++) . bimap (keymaskToString 0) ppKeysym where ppKeysym :: KeySym -> String ppKeysym x = case specialMap Map.!? x of Just s -> "<" <> s <> ">" Nothing -> case regularMap Map.!? x of Nothing -> keysymToString x Just s -> s regularMap = Map.fromList (map swap regularKeys) specialMap = Map.fromList (map swap allSpecialKeys) -- | Strip numlock, capslock, mouse buttons and XKB group from a 'KeyMask', -- leaving only modifier keys like Shift, Control, Super, Hyper in the mask -- (hence the \"Key\" in \"cleanKeyMask\"). -- -- Core's 'cleanMask' only strips the first two because key events from -- passive grabs (key bindings) are stripped of mouse buttons and XKB group by -- the X server already for compatibility reasons. For more info, see: -- cleanKeyMask :: X (KeyMask -> KeyMask) cleanKeyMask = cleanKeyMask' <$> gets numberlockMask cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask cleanKeyMask' numLockMask mask = mask .&. complement (numLockMask .|. lockMask) .&. (button1Mask - 1) -- | A list of "regular" (extended ASCII) keys. regularKeys :: [(String, KeySym)] regularKeys = map (first (:[])) $ zip ['!' .. '~' ] -- ASCII [xK_exclam .. xK_asciitilde] <> zip ['\xa0' .. '\xff' ] -- Latin1 [xK_nobreakspace .. xK_ydiaeresis] -- | A list of all special key names and their associated KeySyms. allSpecialKeys :: [(String, KeySym)] allSpecialKeys = functionKeys <> specialKeys <> multimediaKeys -- | A list pairing function key descriptor strings (e.g. @\"\\"@) -- with the associated KeySyms. functionKeys :: [(String, KeySym)] functionKeys = [ ('F' : show n, k) | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ] -- | A list of special key names and their corresponding KeySyms. specialKeys :: [(String, KeySym)] specialKeys = [ ("Backspace" , xK_BackSpace) , ("Tab" , xK_Tab) , ("Return" , xK_Return) , ("Pause" , xK_Pause) , ("Num_Lock" , xK_Num_Lock) , ("Caps_Lock" , xK_Caps_Lock) , ("Scroll_lock", xK_Scroll_Lock) , ("Sys_Req" , xK_Sys_Req) , ("Print" , xK_Print) , ("Escape" , xK_Escape) , ("Esc" , xK_Escape) , ("Delete" , xK_Delete) , ("Home" , xK_Home) , ("Left" , xK_Left) , ("Up" , xK_Up) , ("Right" , xK_Right) , ("Down" , xK_Down) , ("L" , xK_Left) , ("U" , xK_Up) , ("R" , xK_Right) , ("D" , xK_Down) , ("Page_Up" , xK_Page_Up) , ("Page_Down" , xK_Page_Down) , ("End" , xK_End) , ("Insert" , xK_Insert) , ("Break" , xK_Break) , ("Space" , xK_space) , ("Control_L" , xK_Control_L) , ("Control_R" , xK_Control_R) , ("Shift_L" , xK_Shift_L) , ("Shift_R" , xK_Shift_R) , ("Alt_L" , xK_Alt_L) , ("Alt_R" , xK_Alt_R) , ("Meta_L" , xK_Meta_L) , ("Meta_R" , xK_Meta_R) , ("Super_L" , xK_Super_L) , ("Super_R" , xK_Super_R) , ("Hyper_L" , xK_Hyper_L) , ("Hyper_R" , xK_Hyper_R) , ("KP_Space" , xK_KP_Space) , ("KP_Tab" , xK_KP_Tab) , ("KP_Enter" , xK_KP_Enter) , ("KP_F1" , xK_KP_F1) , ("KP_F2" , xK_KP_F2) , ("KP_F3" , xK_KP_F3) , ("KP_F4" , xK_KP_F4) , ("KP_Home" , xK_KP_Home) , ("KP_Left" , xK_KP_Left) , ("KP_Up" , xK_KP_Up) , ("KP_Right" , xK_KP_Right) , ("KP_Down" , xK_KP_Down) , ("KP_Prior" , xK_KP_Prior) , ("KP_Page_Up" , xK_KP_Page_Up) , ("KP_Next" , xK_KP_Next) , ("KP_Page_Down", xK_KP_Page_Down) , ("KP_End" , xK_KP_End) , ("KP_Begin" , xK_KP_Begin) , ("KP_Insert" , xK_KP_Insert) , ("KP_Delete" , xK_KP_Delete) , ("KP_Equal" , xK_KP_Equal) , ("KP_Multiply", xK_KP_Multiply) , ("KP_Add" , xK_KP_Add) , ("KP_Separator", xK_KP_Separator) , ("KP_Subtract", xK_KP_Subtract) , ("KP_Decimal" , xK_KP_Decimal) , ("KP_Divide" , xK_KP_Divide) , ("KP_0" , xK_KP_0) , ("KP_1" , xK_KP_1) , ("KP_2" , xK_KP_2) , ("KP_3" , xK_KP_3) , ("KP_4" , xK_KP_4) , ("KP_5" , xK_KP_5) , ("KP_6" , xK_KP_6) , ("KP_7" , xK_KP_7) , ("KP_8" , xK_KP_8) , ("KP_9" , xK_KP_9) ] -- | List of multimedia keys. If Xlib does not know about some keysym -- it's omitted from the list ('stringToKeysym' returns 'noSymbol' in -- this case). multimediaKeys :: [(String, KeySym)] multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $ [ "XF86ModeLock" , "XF86MonBrightnessUp" , "XF86MonBrightnessDown" , "XF86KbdLightOnOff" , "XF86KbdBrightnessUp" , "XF86KbdBrightnessDown" , "XF86Standby" , "XF86AudioLowerVolume" , "XF86AudioMute" , "XF86AudioRaiseVolume" , "XF86AudioPlay" , "XF86AudioStop" , "XF86AudioPrev" , "XF86AudioNext" , "XF86HomePage" , "XF86Mail" , "XF86Start" , "XF86Search" , "XF86AudioRecord" , "XF86Calculator" , "XF86Memo" , "XF86ToDoList" , "XF86Calendar" , "XF86PowerDown" , "XF86ContrastAdjust" , "XF86RockerUp" , "XF86RockerDown" , "XF86RockerEnter" , "XF86Back" , "XF86Forward" , "XF86Stop" , "XF86Refresh" , "XF86PowerOff" , "XF86WakeUp" , "XF86Eject" , "XF86ScreenSaver" , "XF86WWW" , "XF86Sleep" , "XF86Favorites" , "XF86AudioPause" , "XF86AudioMedia" , "XF86MyComputer" , "XF86VendorHome" , "XF86LightBulb" , "XF86Shop" , "XF86History" , "XF86OpenURL" , "XF86AddFavorite" , "XF86HotLinks" , "XF86BrightnessAdjust" , "XF86Finance" , "XF86Community" , "XF86AudioRewind" , "XF86BackForward" , "XF86Launch0" , "XF86Launch1" , "XF86Launch2" , "XF86Launch3" , "XF86Launch4" , "XF86Launch5" , "XF86Launch6" , "XF86Launch7" , "XF86Launch8" , "XF86Launch9" , "XF86LaunchA" , "XF86LaunchB" , "XF86LaunchC" , "XF86LaunchD" , "XF86LaunchE" , "XF86LaunchF" , "XF86ApplicationLeft" , "XF86ApplicationRight" , "XF86Book" , "XF86CD" , "XF86Calculater" , "XF86Clear" , "XF86Close" , "XF86Copy" , "XF86Cut" , "XF86Display" , "XF86DOS" , "XF86Documents" , "XF86Excel" , "XF86Explorer" , "XF86Game" , "XF86Go" , "XF86iTouch" , "XF86LogOff" , "XF86Market" , "XF86Meeting" , "XF86MenuKB" , "XF86MenuPB" , "XF86MySites" , "XF86New" , "XF86News" , "XF86OfficeHome" , "XF86Open" , "XF86Option" , "XF86Paste" , "XF86Phone" , "XF86Q" , "XF86Reply" , "XF86Reload" , "XF86RotateWindows" , "XF86RotationPB" , "XF86RotationKB" , "XF86Save" , "XF86ScrollUp" , "XF86ScrollDown" , "XF86ScrollClick" , "XF86Send" , "XF86Spell" , "XF86SplitScreen" , "XF86Support" , "XF86TaskPane" , "XF86Terminal" , "XF86Tools" , "XF86Travel" , "XF86UserPB" , "XF86User1KB" , "XF86User2KB" , "XF86Video" , "XF86WheelButton" , "XF86Word" , "XF86Xfer" , "XF86ZoomIn" , "XF86ZoomOut" , "XF86Away" , "XF86Messenger" , "XF86WebCam" , "XF86MailForward" , "XF86Pictures" , "XF86Music" , "XF86TouchpadToggle" , "XF86AudioMicMute" , "XF86_Switch_VT_1" , "XF86_Switch_VT_2" , "XF86_Switch_VT_3" , "XF86_Switch_VT_4" , "XF86_Switch_VT_5" , "XF86_Switch_VT_6" , "XF86_Switch_VT_7" , "XF86_Switch_VT_8" , "XF86_Switch_VT_9" , "XF86_Switch_VT_10" , "XF86_Switch_VT_11" , "XF86_Switch_VT_12" , "XF86_Ungrab" , "XF86_ClearGrab" , "XF86_Next_VMode" , "XF86_Prev_VMode" , "XF86Bluetooth" ] -- | The specialized 'W.Screen' derived from 'WindowSet'. type WindowScreen -- FIXME move to core = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -- | An infinite stream type data Stream a = !a :~ Stream a infixr 5 :~ instance Functor Stream where fmap :: (a -> b) -> Stream a -> Stream b fmap f = go where go (x :~ xs) = f x :~ go xs instance IsList (Stream a) where type (Item (Stream a)) = a fromList :: [a] -> Stream a fromList (x : xs) = x :~ fromList xs fromList [] = errorWithoutStackTrace "XMonad.Prelude.Stream.fromList: Can't create stream out of finite list." toList :: Stream a -> [a] toList (x :~ xs) = x : toList xs -- | Absorb a list into an infinite stream. (+~) :: [a] -> Stream a -> Stream a xs +~ s = foldr (:~) s xs infixr 5 +~ -- | Absorb a non-empty list into an infinite stream. cycleS :: NonEmpty a -> Stream a cycleS (x :| xs) = s where s = x :~ xs +~ s -- | @takeS n stream@ returns the first @n@ elements of @stream@; if @n < 0@, -- this returns the empty list. takeS :: Int -> Stream a -> [a] takeS n = take n . toList xmonad-contrib-0.18.0/XMonad/Prompt.hs0000644000000000000000000023060607346545000015727 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt -- Copyright : (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky -- 2015 Sibi Prabakaran, 2018 Yclept Nemo -- License : BSD3 -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- A module for writing graphical prompts for XMonad -- ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Bugs: -- if 'alwaysHighlight' is True, and -- 1 type several characters -- 2 tab-complete past several entries -- 3 backspace back to the several characters -- 4 tab-complete once (results in the entry past the one in [2]) -- 5 tab-complete against this shorter list of completions -- then the prompt will freeze (XMonad continues however). ----------------------------------------------------------------------------- module XMonad.Prompt ( -- * Usage -- $usage mkXPrompt , mkXPromptWithReturn , mkXPromptWithModes , def , amberXPConfig , greenXPConfig , XPMode , XPType (..) , XPColor (..) , XPPosition (..) , XPConfig (..) , XPrompt (..) , XP , defaultXPKeymap, defaultXPKeymap' , emacsLikeXPKeymap, emacsLikeXPKeymap' , vimLikeXPKeymap, vimLikeXPKeymap' , quit , promptSubmap, promptBuffer, toHeadChar, bufferOne , killBefore, killAfter, startOfLine, endOfLine , insertString, pasteString, pasteString' , clipCursor, moveCursor, moveCursorClip , setInput, getInput, getOffset , defaultColor, modifyColor, setColor , resetColor, setBorderColor , modifyPrompter, setPrompter, resetPrompter , selectedCompletion, setCurrentCompletions, getCurrentCompletions , moveWord, moveWord', killWord, killWord' , changeWord, deleteString , moveHistory, setSuccess, setDone, setModeDone , Direction1D(..) , ComplFunction , ComplCaseSensitivity(..) -- * X Utilities -- $xutils , mkUnmanagedWindow , fillDrawable -- * Other Utilities -- $utils , mkComplFunFromList , mkComplFunFromList' -- * @nextCompletion@ implementations , getNextOfLastWord , getNextCompletion -- * List utilities , getLastWord , skipLastWord , splitInSubListsAt , breakAtSpace , uniqSort , historyCompletion , historyCompletionP -- * History filters , deleteAllDuplicates , deleteConsecutive , HistoryMatches , initMatches , historyUpMatching , historyDownMatching -- * Types , XPState ) where import XMonad hiding (cleanMask, config) import XMonad.Prelude hiding (toList, fromList) import qualified XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.Types import XMonad.Util.XSelection (getSelection) import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded) import Control.Arrow (first, (&&&), (***)) import Control.Concurrent (threadDelay) import Control.Exception as E hiding (handle) import Control.Monad.State import Data.Bifunctor (bimap) import Data.Bits import Data.IORef import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import Data.Set (fromList, toList) import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Posix.Files import Data.List.NonEmpty (nonEmpty) -- $usage -- For usage examples see "XMonad.Prompt.Shell", -- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh" -- -- TODO: -- -- * scrolling the completions that don't fit in the window (?) type XP = StateT XPState IO data XPState = XPS { dpy :: Display , rootw :: !Window , win :: !Window , screen :: !Rectangle , winWidth :: !Dimension -- ^ Width of the prompt window , complWinDim :: Maybe ComplWindowDim , complIndex :: !(Int,Int) , complWin :: IORef (Maybe Window) -- ^ This is an 'IORef' to enable removal of the completion -- window if an exception occurs, since otherwise the most -- recent value of 'complWin' would not be available. , showComplWin :: Bool , operationMode :: XPOperationMode , highlightedCompl :: Maybe String , gcon :: !GC , fontS :: !XMonadFont , commandHistory :: W.Stack String , offset :: !Int , config :: XPConfig , successful :: Bool , cleanMask :: KeyMask -> KeyMask , done :: Bool , modeDone :: Bool , color :: XPColor , prompter :: String -> String , eventBuffer :: [(KeySym, String, Event)] , inputBuffer :: String , currentCompletions :: Maybe [String] } data XPConfig = XPC { font :: String -- ^ Font. For TrueType fonts, use something like -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font -- Description, i.e. something like -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@. , bgColor :: String -- ^ Background color , fgColor :: String -- ^ Font color , bgHLight :: String -- ^ Background color of a highlighted completion entry , fgHLight :: String -- ^ Font color of a highlighted completion entry , borderColor :: String -- ^ Border color , promptBorderWidth :: !Dimension -- ^ Border width , position :: XPPosition -- ^ Position: 'Top', 'Bottom', or 'CenteredAt' , alwaysHighlight :: !Bool -- ^ Always highlight an item, overriden to True with multiple modes , height :: !Dimension -- ^ Window height , maxComplRows :: Maybe Dimension -- ^ Just x: maximum number of rows to show in completion window , maxComplColumns :: Maybe Dimension -- ^ Just x: maximum number of columns to show in completion window , historySize :: !Int -- ^ The number of history entries to be saved , historyFilter :: [String] -> [String] -- ^ a filter to determine which -- history entries to remember , promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) -- ^ Mapping from key combinations to actions , completionKey :: (KeyMask, KeySym) -- ^ Key to trigger forward completion , prevCompletionKey :: (KeyMask, KeySym) -- ^ Key to trigger backward completion , changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes) , defaultText :: String -- ^ The text by default in the prompt line , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, -- and delay by x microseconds , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed , complCaseSensitivity :: ComplCaseSensitivity -- ^ Perform completion in a case-sensitive manner , searchPredicate :: String -> String -> Bool -- ^ Given the typed string and a possible -- completion, is the completion valid? , defaultPrompter :: String -> String -- ^ Modifies the prompt given by 'showXPrompt' , sorter :: String -> [String] -> [String] -- ^ Used to sort the possible completions by how well they -- match the search string (see X.P.FuzzyMatch for an -- example). } data XPType = forall p . XPrompt p => XPT p type ComplFunction = String -> IO [String] type XPMode = XPType data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType) data ComplCaseSensitivity = CaseSensitive | CaseInSensitive instance Show XPType where show (XPT p) = showXPrompt p instance XPrompt XPType where showXPrompt = show nextCompletion (XPT t) = nextCompletion t commandToComplete (XPT t) = commandToComplete t completionToCommand (XPT t) = completionToCommand t completionFunction (XPT t) = completionFunction t modeAction (XPT t) = modeAction t -- | A class for an abstract prompt. In order for your data type to be a -- valid prompt you _must_ make it an instance of this class. -- -- The minimal complete definition is just 'showXPrompt', i.e. the name -- of the prompt. This string will be displayed in the command line -- window (before the cursor). -- -- As an example of a complete 'XPrompt' instance definition, we can -- look at the 'XMonad.Prompt.Shell.Shell' prompt from -- "XMonad.Prompt.Shell": -- -- > data Shell = Shell -- > -- > instance XPrompt Shell where -- > showXPrompt Shell = "Run: " class XPrompt t where {-# MINIMAL showXPrompt #-} -- | This method is used to print the string to be -- displayed in the command line window. showXPrompt :: t -> String -- | This method is used to generate the next completion to be -- printed in the command line when tab is pressed, given the -- string presently in the command line and the list of -- completion. -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True) nextCompletion :: t -> String -> [String] -> String nextCompletion = getNextOfLastWord -- | This method is used to generate the string to be passed to -- the completion function. commandToComplete :: t -> String -> String commandToComplete _ = getLastWord -- | This method is used to process each completion in order to -- generate the string that will be compared with the command -- presently displayed in the command line. If the prompt is using -- 'getNextOfLastWord' for implementing 'nextCompletion' (the -- default implementation), this method is also used to generate, -- from the returned completion, the string that will form the -- next command line when tab is pressed. completionToCommand :: t -> String -> String completionToCommand _ c = c -- | When the prompt has multiple modes, this is the function -- used to generate the autocompletion list. -- The argument passed to this function is given by `commandToComplete` -- The default implementation shows an error message. completionFunction :: t -> ComplFunction completionFunction t = const $ return ["Completions for " ++ showXPrompt t ++ " could not be loaded"] -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called -- when the user picks an item from the autocompletion list. -- The first argument is the prompt (or mode) on which the item was picked -- The first string argument is the autocompleted item's text. -- The second string argument is the query made by the user (written in the prompt's buffer). -- See XMonad/Actions/Launcher.hs for a usage example. modeAction :: t -> String -> String -> X () modeAction _ _ _ = return () data XPPosition = Top | Bottom -- | Prompt will be placed in the center horizontally and -- in the certain place of screen vertically. If it's in the upper -- part of the screen, completion window will be placed below (like -- in 'Top') and otherwise above (like in 'Bottom') | CenteredAt { xpCenterY :: Rational -- ^ Rational between 0 and 1, giving -- y coordinate of center of the prompt relative to the screen height. , xpWidth :: Rational -- ^ Rational between 0 and 1, giving -- width of the prompt relative to the screen width. } deriving (Show,Read) data XPColor = XPColor { bgNormal :: String -- ^ Background color , fgNormal :: String -- ^ Font color , bgHighlight :: String -- ^ Background color of a highlighted completion entry , fgHighlight :: String -- ^ Font color of a highlighted completion entry , border :: String -- ^ Border color } amberXPConfig, greenXPConfig :: XPConfig instance Default XPColor where def = XPColor { bgNormal = "grey22" , fgNormal = "grey80" , bgHighlight = "grey" , fgHighlight = "black" , border = "white" } instance Default XPConfig where def = #ifdef XFT XPC { font = "xft:monospace-12" #else XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" #endif , bgColor = bgNormal def , fgColor = fgNormal def , bgHLight = bgHighlight def , fgHLight = fgHighlight def , borderColor = border def , promptBorderWidth = 1 , promptKeymap = defaultXPKeymap , completionKey = (0, xK_Tab) , prevCompletionKey = (shiftMask, xK_Tab) , changeModeKey = xK_grave , position = Bottom , height = 18 , maxComplRows = Nothing , maxComplColumns = Nothing , historySize = 256 , historyFilter = id , defaultText = [] , autoComplete = Nothing , showCompletionOnTab = False , complCaseSensitivity = CaseSensitive , searchPredicate = isPrefixOf , alwaysHighlight = False , defaultPrompter = id , sorter = const id } greenXPConfig = def { bgColor = "black" , fgColor = "green" , promptBorderWidth = 0 } amberXPConfig = def { bgColor = "black" , fgColor = "#ca8f2d" , fgHLight = "#eaaf4c" } initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode -> GC -> XMonadFont -> [String] -> XPConfig -> (KeyMask -> KeyMask) -> Dimension -> XPState initState d rw w s opMode gc fonts h c cm width = XPS { dpy = d , rootw = rw , win = w , screen = s , winWidth = width , complWinDim = Nothing , complWin = unsafePerformIO (newIORef Nothing) , showComplWin = not (showCompletionOnTab c) , operationMode = opMode , highlightedCompl = Nothing , gcon = gc , fontS = fonts , commandHistory = W.Stack { W.focus = defaultText c , W.up = [] , W.down = h } , complIndex = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True , offset = length (defaultText c) , config = c , successful = False , done = False , modeDone = False , cleanMask = cm , prompter = defaultPrompter c , color = defaultColor c , eventBuffer = [] , inputBuffer = "" , currentCompletions = Nothing } -- Returns the current XPType currentXPMode :: XPState -> XPType currentXPMode st = case operationMode st of XPMultipleModes modes -> W.focus modes XPSingleMode _ xptype -> xptype -- When in multiple modes, this function sets the next mode -- in the list of modes as active setNextMode :: XPState -> XPState setNextMode st = case operationMode st of XPMultipleModes modes -> case W.down modes of [] -> st -- there is no next mode, return same state (m:ms) -> let currentMode = W.focus modes in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack _ -> st --nothing to do, the prompt's operation has only one mode -- Returns the highlighted item highlightedItem :: XPState -> [String] -> Maybe String highlightedItem st' completions = case complWinDim st' of Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are Just winDim -> let ComplWindowDim{ cwCols, cwRows } = winDim complMatrix = chunksOf (length cwRows) (take (length cwCols * length cwRows) completions) (col_index,row_index) = complIndex st' in case completions of [] -> Nothing _ -> complMatrix !? col_index >>= (!? row_index) -- | Return the selected completion, i.e. the 'String' we actually act -- upon after the user confirmed their selection (by pressing @Enter@). selectedCompletion :: XPState -> String selectedCompletion st -- If 'alwaysHighlight' is used, look at the currently selected item (if any) | alwaysHighlight (config st) = fromMaybe (command st) $ highlightedCompl st -- Otherwise, look at what the user actually wrote so far | otherwise = command st -- this would be much easier with functional references command :: XPState -> String command = W.focus . commandHistory setCommand :: String -> XPState -> XPState setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} -- | Sets the input string to the given value. setInput :: String -> XP () setInput = modify . setCommand -- | Returns the current input string. Intended for use in custom keymaps -- where 'get' or similar can't be used to retrieve it. getInput :: XP String getInput = gets command -- | Returns the offset of the current input string. Intended for use in custom -- keys where 'get' or similar can't be used to retrieve it. getOffset :: XP Int getOffset = gets offset -- | Accessor encapsulating disparate color fields of 'XPConfig' into an -- 'XPColor' (the configuration provides default values). defaultColor :: XPConfig -> XPColor defaultColor c = XPColor { bgNormal = bgColor c , fgNormal = fgColor c , bgHighlight = bgHLight c , fgHighlight = fgHLight c , border = borderColor c } -- | Modify the prompt colors. modifyColor :: (XPColor -> XPColor) -> XP () modifyColor c = modify $ \s -> s { color = c $ color s } -- | Set the prompt colors. setColor :: XPColor -> XP () setColor = modifyColor . const -- | Reset the prompt colors to those from 'XPConfig'. resetColor :: XP () resetColor = gets (defaultColor . config) >>= setColor -- | Set the prompt border color. setBorderColor :: String -> XPColor -> XPColor setBorderColor bc xpc = xpc { border = bc } -- | Modify the prompter, i.e. for chaining prompters. modifyPrompter :: ((String -> String) -> (String -> String)) -> XP () modifyPrompter p = modify $ \s -> s { prompter = p $ prompter s } -- | Set the prompter. setPrompter :: (String -> String) -> XP () setPrompter = modifyPrompter . const -- | Reset the prompter to the one from 'XPConfig'. resetPrompter :: XP () resetPrompter = gets (defaultPrompter . config) >>= setPrompter -- | Set the current completion list, or 'Nothing' to invalidate the current -- completions. setCurrentCompletions :: Maybe [String] -> XP () setCurrentCompletions cs = modify $ \s -> s { currentCompletions = cs } -- | Get the current completion list. getCurrentCompletions :: XP (Maybe [String]) getCurrentCompletions = gets currentCompletions -- | Same as 'mkXPrompt', except that the action function can have -- type @String -> X a@, for any @a@, and the final action returned -- by 'mkXPromptWithReturn' will have type @X (Maybe a)@. @Nothing@ -- is yielded if the user cancels the prompt (by e.g. hitting Esc or -- Ctrl-G). For an example of use, see the 'XMonad.Prompt.Input' -- module. mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a) mkXPromptWithReturn t conf compl action = do st' <- mkXPromptImplementation (showXPrompt t) conf (XPSingleMode compl (XPT t)) if successful st' then Just <$> action (selectedCompletion st') else return Nothing -- | Creates a prompt given: -- -- * a prompt type, instance of the 'XPrompt' class. -- -- * a prompt configuration ('def' can be used as a starting point) -- -- * a completion function ('mkComplFunFromList' can be used to -- create a completions function given a list of possible completions) -- -- * an action to be run: the action must take a string and return 'XMonad.X' () mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () mkXPrompt t conf compl action = void $ mkXPromptWithReturn t conf compl action -- | Creates a prompt with multiple modes given: -- -- * A non-empty list of modes -- * A prompt configuration -- -- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are -- instances of XPrompt. See XMonad.Actions.Launcher for more details -- -- The argument supplied to the action to execute is always the current highlighted item, -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. mkXPromptWithModes :: [XPType] -> XPConfig -> X () mkXPromptWithModes [] _ = pure () mkXPromptWithModes (defaultMode : modes) conf = do let modeStack = W.Stack { W.focus = defaultMode -- Current mode , W.up = [] , W.down = modes -- Other modes } om = XPMultipleModes modeStack st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om when (successful st') $ case operationMode st' of XPMultipleModes ms -> let action = modeAction $ W.focus ms in action (command st') $ fromMaybe "" (highlightedCompl st') _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode -- Internal function used to implement 'mkXPromptWithReturn' and -- 'mkXPromptWithModes'. mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState mkXPromptImplementation historyKey conf om = do XConf { display = d, theRoot = rw } <- ask s <- gets $ screenRect . W.screenDetail . W.current . windowset cleanMask <- cleanKeyMask cachedir <- asks (cacheDir . directories) hist <- io $ readHistory cachedir fs <- initXMF (font conf) let width = getWinWidth s (position conf) st' <- io $ bracket (createPromptWin d rw conf s width) (destroyWindow d) (\w -> bracket (createGC d w) (freeGC d) (\gc -> do selectInput d w $ exposureMask .|. keyPressMask setGraphicsExposures d gc False let hs = fromMaybe [] $ M.lookup historyKey hist st = initState d rw w s om gc fs hs conf cleanMask width runXP st)) releaseXMF fs when (successful st') $ do let prune = take (historySize conf) io $ writeHistory cachedir $ M.insertWith (\xs ys -> prune . historyFilter conf $ xs ++ ys) historyKey -- We need to apply historyFilter before as well, since -- otherwise the filter would not be applied if there is no -- history (prune $ historyFilter conf [selectedCompletion st']) hist return st' where -- | Based on the ultimate position of the prompt and the screen -- dimensions, calculate its width. getWinWidth :: Rectangle -> XPPosition -> Dimension getWinWidth scr = \case CenteredAt{ xpWidth } -> floor $ fi (rect_width scr) * xpWidth _ -> rect_width scr -- | Inverse of 'Codec.Binary.UTF8.String.utf8Encode', that is, a convenience -- function that checks to see if the input string is UTF8 encoded before -- decoding. utf8Decode :: String -> String utf8Decode str | isUTF8Encoded str = decodeString str | otherwise = str runXP :: XPState -> IO XPState runXP st = do let d = dpy st w = win st bracket (grabKeyboard d w True grabModeAsync grabModeAsync currentTime) (\_ -> ungrabKeyboard d currentTime) (\status -> execStateT (when (status == grabSuccess) $ do ah <- gets (alwaysHighlight . config) when ah $ do compl <- listToMaybe <$> getCompletions modify' $ \xpst -> xpst{ highlightedCompl = compl } updateWindows eventLoop handleMain evDefaultStop) st `finally` (mapM_ (destroyWindow d) =<< readIORef (complWin st)) `finally` sync d False) type KeyStroke = (KeySym, String) -- | Check whether the given key stroke is a modifier. isModifier :: KeyStroke -> Bool isModifier (_, keyString) = null keyString -- | Main event "loop". Gives priority to events from the state's event buffer. eventLoop :: (KeyStroke -> Event -> XP ()) -> XP Bool -> XP () eventLoop handle stopAction = do b <- gets eventBuffer (keysym,keystr,event) <- case b of [] -> do d <- gets dpy io $ allocaXEvent $ \e -> do -- Also capture @buttonPressMask@, see Note [Allow ButtonEvents] maskEvent d (exposureMask .|. keyPressMask .|. buttonPressMask) e ev <- getEvent e if ev_event_type ev == keyPress then do (_, s) <- lookupString $ asKeyEvent e ks <- keycodeToKeysym d (ev_keycode ev) 0 return (ks, s, ev) else return (noSymbol, "", ev) (l : ls) -> do modify $ \s -> s { eventBuffer = ls } return l handle (keysym,keystr) event stopAction >>= \stop -> unless stop (eventLoop handle stopAction) -- | Default event loop stop condition. evDefaultStop :: XP Bool evDefaultStop = gets ((||) . modeDone) <*> gets done -- | Common patterns shared by all event handlers. handleOther :: KeyStroke -> Event -> XP () handleOther _ ExposeEvent{ev_window = w} = do -- Expose events can be triggered by switching virtual consoles. st <- get when (win st == w) updateWindows handleOther _ ButtonEvent{ev_event_type = t} = do -- See Note [Allow ButtonEvents] when (t == buttonPress) $ do d <- gets dpy io $ allowEvents d replayPointer currentTime handleOther _ _ = return () {- Note [Allow ButtonEvents] Some settings (like @clickJustFocuses = False@) set up the passive pointer grabs that xmonad makes to intercept clicks to unfocused windows with @pointer_mode = grabModeSync@ and @keyboard_mode = grabModeSync@. This means that any click in an unfocused window leads to a pointer/keyboard grab that freezes both devices until 'allowEvents' is called. But "XMonad.Prompt" has its own X event loop, so 'allowEvents' is never called and everything remains frozen indefinitely. This does not happen when the grabs are made with @grabModeAsync@, as pointer events processing is not frozen and the grab only lasts as long as the mouse button is pressed. Hence, in this situation we call 'allowEvents' in the prompts event loop whenever a button event is received, releasing the pointer grab. In this case, 'replayPointer' takes care of the fact that these events are not merely discarded, but passed to the respective application window. -} -- | Prompt event handler for the main loop. Dispatches to input, completion -- and mode switching handlers. handleMain :: KeyStroke -> Event -> XP () handleMain stroke@(keysym, keystr) = \case KeyEvent{ev_event_type = t, ev_state = m} -> do (prevCompKey, (compKey, modeKey)) <- gets $ (prevCompletionKey &&& completionKey &&& changeModeKey) . config keymask <- gets cleanMask <*> pure m -- haven't subscribed to keyRelease, so just in case when (t == keyPress) $ if | (keymask, keysym) == compKey -> getCurrentCompletions >>= handleCompletionMain Next | (keymask, keysym) == prevCompKey -> getCurrentCompletions >>= handleCompletionMain Prev | otherwise -> do keymap <- gets (promptKeymap . config) let mbAction = M.lookup (keymask, keysym) keymap -- Either run when we can insert a valid character, or the -- pressed key has an action associated to it. unless (isModifier stroke && isNothing mbAction) $ do setCurrentCompletions Nothing if keysym == modeKey then modify setNextMode >> updateWindows else handleInput keymask mbAction event -> handleOther stroke event where -- Prompt input handler for the main loop. handleInput :: KeyMask -> Maybe (XP ()) -> XP () handleInput keymask = \case Just action -> action >> updateWindows Nothing -> when (keymask .&. controlMask == 0) $ do insertString $ utf8Decode keystr updateWindows updateHighlightedCompl complete <- tryAutoComplete when complete acceptSelection -- There are two options to store the completion list during the main loop: -- * Use the State monad, with 'Nothing' as the initial state. -- * Join the output of the event loop handler to the input of the (same) -- subsequent handler, using 'Nothing' as the initial input. -- Both approaches are, under the hood, equivalent. -- -- | Prompt completion handler for the main loop. Given 'Nothing', generate the -- current completion list. With the current list, trigger a completion. handleCompletionMain :: Direction1D -> Maybe [String] -> XP () handleCompletionMain dir compls = case compls of Just cs -> handleCompletion dir cs Nothing -> do cs <- getCompletions when (length cs > 1) $ modify $ \s -> s { showComplWin = True } setCurrentCompletions $ Just cs handleCompletion dir cs handleCompletion :: Direction1D -> [String] -> XP () handleCompletion dir cs = do alwaysHlight <- gets $ alwaysHighlight . config st <- get let updateWins = redrawWindows (pure ()) updateState l = if alwaysHlight then hlComplete (getLastWord $ command st) l st else simpleComplete l st case cs of [] -> updateWindows [x] -> do updateState [x] cs' <- getCompletions updateWins cs' setCurrentCompletions $ Just cs' l -> updateState l >> updateWins l where -- When alwaysHighlight is off, just complete based on what the -- user has typed so far. simpleComplete :: [String] -> XPState -> XP () simpleComplete l st = do let newCommand = nextCompletion (currentXPMode st) (command st) l modify $ \s -> setCommand newCommand $ s { offset = length newCommand , highlightedCompl = Just newCommand } -- If alwaysHighlight is on, and the user wants the next -- completion, move to the next completion item and update the -- buffer to reflect that. -- --TODO: Scroll or paginate results hlComplete :: String -> [String] -> XPState -> XP () hlComplete prevCompl l st | -- The current suggestion matches the command and is a -- proper suffix of the last suggestion, so replace it. isSuffixOfCmd && isProperSuffixOfLast = replaceCompletion prevCompl | -- We only have one suggestion, so we need to be a little -- bit smart in order to avoid a loop. Just (ch :| []) <- nonEmpty cs = if command st == hlCompl then put st else replaceCompletion ch -- The current suggestion matches the command, so advance -- to the next completion and try again. | isSuffixOfCmd = hlComplete hlCompl l $ st{ complIndex = complIndex' , highlightedCompl = nextHlCompl } -- If nothing matches at all, delete the suggestion and -- highlight the next one. | otherwise = replaceCompletion prevCompl where hlCompl :: String = fromMaybe (command st) $ highlightedItem st l complIndex' :: (Int, Int) = computeComplIndex dir st nextHlCompl :: Maybe String = highlightedItem st{ complIndex = complIndex' } cs isSuffixOfCmd :: Bool = hlCompl `isSuffixOf` command st isProperSuffixOfLast :: Bool = hlCompl `isSuffixOf` prevCompl && not (prevCompl `isSuffixOf` hlCompl) replaceCompletion :: String -> XP () = \str -> do put st replicateM_ (length $ words str) $ killWord Prev insertString' hlCompl endOfLine -- | Initiate a prompt sub-map event loop. Submaps are intended to provide -- alternate keybindings. Accepts a default action and a mapping from key -- combinations to actions. If no entry matches, the default action is run. promptSubmap :: XP () -> M.Map (KeyMask, KeySym) (XP ()) -> XP () promptSubmap defaultAction keymap = do md <- gets modeDone setModeDone False updateWindows eventLoop (handleSubmap defaultAction keymap) evDefaultStop setModeDone md handleSubmap :: XP () -> M.Map (KeyMask, KeySym) (XP ()) -> KeyStroke -> Event -> XP () handleSubmap defaultAction keymap stroke KeyEvent{ev_event_type = t, ev_state = m} = do keymask <- gets cleanMask <*> pure m when (t == keyPress) $ handleInputSubmap defaultAction keymap keymask stroke handleSubmap _ _ stroke event = handleOther stroke event handleInputSubmap :: XP () -> M.Map (KeyMask, KeySym) (XP ()) -> KeyMask -> KeyStroke -> XP () handleInputSubmap defaultAction keymap keymask stroke@(keysym, _) = case M.lookup (keymask,keysym) keymap of Just action -> action >> updateWindows Nothing -> unless (isModifier stroke) $ defaultAction >> updateWindows -- | Initiate a prompt input buffer event loop. Input is sent to a buffer and -- bypasses the prompt. The provided function is given the existing buffer and -- the input keystring. The first field of the result determines whether the -- input loop continues (if @True@). The second field determines whether the -- input is appended to the buffer, or dropped (if @False@). If the loop is to -- stop without keeping input - that is, @(False,False)@ - the event is -- prepended to the event buffer to be processed by the parent loop. This -- allows loop to process both fixed and indeterminate inputs. -- -- Result given @(continue,keep)@: -- -- * cont and keep -- -- * grow input buffer -- -- * stop and keep -- -- * grow input buffer -- * stop loop -- -- * stop and drop -- -- * buffer event -- * stop loop -- -- * cont and drop -- -- * do nothing promptBuffer :: (String -> String -> (Bool,Bool)) -> XP String promptBuffer f = do md <- gets modeDone setModeDone False eventLoop (handleBuffer f) evDefaultStop buff <- gets inputBuffer modify $ \s -> s { inputBuffer = "" } setModeDone md return buff handleBuffer :: (String -> String -> (Bool,Bool)) -> KeyStroke -> Event -> XP () handleBuffer f stroke event@KeyEvent{ev_event_type = t, ev_state = m} = do keymask <- gets cleanMask <*> pure m when (t == keyPress) $ handleInputBuffer f keymask stroke event handleBuffer _ stroke event = handleOther stroke event handleInputBuffer :: (String -> String -> (Bool,Bool)) -> KeyMask -> KeyStroke -> Event -> XP () handleInputBuffer f keymask stroke@(keysym, keystr) event = unless (isModifier stroke || keymask .&. controlMask /= 0) $ do (evB,inB) <- gets (eventBuffer &&& inputBuffer) let keystr' = utf8Decode keystr let (cont,keep) = f inB keystr' when keep $ modify $ \s -> s { inputBuffer = inB ++ keystr' } unless cont $ setModeDone True unless (cont || keep) $ modify $ \s -> s { eventBuffer = (keysym,keystr,event) : evB } -- | Predicate instructing 'promptBuffer' to get (and keep) a single non-empty -- 'KeyEvent'. bufferOne :: String -> String -> (Bool,Bool) bufferOne xs x = (null xs && null x,True) -- | Return the @(column, row)@ of the desired highlight, or @(0, 0)@ if -- there is no prompt window or a wrap-around occurs. computeComplIndex :: Direction1D -> XPState -> (Int, Int) computeComplIndex dir st = case complWinDim st of Nothing -> (0, 0) -- no window dimensions (just destroyed or not created) Just ComplWindowDim{ cwCols, cwRows } -> if rowm == currentrow + direction then (currentcol, rowm) -- We are not in the last row, so advance the row else (colm, rowm) -- otherwise advance to the respective column where (currentcol, currentrow) = complIndex st (colm, rowm) = ( (currentcol + direction) `mod` length cwCols , (currentrow + direction) `mod` length cwRows ) direction = case dir of Next -> 1 Prev -> -1 tryAutoComplete :: XP Bool tryAutoComplete = do ac <- gets (autoComplete . config) case ac of Just d -> do cs <- getCompletions case cs of [c] -> runCompleted c d >> return True _ -> return False Nothing -> return False where runCompleted cmd delay = do st <- get let new_command = nextCompletion (currentXPMode st) (command st) [cmd] modify $ setCommand "autocompleting..." updateWindows io $ threadDelay delay modify $ setCommand new_command return True -- KeyPresses -- | Default key bindings for prompts. Click on the \"Source\" link -- to the right to see the complete list. See also 'defaultXPKeymap''. defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap = defaultXPKeymap' isSpace -- | A variant of 'defaultXPKeymap' which lets you specify a custom -- predicate for identifying non-word characters, which affects all -- the word-oriented commands (move\/kill word). The default is -- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ -- would be considered as a single word. You could use a predicate -- like @(\\c -> isSpace c || c == \'\/\')@ to move through or -- delete components of the path one at a time. defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap' p = M.fromList $ map (first $ (,) controlMask) -- control + [ (xK_u, killBefore) , (xK_k, killAfter) , (xK_a, startOfLine) , (xK_e, endOfLine) , (xK_y, pasteString) -- Retain the pre-0.14 moveWord' behavior: , (xK_Right, moveWord' p Next >> moveCursor Next) , (xK_Left, moveCursor Prev >> moveWord' p Prev) , (xK_Delete, killWord' p Next) , (xK_BackSpace, killWord' p Prev) , (xK_w, killWord' p Prev) , (xK_g, quit) , (xK_bracketleft, quit) ] ++ map (first $ (,) 0) [ (xK_Return, acceptSelection) , (xK_KP_Enter, acceptSelection) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) , (xK_Right, moveCursor Next) , (xK_Home, startOfLine) , (xK_End, endOfLine) , (xK_Down, moveHistory W.focusUp') , (xK_Up, moveHistory W.focusDown') , (xK_Escape, quit) ] -- | A keymap with many emacs-like key bindings. Click on the -- \"Source\" link to the right to see the complete list. -- See also 'emacsLikeXPKeymap''. emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace -- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom -- predicate for identifying non-word characters, which affects all -- the word-oriented commands (move\/kill word). The default is -- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ -- would be considered as a single word. You could use a predicate -- like @(\\c -> isSpace c || c == \'\/\')@ to move through or -- delete components of the path one at a time. emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) emacsLikeXPKeymap' p = M.fromList $ map (first $ (,) controlMask) -- control + [ (xK_z, killBefore) --kill line backwards , (xK_k, killAfter) -- kill line fowards , (xK_a, startOfLine) --move to the beginning of the line , (xK_e, endOfLine) -- move to the end of the line , (xK_d, deleteString Next) -- delete a character foward , (xK_b, moveCursor Prev) -- move cursor forward , (xK_f, moveCursor Next) -- move cursor backward , (xK_BackSpace, killWord' p Prev) -- kill the previous word , (xK_y, pasteString) , (xK_g, quit) , (xK_bracketleft, quit) , (xK_t, transposeChars) , (xK_m, acceptSelection) ] ++ map (first $ (,) mod1Mask) -- meta key + [ (xK_BackSpace, killWord' p Prev) -- Retain the pre-0.14 moveWord' behavior: , (xK_f, moveWord' p Next >> moveCursor Next) -- move a word forward , (xK_b, moveCursor Prev >> moveWord' p Prev) -- move a word backward , (xK_d, killWord' p Next) -- kill the next word , (xK_n, moveHistory W.focusUp') , (xK_p, moveHistory W.focusDown') ] ++ map (first $ (,) 0) -- [ (xK_Return, acceptSelection) , (xK_KP_Enter, acceptSelection) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) , (xK_Right, moveCursor Next) , (xK_Home, startOfLine) , (xK_End, endOfLine) , (xK_Down, moveHistory W.focusUp') , (xK_Up, moveHistory W.focusDown') , (xK_Escape, quit) ] -- | Vim-ish key bindings. Click on the \"Source\" link to the right to see the -- complete list. See also 'vimLikeXPKeymap''. vimLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) vimLikeXPKeymap = vimLikeXPKeymap' (setBorderColor "grey22") id id isSpace -- | A variant of 'vimLikeXPKeymap' with customizable aspects: vimLikeXPKeymap' :: (XPColor -> XPColor) -- ^ Modifies the prompt color when entering normal mode. -- The default is @setBorderColor "grey22"@ - same color as -- the default background color. -> (String -> String) -- ^ Prompter to use in normal mode. The default of 'id' -- balances 'defaultPrompter' but @("[n] " ++)@ is a good -- alternate with 'defaultPrompter' as @("[i] " ++)@. -> (String -> String) -- ^ Filter applied to the X Selection before pasting. The -- default is 'id' but @filter isPrint@ is a good -- alternate. -> (Char -> Bool) -- ^ Predicate identifying non-word characters. The default -- is 'isSpace'. See the documentation of other keymaps for -- alternates. -> M.Map (KeyMask,KeySym) (XP ()) vimLikeXPKeymap' fromColor promptF pasteFilter notWord = M.fromList $ map (first $ (,) controlMask) -- control + [ (xK_m, acceptSelection) ] ++ map (first $ (,) 0) [ (xK_Return, acceptSelection) , (xK_KP_Enter, acceptSelection) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) , (xK_Right, moveCursor Next) , (xK_Home, startOfLine) , (xK_End, endOfLine) , (xK_Down, moveHistory W.focusUp') , (xK_Up, moveHistory W.focusDown') , (xK_Escape, moveCursor Prev >> modifyColor fromColor >> setPrompter promptF >> promptSubmap (return ()) normalVimXPKeymap >> resetColor >> resetPrompter ) ] where normalVimXPKeymap = M.fromList $ map (first $ (,) 0) [ (xK_i, setModeDone True) , (xK_a, moveCursor Next >> setModeDone True) , (xK_s, deleteString Next >> setModeDone True) , (xK_x, deleteString Next >> clipCursor) , (xK_Delete, deleteString Next >> clipCursor) , (xK_p, moveCursor Next >> pasteString' pasteFilter >> moveCursor Prev ) , (xK_0, startOfLine) , (xK_Escape, quit) , (xK_Down, moveHistory W.focusUp') , (xK_j, moveHistory W.focusUp') , (xK_Up, moveHistory W.focusDown') , (xK_k, moveHistory W.focusDown') , (xK_Right, moveCursorClip Next) , (xK_l, moveCursorClip Next) , (xK_h, moveCursorClip Prev) , (xK_Left, moveCursorClip Prev) , (xK_BackSpace, moveCursorClip Prev) -- Implementation using the original 'moveWord'': --, (xK_e, moveCursor Next >> moveWord' notWord Next >> moveCursor Prev) --, (xK_b, moveWord' notWord Prev) --, (xK_w, moveWord' (not . notWord) Next >> clipCursor) , (xK_e, moveCursorClip Next >> moveWord' notWord Next) , (xK_b, moveCursorClip Prev >> moveWord' notWord Prev) , (xK_w, moveWord' (not . notWord) Next >> moveCursorClip Next) , (xK_f, promptBuffer bufferOne >>= toHeadChar Next) , (xK_d, promptSubmap (setModeDone True) deleteVimXPKeymap) , (xK_c, promptSubmap (setModeDone True) changeVimXPKeymap >> setModeDone True ) , (xK_Return, acceptSelection) , (xK_KP_Enter, acceptSelection) ] ++ map (first $ (,) shiftMask) [ (xK_dollar, endOfLine >> moveCursor Prev) , (xK_D, killAfter >> moveCursor Prev) , (xK_C, killAfter >> setModeDone True) , (xK_P, pasteString' pasteFilter >> moveCursor Prev) , (xK_A, endOfLine >> setModeDone True) , (xK_I, startOfLine >> setModeDone True) , (xK_F, promptBuffer bufferOne >>= toHeadChar Prev) ] deleteVimXPKeymap = M.fromList $ map (bimap (0 ,) (>> setModeDone True)) [ (xK_e, deleteString Next >> killWord' notWord Next >> clipCursor) , (xK_w, killWord' (not . notWord) Next >> clipCursor) , (xK_0, killBefore) , (xK_b, killWord' notWord Prev) , (xK_d, setInput "") ] ++ map (bimap (shiftMask ,) (>> setModeDone True)) [ (xK_dollar, killAfter >> moveCursor Prev) ] changeVimXPKeymap = M.fromList $ map (bimap (0 ,) (>> setModeDone True)) [ (xK_e, deleteString Next >> killWord' notWord Next) , (xK_0, killBefore) , (xK_b, killWord' notWord Prev) , (xK_c, setInput "") , (xK_w, changeWord notWord) ] ++ map (bimap (shiftMask, ) (>> setModeDone True)) [ (xK_dollar, killAfter) ] -- Useful for exploring off-by-one issues. --testOffset :: XP () --testOffset = do -- off <- getOffset -- str <- getInput -- setInput $ str ++ "|" ++ (show off) ++ ":" ++ (show $ length str) -- | Set @True@ to save the prompt's entry to history and run it via the -- provided action. setSuccess :: Bool -> XP () setSuccess b = modify $ \s -> s { successful = b } -- | Set @True@ to leave all event loops, no matter how nested. setDone :: Bool -> XP () setDone b = modify $ \s -> s { done = b } -- | Set @True@ to leave the current event loop, i.e. submaps. setModeDone :: Bool -> XP () setModeDone b = modify $ \s -> s { modeDone = b } -- KeyPress and State -- | Accept the current selection and exit. acceptSelection :: StateT XPState IO () acceptSelection = setSuccess True >> setDone True -- | Quit. quit :: XP () quit = flushString >> setSuccess False >> setDone True >> setModeDone True -- | Kill the portion of the command before the cursor killBefore :: XP () killBefore = modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset = 0 } -- | Kill the portion of the command including and after the cursor killAfter :: XP () killAfter = modify $ \s -> setCommand (take (offset s) (command s)) s -- | Kill the next\/previous word, using 'isSpace' as the default -- predicate for non-word characters. See 'killWord''. killWord :: Direction1D -> XP () killWord = killWord' isSpace -- | Kill the next\/previous word, given a predicate to identify -- non-word characters. First delete any consecutive non-word -- characters; then delete consecutive word characters, stopping -- just before the next non-word character. -- -- For example, by default (using 'killWord') a path like -- @foo\/bar\/baz@ would be deleted in its entirety. Instead you can -- use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to -- delete the path one component at a time. killWord' :: (Char -> Bool) -> Direction1D -> XP () killWord' p d = do o <- gets offset c <- gets command let (f,ss) = splitAt o c delNextWord = dropWhile (not . p) . dropWhile p delPrevWord = reverse . delNextWord . reverse (ncom,noff) = case d of Next -> (f ++ delNextWord ss, o) Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! modify $ \s -> setCommand ncom $ s { offset = noff} -- | From Vim's @:help cw@: -- -- * Special case: When the cursor is in a word, "cw" and "cW" do not include -- the white space after a word, they only change up to the end of the word. changeWord :: (Char -> Bool) -> XP () changeWord p = join $ f <$> getInput <*> getOffset <*> pure p where f :: String -> Int -> (Char -> Bool) -> XP () f str off _ | length str <= off || null str = return () f str off p'| p' $ str !! off = killWord' (not . p') Next | otherwise = killWord' p' Next -- | Interchange characters around point, moving forward one character -- if not at the end of the input. transposeChars :: XP () transposeChars = do off <- gets offset cmd <- gets command let (beforeCursor, afterCursor) = splitAt off cmd (ncom, noff) = fromMaybe (cmd, off) (go beforeCursor afterCursor off) modify $ \s -> setCommand ncom $ s{ offset = noff } where go :: [a] -> [a] -> Int -> Maybe ([a], Int) go (reverse -> (b1 : b2 : bs)) [] offset = -- end of line Just (reverse $ b2 : b1 : bs, offset) go (reverse -> (b : bs)) (a : as) offset = -- middle of line Just (reverse (a : bs) ++ b : as, offset + 1) go _ _ _ = Nothing -- | Put the cursor at the end of line endOfLine :: XP () endOfLine = modify $ \s -> s { offset = length (command s)} -- | Put the cursor at the start of line startOfLine :: XP () startOfLine = modify $ \s -> s { offset = 0 } -- | Flush the command string and reset the offset flushString :: XP () flushString = modify $ \s -> setCommand "" $ s { offset = 0} --reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. --If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again resetComplIndex :: XPState -> XPState resetComplIndex st = if alwaysHighlight (config st) then st { complIndex = (0,0) } else st -- | Insert a character at the cursor position insertString :: String -> XP () insertString str = do insertString' str modify resetComplIndex insertString' :: String -> XP () insertString' str = modify $ \s -> let cmd = c (command s) (offset s) st = s { offset = o (offset s)} in setCommand cmd st where o oo = oo + length str c oc oo | oo >= length oc = oc ++ str | otherwise = f ++ str ++ ss where (f,ss) = splitAt oo oc -- | Insert the current X selection string at the cursor position. The X -- selection is not modified. pasteString :: XP () pasteString = pasteString' id -- | A variant of 'pasteString' which allows modifying the X selection before -- pasting. pasteString' :: (String -> String) -> XP () pasteString' f = insertString . f =<< getSelection -- | Remove a character at the cursor position deleteString :: Direction1D -> XP () deleteString d = modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} where o oo = if d == Prev then max 0 (oo - 1) else oo c oc oo | oo >= length oc && d == Prev = take (oo - 1) oc | oo < length oc && d == Prev = take (oo - 1) f ++ ss | oo < length oc && d == Next = f ++ drop 1 ss | otherwise = oc where (f,ss) = splitAt oo oc -- | Ensure the cursor remains over the command by shifting left if necessary. clipCursor :: XP () clipCursor = modify $ \s -> s { offset = o (offset s) (command s)} where o oo c = min (max 0 $ length c - 1) oo -- | Move the cursor one position. moveCursor :: Direction1D -> XP () moveCursor d = modify $ \s -> s { offset = o (offset s) (command s)} where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) -- | Move the cursor one position, but not beyond the command. moveCursorClip :: Direction1D -> XP () moveCursorClip = (>> clipCursor) . moveCursor -- modify $ \s -> s { offset = o (offset s) (command s)} -- where o oo c = if d == Prev then max 0 (oo - 1) else min (max 0 $ length c - 1) (oo + 1) -- | Move the cursor one word, using 'isSpace' as the default -- predicate for non-word characters. See 'moveWord''. moveWord :: Direction1D -> XP () moveWord = moveWord' isSpace -- | Given a direction, move the cursor to just before the next -- (predicate,not-predicate) character transition. This means a (not-word,word) -- transition should be followed by a 'moveCursorClip' action. Always considers -- the character under the current cursor position. This means a -- (word,not-word) transition should be preceded by a 'moveCursorClip' action. -- Calculated as the length of consecutive non-predicate characters starting -- from the cursor position, plus the length of subsequent consecutive -- predicate characters, plus when moving backwards the distance of the cursor -- beyond the input. Reduced by one to avoid jumping off either end of the -- input, when present. -- -- Use these identities to retain the pre-0.14 behavior: -- -- @ -- (oldMoveWord' p Prev) = (moveCursor Prev >> moveWord' p Prev) -- @ -- -- @ -- (oldMoveWord' p Next) = (moveWord' p Next >> moveCursor Next) -- @ moveWord' :: (Char -> Bool) -> Direction1D -> XP () moveWord' p d = do c <- gets command o <- gets offset let (f,ss) = splitOn o c splitOn n xs = (take (n+1) xs, drop n xs) gap = case d of Prev -> max 0 $ (o + 1) - length c Next -> 0 len = max 0 . flip (-) 1 . (gap +) . uncurry (+) . (length *** (length . takeWhile (not . p))) . span p newoff = case d of Prev -> o - len (reverse f) Next -> o + len ss modify $ \s -> s { offset = newoff } -- | Set the prompt's input to an entry further up or further down the history -- stack. Use 'Stack' functions from 'XMonad.StackSet', i.e. 'focusUp'' or -- 'focusDown''. moveHistory :: (W.Stack String -> W.Stack String) -> XP () moveHistory f = do modify $ \s -> let ch = f $ commandHistory s in s { commandHistory = ch , offset = length $ W.focus ch , complIndex = (0,0) } updateWindows updateHighlightedCompl -- | Move the cursor in the given direction to the first instance of the first -- character of the given string, assuming the string is not empty. The -- starting cursor character is not considered, and the cursor is placed over -- the matching character. toHeadChar :: Direction1D -> String -> XP () toHeadChar _ "" = pure () toHeadChar d (c : _) = do cmd <- gets command off <- gets offset let off' = (if d == Prev then negate . fst else snd) . join (***) (maybe 0 (+1) . elemIndex c) . (reverse *** drop 1) $ splitAt off cmd modify $ \st -> st { offset = offset st + off' } updateHighlightedCompl :: XP () updateHighlightedCompl = do st <- get cs <- getCompletions alwaysHighlight' <- gets $ alwaysHighlight . config when alwaysHighlight' $ modify $ \s -> s {highlightedCompl = highlightedItem st cs} ------------------------------------------------------------------------ -- X Stuff -- | The completion windows in its entirety. data ComplWindowDim = ComplWindowDim { cwX :: !Position -- ^ Starting x position , cwY :: !Position -- ^ Starting y position , cwWidth :: !Dimension -- ^ Width of the entire prompt , cwRowHeight :: !Dimension -- ^ Height of a single row , cwCols :: ![Position] -- ^ Starting position of all columns , cwRows :: ![Position] -- ^ Starting positions of all rows } deriving (Eq) -- | Create the prompt window. createPromptWin :: Display -> Window -> XPConfig -> Rectangle -> Dimension -> IO Window createPromptWin dpy rootw XPC{ position, height } scn width = do w <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw (rect_x scn + x) (rect_y scn + y) width height setClassHint dpy w (ClassHint "xmonad-prompt" "xmonad") mapWindow dpy w return w where (x, y) :: (Position, Position) = fi <$> case position of Top -> (0, 0) Bottom -> (0, rect_height scn - height) CenteredAt py w -> ( floor $ fi (rect_width scn) * ((1 - w) / 2) , floor $ py * fi (rect_height scn) - (fi height / 2) ) -- | Update the state of the completion window. updateComplWin :: Maybe Window -> Maybe ComplWindowDim -> XP () updateComplWin win winDim = do cwr <- gets complWin io $ writeIORef cwr win modify' (\s -> s { complWinDim = winDim }) --- | Update all prompt windows. updateWindows :: XP () updateWindows = redrawWindows (void destroyComplWin) =<< getCompletions -- | Draw the main prompt window and, if necessary, redraw the -- completion window. redrawWindows :: XP () -- ^ What to do if the completions are empty -> [String] -- ^ Given completions -> XP () redrawWindows emptyAction compls = do d <- gets dpy drawWin maybe emptyAction redrawComplWin (nonEmpty compls) io $ sync d False where -- | Draw the main prompt window. drawWin :: XP () = do XPS{ color, dpy, win, gcon, winWidth } <- get XPC{ height, promptBorderWidth } <- gets config let scr = defaultScreenOfDisplay dpy ht = height -- height of a single row bw = promptBorderWidth Just bgcolor <- io $ initColor dpy (bgNormal color) Just borderC <- io $ initColor dpy (border color) pm <- io $ createPixmap dpy win winWidth ht (defaultDepthOfScreen scr) io $ fillDrawable dpy pm gcon borderC bgcolor (fi bw) winWidth ht printPrompt pm io $ copyArea dpy pm win gcon 0 0 winWidth ht 0 0 io $ freePixmap dpy pm -- | Redraw the completion window, if necessary. redrawComplWin :: NonEmpty String -> XP () redrawComplWin compl = do XPS{ showComplWin, complWinDim, complWin } <- get nwi <- getComplWinDim compl let recreate = do destroyComplWin w <- createComplWin nwi drawComplWin w compl if showComplWin then io (readIORef complWin) >>= \case Just w -> case complWinDim of Just wi -> if nwi == wi -- complWinDim did not change then drawComplWin w compl -- so update else recreate Nothing -> recreate Nothing -> recreate else destroyComplWin where createComplWin :: ComplWindowDim -> XP Window createComplWin wi@ComplWindowDim{ cwX, cwY, cwWidth, cwRowHeight } = do XPS{ dpy, rootw } <- get let scr = defaultScreenOfDisplay dpy w <- io $ mkUnmanagedWindow dpy scr rootw cwX cwY cwWidth cwRowHeight io $ mapWindow dpy w updateComplWin (Just w) (Just wi) return w -- | Print the main part of the prompt: the prompter, as well as the -- command line (including the current input) and the cursor. printPrompt :: Drawable -> XP () printPrompt drw = do st@XPS{ prompter, color, gcon, config, dpy, fontS, offset } <- get let -- (prompt-specific text before the command, the entered command) (prt, com) = (prompter . show . currentXPMode &&& command) st str = prt ++ com -- break the string in 3 parts: till the cursor, the cursor and the rest (preCursor, cursor, postCursor) = if offset >= length com then (str, " ","") -- add a space: it will be our cursor ;-) else let (a, b) = splitAt offset com in (prt ++ a, take 1 b, drop 1 b) -- vertical and horizontal text alignment (asc, desc) <- io $ textExtentsXMF fontS str -- font ascent and descent let y = fi ((height config - fi (asc + desc)) `div` 2) + asc x = (asc + desc) `div` 2 pcFont <- io $ textWidthXMF dpy fontS preCursor cFont <- io $ textWidthXMF dpy fontS cursor let draw = printStringXMF dpy drw fontS gcon -- print the first part draw (fgNormal color) (bgNormal color) x y preCursor -- reverse the colors and print the "cursor" ;-) draw (bgNormal color) (fgNormal color) (x + fi pcFont) y cursor -- flip back to the original colors and print the rest of the string draw (fgNormal color) (bgNormal color) (x + fi (pcFont + cFont)) y postCursor -- | Get all available completions for the current input. getCompletions :: XP [String] getCompletions = do st@XPS{ config } <- get let cmd = commandToComplete (currentXPMode st) (command st) compl = getCompletionFunction st srt = sorter config io $ (srt cmd <$> compl cmd) `E.catch` \(SomeException _) -> return [] where -- | Get the current completion function depending on the active mode. getCompletionFunction :: XPState -> ComplFunction getCompletionFunction st = case operationMode st of XPSingleMode compl _ -> compl XPMultipleModes modes -> completionFunction $ W.focus modes -- | Destroy the currently drawn completion window, if there is one. destroyComplWin :: XP () destroyComplWin = do XPS{ dpy, complWin } <- get io (readIORef complWin) >>= \case Just w -> do io $ destroyWindow dpy w updateComplWin Nothing Nothing Nothing -> return () -- | Given the completions that we would like to show, calculate the -- required dimensions for the completion windows. getComplWinDim :: NonEmpty String -> XP ComplWindowDim getComplWinDim compl = do XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get let -- Height of a single completion row ht = height cfg bw = promptBorderWidth cfg tws <- mapM (textWidthXMF dpy fs) compl let -- Length of widest completion we will print maxComplLen = (fi ht `div` 2) + maximum tws -- Height of the screen rectangle _without_ the prompt window remHeight = rect_height scr - ht maxColumns = maybe id min (maxComplColumns cfg) columns = max 1 . maxColumns $ winWidth `div` fi maxComplLen columnWidth = winWidth `div` columns (fullRows, lastRow) = length compl `divMod` fi columns allRows = max 1 (fullRows + if lastRow == 0 then 0 else 1) -- Maximum number of rows allowed by the config and the screen dimensions maxRows = maybe id min (maxComplRows cfg) (remHeight `div` ht) -- Actual number of rows to be drawn rows = min maxRows (fi allRows) rowHeight = rows * ht -- Starting x and y position of the completion windows. (x, y) = bimap (rect_x scr +) ((rect_y scr +) . fi) $ case position cfg of Top -> (0, ht - bw) Bottom -> (0, remHeight - rowHeight + bw) CenteredAt py w | py <= 1/2 -> ( floor $ fi (rect_width scr) * ((1 - w) / 2) , floor (py * fi (rect_height scr) + (fi ht / 2)) - bw ) | otherwise -> ( floor $ fi (rect_width scr) * ((1 - w) / 2) , floor (py * fi (rect_height scr) - (fi ht / 2)) - rowHeight + bw ) -- Get font ascent and descent. Coherence condition: we will print -- everything using the same font. (asc, desc) <- io $ textExtentsXMF fs $ NE.head compl let yp = fi $ (ht + fi (asc - desc)) `div` 2 -- y position of the first row yRows = take (fi rows) [yp, yp + fi ht ..] -- y positions of all rows xp = (asc + desc) `div` 2 -- x position of the first column xCols = take (fi columns) [xp, xp + fi columnWidth ..] -- x positions of all columns pure $ ComplWindowDim x y winWidth rowHeight xCols yRows -- | Draw the completion window. drawComplWin :: Window -> NonEmpty String -> XP () drawComplWin w entries = do XPS{ config, color, dpy, gcon } <- get let scr = defaultScreenOfDisplay dpy bw = promptBorderWidth config Just bgcolor <- io $ initColor dpy (bgNormal color) Just borderC <- io $ initColor dpy (border color) cwd@ComplWindowDim{ cwWidth, cwRowHeight } <- getComplWinDim entries p <- io $ createPixmap dpy w cwWidth cwRowHeight (defaultDepthOfScreen scr) io $ fillDrawable dpy p gcon borderC bgcolor (fi bw) cwWidth cwRowHeight printComplEntries dpy p gcon (fgNormal color) (bgNormal color) entries cwd --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy) io $ copyArea dpy p w gcon 0 0 cwWidth cwRowHeight 0 0 io $ freePixmap dpy p -- | Print all of the completion entries. printComplEntries :: Display -> Drawable -> GC -> String -- ^ Default foreground color -> String -- ^ Default background color -> NonEmpty String -- ^ Entries to be printed... -> ComplWindowDim -- ^ ...into a window of this size -> XP () printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do st@XPS{ color, complIndex, config = XPC{ alwaysHighlight } } <- get let printItemAt :: Position -> Position -> String -> XP () printItemAt x y item = printStringXMF dpy drw (fontS st) gc fgCol bgCol x y item where (fgCol, bgCol) | -- default to the first item, the one in (0, 0) alwaysHighlight, complIndex == findComplIndex item = (fgHighlight color, bgHighlight color) | -- compare item with buffer's value completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) = (fgHighlight color, bgHighlight color) | -- if nothing matches, use default colors otherwise = (fc, bc) zipWithM_ (\x -> zipWithM_ (printItemAt x) cwRows) cwCols complMat where -- | Create the completion matrix to be printed. complMat :: [[String]] = chunksOf (length cwRows) (take (length cwCols * length cwRows) (NE.toList entries)) -- | Find the column and row indexes in which a string appears. -- If the string is not in the matrix, the indices default to @(0, 0)@. findComplIndex :: String -> (Int, Int) findComplIndex item = (colIndex, rowIndex) where colIndex = fromMaybe 0 $ findIndex (\cols -> item `elem` cols) complMat rowIndex = fromMaybe 0 $ elemIndex item =<< complMat !? colIndex -- History type History = M.Map String [String] emptyHistory :: History emptyHistory = M.empty getHistoryFile :: FilePath -> FilePath getHistoryFile cachedir = cachedir ++ "/prompt-history" readHistory :: FilePath -> IO History readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory where readHist = do let path = getHistoryFile cachedir xs <- withFile path ReadMode hGetLine readIO xs 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 where mode = ownerReadMode .|. ownerWriteMode -- $xutils -- | Fills a 'Drawable' with a rectangle and a border fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel -> Dimension -> Dimension -> Dimension -> IO () fillDrawable d drw gc borderC bgcolor bw wh ht = do -- we start with the border setForeground d gc borderC fillRectangle d drw gc 0 0 wh ht -- here foreground means the background of the text setForeground d gc bgcolor fillRectangle d drw gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) -- | Creates a window with the attribute override_redirect set to True. -- Windows Managers should not touch this kind of windows. mkUnmanagedWindow :: Display -> Screen -> Window -> Position -> Position -> Dimension -> Dimension -> IO Window mkUnmanagedWindow d s rw x y w h = do let visual = defaultVisualOfScreen s attrmask = cWOverrideRedirect allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 (defaultDepthOfScreen s) inputOutput visual attrmask attributes -- $utils -- | This function takes a list of possible completions and returns a -- completions function to be used with 'mkXPrompt' mkComplFunFromList :: XPConfig -> [String] -> String -> IO [String] mkComplFunFromList _ _ [] = return [] mkComplFunFromList c l s = pure $ filter (searchPredicate c s) l -- | This function takes a list of possible completions and returns a -- completions function to be used with 'mkXPrompt'. If the string is -- null it will return all completions. mkComplFunFromList' :: XPConfig -> [String] -> String -> IO [String] mkComplFunFromList' _ l [] = return l mkComplFunFromList' c l s = pure $ filter (searchPredicate c s) l -- | Given the prompt type, the command line and the completion list, -- return the next completion in the list for the last word of the -- command line. This is the default 'nextCompletion' implementation. getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni) where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of Just i -> if i >= length l - 1 then 0 else i + 1 Nothing -> 0 -- | An alternative 'nextCompletion' implementation: given a command -- and a completion list, get the next completion in the list matching -- the whole command line. getNextCompletion :: String -> [String] -> String getNextCompletion c l = l !! idx where idx = case c `elemIndex` l of Just i -> if i >= length l - 1 then 0 else i + 1 Nothing -> 0 -- | Given a maximum length, splits a list into sublists splitInSubListsAt :: Int -> [a] -> [[a]] splitInSubListsAt = chunksOf {-# DEPRECATED splitInSubListsAt "Use XMonad.Prelude.chunksOf instead." #-} -- | Gets the last word of a string or the whole string if formed by -- only one word getLastWord :: String -> String getLastWord = reverse . fst . breakAtSpace . reverse -- | Skips the last word of the string, if the string is composed by -- more then one word. Otherwise returns the string. skipLastWord :: String -> String skipLastWord = reverse . snd . breakAtSpace . reverse breakAtSpace :: String -> (String, String) breakAtSpace s | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2') | otherwise = (s1, s2) where (s1, s2 ) = break isSpace s (s1',s2') = breakAtSpace $ drop 1 s2 -- | 'historyCompletion' provides a canned completion function much like -- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work -- from the query history stored in the XMonad cache directory. historyCompletion :: X ComplFunction historyCompletion = historyCompletionP (const True) -- | Like 'historyCompletion' but only uses history data from Prompts whose -- name satisfies the given predicate. 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. uniqSort :: Ord a => [a] -> [a] uniqSort = toList . fromList -- | Functions to be used with the 'historyFilter' setting. -- 'deleteAllDuplicates' will remove all duplicate entries. -- 'deleteConsecutive' will only remove duplicate elements -- immediately next to each other. deleteAllDuplicates, deleteConsecutive :: [String] -> [String] deleteAllDuplicates = nub deleteConsecutive = map (NE.head . notEmpty) . group -- The elements of group will always have at least one element. newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String))) -- | Initializes a new HistoryMatches structure to be passed -- to historyUpMatching initMatches :: (Functor m, MonadIO m) => m HistoryMatches initMatches = HistoryMatches <$> liftIO (newIORef ([],Nothing)) historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP () historyNextMatching hm@(HistoryMatches ref) next = do (completed,completions) <- io $ readIORef ref input <- getInput if input `elem` completed then case completions of Just cs -> do let cmd = W.focus cs modify $ setCommand cmd modify $ \s -> s { offset = length cmd } io $ writeIORef ref (cmd:completed,Just $ next cs) Nothing -> return () else do -- the user typed something new, recompute completions io . writeIORef ref . ([input] ,) . filterMatching input =<< gets commandHistory historyNextMatching hm next where filterMatching :: String -> W.Stack String -> Maybe (W.Stack String) filterMatching prefix = W.filter (prefix `isPrefixOf`) . next -- | Retrieve the next history element that starts with -- the current input. Pass it the result of initMatches -- when creating the prompt. Example: -- -- > .. -- > ((modMask,xK_p), shellPrompt . myPrompt =<< initMatches) -- > .. -- > myPrompt ref = def -- > { promptKeymap = M.union [((0,xK_Up), historyUpMatching ref) -- > ,((0,xK_Down), historyDownMatching ref)] -- > (promptKeymap def) -- > , .. } -- historyUpMatching, historyDownMatching :: HistoryMatches -> XP () historyUpMatching hm = historyNextMatching hm W.focusDown' historyDownMatching hm = historyNextMatching hm W.focusUp' xmonad-contrib-0.18.0/XMonad/Prompt/0000755000000000000000000000000007346545000015364 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Prompt/AppLauncher.hs0000644000000000000000000000526607346545000020133 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.AppLauncher -- Description : A prompt for launch applications that receive command line parameters. -- Copyright : (C) 2008 Luis Cabellos -- License : BSD3 -- -- Maintainer : zhen.sydow@gmail.com -- Stability : unstable -- Portability : unportable -- -- A module for launch applicationes that receive parameters in the command -- line. The launcher call a prompt to get the parameters. -- ----------------------------------------------------------------------------- module XMonad.Prompt.AppLauncher ( -- * Usage -- $usage launchApp ,module XMonad.Prompt -- * Use case: launching gimp with file -- $tip -- * Types ,Application, AppPrompt, ) where import XMonad (X(),MonadIO) import XMonad.Core (spawn) import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(searchPredicate)) import XMonad.Prompt.Shell (getShellCompl) {- $usage This module is intended to allow the launch of the same application but changing the parameters using the user response. For example, when you want to open a image in gimp program, you can open gimp and then use the File Menu to open the image or you can use this module to select the image in the command line. We use Prompt to get the user command line. This also allow to autoexpand the names of the files when we are writing the command line. -} {- $tip First, you need to import necessary modules. Prompt is used to get the promp configuration and the AppLauncher module itself. > import XMonad.Prompt > import XMonad.Prompt.AppLauncher as AL Then you can add the bindings to the applications. > ... > , ((modm, xK_g), AL.launchApp def "gimp" ) > , ((modm, xK_g), AL.launchApp def "evince" ) > ... -} -- A customized prompt newtype AppPrompt = AppPrompt String instance XPrompt AppPrompt where showXPrompt (AppPrompt n) = n ++ " " type Application = String type Parameters = String {- | Given an application and its parameters, launch the application. -} launch :: MonadIO m => Application -> Parameters -> m () launch app params = spawn ( app ++ " " ++ params ) {- | Get the user's response to a prompt an launch an application using the input as command parameters of the application.-} launchApp :: XPConfig -> Application -> X () launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl [] $ searchPredicate config) $ launch app xmonad-contrib-0.18.0/XMonad/Prompt/AppendFile.hs0000644000000000000000000000702507346545000017733 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- 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! -- ----------------------------------------------------------------------------- module XMonad.Prompt.AppendFile ( -- * Usage -- $usage appendFilePrompt, appendFilePrompt', AppendFile, ) where import XMonad.Core import XMonad.Prompt import XMonad.Prelude (mkAbsolutePath) import System.IO -- $usage -- -- You can use this module by importing it, along with -- "XMonad.Prompt", into your @xmonad.hs@ file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.AppendFile -- -- and adding an appropriate keybinding, for example: -- -- > , ((modm .|. controlMask, xK_n), appendFilePrompt def "/home/me/NOTES") -- -- Additional notes can be added via regular Haskell or XMonad functions; for -- example, to preface notes with the time they were made, one could write a -- binding like -- -- > , ((modm .|. controlMask, xK_n), do -- > spawn ("date>>"++"/home/me/NOTES") -- > appendFilePrompt def "/home/me/NOTES" -- > ) -- -- (Put the spawn on the line after the prompt to append the time instead.) -- -- 'appendFilePrompt'' can be used to transform the string input in the prompt -- before saving into the file. Previous example with date can be rewritten as: -- -- > , ((modm .|. controlMask, xK_n), do -- > date <- io $ fmap (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime -- > appendFilePrompt' def (date ++) $ "/home/me/NOTES" -- > ) -- -- A benefit is that if the prompt is cancelled the date is not output to -- the file too. -- -- For detailed instructions on editing your key bindings, see -- . newtype AppendFile = AppendFile FilePath instance XPrompt AppendFile where showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": " -- | 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 = appendFilePrompt' c id -- | Given an XPrompt configuration, string transformation function -- and a file path, prompt the user for a line of text, transform it -- and append the result to the given file. appendFilePrompt' :: XPConfig -> (String -> String) -> FilePath -> X () appendFilePrompt' c trans fn = mkXPrompt (AppendFile fn) c (const (return [])) (doAppend trans fn) -- | Append a string to a file. doAppend :: (String -> String) -> FilePath -> String -> X () doAppend trans fn s = mkAbsolutePath fn >>= \f -> (io . withFile f AppendMode . flip hPutStrLn . trans) s xmonad-contrib-0.18.0/XMonad/Prompt/ConfirmPrompt.hs0000644000000000000000000000376407346545000020531 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.ConfirmPrompt -- Description : A prompt for setting up simple confirmation prompts for keybindings. -- Copyright : (C) 2015 Antoine Beaupré -- License : BSD3 -- -- Maintainer : Antoine Beaupré -- Stability : unstable -- Portability : unportable -- -- A module for setting up simple confirmation prompts for keybindings. -- ----------------------------------------------------------------------------- module XMonad.Prompt.ConfirmPrompt (confirmPrompt -- * Usage -- $usage , module XMonad.Prompt -- * Use case: confirming exit -- $tip , EnterPrompt ) where import XMonad (X) import XMonad.Prompt (XPConfig, XPrompt, showXPrompt, mkXPrompt, mkComplFunFromList) {- $usage This module makes it easy to add a confirmation prompt for specific actions. Instead of just running the action, a simple confirmation prompt will be created using 'XMonad.Prompt' primitives. The action will then run normally if the user confirms. -} {- $tip This should be used something like this: > ... > , ((modm , xK_l), confirmPrompt def "exit" $ io (exitWith ExitSuccess)) > ... -} {- | Customized 'XPrompt' prompt that will ask to confirm the given string -} newtype EnterPrompt = EnterPrompt String instance XPrompt EnterPrompt where showXPrompt (EnterPrompt n) = "Confirm " ++ n ++ " (esc/ENTER)" {- | Prompt the user to confirm a given action. We offer no completion 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 config []) $ const func xmonad-contrib-0.18.0/XMonad/Prompt/DirExec.hs0000644000000000000000000000740107346545000017245 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.DirExec -- Description : A directory file executables prompt for XMonad. -- Copyright : (C) 2008 Juraj Hercek -- License : BSD3 -- -- Maintainer : juhe_xmonad@hck.sk -- Stability : unstable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Prompt.DirExec ( -- * Usage -- $usage dirExecPrompt , dirExecPromptNamed , DirExec ) where import Control.Exception as E import System.Directory import XMonad import XMonad.Prelude import XMonad.Prompt econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt.DirExec -- -- 2. In your keybindings add something like: -- -- > , ("M-C-x", dirExecPrompt def spawn "/home/joe/.scipts") -- -- or -- -- > , ("M-C-x", dirExecPromptNamed def spawn -- > "/home/joe/.scripts" "My Scripts: ") -- -- or add this after your default bindings: -- -- > ++ -- > [ ("M-x " ++ key, dirExecPrompt def fn "/home/joe/.scripts") -- > | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ] -- > ] -- > ++ -- -- The first alternative uses the last element of the directory path for -- a name of prompt. The second alternative uses the provided string -- for the name of the prompt. The third alternative defines 2 key bindings, -- first one spawns the program by shell, second one runs the program in -- terminal -- -- For detailed instruction on editing the key binding see -- . newtype DirExec = DirExec String instance XPrompt DirExec where showXPrompt (DirExec name) = name -- | Function 'dirExecPrompt' starts the prompt with list of all executable -- files in directory specified by 'FilePath'. The name of the prompt is taken -- from the last element of the path. If you specify root directory - @\/@ - as -- the path, name @Root:@ will be used as the name of the prompt instead. The -- 'XPConfig' parameter can be used to customize visuals of the prompt. -- The runner parameter specifies the function used to run the program - see -- usage for more information dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X () dirExecPrompt cfg runner path = do let name = (++ ": ") . last . (["Root"] ++) -- handling of "/" path parameter . words . map (\x -> if x == '/' then ' ' else x) $ path dirExecPromptNamed cfg runner path name -- | Function 'dirExecPromptNamed' does the same as 'dirExecPrompt' except -- the name of the prompt is specified by 'String' parameter. dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X () dirExecPromptNamed cfg runner path name = do let path' = path ++ "/" cmds <- io $ getDirectoryExecutables path' mkXPrompt (DirExec name) cfg (compList cmds) (runner . (path' ++)) where compList cmds s = return . filter (isInfixOf s) $ cmds getDirectoryExecutables :: FilePath -> IO [String] getDirectoryExecutables path = (getDirectoryContents path >>= filterM (\x -> let x' = path ++ x in liftA2 (&&) (doesFileExist x') (fmap executable (getPermissions x')))) `E.catch` econst [] xmonad-contrib-0.18.0/XMonad/Prompt/Directory.hs0000644000000000000000000000443107346545000017666 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Directory -- Description : A directory prompt for XMonad. -- Copyright : (C) 2007 Andrea Rossato, David Roundy -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A directory prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Directory ( -- * Usage -- $usage directoryPrompt, directoryMultipleModes, directoryMultipleModes', Dir ) where import XMonad.Prelude ( sort ) import XMonad import XMonad.Prompt import XMonad.Prompt.Shell ( compgenDirectories ) -- $usage -- For an example usage see "XMonad.Layout.WorkspaceDir" data Dir = Dir String ComplCaseSensitivity (String -> X ()) instance XPrompt Dir where 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 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 = directoryMultipleModes' CaseSensitive -- | 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 notboring ('.':_) = False notboring _ = True xmonad-contrib-0.18.0/XMonad/Prompt/Email.hs0000644000000000000000000000430507346545000016751 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Prompt.Email ( -- * Usage -- $usage emailPrompt ) where import XMonad.Core import XMonad.Util.Run import XMonad.Prelude (void) import XMonad.Prompt import XMonad.Prompt.Input -- $usage -- -- You can use this module by importing it, along with -- "XMonad.Prompt", into your @xmonad.hs@ file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Email -- -- and adding an appropriate keybinding, for example: -- -- > , ((modm .|. controlMask, xK_e), emailPrompt def addresses) -- -- where @addresses@ is a list of email addresses that should -- autocomplete, for example: -- -- > addresses = ["me@me.com", "mr@big.com", "tom.jones@foo.bar"] -- -- You can still send email to any address, but sending to these -- addresses will be faster since you only have to type a few -- characters and then hit \'tab\'. -- -- For detailed instructions on editing your key bindings, see -- . -- | Prompt the user for a recipient, subject, and body, and send an -- email via the GNU \'mail\' utility. The second argument is a list -- of addresses for autocompletion. emailPrompt :: XPConfig -> [String] -> X () emailPrompt c addrs = inputPromptWithCompl c "To" (mkComplFunFromList c addrs) ?+ \to -> inputPrompt c "Subject" ?+ \subj -> inputPrompt c "Body" ?+ \body -> void (runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")) xmonad-contrib-0.18.0/XMonad/Prompt/FuzzyMatch.hs0000644000000000000000000001116507346545000020030 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 -- -- Maintainer : Norbert Zeh -- Stability : unstable -- Portability : unportable -- -- A module for fuzzy completion matching in prompts akin to emacs ido mode. -- -------------------------------------------------------------------------------- module XMonad.Prompt.FuzzyMatch ( -- * Usage -- $usage fuzzyMatch , fuzzySort ) where import XMonad.Prelude import qualified Data.List.NonEmpty as NE -- $usage -- -- This module offers two aspects of fuzzy matching of completions offered by -- XMonad.Prompt. -- -- 'fuzzyMatch' can be used as the searchPredicate in the XPConfig. The effect -- is that any completion that contains the currently typed characters as a -- subsequence is a valid completion; matching is case insensitive. This means -- that the sequence of typed characters can be obtained from the completion by -- deleting an appropriate subset of its characters. Example: "spr" matches -- \"FastSPR\" but also \"SuccinctParallelTrees\" because it's a subsequence of -- the latter: "S.......P.r..........". -- -- While this type of inclusiveness is helpful most of the time, it sometimes -- also produces surprising matches. 'fuzzySort' helps sorting matches by -- relevance, using a simple heuristic for measuring relevance. The matches are -- sorted primarily by the length of the substring that contains the query -- characters and secondarily the starting position of the match. So, if the -- search string is "spr" and the matches are \"FastSPR\", \"FasterSPR\", and -- \"SuccinctParallelTrees\", then the order is \"FastSPR\", \"FasterSPR\", -- \"SuccinctParallelTrees\" because both \"FastSPR\" and \"FasterSPR\" contain -- "spr" within a substring of length 3 (\"SPR\") while the shortest substring -- of \"SuccinctParallelTrees\" that matches "spr" is \"SuccinctPar\", which has -- length 11. \"FastSPR\" is ranked before \"FasterSPR\" because its match -- starts at position 5 while the match in \"FasterSPR\" starts at position 7. -- -- To use these functions in an XPrompt, for example, for windowPrompt: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Window ( windowPrompt ) -- > import XMonad.Prompt.FuzzyMatch -- > -- > myXPConfig = def { searchPredicate = fuzzyMatch -- > , sorter = fuzzySort -- > } -- -- then add this to your keys definition: -- -- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows) -- -- For detailed instructions on editing the key bindings, see -- . -- | Returns True if the first argument is a subsequence of the second argument, -- that is, it can be obtained from the second sequence by deleting elements. fuzzyMatch :: String -> String -> Bool fuzzyMatch a b = isSubsequenceOf (map toLower a) (map toLower b) -- | Sort the given set of strings by how well they match. Match quality is -- measured first by the length of the substring containing the match and second -- by the positions of the matching characters in the string. fuzzySort :: String -> [String] -> [String] fuzzySort q = map snd . sort . map (rankMatch q) rankMatch :: String -> String -> ((Int, Int), String) rankMatch q s = (if null matches then (maxBound, maxBound) else minimum matches, s) where matches = rankMatches q s rankMatches :: String -> String -> [(Int, Int)] rankMatches [] _ = [(0, 0)] rankMatches (q:qs) s = map (\(l, r) -> (r - l, l)) $ findShortestMatches (q :| qs) s findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)] findShortestMatches q s = foldl' extendMatches spans oss where (os :| oss) = NE.map (findOccurrences s) q spans = [(o, o) | o <- os] findOccurrences :: String -> Char -> [Int] findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..] extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches spans = map last . groupBy ((==) `on` snd) . extendMatches' spans extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' [] _ = [] extendMatches' _ [] = [] extendMatches' spans@((l, r):spans') xs@(x:xs') | r < x = (l, x) : extendMatches' spans' xs | otherwise = extendMatches' spans xs' xmonad-contrib-0.18.0/XMonad/Prompt/Input.hs0000644000000000000000000001112107346545000017013 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- A generic framework for prompting the user for input and passing it -- along to some other action. -- ----------------------------------------------------------------------------- module XMonad.Prompt.Input ( -- * Usage -- $usage inputPrompt, inputPromptWithCompl, (?+), InputPrompt, ) where import XMonad.Core import XMonad.Prompt -- $usage -- -- To use this module, import it along with "XMonad.Prompt": -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Input -- -- This module provides no useful functionality in isolation, but -- is intended for use in building other actions which require user -- input. -- -- For example, suppose Mr. Big wants a way to easily fire his -- employees. We'll assume that he already has a function -- -- > fireEmployee :: String -> X () -- -- which takes as input the name of an employee, and fires them. He -- just wants a convenient way to provide the input for this function -- from within xmonad. Here is where the "XMonad.Prompt.Input" module -- comes into play. He can use the 'inputPrompt' function to create a -- prompt, and the '?+' operator to compose the prompt with the -- @fireEmployee@ action, like so: -- -- > firingPrompt :: X () -- > 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 def "Fire" -- > (mkComplFunFromList def employees) ?+ fireEmployee -- -- Now all he has to do is add a keybinding to @firingPrompt@ (or -- @firingPrompt'@), such as -- -- > , ((modm .|. controlMask, xK_f), firingPrompt) -- -- Now when Mr. Big hits mod-ctrl-f, a prompt will pop up saying -- \"Fire: \", waiting for him to type the name of someone to fire. -- If he thinks better of it after hitting mod-ctrl-f and cancels the -- prompt (e.g. by hitting Esc), the @fireEmployee@ action will not be -- invoked. -- -- (For detailed instructions on editing your key bindings, see -- .) -- -- "XMonad.Prompt.Input" is also intended to ease the process of -- developing other modules which require user input. For an example -- of a module developed using this functionality, see -- "XMonad.Prompt.Email", which prompts the user for a recipient, -- subject, and one-line body, and sends a quick email. newtype InputPrompt = InputPrompt String instance XPrompt InputPrompt where showXPrompt (InputPrompt s) = s ++ ": " -- | Given a prompt configuration and some prompt text, create an X -- action which pops up a prompt waiting for user input, and returns -- whatever they type. Note that the type of the action is @X -- (Maybe String)@, which reflects the fact that the user might -- cancel the prompt (resulting in @Nothing@), or enter an input -- string @s@ (resulting in @Just s@). inputPrompt :: XPConfig -> String -> X (Maybe String) inputPrompt c p = inputPromptWithCompl c p (const (return [])) -- | The same as 'inputPrompt', but with a completion function. The -- type @ComplFunction@ is @String -> IO [String]@, as defined in -- "XMonad.Prompt". The 'mkComplFunFromList' utility function, also -- defined in "XMonad.Prompt", is useful for creating such a -- function from a known list of possibilities. inputPromptWithCompl :: XPConfig -> String -> ComplFunction -> X (Maybe String) inputPromptWithCompl c p compl = mkXPromptWithReturn (InputPrompt p) c compl return infixr 1 ?+ -- | A combinator for hooking up an input prompt action to a function -- which can take the result of the input prompt and produce another -- action. If the user cancels the input prompt, the -- second function will not be run. -- -- The astute student of types will note that this is actually a -- very general combinator and has nothing in particular to do -- with input prompts. If you find a more general use for it and -- want to move it to a different module, be my guest. (?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m () x ?+ k = x >>= maybe (return ()) k xmonad-contrib-0.18.0/XMonad/Prompt/Layout.hs0000644000000000000000000000345507346545000017204 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Layout -- Description : A layout-selection prompt. -- Copyright : (C) 2007 Andrea Rossato, David Roundy -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A layout-selection prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Layout ( -- * Usage -- $usage layoutPrompt ) where import XMonad.Prelude ( sort, nub ) import XMonad hiding ( workspaces ) import XMonad.Prompt import XMonad.Prompt.Workspace ( Wor(..) ) import XMonad.StackSet ( workspaces, layout ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Layout -- -- > , ((modm .|. shiftMask, xK_m ), layoutPrompt def) -- -- For detailed instruction on editing the key binding see -- . -- -- WARNING: This prompt won't display all possible layouts, because the -- code to enable this was rejected from xmonad core. It only displays -- layouts that are actually in use. Also, you can only select layouts if -- you are using NewSelect, rather than the Select defined in xmonad core -- (which doesn't have this feature). So all in all, this module is really -- more a proof-of-principle than something you can actually use -- productively. layoutPrompt :: XPConfig -> X () layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset) mkXPrompt (Wor "") c (mkComplFunFromList' c $ sort $ nub ls) (sendMessage . JumpToLayout) xmonad-contrib-0.18.0/XMonad/Prompt/Man.hs0000644000000000000000000000617007346545000016437 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Man -- Description : A manual page prompt. -- Copyright : (c) 2007 Valery V. Vorotyntsev -- License : BSD3-style (see LICENSE) -- -- Maintainer : Valery V. Vorotyntsev -- Portability : non-portable (uses "manpath" and "bash") -- -- A manual page prompt for XMonad window manager. -- -- TODO -- -- * narrow completions by section number, if the one is specified -- (like @\/etc\/bash_completion@ does) ----------------------------------------------------------------------------- module XMonad.Prompt.Man ( -- * Usage -- $usage manPrompt , getCommandOutput , Man ) where import XMonad import XMonad.Prelude import XMonad.Prompt import XMonad.Util.Run import XMonad.Prompt.Shell (split) import System.Directory import System.FilePath (dropExtensions, ()) import System.IO import System.Process import qualified Control.Exception as E -- $usage -- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Man -- -- 2. In your keybindings add something like: -- -- > , ((modm, xK_F1), manPrompt def) -- -- For detailed instruction on editing the key binding see -- . data Man = Man instance XPrompt Man where showXPrompt Man = "Manual page: " -- | Query for manual page to be displayed. manPrompt :: XPConfig -> X () manPrompt c = do mans <- io getMans mkXPrompt Man c (manCompl c mans) $ runInTerm "" . (++) "man " getMans :: IO [String] getMans = do paths <- do let getout cmd = getCommandOutput cmd `E.catch` \E.SomeException{} -> return "" -- one of these combinations should give some output p1 <- getout "manpath -g 2>/dev/null" p2 <- getout "manpath 2>/dev/null" return $ intercalate ":" $ lines $ p1 ++ p2 let sects = ["man" ++ show n | n <- [1..9 :: Int]] dirs = [d s | d <- split ':' paths, s <- sects] mans <- forM (nub dirs) $ \d -> do exists <- doesDirectoryExist d if exists then map dropExtensions <$> getDirectoryContents d else return [] return $ uniqSort $ concat mans 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 <$> getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'") mkComplFunFromList c (f ++ mans) s -- | Run a command using shell and return its output. -- -- XXX Merge into "XMonad.Util.Run"? -- -- (Ask \"gurus\" whether @evaluate (length ...)@ approach is -- better\/more idiomatic.) getCommandOutput :: String -> IO String getCommandOutput s = do -- we can ignore the process handle because we ignor SIGCHLD (pin, pout, perr, _) <- runInteractiveCommand s hClose pin output <- hGetContents pout E.evaluate (length output) hClose perr return output xmonad-contrib-0.18.0/XMonad/Prompt/OrgMode.hs0000644000000000000000000005500607346545000017262 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.OrgMode -- Description : A prompt for interacting with org-mode. -- Copyright : (c) 2021 Tony Zorman -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tony Zorman -- Stability : experimental -- Portability : unknown -- -- A prompt for interacting with . -- This can be seen as an org-specific version of -- "XMonad.Prompt.AppendFile", allowing for more interesting -- interactions with that particular file type. -- -- It can be used to quickly save TODOs, NOTEs, and the like with the -- additional capability to schedule/deadline a task, add a priority, -- refile to some existing heading, and use the system's clipboard -- (really: the primary selection) as the contents of the note. -- -- A blog post highlighting some features of this module can be found -- . -- -------------------------------------------------------------------- module XMonad.Prompt.OrgMode ( -- * Usage -- $usage -- * Prompts orgPrompt, -- :: XPConfig -> String -> FilePath -> X () orgPromptRefile, -- :: XPConfig -> [String] -> String -> FilePath -> X () orgPromptRefileTo, -- :: XPConfig -> String -> String -> FilePath -> X () orgPromptPrimary, -- :: XPConfig -> String -> FilePath -> X () -- * Types ClipboardSupport (..), OrgMode, -- abstract #ifdef TESTING pInput, Note (..), Priority (..), Date (..), Time (..), TimeOfDay (..), DayOfWeek (..), #endif ) where import XMonad.Prelude import XMonad (X, io, whenJust) import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPromptWithReturn, mkComplFunFromList, ComplFunction) import XMonad.Util.Parser import XMonad.Util.XSelection (getSelection) import XMonad.Util.Run import Control.DeepSeq (deepseq) import qualified Data.List.NonEmpty as NE (head) import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian) #if MIN_VERSION_time(1, 9, 0) import Data.Time.Format.ISO8601 (iso8601Show) #else import Data.Time.Format (defaultTimeLocale, formatTime, iso8601DateFormat) #endif import GHC.Natural (Natural) import System.IO (IOMode (AppendMode, ReadMode), hClose, hGetContents, openFile, withFile) {- $usage You can use this module by importing it, along with "XMonad.Prompt", in your @xmonad.hs@ > import XMonad.Prompt > import XMonad.Prompt.OrgMode (orgPrompt) and adding an appropriate keybinding. For example, using syntax from "XMonad.Util.EZConfig": > , ("M-C-o", orgPrompt def "TODO" "/home/me/org/todos.org") This would create notes of the form @* TODO /my-message/@ in the specified file. You can also enter a relative path; in that case the file path will be prepended with @$HOME@ or an equivalent directory. I.e. instead of the above you can write > , ("M-C-o", orgPrompt def "TODO" "org/todos.org") > -- also possible: "~/org/todos.org" There is also some scheduling and deadline functionality present. This may be initiated by entering @+s@ or @+d@—separated by at least one whitespace character on either side—into the prompt, respectively. Then, one may enter a date and (optionally) a time of day. Any of the following are valid dates, where brackets indicate optionality: - tod[ay] - tom[orrow] - /any weekday/ - /any date of the form DD [MM] [YYYY]/ In the last case, the missing month and year will be filled out with the current month and year. For weekdays, we also disambiguate as early as possible; a simple @w@ will suffice to mean Wednesday, but @s@ will not be enough to say Sunday. You can, however, also write the full word without any troubles. Weekdays always schedule into the future; e.g., if today is Monday and you schedule something for Monday, you will actually schedule it for the /next/ Monday (the one in seven days). The time is specified in the @HH:MM@ or @HHMM@ format. The minutes may be omitted, in which case we assume a full hour is specified. 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 is basic support for alphabetic org-mode . Simply append either @#A@, @#B@, or @#C@ (capitalisation is optional) to the end of the note. For example, one could write @"hello +s 11 jan 2013 #A"@ or @"hello #C"@. Note that there has to be at least one whitespace character between the end of the note and the chosen priority. There's also the possibility to take what's currently in the primary selection and paste that as the content of the created note. This is especially useful when you want to quickly save a URL for later and return to whatever you were doing before. See the 'orgPromptPrimary' prompt for that. Finally, 'orgPromptRefile' and 'orgPromptRefileTo' provide support to automatically the generated item under a heading of choice. For example, binding > orgPromptRefile def "TODO" "todos.org" to a key will first pop up an ordinary prompt that works exactly like 'orgPrompt', and then query the user for an already existing heading (with completions) as provided by the @~/todos.org@ file. If that prompt is cancelled, the heading will appear in the org file as normal (i.e., at the end of the file); otherwise, it gets refiled under the selected heading. -} {- TODO - XMonad.Util.XSelection.getSelection is really, really horrible. The plan would be to rewrite this in a way so it uses xmonad's connection to the X server. - Add option to explicitly use the system clipboard instead of the primary selection. -} ------------------------------------------------------------------------ -- Prompt data OrgMode = OrgMode { clpSupport :: ClipboardSupport , todoHeader :: String -- ^ Will display like @* todoHeader @ , orgFile :: FilePath } mkOrgCfg :: ClipboardSupport -> String -> FilePath -> X OrgMode mkOrgCfg clp header fp = OrgMode clp header <$> mkAbsolutePath fp -- | Whether we should use a clipboard and which one to use. data ClipboardSupport = PrimarySelection | NoClpSupport -- | How one should display the clipboard string. data Clp = Header String -- ^ In the header as a link: @* [[clp][message]]@ | Body String -- ^ In the body as additional text: @* message \n clp@ instance XPrompt OrgMode where showXPrompt :: OrgMode -> String showXPrompt OrgMode{ todoHeader, orgFile, clpSupport } = mconcat ["Add ", todoHeader, clp, " to ", orgFile, ": "] where clp :: String = case clpSupport of NoClpSupport -> "" PrimarySelection -> " + PS" -- | Prompt for interacting with @org-mode@. orgPrompt :: XPConfig -- ^ Prompt configuration -> String -- ^ What kind of note to create; will be displayed after -- a single @*@ -> FilePath -- ^ Path to @.org@ file, e.g. @home\/me\/todos.org@ -> X () orgPrompt xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg NoClpSupport -- | Like 'orgPrompt', but additionally make use of the primary -- selection. If it is a URL, then use an org-style link -- @[[primary-selection][entered message]]@ as the heading. Otherwise, -- use the primary selection as the content of the note. -- -- The prompt will display a little @+ PS@ in the window -- after the type of note. orgPromptPrimary :: XPConfig -> String -> FilePath -> X () orgPromptPrimary xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg PrimarySelection -- | Internal type in order to generate a nice prompt in -- 'orgPromptRefile' and 'orgPromptRefileTo'. data RefilePrompt = Refile instance XPrompt RefilePrompt where showXPrompt :: RefilePrompt -> String showXPrompt Refile = "Refile note to: " -- | Like 'orgPrompt' (which see for the other arguments), but offer to -- refile the entered note afterwards. -- -- Note that refiling is done by shelling out to Emacs, hence an @emacs@ -- binary must be in @$PATH@. One may customise this by following the -- instructions in "XMonad.Util.Run#g:EDSL"; more specifically, by -- changing the 'XMonad.Util.Run.emacs' field of -- 'XMonad.Util.Run.ProcessConfig'. orgPromptRefile :: XPConfig -> String -> FilePath -> X () orgPromptRefile xpc str fp = do orgCfg <- mkOrgCfg NoClpSupport str fp -- NOTE: Ideally we would just use System.IO.readFile' here -- (especially because it also reads everything strictly), but this is -- only available starting in base 4.15.x. fileContents <- io $ do handle <- openFile (orgFile orgCfg) ReadMode contents <- hGetContents handle contents <$ (contents `deepseq` hClose handle) -- Save the entry as soon as possible. notCancelled <- mkOrgPrompt xpc orgCfg when notCancelled $ -- If the user didn't cancel, try to parse the org file and offer to -- refile the entry if possible. whenJust (runParser pOrgFile fileContents) $ \headings -> mkXPromptWithReturn Refile xpc (completeHeadings headings) pure >>= \case Nothing -> pure () Just parent -> refile parent (orgFile orgCfg) where completeHeadings :: [Heading] -> ComplFunction completeHeadings = mkComplFunFromList xpc . map headingText -- | Like 'orgPromptRefile', but with a fixed heading for refiling; no -- prompt will appear to query for a target. -- -- Heading names may omit tags, but generally need to be prefixed by the -- correct todo keywords; e.g., -- -- > orgPromptRefileTo def "PROJECT Work" "TODO" "~/todos.org" -- -- Will refile the created note @"TODO "@ to the @"PROJECT Work"@ -- heading, even with the actual name is @"PROJECT Work -- :work:other_tags:"@. Just entering @"Work"@ will not work, as Emacs -- doesn't recognise @"PROJECT"@ as an Org keyword by default (i.e. when -- started in batch-mode). orgPromptRefileTo :: XPConfig -> String -- ^ Heading to refile the entry under. -> String -> FilePath -> X () orgPromptRefileTo xpc refileHeading str fp = do orgCfg <- mkOrgCfg NoClpSupport str fp notCancelled <- mkOrgPrompt xpc orgCfg when notCancelled $ refile refileHeading (orgFile orgCfg) -- | Create the actual prompt. Returns 'False' when the input was -- cancelled by the user (by, for example, pressing @Esc@ or @C-g@) and -- 'True' otherwise. mkOrgPrompt :: XPConfig -> OrgMode -> X Bool mkOrgPrompt xpc oc@OrgMode{ todoHeader, orgFile, clpSupport } = isJust <$> mkXPromptWithReturn oc xpc (const (pure [])) appendNote where -- | Parse the user input, create an @org-mode@ note out of that and -- try to append it to the given file. appendNote :: String -> X () appendNote input = io $ do clpStr <- case clpSupport of NoClpSupport -> pure $ Body "" PrimarySelection -> do sel <- getSelection pure $ if any (`isPrefixOf` sel) ["http://", "https://"] then Header sel else Body $ "\n " <> sel withFile orgFile AppendMode . flip hPutStrLn <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput $ input ------------------------------------------------------------------------ -- Refiling -- | Let Emacs do the refiling, as this seems—and I know how this -- sounds—more robust than trying to do it ad-hoc in this module. refile :: String -> FilePath -> X () refile (asString -> parent) (asString -> fp) = proc $ inEmacs >-> asBatch >-> eval (progn [ "find-file" <> fp , "end-of-buffer" , "org-refile nil nil" <> list [ parent , fp , "nil" , saveExcursion ["org-find-exact-headline-in-buffer" <> parent] ] , "save-buffer" ]) ------------------------------------------------------------------------ -- Time -- | A 'Time' is a 'Date' with the possibility of having a specified -- @HH:MM@ time. data Time = Time { date :: Date , tod :: Maybe 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 #if MIN_VERSION_time(1, 9, 0) isoDay :: String = iso8601Show day #else isoDay :: String = formatTime defaultTimeLocale (iso8601DateFormat Nothing) day #endif -- | Pretty print a 'Date' and an optional time to reflect the actual -- date. ppDate :: Time -> IO String ppDate Time{ date, tod } = do curTime <- getCurrentTime let curDay = utctDay curTime (y, m, _) = toGregorian curDay diffToDay d = diffBetween d (dayOfWeek curDay) pure . toOrgFmt tod $ case date of Today -> curDay Tomorrow -> utctDay $ addDays 1 curTime Next wday -> utctDay $ addDays (diffToDay wday) curTime Date (d, mbM, mbY) -> fromGregorian (fromMaybe y mbY) (fromMaybe m mbM) d where -- | Add a specified number of days to a 'UTCTime'. addDays :: NominalDiffTime -> UTCTime -> UTCTime = addUTCTime . (* nominalDay) -- | Evil enum hackery. diffBetween :: DayOfWeek -> DayOfWeek -> NominalDiffTime diffBetween d cur -- we want to jump to @d@ | d == cur = 7 | otherwise = fromIntegral . abs $ (fromEnum d - fromEnum cur) `mod` 7 -- Old GHC versions don't have a @time@ library new enough to have -- this, so replicate it here for the moment. dayOfWeek :: Day -> DayOfWeek dayOfWeek (ModifiedJulianDay d) = toEnum $ fromInteger $ d + 3 data DayOfWeek = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday deriving (Eq, Ord, Show) -- | \"Circular\", so for example @[Tuesday ..]@ gives an endless -- sequence. Also: 'fromEnum' gives [1 .. 7] for [Monday .. Sunday], -- and 'toEnum' performs mod 7 to give a cycle of days. instance Enum DayOfWeek where toEnum :: Int -> DayOfWeek toEnum i = case mod i 7 of 0 -> Sunday 1 -> Monday 2 -> Tuesday 3 -> Wednesday 4 -> Thursday 5 -> Friday _ -> Saturday fromEnum :: DayOfWeek -> Int fromEnum = \case Monday -> 1 Tuesday -> 2 Wednesday -> 3 Thursday -> 4 Friday -> 5 Saturday -> 6 Sunday -> 7 ------------------------------------------------------------------------ -- Note -- | An @org-mode@ style note. data Note = Scheduled String Time Priority | Deadline String Time Priority | NormalMsg String Priority deriving (Eq, Show) -- | An @org-mode@ style priority symbol[1]; e.g., something like -- @[#A]@. Note that this uses the standard org conventions: supported -- priorities are @A@, @B@, and @C@, with @A@ being the highest. -- Numerical priorities are not supported. -- -- [1]: https://orgmode.org/manual/Priorities.html data Priority = A | B | C | NoPriority deriving (Eq, Show) -- | Pretty print a given 'Note'. ppNote :: Clp -> String -> Note -> IO String ppNote clp todo = \case Scheduled str time prio -> mkLine str "SCHEDULED: " (Just time) prio Deadline str time prio -> mkLine str "DEADLINE: " (Just time) prio NormalMsg str prio -> mkLine str "" Nothing prio where mkLine :: String -> String -> Maybe Time -> Priority -> IO String mkLine str sched time prio = do t <- case time of Nothing -> pure "" Just ti -> (("\n " <> sched) <>) <$> ppDate ti pure $ "* " <> todo <> priority <> case clp of Body c -> mconcat [str, t, c] Header c -> mconcat ["[[", c, "][", str,"]]", t] where priority = case prio of NoPriority -> " " otherPrio -> " [#" <> show otherPrio <> "] " ------------------------------------------------------------------------ -- Note parsing -- | Parse the given string into a 'Note'. pInput :: String -> Maybe Note pInput inp = (`runParser` inp) . choice $ [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority , Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority , do s <- munch1 (pure True) let (s', p) = splitAt (length s - 3) s pure $ case tryPrio p of Just prio -> NormalMsg (dropStripEnd 0 s') prio Nothing -> NormalMsg s NoPriority ] where tryPrio :: String -> Maybe Priority tryPrio [' ', '#', x] | x `elem` ("Aa" :: String) = Just A | x `elem` ("Bb" :: String) = Just B | x `elem` ("Cc" :: String) = Just C tryPrio _ = Nothing -- Trim whitespace at the end of a string after dropping some number -- of characters from it. dropStripEnd :: Int -> String -> String dropStripEnd n = reverse . dropWhile (== ' ') . drop n . reverse getLast :: String -> Parser String getLast ptn = dropStripEnd (length ptn) -- drop only the last pattern before stripping . concat <$> endBy1 (go "") (pure ptn) where go :: String -> Parser String go consumed = do str <- munch (/= NE.head (notEmpty ptn)) word <- munch1 (/= ' ') bool go pure (word == ptn) $ consumed <> str <> word -- | Parse a 'Priority'. pPriority :: Parser Priority pPriority = option NoPriority $ " " *> skipSpaces *> choice [ "#" *> foldCase "a" $> A , "#" *> foldCase "b" $> B , "#" *> foldCase "c" $> C ] -- | Try to parse a 'Time'. pTimeOfDay :: Parser (Maybe TimeOfDay) pTimeOfDay = option Nothing $ skipSpaces >> Just <$> choice [ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM , pHHMM -- HHMM , TimeOfDay <$> pHour <*> pure 0 -- HH ] where pHHMM :: Parser TimeOfDay pHHMM = do let getTwo = count 2 (satisfy isDigit) hh <- read <$> getTwo guard (hh >= 0 && hh <= 23) mm <- read <$> getTwo guard (mm >= 0 && mm <= 59) pure $ TimeOfDay hh mm pHour :: Parser Int = pNumBetween 0 23 pMinute :: Parser Int = pNumBetween 0 59 -- | Parse a 'Date'. pDate :: Parser Date pDate = skipSpaces *> choice [ pPrefix "tod" "ay" Today , pPrefix "tom" "orrow" Tomorrow , Next <$> pNext , Date <$> pDate' ] where pNext :: Parser DayOfWeek = choice [ pPrefix "m" "onday" Monday , pPrefix "tu" "esday" Tuesday , pPrefix "w" "ednesday" Wednesday, pPrefix "th" "ursday" Thursday , pPrefix "f" "riday" Friday , pPrefix "sa" "turday" Saturday , pPrefix "su" "nday" Sunday ] numWithoutColon :: Parser Int numWithoutColon = do str <- pNumBetween 1 12 -- month c <- get if c == ':' then pfail else pure str pDate' :: Parser (Int, Maybe Int, Maybe Integer) pDate' = (,,) <$> pNumBetween 1 31 -- day <*> optional (skipSpaces *> choice [ pPrefix "ja" "nuary" 1 , pPrefix "f" "ebruary" 2 , pPrefix "mar" "ch" 3 , pPrefix "ap" "ril" 4 , pPrefix "may" "" 5 , pPrefix "jun" "e" 6 , pPrefix "jul" "y" 7 , pPrefix "au" "gust" 8 , pPrefix "s" "eptember" 9 , pPrefix "o" "ctober" 10 , pPrefix "n" "ovember" 11, pPrefix "d" "ecember" 12 , numWithoutColon ]) <*> optional (skipSpaces *> num >>= \i -> guard (i >= 25) $> i) -- Parse a prefix and drop a potential suffix up to the next (space -- separated) word. If successful, return @ret@. pPrefix :: String -> String -> a -> Parser a pPrefix start (map toLower -> leftover) ret = do void (foldCase start) l <- map toLower <$> munch (/= ' ') guard (l `isPrefixOf` leftover) pure ret -- | Parse a number between @lo@ (inclusive) and @hi@ (inclusive). pNumBetween :: Int -> Int -> Parser Int pNumBetween lo hi = do n <- num n <$ guard (n >= lo && n <= hi) -- Parse the given string case insensitively. foldCase :: String -> Parser String foldCase = traverse (\c -> char (toLower c) <|> char (toUpper c)) ------------------------------------------------------------------------ -- File parsing data Heading = Heading { level :: Natural -- ^ Level of the Org heading; i.e., the number of leading stars. , headingText :: String -- ^ The heading text without its level. } -- | Naïvely parse an Org file. At this point, only the headings are -- parsed into a non-nested list (ignoring parent-child relations); no -- further analysis is done on the individual lines themselves. pOrgFile :: Parser [Heading] pOrgFile = many pHeading pHeading :: Parser Heading pHeading = skipSpaces *> do level <- genericLength <$> munch1 (== '*') <* " " headingText <- pLine void $ many (pLine >>= \line -> guard (isNotHeading line) $> line) -- skip body pure Heading{..} pLine :: Parser String pLine = munch (/= '\n') <* "\n" isNotHeading :: String -> Bool isNotHeading str = case break (/= '*') str of ("", _) -> True (_ , ' ' : _) -> False _ -> True xmonad-contrib-0.18.0/XMonad/Prompt/Pass.hs0000644000000000000000000002467707346545000016646 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Pass -- Description : A prompt for interacting with @pass(1)@. -- Copyright : (c) 2014 Igor Babuschkin, Antoine R. Dumont -- License : BSD3-style (see LICENSE) -- -- Maintainer : Antoine R. Dumont -- Stability : unstable -- Portability : unportable -- -- A thin wrapper around the standard @pass(1)@ UNIX utility. -- -- 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 -- -- - various functions to lookup passwords in the password-store: -- -- + 'passPrompt' copies the password directly to the clipboard. -- -- + 'passOTPPrompt' copies a one-time-password to the clipboard -- (this uses ). -- -- + 'passTypePrompt' and 'passOTPTypePrompt' work like the above, -- respectively, but use @xdotool@ to type out the password. -- -- - 'passGeneratePrompt' generates a password for a given password -- label that the user inputs. -- -- - 'passEditPrompt' edits a password for a given password label that -- the user inputs. -- -- - 'passRemovePrompt' deletes a stored password for a given password -- label that the user inputs. -- -- The password store is setup through an environment variable -- @$PASSWORD_STORE_DIR@, or @$HOME\/.password-store@ if it is unset. -- The editor is determined from the environment variable @$EDITOR@. -- -- Source: -- -- - The -- implementation is . -- -- - Inspired by -- ----------------------------------------------------------------------------- module XMonad.Prompt.Pass ( -- * Usage -- $usage -- * Retrieving passwords passPrompt , passPrompt' , passTypePrompt -- * Editing passwords , passEditPrompt , passEditPrompt' , passRemovePrompt , passRemovePrompt' , passGeneratePrompt , passGeneratePrompt' , passGenerateAndCopyPrompt , passGenerateAndCopyPrompt' -- * One-time-passwords , passOTPPrompt , passOTPTypePrompt ) where import System.Directory (getHomeDirectory) import System.FilePath (dropExtension, ()) import System.Posix.Env (getEnv) import XMonad import XMonad.Prelude import XMonad.Prompt ( XPConfig, XPrompt, commandToComplete, getNextCompletion, mkXPrompt, nextCompletion, searchPredicate, showXPrompt, ) import XMonad.Util.Run (runProcessWithInput) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt.Pass -- -- Then add a keybinding for 'passPrompt', 'passGeneratePrompt', -- 'passRemovePrompt', 'passEditPrompt' or 'passTypePrompt': -- -- > , ((modMask , xK_p) , passPrompt def) -- > , ((modMask .|. controlMask, xK_p) , passGeneratePrompt def) -- > , ((modMask .|. shiftMask, xK_p) , passEditPrompt def) -- > , ((modMask .|. controlMask .|. shiftMask, xK_p), passRemovePrompt def) -- -- You can also use the versions that let you specify a custom prompt: -- -- > , ((modMask , xK_p) , passPrompt' "Ask 'pass' for" def) -- -- Note that, by default, we do not use fuzzy matching in this module. -- To enable this feature, import the "XMonad.Prompt.FuzzyMatch" module -- and add the relevant functions to your prompt configuration: -- -- > myXPConfig :: XPConfig -- > myXPConfig = def -- > { searchPredicate = fuzzyMatch -- > , sorter = fuzzySort -- > } -- > -- > , ((modMask , xK_p), passPrompt myXPConfig) -- -- For detailed instructions on: -- -- - editing your key bindings, see . -- -- - how to setup the password store, see -- or @man 1 pass@. -- --------------------------------------------------------------------------------- -- Prompt type PromptLabel = String newtype Pass = Pass PromptLabel instance XPrompt Pass where showXPrompt (Pass prompt) = prompt ++ ": " commandToComplete _ c = c nextCompletion _ = getNextCompletion -- | A prompt to retrieve a password from a given entry. -- passPrompt :: XPConfig -> X () passPrompt = passPrompt' "Select password" -- | The same as 'passPrompt' but with a user-specified prompt. passPrompt' :: String -> XPConfig -> X () passPrompt' s = mkPassPrompt s selectPassword -- | A prompt to retrieve a OTP from a given entry. Note that you will -- need to use the -- extension for this to work. -- passOTPPrompt :: XPConfig -> X () passOTPPrompt = mkPassPrompt "Select OTP" selectOTP -- | A prompt to retrieve a OTP from a given entry. Note that you will -- need to use the -- extension for this to work. -- passOTPTypePrompt :: XPConfig -> X () passOTPTypePrompt = mkPassPrompt "Select OTP" selectOTPType -- | A prompt to generate a password for a given entry. -- This can be used to override an already stored entry. -- (Beware that no confirmation is asked) -- passGeneratePrompt :: XPConfig -> X () passGeneratePrompt = passGeneratePrompt' "Generate password" -- | The same as 'passGeneratePrompt' but with a user-specified prompt. passGeneratePrompt' :: String -> XPConfig -> X () passGeneratePrompt' s = mkPassPrompt s generatePassword -- | A prompt to generate a password for a given entry and immediately copy it -- to the clipboard. This can be used to override an already stored entry. -- (Beware that no confirmation is asked) -- passGenerateAndCopyPrompt :: XPConfig -> X () passGenerateAndCopyPrompt = passGenerateAndCopyPrompt' "Generate and copy password" -- | The same as 'passGenerateAndCopyPrompt' but with a user-specified prompt. passGenerateAndCopyPrompt' :: String -> XPConfig -> X () passGenerateAndCopyPrompt' s = mkPassPrompt s generateAndCopyPassword -- | A prompt to remove a password for a given entry. -- (Beware that no confirmation is asked) -- passRemovePrompt :: XPConfig -> X () passRemovePrompt = passRemovePrompt' "Remove password" -- | The same as 'passRemovePrompt' but with a user-specified prompt. passRemovePrompt' :: String -> XPConfig -> X () passRemovePrompt' s = mkPassPrompt s removePassword -- | A prompt to type in a password for a given entry. -- This doesn't touch the clipboard. -- passTypePrompt :: XPConfig -> X () passTypePrompt = mkPassPrompt "Type password" typePassword -- | A prompt to edit a given entry. -- This doesn't touch the clipboard. -- passEditPrompt :: XPConfig -> X () passEditPrompt = passEditPrompt' "Edit password" -- | The same as 'passEditPrompt' but with a user-specified prompt. passEditPrompt' :: String -> XPConfig -> X () passEditPrompt' s = mkPassPrompt s editPassword -- | A pass prompt factory. -- mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () mkPassPrompt promptLabel passwordFunction xpconfig = do passwords <- io (passwordStoreFolder >>= getPasswords) mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction where getPassCompl :: [String] -> (String -> String -> Bool) -> String -> IO [String] getPassCompl compls p s = return $ filter (p s) compls -- Compute the password store's location. Use the @$PASSWORD_STORE_DIR@ -- environment variable to set the password store. If empty, return the -- password store located in user's home. passwordStoreFolder :: IO String passwordStoreFolder = getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir where -- Default password store folder in @$HOME/.password-store@. computePasswordStoreDir :: Maybe String -> IO String computePasswordStoreDir = \case Nothing -> getHomeDirectory <&> ( ".password-store") Just storeDir -> return storeDir -- Retrieve the list of passwords from the password store @passwordStoreDir@. getPasswords :: FilePath -> IO [String] getPasswords passwordStoreDir = do files <- runProcessWithInput "find" [ "-L", -- Traverse symlinks passwordStoreDir, "-type", "f", "-name", "*.gpg", "-printf", "%P\n"] [] return . map dropExtension $ lines files --------------------------------------------------------------------------------- -- Selecting a password -- | Select a password. -- selectPassword :: String -> X () selectPassword = spawn . pass "--clip" -- | Select a one-time-password and copy it to the clipboard. -- selectOTP :: String -> X () selectOTP = spawn . pass "otp --clip" -- | Select a one-time-password and type it out. -- selectOTPType :: String -> X () selectOTPType = spawn . typeString . pass "otp" -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- generatePassword :: String -> X () generatePassword passLabel = spawn $ pass "generate --force" passLabel ++ " 30" -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- After generating the password, it is copied to the clipboard. -- generateAndCopyPassword :: String -> X () generateAndCopyPassword passLabel = spawn $ pass "generate --force -c" passLabel ++ " 30" -- | Remove a password stored for a given entry. -- removePassword :: String -> X () removePassword = spawn . pass "rm --force" -- | Edit a password stored for a given entry. -- editPassword :: String -> X () editPassword = spawn . pass "edit" -- | Type a password stored for a given entry using xdotool. -- typePassword :: String -> X () typePassword = spawn . typeString . pass "" -- | Type the given string with @xdotool@. -- -- >>> typeString (pass "" "arXiv") -- "pass \"arXiv\" | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -" typeString :: String -> String typeString cmd = cmd ++ " | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -" -- | Generate a pass prompt. -- -- >>> pass "otp" "\\n'git'\"hub\"" -- "pass otp \"\\\\n'git'\\\"hub\\\"\"" pass :: String -> String -> String pass cmd label = concat ["pass ", cmd, " \"", concatMap escape label, "\""] where escape :: Char -> String escape '"' = "\\\"" escape '\\' = "\\\\" escape x = [x] xmonad-contrib-0.18.0/XMonad/Prompt/RunOrRaise.hs0000644000000000000000000000604307346545000017754 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 -- -- Maintainer : mail@justinbogner.com -- Stability : unstable -- Portability : unportable -- -- A prompt for XMonad which will run a program, open a file, -- or raise an already running program, depending on context. -- ----------------------------------------------------------------------------- module XMonad.Prompt.RunOrRaise ( -- * Usage -- $usage runOrRaisePrompt, RunOrRaisePrompt, ) where import XMonad hiding (config) import XMonad.Prelude import XMonad.Prompt import XMonad.Prompt.Shell import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput) import Control.Exception as E import System.Directory (doesDirectoryExist, doesFileExist, executable, findExecutable, getPermissions) econst :: Monad m => a -> IOException -> m a econst = const . return {- $usage 1. In your @xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.RunOrRaise 2. In your keybindings add something like: > , ((modm .|. controlMask, xK_x), runOrRaisePrompt def) For detailed instruction on editing the key binding see . -} data RunOrRaisePrompt = RRP instance XPrompt RunOrRaisePrompt where showXPrompt RRP = "Run or Raise: " runOrRaisePrompt :: XPConfig -> X () runOrRaisePrompt c = do cmds <- io getCommands mkXPrompt RRP c (getShellCompl cmds $ searchPredicate c) open open :: String -> X () open path = io (isNormalFile path) >>= \b -> if b then spawn $ "xdg-open \"" ++ path ++ "\"" else uncurry runOrRaise . getTarget $ path where 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 = liftA2 (==) pid $ pidof x pidof :: String -> Query Int pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0 pid :: Query Int pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w) where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $ fmap getPID' (getWindowProperty32 d a w) getPID' (Just (x:_)) = fromIntegral x getPID' (Just []) = -1 getPID' Nothing = -1 xmonad-contrib-0.18.0/XMonad/Prompt/Shell.hs0000644000000000000000000002073607346545000016777 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NamedFieldPuns #-} {- | Module : XMonad.Prompt.Shell Description : A shell prompt. Copyright : (C) 2007 Andrea Rossato License : BSD3 Maintainer : andrea.rossato@unibz.it Stability : unstable Portability : unportable A shell prompt for XMonad -} module XMonad.Prompt.Shell ( -- * Usage -- $usage Shell (..) , shellPrompt -- ** Variations on shellPrompt -- $spawns , 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 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 econst :: Monad m => a -> IOException -> m a econst = const . return {- $usage 1. In your @xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.Shell 2. In your keybindings add something like: > , ((modm .|. controlMask, xK_x), shellPrompt def) For detailed instruction on editing the key binding see . -} data Shell = Shell type Predicate = String -> String -> Bool instance XPrompt Shell where showXPrompt Shell = "Run: " completionToCommand _ = escape shellPrompt :: XPConfig -> X () shellPrompt c = do cmds <- io getCommands mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) spawn {- $spawns See safe and unsafeSpawn in "XMonad.Util.Run". prompt is an alias for unsafePrompt; safePrompt and unsafePrompt work on the same principles, but will use XPrompt to interactively query the user for input; the appearance is set by passing an XPConfig as the second argument. The first argument is the program to be run with the interactive input. You would use these like this: > , ((modm, xK_b), safePrompt "firefox" greenXPConfig) > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) Note that you want to use safePrompt for Firefox input, as Firefox wants URLs, and unsafePrompt for the XTerm example because this allows you to easily start a terminal executing an arbitrary command, like 'top'. -} prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X () prompt = unsafePrompt safePrompt c config = mkXPrompt Shell config (getShellCompl [c] $ searchPredicate config) run where run = safeSpawn c . return 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 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 = 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` input && not (y `startsWith` input) = LT | y `startsWith` input && not (x `startsWith` input) = GT | otherwise = x `compare` y 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 getCommands :: IO [String] getCommands = do p <- getEnv "PATH" `E.catch` econst [] let ds = filter (/= "") $ split ':' p es <- forM ds $ \d -> getDirectoryContents d `E.catch` econst [] return . uniqSort . filter (not . ("." `isPrefixOf`)) . concat $ es split :: Eq a => a -> [a] -> [[a]] split _ [] = [] split e l = f : split e (drop 1 ls) where (f,ls) = span (/=e) l escape :: String -> String escape [] = "" escape (x:xs) | isSpecialChar x = '\\' : x : escape xs | otherwise = x : escape xs isSpecialChar :: Char -> Bool isSpecialChar = flip elem " &\\@\"'#?$*()[]{};" -- | Ask the shell environment for the value of a variable in XMonad's environment, with a default value. -- In order to /set/ an environment variable (eg. combine with a prompt so you can modify @$HTTP_PROXY@ dynamically), -- you need to use 'System.Posix.putEnv'. env :: String -> String -> IO String env variable fallthrough = getEnv variable `E.catch` econst fallthrough {- | Ask the shell what browser the user likes. If the user hasn't defined any $BROWSER, defaults to returning \"firefox\", since that seems to be the most common X web browser. Note that if you don't specify a GUI browser but a textual one, that'll be a problem as 'getBrowser' will be called by functions expecting to be able to just execute the string or pass it to a shell; so in that case, define $BROWSER as something like \"xterm -e elinks\" or as the name of a shell script doing much the same thing. -} getBrowser :: IO String getBrowser = env "BROWSER" "firefox" -- | Like 'getBrowser', but should be of a text editor. This gets the $EDITOR variable, defaulting to \"emacs\". getEditor :: IO String getEditor = env "EDITOR" "emacs" xmonad-contrib-0.18.0/XMonad/Prompt/Ssh.hs0000644000000000000000000000762107346545000016463 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Ssh -- Description : An ssh prompt. -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A ssh prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Ssh ( -- * Usage -- $usage sshPrompt, Ssh, ) where import XMonad import XMonad.Prelude import XMonad.Util.Run import XMonad.Prompt import System.Directory import System.Environment import Control.Exception as E econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Ssh -- -- 2. In your keybindings add something like: -- -- > , ((modm .|. controlMask, xK_s), sshPrompt def) -- -- Keep in mind, that if you want to use the completion you have to -- disable the \"HashKnownHosts\" option in your ssh_config -- -- For detailed instruction on editing the key binding see -- . data Ssh = Ssh instance XPrompt Ssh where showXPrompt Ssh = "SSH to: " commandToComplete _ c = maybe c snd (parseHost c) nextCompletion _t c l = maybe next (\(u,_h) -> u ++ "@" ++ next) hostPared where hostPared = parseHost c next = getNextCompletion (maybe c snd hostPared) l sshPrompt :: XPConfig -> X () sshPrompt c = do sc <- io sshComplList mkXPrompt Ssh c (mkComplFunFromList c sc) ssh ssh :: String -> X () ssh = runInTerm "" . ("ssh " ++ ) sshComplList :: IO [String] sshComplList = uniqSort <$> liftA2 (++) sshComplListLocal sshComplListGlobal sshComplListLocal :: IO [String] sshComplListLocal = do h <- getEnv "HOME" s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts" s2 <- sshComplListConf $ h ++ "/.ssh/config" return $ s1 ++ s2 sshComplListGlobal :: IO [String] sshComplListGlobal = do env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent" fs <- mapM fileExists [ env , "/usr/local/etc/ssh/ssh_known_hosts" , "/usr/local/etc/ssh_known_hosts" , "/etc/ssh/ssh_known_hosts" , "/etc/ssh_known_hosts" ] case catMaybes fs of [] -> return [] (f:_) -> sshComplListFile' f sshComplListFile :: String -> IO [String] sshComplListFile kh = do f <- doesFileExist kh if f then sshComplListFile' kh else return [] sshComplListFile' :: String -> IO [String] sshComplListFile' kh = do l <- readFile kh return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words) $ filter nonComment $ lines l sshComplListConf :: String -> IO [String] sshComplListConf kh = do f <- doesFileExist kh if f then sshComplListConf' kh else return [] sshComplListConf' :: String -> IO [String] sshComplListConf' kh = do l <- readFile kh return $ map (!!1) $ filter isHost $ map words $ lines l where isHost ws = take 1 ws == ["Host"] && length ws > 1 fileExists :: String -> IO (Maybe String) fileExists kh = do f <- doesFileExist kh if f then return $ Just kh else return Nothing nonComment :: String -> Bool nonComment [] = False nonComment ('#':_) = False nonComment ('|':_) = False -- hashed, undecodeable nonComment _ = True getWithPort :: String -> String getWithPort ('[':str) = host ++ " -p " ++ port where (host,p) = break (==']') str port = case p of ']':':':x -> x _ -> "22" getWithPort str = str parseHost :: String -> Maybe (String, String) parseHost a = elemIndex '@' a >>= (\c-> Just ( take c a, drop (c+1) a ) ) xmonad-contrib-0.18.0/XMonad/Prompt/Theme.hs0000644000000000000000000000327107346545000016765 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Theme -- Description : A prompt for changing the theme of the current workspace. -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A prompt for changing the theme of the current workspace ----------------------------------------------------------------------------- module XMonad.Prompt.Theme ( -- * Usage -- $usage themePrompt, ThemePrompt, ) where import Control.Arrow ( (&&&) ) import qualified Data.Map as M import XMonad.Prelude ( fromMaybe ) import XMonad import XMonad.Prompt import XMonad.Layout.Decoration import XMonad.Util.Themes -- $usage -- You can use this module with the following in your -- @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Theme -- -- in your keybindings add: -- -- > , ((modm .|. controlMask, xK_t), themePrompt def) -- -- For detailed instruction on editing the key binding see -- . data ThemePrompt = ThemePrompt instance XPrompt ThemePrompt where showXPrompt ThemePrompt = "Select a theme: " commandToComplete _ c = c nextCompletion _ = getNextCompletion themePrompt :: XPConfig -> X () 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 mapOfThemes = M.fromList . uncurry zip . (map ppThemeInfo &&& map theme) $ listOfThemes xmonad-contrib-0.18.0/XMonad/Prompt/Unicode.hs0000644000000000000000000001054607346545000017314 0ustar0000000000000000{- | Module : XMonad.Prompt.Unicode Description : A prompt for inputting Unicode characters. Copyright : (c) 2016 Joachim Breitner 2017 Nick Hu License : BSD-style (see LICENSE) Maintainer : Stability : stable A prompt for searching unicode characters by name and inserting them into the clipboard. The provided @unicodePrompt@ and @typeUnicodePrompt@ use @xsel@ and @xdotool@ respectively. -} module XMonad.Prompt.Unicode ( -- * Usage -- $usage unicodePrompt, typeUnicodePrompt, mkUnicodePrompt ) where import Codec.Binary.UTF8.String (decodeString) import qualified Data.ByteString.Char8 as BS import Numeric import System.IO import System.IO.Error import Text.Printf import XMonad import XMonad.Prelude import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run import XMonad.Prompt data Unicode = Unicode instance XPrompt Unicode where showXPrompt Unicode = "Unicode: " commandToComplete Unicode s = s nextCompletion Unicode = getNextCompletion newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, String)] } deriving (Read, Show) instance ExtensionClass UnicodeData where initialValue = UnicodeData [] extensionType = StateExtension {- $usage You can use this module by importing it, along with "XMonad.Prompt", into your @xmonad.hs@ file: > import XMonad.Prompt > import XMonad.Prompt.Unicode and adding an appropriate keybinding, for example: > , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def) A path to a @UnicodeData.txt@ file or equivalent must be provided. This file should be available through your package manager; search for @unicode-data@. If no package is found, one may opt to download this file directly from [unicode.org](http://www.unicode.org/Public/UNIDATA/UnicodeData.txt). More flexibility is given by the @mkUnicodePrompt@ function, which takes a command and a list of arguments to pass as its first two arguments. See @unicodePrompt@ for details. -} populateEntries :: String -> X Bool populateEntries unicodeDataFilename = do entries <- fmap getUnicodeData (XS.get :: X UnicodeData) if null entries then do datE <- liftIO . tryIOError $ BS.readFile unicodeDataFilename case datE of Left e -> liftIO $ do hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\"" hPrint stderr e hPutStrLn stderr "Do you have unicode-data installed?" return False Right dat -> do XS.put . UnicodeData . sortOn (length . snd) $ parseUnicodeData dat return True else return True parseUnicodeData :: BS.ByteString -> [(Char, String)] parseUnicodeData = mapMaybe parseLine . BS.lines where parseLine l = do field1 : field2 : _ <- return $ BS.split ';' l [(c,"")] <- return . readHex $ BS.unpack field1 desc <- return . decodeString $ BS.unpack field2 return (chr c, desc) type Predicate = String -> String -> Bool searchUnicode :: [(Char, String)] -> Predicate -> String -> [(Char, String)] searchUnicode entries p s = filter go entries where w = filter ((> 1) . length) . words $ map toUpper s go (_, d) = all (`p` d) w mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X () mkUnicodePrompt prog args unicodeDataFilename xpCfg = whenX (populateEntries unicodeDataFilename) $ do entries <- fmap getUnicodeData (XS.get :: X UnicodeData) mkXPrompt Unicode (xpCfg {sorter = sorter xpCfg . map toUpper}) (unicodeCompl entries $ searchPredicate xpCfg) paste where unicodeCompl :: [(Char, String)] -> Predicate -> String -> IO [String] unicodeCompl _ _ "" = return [] unicodeCompl entries p s = do let m = searchUnicode entries p s return . map (\(c,d) -> printf "%s %s" [c] d) $ take 20 m paste [] = return () paste (c:_) = 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. unicodePrompt :: String -> XPConfig -> X () unicodePrompt = mkUnicodePrompt "xsel" ["-i"] -- | Prompt the user for a Unicode character to be typed by @xdotool@. typeUnicodePrompt :: String -> XPConfig -> X () typeUnicodePrompt = mkUnicodePrompt "xdotool" ["type", "--clearmodifiers", "--file", "-"] xmonad-contrib-0.18.0/XMonad/Prompt/Window.hs0000644000000000000000000001364107346545000017174 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Window -- Description : A prompt for bringing windows to you, and bring you to windows. -- Copyright : Devin Mullins -- Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- xprompt operations to bring windows to you, and bring you to windows. -- ----------------------------------------------------------------------------- module XMonad.Prompt.Window ( -- * Usage -- $usage WindowPrompt(..), windowPrompt, windowMultiPrompt, allWindows, allApplications, wsWindows, XWindowMap, ) where import XMonad.Prelude (forM) import qualified Data.Map as M import qualified XMonad.StackSet as W import XMonad import XMonad.Prompt import XMonad.Actions.CopyWindow import XMonad.Actions.WindowBringer import XMonad.Util.NamedWindows -- $usage -- WindowPrompt brings windows to you and you to windows. That is to -- say, it pops up a prompt with window names, in case you forgot -- where you left your XChat. It also offers helpers to build the -- subset of windows which is used for the prompt completion. -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Window -- -- and in the keys definition: -- -- > , ((modm .|. shiftMask, xK_g ), windowPrompt def Goto wsWindows) -- > , ((modm .|. shiftMask, xK_b ), windowPrompt def Bring allWindows) -- -- The autoComplete option is a handy complement here: -- -- > , ((modm .|. shiftMask, xK_g ), windowPrompt -- > def { autoComplete = Just 500000 } -- > Goto allWindows) -- -- The \'500000\' is the number of microseconds to pause before sending you to -- your new window. This is useful so that you don't accidentally send some -- keystrokes to the selected client. -- -- For detailed instruction on editing the key binding see -- . -- Describe actions that can applied on the selected window 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 -- | Internal type used for the multiple mode prompt. data WindowModePrompt = WindowModePrompt WindowPrompt (M.Map String Window) (String -> String -> Bool) instance XPrompt WindowModePrompt where showXPrompt (WindowModePrompt action _ _) = showXPrompt action completionFunction (WindowModePrompt _ winmap predicate) s = return . filter (predicate s) . map fst . M.toList $ winmap modeAction (WindowModePrompt action winmap _) buf auto = do let name = if null auto then buf else auto a = case action of Goto -> gotoAction Bring -> bringAction BringCopy -> bringCopyAction BringToMaster -> bringToMaster WithWindow _ f -> withWindow f a name where withWindow f = flip whenJust f . flip M.lookup winmap winAction a = withWindow (windows . a) gotoAction = winAction W.focusWindow bringAction = winAction bringWindow bringCopyAction = winAction bringCopyWindow bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s) -- | A helper to get the map of all windows. allWindows :: XWindowMap allWindows = windowMap -- | A helper to get the map of all applications allApplications :: XWindowMap allApplications = windowAppMap -- | A helper to get the map of windows of the current workspace. wsWindows :: XWindowMap wsWindows = withWindowSet (return . W.index) >>= winmap where winmap = fmap M.fromList . mapM pair pair w = do name <- show <$> getName w return (name, w) -- | A Map where keys are pretty printable window names and values are -- Xmonad windows identifier. type XWindowMap = X (M.Map String Window) -- | Pops open a prompt with window titles belonging to -- winmap. Choose one, and an action is applied on the -- selected window, according to WindowPrompt. windowPrompt :: XPConfig -> WindowPrompt -> XWindowMap -> X () windowPrompt c t winmap = do wm <- winmap let mode = WindowModePrompt t wm (searchPredicate c) action = modeAction mode compList = completionFunction mode mkXPrompt t c compList (\s -> action s s) -- | Like 'windowPrompt', but uses the multiple modes feature of -- @Prompt@ (via 'mkXPromptWithModes'). -- -- Given a list of actions along with the windows they should work -- with, display the appropriate prompt with the ability to switch -- between them using the @changeModeKey@. -- -- For example, to have a prompt that first shows you all windows, but -- allows you to narrow the list down to just the windows on the -- current workspace: -- -- > windowMultiPrompt config [(Goto, allWindows), (Goto, wsWindows)] windowMultiPrompt :: XPConfig -> [(WindowPrompt, XWindowMap)] -> X () windowMultiPrompt c modes = do modes' <- forM modes $ \(t, wm) -> do wm' <- wm return . XPT $ WindowModePrompt t wm' (searchPredicate c) mkXPromptWithModes modes' c -- | Brings a copy of the specified window into the current workspace. bringCopyWindow :: Window -> WindowSet -> WindowSet bringCopyWindow w ws = copyWindow w (W.currentTag ws) ws xmonad-contrib-0.18.0/XMonad/Prompt/Workspace.hs0000644000000000000000000000313107346545000017654 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Workspace -- Description : A workspace prompt. -- Copyright : (C) 2007 Andrea Rossato, David Roundy -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A workspace prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Workspace ( -- * Usage -- $usage workspacePrompt, -- * For developers Wor(Wor), ) where import XMonad hiding ( workspaces ) import XMonad.Prompt import XMonad.StackSet ( workspaces, tag ) import XMonad.Util.WorkspaceCompare ( getSortByIndex ) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Workspace -- -- > , ((modm .|. shiftMask, xK_m ), workspacePrompt def (windows . W.shift)) -- -- For detailed instruction on editing the key binding see -- . newtype Wor = Wor String instance XPrompt Wor where showXPrompt (Wor x) = x workspacePrompt :: XPConfig -> (String -> X ()) -> X () workspacePrompt c job = do ws <- gets (workspaces . windowset) sort <- getSortByIndex let ts = map tag $ sort ws mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job xmonad-contrib-0.18.0/XMonad/Prompt/XMonad.hs0000644000000000000000000000360407346545000017111 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.XMonad -- Description : A prompt for running XMonad commands. -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A prompt for running XMonad commands -- ----------------------------------------------------------------------------- module XMonad.Prompt.XMonad ( -- * Usage -- $usage xmonadPrompt, xmonadPromptC, xmonadPromptCT, XMonad, ) where import XMonad import XMonad.Prompt import XMonad.Actions.Commands (defaultCommands) import XMonad.Prelude (fromMaybe) -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.XMonad -- -- in your keybindings add: -- -- > , ((modm .|. controlMask, xK_x), xmonadPrompt def) -- -- For detailed instruction on editing the key binding see -- . newtype XMonad = XMonad String instance XPrompt XMonad where showXPrompt (XMonad str) = str <> ": " xmonadPrompt :: XPConfig -> X () xmonadPrompt c = do cmds <- defaultCommands xmonadPromptC cmds c -- | An xmonad prompt with a custom command list xmonadPromptC :: [(String, X ())] -> XPConfig -> X () 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-contrib-0.18.0/XMonad/Prompt/Zsh.hs0000644000000000000000000000342507346545000016470 0ustar0000000000000000{- | 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 2. In your @xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.Zsh 3. In your keybindings add something like: > , ((modm .|. controlMask, xK_x), zshPrompt def "/path/to/capture.zsh") For detailed instruction on editing the key binding see . -} 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-contrib-0.18.0/XMonad/Util/0000755000000000000000000000000007346545000015020 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Util/ActionCycle.hs0000644000000000000000000000616307346545000017557 0ustar0000000000000000{-# 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. -- 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-contrib-0.18.0/XMonad/Util/ActionQueue.hs0000644000000000000000000000603407346545000017601 0ustar0000000000000000{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.ActionQueue -- Description : Queue of XMonad actions -- Copyright : (c) 2021 Xiaokui Shu -- License : BSD-style (see LICENSE) -- -- Maintainer : subbyte@gmail.com -- Stability : unstable -- Portability : unportable -- -- Put XMonad actions in the queue to be executed in either the -- @logHook@ or another hook of your choice. ----------------------------------------------------------------------------- module XMonad.Util.ActionQueue ( -- * Usage -- $usage ActionQueue , actionQueue , enqueue , exequeue ) where import XMonad import qualified XMonad.Util.ExtensibleConf as XC import qualified XMonad.Util.ExtensibleState as XS import Data.Sequence (Seq (..), ViewL (..), viewl, (|>)) -- $usage -- -- This module provides a queue that, by default, gets executed every -- time the @logHook@ runs. To use this module -- -- 1. Enqueue `X ()` actions at the place you need; e.g.: -- -- > enqueue myAction -- -- 2. Add the 'actionQueue' combinator to your configuration: -- -- > main = xmonad $ actionQueue $ def -- > { ... } -- -- This will execute all of the actions in the queue (if any) every time -- the @logHook@ runs. Developers of other extensions using this module -- should re-export 'actionQueue'. -- -- Alternatively, you can directly add 'exequeue' to a hook of your choice. -- This is discouraged when writing user-facing modules, as (accidentally) -- adding 'exequeue' to two different hooks might lead to undesirable -- behaviour. 'actionQueue' uses the "XMonad.Util.ExtensibleConf" interface to -- circumvent this. -- newtype ActionQueue = ActionQueue (Seq (X ())) instance ExtensionClass ActionQueue where initialValue = ActionQueue mempty newtype ActionQueueHooked = ActionQueueHooked () deriving newtype (Semigroup) -- | Every time the @logHook@ runs, execute all actions in the queue. actionQueue :: XConfig l -> XConfig l actionQueue = XC.once (\cfg -> cfg{ logHook = logHook cfg <> exequeue }) ActionQueueHooked -- | Enqueue an action. enqueue :: X () -> X () enqueue = XS.modify . go where go :: X () -> ActionQueue -> ActionQueue go a (ActionQueue as) = ActionQueue $ as |> a -- | Execute every action in the queue. exequeue :: X () exequeue = do -- Note that we are executing all actions one by one. Otherwise, we may -- not execute the actions in the right order. Any of them may call -- 'refresh' or 'windows', which triggers the logHook, which may trigger -- 'exequeue' again if it is used in the logHook. ActionQueue aas <- XS.get case viewl aas of EmptyL -> pure () a :< as -> do XS.put (ActionQueue as) a `catchX` pure () exequeue xmonad-contrib-0.18.0/XMonad/Util/ClickableWorkspaces.hs0000644000000000000000000000636207346545000021276 0ustar0000000000000000------------------------------------------------------------------------------- -- | -- Module : XMonad.Util.ClickableWorkspaces -- Description : Make workspace tags clickable in XMobar (for switching focus). -- Copyright : (c) Geoff deRosenroll -- License : BSD3-style (see LICENSE) -- -- Maintainer : Geoff deRosenroll -- 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-contrib-0.18.0/XMonad/Util/Cursor.hs0000644000000000000000000000240307346545000016630 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Cursor -- Description : Set the default mouse cursor. -- Copyright : (c) 2009 Collabora Ltd -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : Andres Salomon -- Stability : unstable -- Portability : unportable -- -- A module for setting the default mouse cursor. -- -- Some ideas shamelessly stolen from Nils Schweinsberg; thanks! ----------------------------------------------------------------------------- module XMonad.Util.Cursor ( -- * Usage: -- $usage module Graphics.X11.Xlib.Cursor, setDefaultCursor ) where import Graphics.X11.Xlib.Cursor import XMonad -- $usage -- -- > setDefaultCursor xC_left_ptr -- -- For example, to override the default gnome cursor: -- -- > import XMonad.Util.Cursor -- > main = xmonad gnomeConfig { startupHook = setDefaultCursor xC_pirate } -- -- Arrr! -- | Set the default (root) cursor setDefaultCursor :: Glyph -> X () setDefaultCursor glyph = do dpy <- asks display rootw <- asks theRoot liftIO $ do curs <- createFontCursor dpy glyph defineCursor dpy rootw curs flush dpy freeCursor dpy curs xmonad-contrib-0.18.0/XMonad/Util/CustomKeys.hs0000644000000000000000000000630507346545000017466 0ustar0000000000000000-------------------------------------------------------------------- -- | -- Module : XMonad.Util.CustomKeys -- Description : Configure key bindings. -- Copyright : (c) 2007 Valery V. Vorotyntsev -- License : BSD3-style (see LICENSE) -- -- Customized key bindings. -- -- See also "XMonad.Util.EZConfig" in xmonad-contrib. -------------------------------------------------------------------- module XMonad.Util.CustomKeys ( -- * Usage -- $usage customKeys , customKeysFrom ) where import XMonad import XMonad.Prelude ((<&>)) import Control.Monad.Reader import qualified Data.Map as M -- $usage -- -- In @xmonad.hs@ add: -- -- > import XMonad.Util.CustomKeys -- -- Set key bindings with 'customKeys': -- -- > main = xmonad def { keys = customKeys delkeys inskeys } -- > where -- > delkeys :: XConfig l -> [(KeyMask, KeySym)] -- > delkeys XConfig {modMask = modm} = -- > [ (modm .|. shiftMask, xK_Return) -- > terminal -- > , (modm .|. shiftMask, xK_c) -- > close the focused window -- > ] -- > ++ -- > [ (modm .|. m, k) | m <- [0, shiftMask], k <- [xK_w, xK_e, xK_r] ] -- > -- > inskeys :: XConfig l -> [((KeyMask, KeySym), X ())] -- > inskeys conf@(XConfig {modMask = modm}) = -- > [ ((mod1Mask, xK_F2 ), spawn $ terminal conf) -- mod1-f2 %! Run a terminal emulator -- > , ((modm, xK_Delete), kill) -- %! Close the focused window -- > , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock") -- > , ((mod1Mask, xK_Down), spawn "amixer set Master 1-") -- > , ((mod1Mask, xK_Up ), spawn "amixer set Master 1+") -- > ] -- | Customize 'XMonad.Config.def' -- delete needless -- shortcuts and insert those you will use. customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) customKeys = customKeysFrom def -- | General variant of 'customKeys': customize key bindings of -- third-party configuration. customKeysFrom :: XConfig l -- ^ original configuration -> (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) customKeysFrom conf = (runReader .) . customize conf customize :: XConfig l -> (XConfig Layout -> [(KeyMask, KeySym)]) -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -> Reader (XConfig Layout) (M.Map (KeyMask, KeySym) (X ())) 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 <&> 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 <&> foldr (uncurry M.insert) kmap xmonad-contrib-0.18.0/XMonad/Util/DebugWindow.hs0000644000000000000000000002121607346545000017574 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.DebugWindow -- Description : Dump window information for diagnostic\/debugging purposes. -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module to dump window information for diagnostic/debugging purposes. See -- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses. -- ----------------------------------------------------------------------------- module XMonad.Util.DebugWindow (debugWindow) where import Prelude import XMonad import XMonad.Prelude import Codec.Binary.UTF8.String (decodeString) import Control.Exception as E import Foreign.C.String import Numeric (showHex) import System.Exit -- | Output a window by ID in hex, decimal, its ICCCM resource name and class, -- its title if available, and EWMH type and state if available. Also -- indicate override_redirect with an exclamation mark, and wrap in brackets -- if it is unmapped or withdrawn. debugWindow :: Window -> X String debugWindow 0 = return "-no window-" debugWindow w = do d <- asks display let wx = pad 8 '0' $ showHex w "" w' <- safeGetWindowAttributes w case w' of Nothing -> return $ "(deleted window " ++ wx ++ ")" Just WindowAttributes { wa_x = x , wa_y = y , wa_width = wid , wa_height = ht , wa_border_width = bw , wa_map_state = m , wa_override_redirect = o } -> do c' <- io (getWindowProperty8 d wM_CLASS w) let c = case c' of Nothing -> "" Just c'' -> intercalate "/" $ flip unfoldr (map (toEnum . fromEnum) c'') $ \s -> if null s then Nothing else let (w'',s'') = break (== '\NUL') s s' = drop 1 s'' in Just (w'',s') t <- catchX' (wrap <$> getEWMHTitle "VISIBLE" w) $ catchX' (wrap <$> getEWMHTitle "" w) $ catchX' (wrap <$> getICCCMTitle w) $ return "" h' <- getMachine w let h = if null h' then "" else '@':h' -- if it has WM_COMMAND use it, else use the appName -- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some -- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them. p' <- safeGetCommand d w let p = if null p' then "" else wrap $ unwords p' nWP <- getAtom "_NET_WM_PID" pid' <- io $ getWindowProperty32 d nWP w let pid = case pid' of Just [pid''] -> '(':show pid'' ++ ")" _ -> "" let cmd = p ++ pid ++ h let (lb,rb) = case () of () | m == waIsViewable -> ("","") | otherwise -> ("[","]") o' = if o then "!" else "" wT <- getAtom "_NET_WM_WINDOW_TYPE" wt' <- io $ getWindowProperty32 d wT w ewmh <- case wt' of Just wt'' -> windowType d w (fmap fi wt'') _ -> return "" return $ concat [lb ,o' ,wx ,t ," " ,show wid ,'x':show ht ,if bw == 0 then "" else '+':show bw ,"@" ,show x ,',':show y ,if null c then "" else ' ':c ,if null cmd then "" else ' ':cmd ,ewmh ,rb ] getEWMHTitle :: String -> Window -> X String getEWMHTitle sub w = do a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME" getDecodedStringProp w a -- should always be UTF8_STRING but rules are made to be broken getICCCMTitle :: Window -> X String getICCCMTitle w = getDecodedStringProp w wM_NAME getDecodedStringProp :: Window -> Atom -> X String getDecodedStringProp w a = do t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a [s] <- catchX' (tryUTF8 t) $ -- shouldn't happen but some apps do it catchX' (tryCompound 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 <$> io (peekCAString s) tryCompound :: TextProperty -> X [String] tryCompound t@(TextProperty _ enc _ _) = do cOMPOUND_TEXT <- getAtom "COMPOUND_TEXT" when (enc /= cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT" withDisplay $ \d -> io $ wcTextPropertyToTextList d t splitNul :: String -> [String] splitNul "" = [] splitNul s = let (s',ss') = break (== '\NUL') s in s' : splitNul ss' pad :: Int -> Char -> String -> String pad w c s = replicate (w - length s) c ++ s -- modified 'catchX' without the print to 'stderr' catchX' :: X a -> X a -> X a catchX' job errcase = do st <- get 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 put s' return a wrap :: String -> String wrap s = ' ' : '"' : wrap' s ++ "\"" where wrap' (s':ss) | s' == '"' = '\\' : s' : wrap' ss | s' == '\\' = '\\' : s' : wrap' ss | otherwise = s' : wrap' ss wrap' "" = "" -- and so is getCommand safeGetCommand :: Display -> Window -> X [String] safeGetCommand d w = do wC <- getAtom "WM_COMMAND" p <- io $ getWindowProperty8 d wC w case p of Nothing -> return [] Just cs' -> do let cs = map (toEnum . fromEnum) cs' go (a,(s,"\NUL")) = (s:a,("","")) go (a,(s,'\NUL':ss)) = go (s:a,go' ss) go r = r -- ??? go' = break (== '\NUL') in return $ reverse $ fst $ go ([],go' cs) getMachine :: Window -> X String getMachine w = catchX' (getAtom "WM_CLIENT_MACHINE" >>= getDecodedStringProp w) (return "") -- if it's one EWMH atom then we strip prefix and lowercase, otherwise we -- return the whole thing. we also get the state here, with similar rules -- (all EWMH = all prefixes removed and lowercased) windowType :: Display -> Window -> [Atom] -> X String windowType d w ts = do tstr <- decodeType ts wS <- getAtom "_NET_WM_STATE" ss' <- io $ getWindowProperty32 d wS w sstr <- case ss' of Just ss -> windowState (fmap fi ss) _ -> return "" return $ " (" ++ tstr ++ sstr ++ ")" where decodeType :: [Atom] -> X String decodeType [] = return "" decodeType [t] = simplify "_NET_WM_WINDOW_TYPE_" t decodeType tys = unAtoms tys " (" False unAtoms :: [Atom] -> String -> Bool -> X String unAtoms [] t i = return $ if i then t else t ++ ")" unAtoms (a:as) t i = do s' <- io $ getAtomName d a let s = case s' of Just s'' -> s'' _ -> '<':show a ++ ">" unAtoms as (t ++ (if i then ' ':s else s)) True simplify :: String -> Atom -> X String simplify pfx a = do s' <- io $ getAtomName d a case s' of Nothing -> return $ '<':show a ++ ">" Just s -> if pfx `isPrefixOf` s then return $ map toLower (drop (length pfx) s) else return s -- note that above it says this checks all of them before simplifying. -- I'll do that after I'm confident this works as intended. windowState :: [Atom] -> X String windowState [] = return "" windowState as' = go as' ";" where go [] t = return t go (a:as) t = simplify "_NET_WM_STATE_" a >>= \t' -> go as (t ++ ' ':t') xmonad-contrib-0.18.0/XMonad/Util/Dmenu.hs0000644000000000000000000000540707346545000016432 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Dmenu -- Description : Convenient bindings to dmenu. -- Copyright : (c) Spencer Janssen -- License : BSD-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- A convenient binding to dmenu. -- -- Requires the process-1.0 package -- ----------------------------------------------------------------------------- module XMonad.Util.Dmenu ( -- * Usage -- $usage dmenu, dmenuXinerama, dmenuMap, menu, menuArgs, menuMap, menuMapArgs ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M import XMonad.Util.Run -- $usage -- You can use this module with the following in your Config.hs file: -- -- > import XMonad.Util.Dmenu -- -- These functions block xmonad's event loop until dmenu exits; this means that -- programs will not be able to open new windows and you will not be able to -- change workspaces or input focus until you have responded to the prompt one -- way or another. -- %import XMonad.Util.Dmenu -- | Starts dmenu on the current screen. Requires this patch to dmenu: -- dmenuXinerama :: [String] -> X String dmenuXinerama opts = do curscreen <- 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 = menu "dmenu" -- | like 'dmenu' but also takes the command to run. menu :: MonadIO m => String -> [String] -> m String 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 = 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 = menuMapArgs menuCmd [] -- | Like 'menuMap' but also takes a list of command line arguments. menuMapArgs :: MonadIO m => String -> [String] -> M.Map String a -> m (Maybe a) menuMapArgs menuCmd args selectionMap = do selection <- menuFunction (M.keys selectionMap) return $ M.lookup selection selectionMap where menuFunction = menuArgs menuCmd args -- | Run dmenu to select an entry from a map based on the key. dmenuMap :: MonadIO m => M.Map String a -> m (Maybe a) dmenuMap = menuMap "dmenu" xmonad-contrib-0.18.0/XMonad/Util/DynamicScratchpads.hs0000644000000000000000000000745007346545000021126 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.DynamicScratchpads -- Description : Dynamically declare any window as a scratchpad. -- Copyright : (c) Robin Oberschweiber -- License : BSD-style (see LICENSE) -- -- Maintainer : Robin Obercshweiber -- Stability : unstable -- Portability : unportable -- -- Dynamically declare any window as a scratchpad. -- ----------------------------------------------------------------------------- module XMonad.Util.DynamicScratchpads {-# DEPRECATED "Use the dynamic scratchpad facility of XMonad.Util.NamedScratchpad instead." #-} ( -- * Usage -- $usage makeDynamicSP, spawnDynamicSP ) where import Graphics.X11.Types import XMonad.Core import XMonad.Operations import qualified Data.Map as M import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -- $usage -- Allows you to dynamically declare windows as scratchpads. You can bind a key -- to make a window start/stop being a scratchpad, and another key to -- spawn/hide that scratchpad. -- -- Like with XMonad.Util.NamedScratchpad, you have to have a workspace called -- NSP, where hidden scratchpads will be moved to. -- -- You can declare dynamic scratchpads in your xmonad.hs like so: -- -- import XMonad.Util.DynamicScratchpads -- -- , ((modm .|. shiftMask, xK_a), withFocused $ makeDynamicSP "dyn1") -- , ((modm .|. shiftMask, xK_b), withFocused $ makeDynamicSP "dyn2") -- , ((modm , xK_a), spawnDynamicSP "dyn1") -- , ((modm , xK_b), spawnDynamicSP "dyn2") -- | Stores dynamic scratchpads as a map of name to window newtype SPStorage = SPStorage (M.Map String Window) deriving (Read,Show) instance ExtensionClass SPStorage where initialValue = SPStorage M.empty extensionType = PersistentExtension -- | Makes a window a dynamic scratchpad with the given name, or stop a window -- | from being a dynamic scratchpad, if it already is. makeDynamicSP :: String -- ^ Scratchpad name -> Window -- ^ Window to be made a scratchpad -> X () makeDynamicSP s w = do (SPStorage m) <- XS.get case M.lookup s m of Nothing -> addDynamicSP s w Just ow -> if w == ow then removeDynamicSP s else showWindow ow >> addDynamicSP s w {-# DEPRECATED makeDynamicSP "Use XMonad.Util.NamedScratchpad.toggleDynamicNSP instead" #-} -- | Spawn the specified dynamic scratchpad spawnDynamicSP :: String -- ^ Scratchpad name -> X () spawnDynamicSP s = do (SPStorage m) <- XS.get maybe mempty spawnDynamicSP' (M.lookup s m) {-# DEPRECATED spawnDynamicSP "Use XMonad.Util.NamedScratchpad.dynamicNSPAction instead" #-} spawnDynamicSP' :: Window -> X () spawnDynamicSP' w = withWindowSet $ \s -> do let matchingWindows = filter (== w) ((maybe [] W.integrate . W.stack . W.workspace . W.current) s) case matchingWindows of [] -> showWindow w _ -> hideWindow w -- | Make a window a dynamic scratchpad addDynamicSP :: String -> Window -> X () addDynamicSP s w = XS.modify $ alterSPStorage (\_ -> Just w) s -- | Make a window stop being a dynamic scratchpad removeDynamicSP :: String -> X () removeDynamicSP s = XS.modify $ alterSPStorage (const Nothing) s -- | Moves window to the scratchpad workspace, effectively hiding it hideWindow :: Window -> X () hideWindow = windows . W.shiftWin "NSP" -- | Move window to current workspace and focus it showWindow :: Window -> X () showWindow w = windows $ \ws -> W.focusWindow w . W.shiftWin (W.currentTag ws) w $ ws alterSPStorage :: (Maybe Window -> Maybe Window) -> String -> SPStorage -> SPStorage alterSPStorage f k (SPStorage m) = SPStorage $ M.alter f k m -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab: xmonad-contrib-0.18.0/XMonad/Util/Dzen.hs0000644000000000000000000001777407346545000016274 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Dzen -- Description : Handy wrapper for dzen. -- Copyright : (c) glasser@mit.edu -- License : BSD -- -- Maintainer : glasser@mit.edu -- Stability : stable -- Portability : unportable -- -- Handy wrapper for dzen. Requires dzen >= 0.2.4. -- ----------------------------------------------------------------------------- module XMonad.Util.Dzen ( -- * Flexible interface dzenConfig, DzenConfig, timeout, font, xScreen, vCenter, hCenter, center, onCurr, x, y, addArgs, fgColor, bgColor, align, slaveAlign, lineCount, -- * Legacy interface dzen, dzenScreen, dzenWithArgs, -- * Miscellaneous seconds, chomp, (>=>), ) where import XMonad.Prelude import XMonad import XMonad.StackSet import XMonad.Util.Run (runProcessWithInputAndWait, seconds) import XMonad.Util.Font (Align (..)) type DzenConfig = (Int, [String]) -> X (Int, [String]) -- | @dzenConfig config s@ will display the string @s@ according to the -- configuration @config@. For example, to display the string @\"foobar\"@ with -- all the default settings, you can simply call -- -- > dzenConfig return "foobar" -- -- Or, to set a longer timeout, you could use -- -- > dzenConfig (timeout 10) "foobar" -- -- You can combine configurations with the (>=>) operator. To display -- @\"foobar\"@ for 10 seconds on the first screen, you could use -- -- > dzenConfig (timeout 10 >=> xScreen 0) "foobar" -- -- As a final example, you could adapt the above to display @\"foobar\"@ for -- 10 seconds on the current screen with -- -- > dzenConfig (timeout 10 >=> onCurr xScreen) "foobar" dzenConfig :: DzenConfig -> String -> X () dzenConfig conf s = do (t, args) <- conf (seconds 3, []) runProcessWithInputAndWait "dzen2" args (chomp s) t -- | dzen wants exactly one newline at the end of its input, so this can be -- used for your own invocations of dzen. However, all functions in this -- module will call this for you. chomp :: String -> String chomp = (++"\n") . reverse . dropWhile ('\n' ==) . reverse -- | Set the timeout, in seconds. This defaults to 3 seconds if not -- specified. timeout :: Rational -> DzenConfig timeout = timeoutMicro . seconds -- | Set the timeout, in microseconds. Mostly here for the legacy -- interface. timeoutMicro :: Int -> DzenConfig timeoutMicro n (_, ss) = return (n, ss) -- | Add raw command-line arguments to the configuration. These will be -- passed on verbatim to dzen2. The default includes no arguments. addArgs :: [String] -> DzenConfig addArgs ss (n, ss') = return (n, ss ++ ss') -- | Start dzen2 on a particular screen. Only works with versions of dzen -- that support the "-xs" argument. xScreen :: ScreenId -> DzenConfig xScreen sc = addArgs ["-xs", show (fromIntegral sc + 1 :: Int)] -- | Take a screen-specific configuration and supply it with the screen ID -- of the currently focused screen, according to xmonad. For example, show -- a 100-pixel wide bar centered within the current screen, you could use -- -- > dzenConfig (onCurr (hCenter 100)) "foobar" -- -- Of course, you can still combine these with (>=>); for example, to center -- the string @\"foobar\"@ both horizontally and vertically in a 100x14 box -- using the lovely Terminus font, you could use -- -- > terminus = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*" -- > dzenConfig (onCurr (center 100 14) >=> font terminus) "foobar" onCurr :: (ScreenId -> DzenConfig) -> DzenConfig onCurr f conf = gets (screen . current . windowset) >>= flip f conf -- | Put the top of the dzen bar at a particular pixel. x :: Int -> DzenConfig x n = addArgs ["-x", show n] -- | Put the left of the dzen bar at a particular pixel. y :: Int -> DzenConfig y n = addArgs ["-y", show n] -- | Set the foreground color. -- -- Please be advised that @fgColor@ and @bgColor@ also exist in "XMonad.Prompt". -- If you use both modules, you might have to tell the compiler which one you mean: -- -- > import XMonad.Prompt as P -- > import XMonad.Util.Dzen as D -- > -- > dzenConfig (D.fgColor "#f0f0f0") "foobar" fgColor :: String -> DzenConfig fgColor c = addArgs ["-fg", c] -- | Set the background color. bgColor :: String -> DzenConfig bgColor c = addArgs ["-bg", c] -- | Set the alignment of the title (main) window content. -- Note that @AlignRightOffset@ is treated as equal to @AlignRight@. -- -- > import XMonad.Util.Font (Align(..)) -- > -- > dzenConfig (align AlignLeft) "foobar" align :: Align -> DzenConfig align = align' "-ta" -- | Set the alignment of the slave window content. -- Using this option only makes sense if you also use the @lineCount@ parameter. slaveAlign :: Align -> DzenConfig slaveAlign = align' "-sa" -- Set an alignment parameter align' :: String -> Align -> DzenConfig align' opt a = addArgs [opt, s] where s = case a of AlignCenter -> "c" AlignLeft -> "l" AlignRight -> "r" AlignRightOffset _ -> "r" -- | Specify the font. Check out xfontsel to get the format of the String -- right; if your dzen supports xft, then you can supply that here, too. font :: String -> DzenConfig font fn = addArgs ["-fn", fn] -- | @vCenter height sc@ sets the configuration to have the dzen bar appear -- on screen @sc@ with height @height@, vertically centered with respect to -- the actual size of that screen. vCenter :: Int -> ScreenId -> DzenConfig vCenter = center' rect_height "-h" "-y" -- | @hCenter width sc@ sets the configuration to have the dzen bar appear -- on screen @sc@ with width @width@, horizontally centered with respect to -- the actual size of that screen. hCenter :: Int -> ScreenId -> DzenConfig hCenter = center' rect_width "-w" "-x" -- | @center width height sc@ sets the configuration to have the dzen bar -- appear on screen @sc@ with width @width@ and height @height@, centered -- both horizontally and vertically with respect to the actual size of that -- screen. center :: Int -> Int -> ScreenId -> DzenConfig center width height sc = hCenter width sc >=> vCenter height sc -- Center things along a single dimension on a particular screen. center' :: (Rectangle -> Dimension) -> String -> String -> Int -> ScreenId -> DzenConfig center' selector extentName positionName extent sc conf = do rect <- gets (detailFromScreenId sc . windowset) case rect of Nothing -> return conf Just r -> addArgs [extentName , show extent, positionName, show ((fromIntegral (selector r) - extent) `div` 2), "-xs" , show (fromIntegral sc + 1 :: Int) ] conf -- Get the rectangle outlining a particular screen. detailFromScreenId :: ScreenId -> WindowSet -> Maybe Rectangle detailFromScreenId sc ws = fmap screenRect maybeSD where c = current ws v = visible ws mapping = map (\s -> (screen s, screenDetail s)) (c:v) maybeSD = lookup sc mapping -- | Enable slave window and specify the number of lines. -- -- Dzen can optionally draw a second window underneath the title window. -- By default, this window is only displayed if the mouse enters the title window. -- This option is only useful if the string you want to display contains more than one line. lineCount :: Int -> DzenConfig lineCount n = addArgs ["-l", show n] -- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds. -- Example usage: -- -- > dzen "Hi, mom!" (5 `seconds`) dzen :: String -> Int -> X () dzen = flip (dzenConfig . timeoutMicro) -- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen. -- Example usage: -- -- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`) dzenWithArgs :: String -> [String] -> Int -> X () dzenWithArgs str args t = dzenConfig (timeoutMicro t >=> addArgs args) str -- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@. -- Requires dzen to be compiled with Xinerama support. dzenScreen :: ScreenId -> String -> Int -> X () dzenScreen sc str t = dzenConfig (timeoutMicro t >=> xScreen sc) str xmonad-contrib-0.18.0/XMonad/Util/EZConfig.hs0000644000000000000000000004557407346545000017037 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.EZConfig -- Description : Configure key bindings easily in Emacs style. -- Copyright : Devin Mullins -- Brent Yorgey (key parsing) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- -- Useful helper functions for amending the default configuration, and for -- parsing keybindings specified in a special (emacs-like) format. -- -- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.) -- -------------------------------------------------------------------- module XMonad.Util.EZConfig ( -- * Usage -- $usage -- * Adding or removing keybindings additionalKeys, additionalKeysP, remapKeysP, removeKeys, removeKeysP, additionalMouseBindings, removeMouseBindings, -- * Emacs-style keybinding specifications mkKeymap, checkKeymap, mkNamedKeymap, -- * Parsers parseKey, -- used by XMonad.Util.Paste parseKeyCombo, parseKeySequence, readKeySequence, #ifdef TESTING parseModifier, #endif ) where import XMonad import XMonad.Actions.Submap import XMonad.Prelude import XMonad.Util.NamedActions import XMonad.Util.Parser import Control.Arrow (first, (&&&)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import Data.Ord (comparing) import Data.List.NonEmpty (nonEmpty) -- $usage -- To use this module, first import it into your @xmonad.hs@: -- -- > import XMonad.Util.EZConfig -- -- Then, use one of the provided functions to modify your -- configuration. You can use 'additionalKeys', 'removeKeys', -- 'additionalMouseBindings', and 'removeMouseBindings' to easily add -- and remove keybindings or mouse bindings. You can use 'mkKeymap' -- to create a keymap using emacs-style keybinding specifications -- like @\"M-x\"@ instead of @(modMask, xK_x)@, or 'additionalKeysP' -- and 'removeKeysP' to easily add or remove emacs-style keybindings. -- If you use emacs-style keybindings, the 'checkKeymap' function is -- provided, suitable for adding to your 'startupHook', which can warn -- you of any parse errors or duplicate bindings in your keymap. -- -- For more information and usage examples, see the documentation -- provided with each exported function, and check the xmonad config -- archive () -- for some real examples of use. -- | -- Add or override keybindings from the existing set. Example use: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `additionalKeys` -- > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") -- > , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do -- > ] -- -- This overrides the previous definition of mod-m. -- -- Note that, unlike in xmonad 0.4 and previous, you can't use modMask to refer -- to the modMask you configured earlier. You must specify mod1Mask (or -- whichever), or add your own @myModMask = mod1Mask@ line. additionalKeys :: XConfig a -> [((KeyMask, KeySym), X ())] -> XConfig a additionalKeys conf keyList = conf { keys = M.union (M.fromList keyList) . keys conf } infixl 4 `additionalKeys` -- | Like 'additionalKeys', except using short @String@ key -- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as -- described in the documentation for 'mkKeymap'. For example: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `additionalKeysP` -- > [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4") -- > , ("M-", withFocused hide) -- N.B. this is an absurd thing to do -- > ] additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l additionalKeysP conf keyList = conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) } infixl 4 `additionalKeysP` -- | -- Remap keybindings from one binding to another. More precisely, the -- input list contains pairs of the form @(TO, FROM)@, and maps the -- action bound to @FROM@ to the key @TO@. For example, the following -- would bind @"M-m"@ to what's bound to @"M-c"@ (which is to close the -- focused window, in this case): -- -- > main :: IO () -- > main = xmonad $ def `remapKeysP` [("M-m", "M-c")] -- -- NOTE: Submaps are not transparent, and thus these keys can't be -- accessed in this way: more explicitly, the @FROM@ string may **not** -- be a submap. However, the @TO@ can be a submap without problems. -- This means that -- -- > xmonad $ def `remapKeysP` [("M-m", "M-c a")] -- -- is illegal (and indeed will just disregard the binding altogether), -- while -- -- > xmonad $ def `remapKeysP` [("M-c a", "M-m")] -- -- is totally fine. remapKeysP :: XConfig l -> [(String, String)] -> XConfig l remapKeysP conf keyList = conf { keys = \cnf -> mkKeymap cnf (keyList' cnf) <> keys conf cnf } where keyList' :: XConfig Layout -> [(String, X ())] keyList' cnf = mapMaybe (traverse (\s -> case readKeySequence cnf s of Just (ks :| []) -> keys conf cnf M.!? ks _ -> Nothing)) keyList infixl 4 `remapKeysP` -- | -- Remove standard keybindings you're not using. Example use: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a removeKeys conf keyList = conf { keys = \cnf -> foldr M.delete (keys conf cnf) keyList } infixl 4 `removeKeys` -- | Like 'removeKeys', except using short @String@ key descriptors -- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the -- documentation for 'mkKeymap'. For example: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']] removeKeysP :: XConfig l -> [String] -> XConfig l removeKeysP conf keyList = conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (map (, return ()) keyList) } infixl 4 `removeKeysP` -- | Like 'additionalKeys', but for mouse bindings. additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a additionalMouseBindings conf mouseBindingsList = conf { mouseBindings = M.union (M.fromList mouseBindingsList) . mouseBindings conf } infixl 4 `additionalMouseBindings` -- | Like 'removeKeys', but for mouse bindings. removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a removeMouseBindings conf mouseBindingList = conf { mouseBindings = \cnf -> foldr M.delete (mouseBindings conf cnf) mouseBindingList } infixl 4 `removeMouseBindings` -------------------------------------------------------------- -- Keybinding parsing --------------------------------------- -------------------------------------------------------------- -- | Given a config (used to determine the proper modifier key to use) -- and a list of @(String, X ())@ pairs, create a key map by parsing -- the key sequence descriptions contained in the Strings. The key -- sequence descriptions are \"emacs-style\": @M-@, @C-@, @S-@, and -- @M\#-@ denote mod, control, shift, and mod1-mod5 (where @\#@ is -- replaced by the appropriate number) respectively. Note that if -- you want to make a keybinding using \'alt\' even though you use a -- different key (like the \'windows\' key) for \'mod\', you can use -- something like @\"M1-x\"@ for alt+x (check the output of @xmodmap@ -- to see which mod key \'alt\' is bound to). Some special keys can -- also be specified by enclosing their name in angle brackets. -- -- For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\\"@ -- denotes shift-escape; @\"M1-C-\\"@ denotes alt+ctrl+delete -- (assuming alt is bound to mod1, which is common). -- -- Sequences of keys can also be specified by separating the key -- descriptions with spaces. For example, @\"M-x y \\"@ denotes the -- sequence of keys mod+x, y, down. Submaps (see -- "XMonad.Actions.Submap") will be automatically generated to -- correctly handle these cases. -- -- So, for example, a complete key map might be specified as -- -- > keys = \c -> mkKeymap c $ -- > [ ("M-S-", spawn $ terminal c) -- > , ("M-x w", spawn "xmessage 'woohoo!'") -- type mod+x then w to pop up 'woohoo!' -- > , ("M-x y", spawn "xmessage 'yay!'") -- type mod+x then y to pop up 'yay!' -- > , ("M-S-c", kill) -- > ] -- -- Alternatively, you can use 'additionalKeysP' to automatically -- create a keymap and add it to your config. -- -- Here is a complete list of supported special keys. Note that a few -- keys, such as the arrow keys, have synonyms. If there are other -- special keys you would like to see supported, feel free to submit a -- patch, or ask on the xmonad mailing list; adding special keys is -- quite simple. -- -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > , -- > -- > -- > , -- > , -- > , -- > , -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > - -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > - -- -- Long list of multimedia keys. Please note that not all keys may be -- present in your particular setup although most likely they will do. -- -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -, - -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > - -- > -- > -- > -- > -- > mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ()) mkKeymap c = M.fromList . mkSubmaps . readKeymap c mkNamedKeymap :: XConfig l -> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)] mkNamedKeymap c = mkNamedSubmaps . readKeymap c -- | Given a list of pairs of parsed key sequences and actions, -- group them into submaps in the appropriate way. mkNamedSubmaps :: [(NonEmpty (KeyMask, KeySym), NamedAction)] -> [((KeyMask, KeySym), NamedAction)] mkNamedSubmaps = mkSubmaps' submapName mkSubmaps :: [ (NonEmpty (KeyMask, KeySym), X ()) ] -> [((KeyMask, KeySym), X ())] mkSubmaps = mkSubmaps' $ submap . M.fromList mkSubmaps' :: forall a b. (Ord a) => ([(a, b)] -> b) -> [(NonEmpty a, b)] -> [(a, b)] mkSubmaps' subm binds = map combine gathered where gathered :: [[(NonEmpty a, b)]] gathered = groupBy fstKey . sortBy (comparing fst) $ binds combine :: [(NonEmpty a, b)] -> (a, b) combine [(k :| [], act)] = (k, act) combine ks = ( NE.head . fst . NE.head . notEmpty $ ks , subm . mkSubmaps' subm $ map (first (notEmpty . NE.drop 1)) ks ) fstKey :: (NonEmpty a, b) -> (NonEmpty a, b) -> Bool fstKey = (==) `on` (NE.head . fst) -- | Given a configuration record and a list of (key sequence -- description, action) pairs, parse the key sequences into lists of -- @(KeyMask,KeySym)@ pairs. Key sequences which fail to parse will -- be ignored. readKeymap :: XConfig l -> [(String, t)] -> [(NonEmpty (KeyMask, KeySym), t)] readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c)) where maybeKeys (Nothing,_) = Nothing maybeKeys (Just k, act) = Just (k, act) -- | Parse a sequence of keys, returning Nothing if there is -- a parse failure (no parse, or ambiguous parse). readKeySequence :: XConfig l -> String -> Maybe (NonEmpty (KeyMask, KeySym)) readKeySequence c = nonEmpty <=< runParser (parseKeySequence c <* eof) -- | Parse a sequence of key combinations separated by spaces, e.g. -- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2). parseKeySequence :: XConfig l -> Parser [(KeyMask, KeySym)] parseKeySequence c = parseKeyCombo c `sepBy1` many1 (char ' ') -- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s). parseKeyCombo :: XConfig l -> Parser (KeyMask, KeySym) parseKeyCombo c = do mods <- many (parseModifier c) k <- parseKey return (foldl' (.|.) 0 mods, k) -- | Parse a modifier: either M- (user-defined mod-key), -- C- (control), S- (shift), or M#- where # is an integer -- from 1 to 5 (mod1Mask through mod5Mask). parseModifier :: XConfig l -> Parser KeyMask parseModifier c = (string "M-" $> modMask c) <> (string "C-" $> controlMask) <> (string "S-" $> shiftMask) <> do _ <- char 'M' n <- satisfy (`elem` ['1'..'5']) _ <- char '-' return $ indexMod (read [n] - 1) where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] -- | Parse an unmodified basic key, like @\"x\"@, @\"\\"@, etc. parseKey :: Parser KeySym parseKey = parseSpecial <> parseRegular -- | Parse a regular key name (represented by itself). parseRegular :: Parser KeySym parseRegular = choice [ string s $> k | (s, k) <- regularKeys ] -- | Parse a special key name (one enclosed in angle brackets). parseSpecial :: Parser KeySym parseSpecial = do _ <- char '<' choice [ k <$ string name <* char '>' | (name, k) <- allSpecialKeys ] -- | Given a configuration record and a list of (key sequence -- description, action) pairs, check the key sequence descriptions -- for validity, and warn the user (via a popup xmessage window) of -- any unparseable or duplicate key sequences. This function is -- appropriate for adding to your @startupHook@, and you are highly -- encouraged to do so; otherwise, duplicate or unparseable -- keybindings will be silently ignored. -- -- For example, you might do something like this: -- -- > main = xmonad $ myConfig -- > -- > myKeymap = [("S-M-c", kill), ...] -- > myConfig = def { -- > ... -- > keys = \c -> mkKeymap c myKeymap -- > startupHook = return () >> checkKeymap myConfig myKeymap -- > ... -- > } -- -- NOTE: the @return ()@ in the example above is very important! -- Otherwise, you might run into problems with infinite mutual -- recursion: the definition of myConfig depends on the definition of -- startupHook, which depends on the definition of myConfig, ... and -- so on. Actually, it's likely that the above example in particular -- would be OK without the @return ()@, but making @myKeymap@ take -- @myConfig@ as a parameter would definitely lead to -- problems. Believe me. It, uh, happened to my friend. In... a -- dream. Yeah. In any event, the @return () >>@ introduces enough -- laziness to break the deadlock. -- checkKeymap :: XConfig l -> [(String, a)] -> X () checkKeymap conf km = warn (doKeymapCheck conf km) where warn ([],[]) = return () warn (bad,dup) = xmessage $ "Warning:\n" ++ msg "bad" bad ++ "\n" ++ msg "duplicate" dup msg _ [] = "" msg m xs = m ++ " keybindings detected: " ++ showBindings xs showBindings = unwords . map (("\""++) . (++"\"")) -- | Given a config and a list of (key sequence description, action) -- pairs, check the key sequence descriptions for validity, -- returning a list of unparseable key sequences, and a list of -- duplicate key sequences. doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String]) doKeymapCheck conf km = (bad,dups) where ks = map ((readKeySequence conf &&& id) . fst) km bad = nub . map snd . filter (isNothing . fst) $ ks dups = map (snd . NE.head) . mapMaybe nonEmpty . groupBy ((==) `on` fst) . sortBy (comparing fst) . map (first fromJust) . filter (isJust . fst) $ ks xmonad-contrib-0.18.0/XMonad/Util/ExclusiveScratchpads.hs0000644000000000000000000002547507346545000021520 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.ExclusiveScratchpads -- Description : Named scratchpads that can be mutually exclusive. -- Copyright : Bruce Forte (2017) -- License : BSD-style (see LICENSE) -- -- Maintainer : Bruce Forte -- Stability : unstable -- Portability : unportable -- -- Named scratchpads that can be mutually exclusive. -- ----------------------------------------------------------------------------- module XMonad.Util.ExclusiveScratchpads {-# DEPRECATED "Use the exclusive scratchpad functionality of \"XMonad.Util.NamedScratchpad\" insead." #-} ( -- * Usage -- $usage mkXScratchpads, xScratchpadsManageHook, -- * Keyboard related scratchpadAction, hideAll, resetExclusiveSp, -- * Mouse related setNoexclusive, resizeNoexclusive, floatMoveNoexclusive, -- * Types ExclusiveScratchpad(..), ExclusiveScratchpads, -- * Hooks nonFloating, defaultFloating, customFloating ) where import XMonad.Prelude import XMonad import XMonad.Actions.Minimize import XMonad.Actions.TagWindows (addTag,delTag) import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty) import qualified XMonad.StackSet as W import qualified Data.List.NonEmpty as NE -- $usage -- -- For this module to work properly, you need to use "XMonad.Layout.BoringWindows" and -- "XMonad.Layout.Minimize", please refer to the documentation of these modules for more -- information on how to configure them. -- -- To use this module, put the following in your @xmonad.hs@: -- -- > import XMonad.Utils.ExclusiveScratchpads -- > import XMonad.ManageHook (title,appName) -- > import qualified XMonad.StackSet as W -- -- Add exclusive scratchpads, for example: -- -- > exclusiveSps = mkXScratchpads [ ("htop", "urxvt -name htop -e htop", title =? "htop") -- > , ("xclock", "xclock", appName =? "xclock") -- > ] $ customFloating $ W.RationalRect (1/4) (1/4) (1/2) (1/2) -- -- The scratchpads don\'t have to be exclusive, you can create them like this (see 'ExclusiveScratchpad'): -- -- > regularSps = [ XSP "term" "urxvt -name scratchpad" (appName =? "scratchpad") defaultFloating [] ] -- -- Create a list that contains all your scratchpads like this: -- -- > scratchpads = exclusiveSps ++ regularSps -- -- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook" or -- ); e.g., -- -- > manageHook = myManageHook <> xScratchpadsManageHook scratchpads -- -- And finally add some keybindings (see ): -- -- > , ((modMask, xK_h), scratchpadAction scratchpads "htop") -- > , ((modMask, xK_c), scratchpadAction scratchpads "xclock") -- > , ((modMask, xK_t), scratchpadAction scratchpads "term") -- > , ((modMask, xK_h), hideAll scratchpads) -- -- Now you can get your scratchpads by pressing the corresponding keys, if you -- have the @htop@ scratchpad on your current screen and you fetch the @xclock@ -- scratchpad then @htop@ gets hidden. -- -- If you move a scratchpad it still gets hidden when you fetch a scratchpad of -- the same family, to change that behaviour and make windows not exclusive -- anymore when they get resized or moved add these mouse bindings -- (see "XMonad.Doc.Extending#Editing_mouse_bindings"): -- -- > , ((mod4Mask, button1), floatMoveNoexclusive scratchpads) -- > , ((mod4Mask, button3), resizeNoexclusive scratchpads) -- -- To reset a moved scratchpad to the original position that you set with its hook, -- call @resetExclusiveSp@ when it is in focus. For example if you want to extend -- Mod-Return to reset the placement when a scratchpad is in focus but keep the -- default behaviour for tiled windows, set these key bindings: -- -- > , ((modMask, xK_Return), windows W.swapMaster >> resetExclusiveSp scratchpads) -- -- __Note:__ This is just an example, in general you can add more than two -- exclusive scratchpads and multiple families of such. data ExclusiveScratchpad = XSP { name :: String -- ^ Name of the scratchpad , cmd :: String -- ^ Command to spawn the scratchpad , query :: Query Bool -- ^ Query to match the scratchpad , hook :: ManageHook -- ^ Hook to specify the placement policy , exclusive :: [String] -- ^ Names of exclusive scratchpads } type ExclusiveScratchpads = [ExclusiveScratchpad] -- ----------------------------------------------------------------------------------- -- | Create 'ExclusiveScratchpads' from @[(name,cmd,query)]@ with a common @hook@ mkXScratchpads :: [(String,String,Query Bool)] -- ^ List of @(name,cmd,query)@ of the -- exclusive scratchpads -> ManageHook -- ^ The common @hook@ that they use -> ExclusiveScratchpads mkXScratchpads xs h = foldl accumulate [] xs where accumulate a (n,c,q) = XSP n c q h (filter (n/=) names) : a names = map (\(n,_,_) -> n) xs -- | Create 'ManageHook' from 'ExclusiveScratchpads' xScratchpadsManageHook :: ExclusiveScratchpads -- ^ List of exclusive scratchpads from -- which a 'ManageHook' should be generated -> ManageHook xScratchpadsManageHook = composeAll . fmap (\sp -> query sp --> hook sp) -- | Pop up/hide the scratchpad by name and possibly hide its exclusive scratchpadAction :: ExclusiveScratchpads -- ^ List of exclusive scratchpads -> String -- ^ Name of the scratchpad to toggle -> X () scratchpadAction xs n = let ys = filter ((n==).name) xs in case ys of [] -> return () (sp:_) -> let q = query sp in withWindowSet $ \s -> do ws <- filterM (runQuery q) $ W.allWindows s case ws of [] -> do spawn (cmd sp) hideOthers xs n windows W.shiftMaster (w:_) -> do toggleWindow w whenX (runQuery isExclusive w) (hideOthers xs n) where toggleWindow w = liftA2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case True -> whenX (onCurrentScreen w) (minimizeWindow w) False -> do windows (flip W.shiftWin w =<< W.currentTag) maximizeWindowAndFocus w windows W.shiftMaster onCurrentScreen w = withWindowSet (return . elem w . currentWindows) -- | Hide all 'ExclusiveScratchpads' on the current screen hideAll :: ExclusiveScratchpads -- ^ List of exclusive scratchpads -> X () hideAll xs = mapWithCurrentScreen q minimizeWindow where q = joinQueries (map query xs) <&&> isExclusive <&&> isMaximized -- | If the focused window is a scratchpad, the scratchpad gets reset to the original -- placement specified with the hook and becomes exclusive again resetExclusiveSp :: ExclusiveScratchpads -- ^ List of exclusive scratchpads -> X () resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do let ys = filterM (flip runQuery w . query) xs unlessX (null <$> ys) $ do mh <- NE.head . notEmpty . map hook <$> ys -- ys /= [], so `head` is fine n <- NE.head . notEmpty . map name <$> ys -- same (windows . appEndo <=< runQuery mh) w hideOthers xs n delTag "_XSP_NOEXCLUSIVE" w where unlessX = whenX . fmap not -- ----------------------------------------------------------------------------------- -- | Hide the scratchpad of the same family by name if it's on the focused workspace hideOthers :: ExclusiveScratchpads -> String -> X () hideOthers xs n = let ys = concatMap exclusive $ filter ((n==).name) xs qs = map query $ filter ((`elem` ys).name) xs q = joinQueries qs <&&> isExclusive <&&> isMaximized in mapWithCurrentScreen q minimizeWindow -- | Conditionally map a function on all windows of the current screen mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X () mapWithCurrentScreen q f = withWindowSet $ \s -> do ws <- filterM (runQuery q) $ currentWindows s mapM_ f ws -- | Extract all windows on the current screen from a StackSet currentWindows :: W.StackSet i l a sid sd -> [a] currentWindows = W.integrate' . W.stack . W.workspace . W.current -- | Check if given window is a scratchpad isScratchpad :: ExclusiveScratchpads -> Window -> X Bool isScratchpad xs w = withWindowSet $ \s -> do let q = joinQueries $ map query xs ws <- filterM (runQuery q) $ W.allWindows s return $ elem w ws -- | Build a disjunction from a list of clauses joinQueries :: [Query Bool] -> Query Bool joinQueries = foldl (<||>) (liftX $ return False) -- | Useful queries isExclusive, isMaximized :: Query Bool isExclusive = notElem "_XSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS" isMaximized = not <$> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN" -- ----------------------------------------------------------------------------------- -- | Make a window not exclusive anymore setNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads -> Window -- ^ Window which should be made not -- exclusive anymore -> X () setNoexclusive xs w = whenX (isScratchpad xs w) $ addTag "_XSP_NOEXCLUSIVE" w -- | Float and drag the window, make it not exclusive anymore floatMoveNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads -> Window -- ^ Window which should be moved -> X () floatMoveNoexclusive xs w = setNoexclusive xs w >> focus w >> mouseMoveWindow w >> windows W.shiftMaster -- | Resize window, make it not exclusive anymore resizeNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads -> Window -- ^ Window which should be resized -> X () resizeNoexclusive xs w = setNoexclusive xs w >> focus w >> mouseResizeWindow w >> windows W.shiftMaster -- ----------------------------------------------------------------------------------- -- | Manage hook that makes the window non-floating nonFloating :: ManageHook nonFloating = idHook -- | Manage hook that makes the window floating with the default placement defaultFloating :: ManageHook defaultFloating = doFloat -- | Manage hook that makes the window floating with custom placement customFloating :: W.RationalRect -- ^ @RationalRect x y w h@ that specifies relative position, -- height and width (see "XMonad.StackSet#RationalRect") -> ManageHook customFloating = doRectFloat xmonad-contrib-0.18.0/XMonad/Util/ExtensibleConf.hs0000644000000000000000000001512107346545000020264 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -- | -- Module : XMonad.Util.ExtensibleConf -- Description : Extensible and composable configuration for contrib modules. -- Copyright : (c) 2021 Tomáš Janoušek -- License : BSD3 -- Maintainer : Tomáš Janoušek -- -- Extensible and composable configuration for contrib modules. -- -- This is the configuration counterpart of "XMonad.Util.ExtensibleState". It -- allows contrib modules to store custom configuration values inside -- 'XConfig'. This lets them create custom hooks, ensure they hook into xmonad -- core only once, and possibly more. -- module XMonad.Util.ExtensibleConf ( -- * Usage -- $usage -- * High-level idioms based on Semigroup with, add, once, onceM, -- * High-level idioms based on Default withDef, modifyDef, modifyDefM, -- * Low-level primitivies ask, lookup, alter, alterF, ) where import Prelude hiding (lookup) import XMonad hiding (ask, modify, trace) import XMonad.Prelude ((<|>), (<&>), fromMaybe) import Data.Typeable import qualified Data.Map as M -- --------------------------------------------------------------------- -- $usage -- -- To utilize this feature in a contrib module, create a data type for the -- configuration, then use the helper functions provided here to implement -- a user-friendly composable interface for your contrib module. -- -- Example: -- -- > import qualified XMonad.Util.ExtensibleConf as XC -- > -- > {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- > newtype MyConf = MyConf{ fromMyConf :: [Int] } deriving Semigroup -- > -- > customLogger :: Int -> XConfig l -> XConfig l -- > customLogger i = XC.once (\c -> c{ logHook = logHook c <> lh }) (MyConf [i]) -- > where -- > lh :: X () -- > lh = XC.with $ io . print . fromMyConf -- -- The above defines an xmonad configuration combinator that can be applied -- any number of times like so: -- -- > main = xmonad $ … . customLogger 1 . ewmh . customLogger 2 . … $ def{…} -- -- and will always result in just one 'print' invocation in 'logHook'. -- --------------------------------------------------------------------- -- Low-level primitivies -- | Run-time: Retrieve a configuration value of the requested type. ask :: (MonadReader XConf m, Typeable a) => m (Maybe a) ask = asks $ lookup . config -- | Config-time: Retrieve a configuration value of the requested type. lookup :: forall a l. Typeable a => XConfig l -> Maybe a lookup c = fromConfExt =<< typeRep (Proxy @a) `M.lookup` extensibleConf c -- | Config-time: Alter a configuration value, or absence thereof. alter :: forall a l. Typeable a => (Maybe a -> Maybe a) -> XConfig l -> XConfig l alter f = mapEC $ M.alter (mapConfExt f) (typeRep (Proxy @a)) where mapEC g c = c{ extensibleConf = g (extensibleConf c) } -- | Config-time: Functor variant of 'alter', useful if the configuration -- modifications needs to do some 'IO'. alterF :: forall a l f. (Typeable a, Functor f) => (Maybe a -> f (Maybe a)) -> XConfig l -> f (XConfig l) alterF f = mapEC $ M.alterF (mapConfExtF f) (typeRep (Proxy @a)) where mapEC g c = g (extensibleConf c) <&> \ec -> c{ extensibleConf = ec } fromConfExt :: Typeable a => ConfExtension -> Maybe a fromConfExt (ConfExtension val) = cast val mapConfExt :: Typeable a => (Maybe a -> Maybe a) -> Maybe ConfExtension -> Maybe ConfExtension mapConfExt f = fmap ConfExtension . f . (>>= fromConfExt) mapConfExtF :: (Typeable a, Functor f) => (Maybe a -> f (Maybe a)) -> Maybe ConfExtension -> f (Maybe ConfExtension) mapConfExtF f = fmap (fmap ConfExtension) . f . (>>= fromConfExt) -- --------------------------------------------------------------------- -- High-level idioms based on Semigroup -- | Run-time: Run a monadic action with the value of the custom -- configuration, if set. with :: (MonadReader XConf m, Typeable a, Monoid b) => (a -> m b) -> m b with a = ask >>= maybe (pure mempty) a -- | Config-time: Add (append) a piece of custom configuration to an 'XConfig' -- using the 'Semigroup' instance of the configuration type. add :: (Semigroup a, Typeable a) => a -- ^ configuration to add -> XConfig l -> XConfig l add x = alter (<> Just x) -- | Config-time: 'add' a piece of custom configuration, and if it's the first -- piece of this type, also modify the 'XConfig' using the provided function. -- -- This can be used to implement a composable interface for modules that must -- only hook into xmonad core once. -- -- (The piece of custom configuration is the last argument as it's expected to -- come from the user.) once :: forall a l. (Semigroup a, Typeable a) => (XConfig l -> XConfig l) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add -> XConfig l -> XConfig l once f x c = maybe f (const id) (lookup @a c) $ add x c -- | Config-time: Applicative (monadic) variant of 'once', useful if the -- 'XConfig' modification needs to do some 'IO' (e.g. create an -- 'Data.IORef.IORef'). onceM :: forall a l m. (Applicative m, Semigroup a, Typeable a) => (XConfig l -> m (XConfig l)) -- ^ 'XConfig' modification done only once -> a -- ^ configuration to add -> XConfig l -> m (XConfig l) onceM f x c = maybe f (const pure) (lookup @a c) $ add x c -- --------------------------------------------------------------------- -- High-level idioms based on Default -- | Run-time: Run a monadic action with the value of the custom -- configuration, or the 'Default' value thereof, if absent. withDef :: (MonadReader XConf m, Typeable a, Default a) => (a -> m b) -> m b withDef a = ask >>= a . fromMaybe def -- | Config-time: Modify a configuration value in 'XConfig', initializing it -- to its 'Default' value first if absent. This is an alternative to 'add' for -- when a 'Semigroup' instance is unavailable or unsuitable. -- -- Note that this must /not/ be used together with any variant of 'once'! modifyDef :: forall a l. (Default a, Typeable a) => (a -> a) -- ^ modification of configuration -> XConfig l -> XConfig l modifyDef f = alter ((f <$>) . (<|> Just def)) -- | Config-time: Applicative (monadic) variant of 'modifyDef', useful if the -- configuration value modification needs to do some 'IO' (e.g. create an -- 'Data.IORef.IORef'). -- -- Note that this must /not/ be used together with any variant of 'once'! modifyDefM :: forall a l m. (Applicative m, Default a, Typeable a) => (a -> m a) -- ^ modification of configuration -> XConfig l -> m (XConfig l) modifyDefM f = alterF (traverse f . (<|> Just def)) xmonad-contrib-0.18.0/XMonad/Util/ExtensibleState.hs0000644000000000000000000001347407346545000020470 0ustar0000000000000000{-# 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) -- -- Maintainer : daniel.schoepe@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module for storing custom mutable state in xmonad. -- ----------------------------------------------------------------------------- module XMonad.Util.ExtensibleState ( -- * Usage -- $usage put , modify , modify' , modifyM , modifyM' , remove , get , gets , modified , modifiedM ) where import Data.Typeable (typeOf,cast) import qualified Data.Map as M import XMonad.Core import XMonad.Util.PureX import qualified Control.Monad.State as State import XMonad.Prelude (fromMaybe) -- --------------------------------------------------------------------- -- $usage -- -- To utilize this feature in a contrib module, create a data type -- and make it an instance of ExtensionClass. You can then use -- the functions from this module for storing and retrieving your data: -- -- > import qualified XMonad.Util.ExtensibleState as XS -- > -- > data ListStorage = ListStorage [Integer] -- > instance ExtensionClass ListStorage where -- > initialValue = ListStorage [] -- > -- > .. XS.put (ListStorage [23,42]) -- -- To retrieve the stored value call: -- -- > .. XS.get -- -- If the type can't be inferred from the usage of the retrieved data, you -- have to add an explicit type signature: -- -- > .. XS.get :: X ListStorage -- -- 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 (Read,Show) -- > -- > instance ExtensionClass ListStorage where -- > initialValue = ListStorage [] -- > extensionType = PersistentExtension -- -- One should take care that the string representation of the chosen type -- is unique among the stored values, otherwise it will be overwritten. -- Normally these string representations contain fully qualified module names -- when automatically deriving Typeable, so -- name collisions should not be a problem in most cases. -- A module should not try to store common datatypes(e.g. a list of Integers) -- without a custom data type as a wrapper to avoid collisions with other modules -- trying to store the same data type without a wrapper. -- -- | Modify the map of state extensions by applying the given function. modifyStateExts :: XLike m => (M.Map String (Either String StateExtension) -> M.Map String (Either String StateExtension)) -> m () modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) } -- | Apply a function to a stored value of the matching type or the initial value if there -- is none. modify :: (ExtensionClass a, XLike m) => (a -> a) -> m () modify = modifyM . (pure .) -- | Apply an action to a stored value of the matching type or the initial value if there -- is none. modifyM :: (ExtensionClass a, XLike m) => (a -> m a) -> m () modifyM f = put =<< f =<< get -- | Like 'modify' but the result value is forced to WHNF before being stored. modify' :: (ExtensionClass a, XLike m) => (a -> a) -> m () modify' = modifyM' . (pure .) -- | Like 'modifyM' but the result value is forced to WHNF before being stored. modifyM' :: (ExtensionClass a, XLike m) => (a -> m a) -> m () modifyM' f = (put $!) =<< f =<< get -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type -- is equal to the new one's) put :: (ExtensionClass a, XLike m) => a -> m () put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v -- | 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 = fromMaybe initialValue $ cast val getState' :: (ExtensionClass a, XLike m) => a -> m a getState' k = do v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState case v of Just (Right (StateExtension val)) -> return $ toValue val Just (Right (PersistentExtension val)) -> return $ toValue val Just (Left str) | PersistentExtension x <- extensionType k -> do let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x put (val `asTypeOf` k) return val _ -> return initialValue safeRead str = case reads str of [(x,"")] -> Just x _ -> Nothing gets :: (ExtensionClass a, XLike m) => (a -> b) -> m b gets = flip fmap get -- | Remove the value from the extensible state field that has the same type as the supplied argument remove :: (ExtensionClass a, XLike m) => a -> m () remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool modified = modifiedM . (pure .) modifiedM :: (ExtensionClass a, Eq a, XLike m) => (a -> m a) -> m Bool modifiedM f = do v <- get f v >>= \case v' | v' == v -> return False | otherwise -> put v' >> return True xmonad-contrib-0.18.0/XMonad/Util/Font.hs0000644000000000000000000002010607346545000016261 0ustar0000000000000000{-# LANGUAGE CPP #-} ---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A module for abstracting a font facility over Core fonts and Xft -- ----------------------------------------------------------------------------- module XMonad.Util.Font ( -- * Usage: -- $usage XMonadFont(..) , initXMF , releaseXMF , initCoreFont , releaseCoreFont , initUtf8Font , releaseUtf8Font , Align (..) , stringPosition , textWidthXMF , textExtentsXMF , printStringXMF , stringToPixel , pixelToString , fi ) where import XMonad import XMonad.Prelude import Foreign import Control.Exception as E import Text.Printf (printf) #ifdef XFT import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender import Graphics.X11.Xft #endif -- Hide the Core Font/Xft switching here data XMonadFont = Core FontStruct | Utf8 FontSet #ifdef XFT | Xft (NE.NonEmpty XftFont) #endif -- $usage -- See "XMonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples -- | Get the Pixel value for a named color: if an invalid name is -- given the black pixel will be returned. stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel stringToPixel d s = fromMaybe fallBack <$> io getIt where getIt = initColor d s fallBack = blackPixel d (defaultScreen d) -- | Convert a @Pixel@ into a @String@. -- -- This function removes any alpha channel from the @Pixel@, because X11 -- mishandles alpha channels and produces black. pixelToString :: (MonadIO m) => Display -> Pixel -> m String pixelToString d p = do let cm = defaultColormap d (defaultScreen d) (Color _ r g b _) <- io (queryColor d cm $ Color (p .&. 0x00FFFFFF) 0 0 0 0) return ("#" ++ hex r ++ hex g ++ hex b) where -- NOTE: The @Color@ type has 16-bit values for red, green, and -- blue, even though the actual type in X is only 8 bits wide. It -- seems that the upper and lower 8-bit sections of the @Word16@ -- values are the same. So, we just discard the lower 8 bits. -- -- (Strictly, X11 supports 16-bit values but no visual supported -- by XOrg does. It is still correct to discard the lower bits, as -- they are not guaranteed to be meaningful in such visuals.) hex = printf "%02x" . (`shiftR` 8) econst :: a -> IOException -> a econst = const -- | Given a fontname returns the font structure. If the font name is -- not valid the default font will be loaded and returned. initCoreFont :: String -> X FontStruct initCoreFont s = do d <- asks display io $ E.catch (getIt d) (fallBack d) where getIt d = loadQueryFont d s fallBack d = econst $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" releaseCoreFont :: FontStruct -> X () releaseCoreFont fs = do d <- asks display io $ freeFont d fs initUtf8Font :: String -> X FontSet initUtf8Font s = do d <- asks display (_,_,fs) <- io $ E.catch (getIt d) (fallBack d) return fs where getIt d = createFontSet d s fallBack d = econst $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" releaseUtf8Font :: FontSet -> X () releaseUtf8Font fs = do d <- asks display io $ freeFontSet d fs -- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend -- Example: 'xft: Sans-10' initXMF :: String -> X XMonadFont initXMF s = #ifndef XFT Utf8 <$> initUtf8Font s #else if xftPrefix `isPrefixOf` s then do dpy <- asks display let fonts = case wordsBy (== ',') (drop (length xftPrefix) s) of [] -> fallback :| [] -- NE.singleton only in base 4.15 (x : xs) -> x :| xs fb <- io $ openFont dpy fallback fmap Xft . io $ traverse (\f -> E.catch (openFont dpy f) (econst $ pure fb)) fonts else Utf8 <$> initUtf8Font s where xftPrefix = "xft:" fallback = "xft:monospace" openFont dpy str = xftFontOpen dpy (defaultScreenOfDisplay dpy) str wordsBy p str = case dropWhile p str of "" -> [] str' -> w : wordsBy p str'' where (w, str'') = break p str' #endif releaseXMF :: XMonadFont -> X () #ifdef XFT releaseXMF (Xft xftfonts) = do dpy <- asks display io $ mapM_ (xftFontClose dpy) xftfonts #endif releaseXMF (Utf8 fs) = releaseUtf8Font fs releaseXMF (Core fs) = releaseCoreFont fs textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int textWidthXMF _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s #ifdef XFT textWidthXMF dpy (Xft xftdraw) s = liftIO $ do #if MIN_VERSION_X11_xft(0, 3, 4) gi <- xftTextAccumExtents dpy (toList xftdraw) s #else gi <- xftTextExtents dpy (NE.head xftdraw) s #endif return $ xglyphinfo_xOff gi #endif textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32) textExtentsXMF (Utf8 fs) s = do let (_,rl) = wcTextExtents fs s ascent = 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 #if MIN_VERSION_X11_xft(0, 3, 4) textExtentsXMF (Xft xftfonts) _ = io $ do ascent <- fi <$> xftfont_max_ascent xftfonts descent <- fi <$> xftfont_max_descent xftfonts #else textExtentsXMF (Xft xftfonts) _ = io $ do ascent <- fi <$> xftfont_ascent (NE.head xftfonts) descent <- fi <$> xftfont_descent (NE.head xftfonts) #endif return (ascent, descent) #endif -- | String position data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int deriving (Show, Read) -- | Return the string x and y 'Position' in a 'Rectangle', given a -- 'FontStruct' and the 'Align'ment stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position) stringPosition dpy fs (Rectangle _ _ w h) al s = do width <- textWidthXMF dpy fs s (a,d) <- textExtentsXMF fs s let y = fi $ ((h - fi (a + d)) `div` 2) + fi a; x = case al of AlignCenter -> fi (w `div` 2) - fi (width `div` 2) AlignLeft -> 1 AlignRight -> fi (w - (fi width + 1)); AlignRightOffset offset -> fi (w - (fi width + 1)) - fi offset; return (x,y) printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String -> Position -> Position -> String -> m () printStringXMF d p (Core fs) gc fc bc x y s = io $ do setFont d gc $ fontFromFontStruct fs [fc',bc'] <- mapM (stringToPixel d) [fc,bc] setForeground d gc fc' setBackground d gc bc' drawImageString d p gc x y s printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do [fc',bc'] <- mapM (stringToPixel d) [fc,bc] setForeground d gc fc' setBackground d gc bc' io $ wcDrawImageString d p fs gc x y s #ifdef XFT printStringXMF dpy drw fs@(Xft fonts) gc fc bc x y s = do let screen = defaultScreenOfDisplay dpy colormap = defaultColormapOfScreen screen visual = defaultVisualOfScreen screen bcolor <- stringToPixel dpy bc (a,d) <- textExtentsXMF fs s #if MIN_VERSION_X11_xft(0, 3, 4) gi <- io $ xftTextAccumExtents dpy (toList fonts) s #else gi <- io $ xftTextExtents dpy (NE.head fonts) s #endif io $ setForeground dpy gc bcolor io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi)) (y - fi a) (fi $ xglyphinfo_xOff gi) (fi $ a + d) io $ withXftDraw dpy drw visual colormap $ \draw -> withXftColorName dpy visual colormap fc $ #if MIN_VERSION_X11_xft(0, 3, 4) \color -> xftDrawStringFallback draw color (toList fonts) (fi x) (fi y) s #else \color -> xftDrawString draw color (NE.head fonts) x y s #endif #endif xmonad-contrib-0.18.0/XMonad/Util/Grab.hs0000644000000000000000000000774307346545000016242 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Grab -- Description : Utilities for grabbing/ungrabbing keys. -- Copyright : (c) 2018 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Maintainer : L. S. Leary -- Stability : unstable -- Portability : unportable -- -- This module should not be directly used by users. Its purpose is to -- facilitate grabbing and ungrabbing keys. -------------------------------------------------------------------------------- -- --< Imports & Exports >-- {{{ module XMonad.Util.Grab ( -- * Usage -- $Usage grabKP , ungrabKP , grabUngrab , grab , customRegrabEvHook ) where -- core import XMonad hiding (mkGrabs) import Control.Monad ( when ) import Data.Bits ( setBit ) import Data.Foldable ( traverse_ ) -- base import qualified Data.Map.Strict as M import Data.Semigroup ( All(..) ) import Data.Traversable ( for ) -- }}} -- --< Usage >-- {{{ -- $Usage -- -- This module should not be directly used by users. Its purpose is to -- facilitate grabbing and ungrabbing keys. -- }}} -- --< Public Utils >-- {{{ -- | A more convenient version of 'grabKey'. grabKP :: KeyMask -> KeyCode -> X () grabKP mdfr kc = do XConf { display = dpy, theRoot = rootw } <- ask io (grabKey dpy kc mdfr rootw True grabModeAsync grabModeAsync) -- | A more convenient version of 'ungrabKey'. ungrabKP :: KeyMask -> KeyCode -> X () ungrabKP mdfr kc = do XConf { display = dpy, theRoot = rootw } <- ask io (ungrabKey dpy kc mdfr rootw) -- | A convenience function to grab and ungrab keys grabUngrab :: [(KeyMask, KeySym)] -- ^ Keys to grab -> [(KeyMask, KeySym)] -- ^ Keys to ungrab -> X () grabUngrab gr ugr = do f <- mkGrabs traverse_ (uncurry ungrabKP) (f ugr) traverse_ (uncurry grabKP) (f gr) -- | A convenience function to grab keys. This also ungrabs all -- previously grabbed keys. grab :: [(KeyMask, KeySym)] -> X () grab ks = do XConf { display = dpy, theRoot = rootw } <- ask io (ungrabKey dpy anyKey anyModifier rootw) grabUngrab ks [] -- | An event hook that runs a custom action to regrab the necessary keys. customRegrabEvHook :: X () -> Event -> X All customRegrabEvHook regr = \case e@MappingNotifyEvent{} -> do io (refreshKeyboardMapping e) when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ setNumlockMask >> regr pure (All False) _ -> pure (All True) -- }}} -- --< Private Utils >-- {{{ -- | Private action shamelessly copied and restyled from XMonad.Main source. setNumlockMask :: X () setNumlockMask = withDisplay $ \dpy -> do ms <- io (getModifierMapping dpy) xs <- sequence [ do ks <- io (keycodeToKeysym dpy kc 0) pure $ if ks == xK_Num_Lock then setBit 0 (fromIntegral m) else 0 :: KeyMask | (m, kcs) <- ms , kc <- kcs , kc /= 0 ] modify $ \s -> s { numberlockMask = foldr (.|.) 0 xs } -- | Private function shamelessly copied and refactored from XMonad.Main source. mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)]) mkGrabs = withDisplay $ \dpy -> do let (minCode, maxCode) = displayKeycodes dpy allCodes = [fromIntegral minCode .. fromIntegral maxCode] syms <- io . for allCodes $ \code -> keycodeToKeysym dpy code 0 let keysymMap = M.fromListWith (++) (zip syms $ pure <$> allCodes) keysymToKeycodes sym = M.findWithDefault [] sym keysymMap extraMods <- extraModifiers pure $ \ks -> do (mask, sym) <- ks keycode <- keysymToKeycodes sym extraMod <- extraMods pure (mask .|. extraMod, keycode) -- }}} -- NOTE: there is some duplication between this module and core. The -- latter probably will never change, but this needs to be kept in sync -- with any potential bugs that might arise. xmonad-contrib-0.18.0/XMonad/Util/Hacks.hs0000644000000000000000000002036007346545000016406 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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. -- Stability : unstable -- Portability : unportable -- -- This module is a collection of random fixes, workarounds and other functions -- that rely on somewhat hacky implementations which may have unwanted side effects -- and/or are small enough to not warrant a separate module. -- -- Import this module as qualified like so: -- -- > import qualified XMonad.Util.Hacks as Hacks -- -- and then use the functions you want as described in their respective documentation. -- ----------------------------------------------------------------------------- module XMonad.Util.Hacks ( -- * Windowed fullscreen -- $windowedFullscreenFix windowedFullscreenFixEventHook, -- * Java Hack -- $java javaHack, -- * Stacking trays (trayer) above panels (xmobar) -- $raiseTrayer trayerAboveXmobarEventHook, trayAbovePanelEventHook, -- * Inform xmobar when trays (e.g. trayer) change width -- $padTrayer trayerPaddingXmobarEventHook, trayPaddingXmobarEventHook, trayPaddingEventHook, ) where import XMonad import XMonad.Hooks.StatusBar (xmonadPropLog') import XMonad.Prelude (All (All), fi, filterM, when) import System.Posix.Env (putEnv) -- $windowedFullscreenFix -- Windowed fullscreen describes the behaviour in which XMonad, -- by default, does not automatically put windows that request being fullscreened -- into actual fullscreen, but keeps them constrained -- to their normal window dimensions, still rendering them in fullscreen. -- -- With chromium based applications like Chrome, Discord and others this -- can cause issues, where the window does not correctly see the size of the window -- when displaying the fullscreen content, thus cutting off the window content. -- -- This function works around that issue by forcing the window to recalculate their -- dimensions after initiating fullscreen, thus making chrome-based applications -- behave properly when in windowed fullscreen. -- -- The following gif shows the behaviour of chrome (left) without this fix -- compared to firefox, which already behaves as expected by default: -- <> -- -- Using this function, chrome will now behave as expected as well: -- <> -- -- Usage: -- add to handleEventHook as follows: -- -- > handleEventHook = handleEventHook def <> Hacks.windowedFullscreenFixEventHook -- -- | Fixes fullscreen behaviour of chromium based apps by quickly applying and undoing a resize. -- This causes chromium to recalculate the fullscreen window -- dimensions to match the actual "windowed fullscreen" dimensions. windowedFullscreenFixEventHook :: Event -> X All windowedFullscreenFixEventHook (ClientMessageEvent _ _ _ dpy win typ (_:dats)) = do wmstate <- getAtom "_NET_WM_STATE" fullscreen <- getAtom "_NET_WM_STATE_FULLSCREEN" when (typ == wmstate && fromIntegral fullscreen `elem` dats) $ withWindowAttributes dpy win $ \attrs -> liftIO $ do resizeWindow dpy win (fromIntegral $ wa_width attrs - 1) (fromIntegral $ wa_height attrs) resizeWindow dpy win (fromIntegral $ wa_width attrs) (fromIntegral $ wa_height attrs) return $ All True windowedFullscreenFixEventHook _ = return $ All True -- $java -- Some java Applications might not work with xmonad. A common workaround would be to set the environment -- variable @_JAVA_AWT_WM_NONREPARENTING@ to 1. The function 'javaHack' does exactly that. -- Example usage: -- -- > main = xmonad $ Hacks.javaHack (def {...}) -- -- | Fixes Java applications that don't work well with xmonad, by setting @_JAVA_AWT_WM_NONREPARENTING=1@ javaHack :: XConfig l -> XConfig l javaHack conf = conf { startupHook = startupHook conf *> io (putEnv "_JAVA_AWT_WM_NONREPARENTING=1") } -- $raiseTrayer -- Placing @trayer@ on top of @xmobar@ is somewhat tricky: -- -- - they both should be lowered to the bottom of the stacking order to avoid -- overlapping fullscreen windows -- -- - the tray needs to be stacked on top of the panel regardless of which -- happens to start first -- -- 'trayerAboveXmobarEventHook' (and the more generic -- 'trayAbovePanelEventHook') is an event hook that ensures the latter: -- whenever the tray lowers itself to the bottom of the stack, it checks -- whether there are any panels above it and lowers these again. -- -- To ensure the former, that is having both @trayer@ and @xmobar@ lower -- themselves, which is a necessary prerequisite for this event hook to -- trigger: -- -- - set @lowerOnStart = True@ and @overrideRedirect = True@ in @~/.xmobarrc@ -- - pass @-l@ to @trayer@ -- -- Usage: -- -- > handleEventHook = … <> Hacks.trayerAboveXmobarEventHook -- | Like 'trayAbovePanelEventHook', but specialised for trayer/xmobar. trayerAboveXmobarEventHook :: Event -> X All trayerAboveXmobarEventHook = trayAbovePanelEventHook (className =? "trayer") (appName =? "xmobar") -- | Whenever a tray window lowers itself to the bottom of the stack, look for -- any panels above it and lower these. trayAbovePanelEventHook :: Query Bool -- ^ tray -> Query Bool -- ^ panel -> (Event -> X All) -- ^ event hook trayAbovePanelEventHook trayQ panelQ ConfigureEvent{ev_window = w, ev_above = a} | a == none = do whenX (runQuery trayQ w) $ withDisplay $ \dpy -> do rootw <- asks theRoot (_, _, ws) <- io $ queryTree dpy rootw let aboveTrayWs = dropWhile (w /=) ws panelWs <- filterM (runQuery panelQ) aboveTrayWs mapM_ (io . lowerWindow dpy) panelWs mempty trayAbovePanelEventHook _ _ _ = mempty -- $padTrayer -- Communicating tray (e.g., trayer) resize events to xmobar so that -- padding space may be reserved on xmobar for the tray. -- -- Basic Usage with trayer: -- -- First, add the padding hook to your @handleEventHook@ as follows: -- -- > main = xmonad $ def -- > { ... -- > , handleEventHook = handleEventHook def -- > <> Hacks.trayerPaddingXmobarEventHook -- > } -- -- Then, assuming the tray is placed on the right, update your -- @xmobarrc@ as follows: -- -- > Config { ... -- > , commands = [ ... -- > , Run XPropertyLog "_XMONAD_TRAYPAD", ... ] -- > , template = " ... %_XMONAD_TRAYPAD%" -- > } -- -- As an example of what happens in this basic usage, consider the -- case where trayer updates to a width of 53 pixels. -- The following property will appear on the root window: -- -- > _XMONAD_TRAYPAD(UTF8_STRING) = "" -- | A simple trayer/xmobar-specific event hook that watches for trayer window -- resize changes and updates the _XMONAD_TRAYPAD property with xmobar markup -- that leaves a gap for the trayer. trayerPaddingXmobarEventHook :: Event -> X All -- ^ event hook trayerPaddingXmobarEventHook = trayPaddingXmobarEventHook (className =? "trayer") "_XMONAD_TRAYPAD" -- | A generic version of 'trayerPaddingXmobarEventHook' that -- allows the user to specify how to identify a tray window and the property -- to use with 'xmonadPropLog''. This is useful for other trays like -- stalonetray and also when space for more than one tray-like window needs to -- be reserved. trayPaddingXmobarEventHook :: Query Bool -- ^ query to identify the tray window -> String -- ^ 'xmonadPropLog'' property to use -> Event -> X All -- ^ resulting event hook trayPaddingXmobarEventHook trayQ prop = trayPaddingEventHook trayQ hspaceLog where hspaceLog width = xmonadPropLog' prop ("") -- | A fully generic tray resize hook that invokes a callback whenever a -- tray-like window changes width. trayPaddingEventHook :: Query Bool -- ^ query to identify the tray window -> (Int -> X ()) -- ^ action to perform when tray width changes -> Event -> X All -- ^ resulting event hook trayPaddingEventHook trayQ widthChanged ConfigureEvent{ ev_window = w, ev_width = wa } = do whenX (runQuery trayQ w) $ widthChanged (fi wa) mempty trayPaddingEventHook _ _ _ = mempty xmonad-contrib-0.18.0/XMonad/Util/History.hs0000644000000000000000000000747307346545000017030 0ustar0000000000000000{-# LANGUAGE NamedFieldPuns, DeriveTraversable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.History -- Description : Track history in /O(log n)/ time. -- Copyright : (c) 2022 L. S. Leary -- License : BSD3-style (see LICENSE) -- -- Maintainer : @LSLeary (on github) -- Stability : unstable -- Portability : unportable -- -- Provides 'History', a variation on a LIFO stack with a uniqueness property. -- In order to achieve the desired asymptotics, the data type is implemented as -- an ordered Map. -- ----------------------------------------------------------------------------- module XMonad.Util.History ( History, origin, event, erase, recall, ledger, transcribe, ) where -- base import Data.Function (on) import Text.Read ( Read(readPrec, readListPrec), Lexeme(Ident) , parens, prec, lexP, step, readListPrecDefault ) -- containers import Data.IntMap (IntMap) import qualified Data.IntMap.Strict as I import Data.Map (Map) import qualified Data.Map.Strict as M -- | A history of unique @k@-events with @a@-annotations. -- -- @History k a@ can be considered a (LIFO) stack of @(k, a)@ values with the -- property that each @k@ is unique. From this point of view, 'event' pushes -- and 'ledger' pops/peeks all. -- -- The naive implementation has /O(n)/ 'event' and 'erase' due to the -- uniqueness condition, but we can still use it as a denotation: -- -- > mu :: History k a -> [(k, a)] -- -- As an opaque data type with strict operations, @History k a@ values are all -- finite expressions in the core interface: 'origin', 'erase' and 'event'. -- Hence we define @mu@ by structural induction on these three cases. -- data History k a = History { annals :: !(IntMap (k, a)) , recorded :: !(Map k Int) } deriving (Functor, Foldable, Traversable) instance (Eq k, Eq a) => Eq (History k a) where (==) = (==) `on` ledger instance (Ord k, Ord a) => Ord (History k a) where compare = compare `on` ledger instance (Show k, Show a) => Show (History k a) where showsPrec d h = showParen (d > app_prec) $ showString "transcribe " . showsPrec (app_prec+1) (ledger h) where app_prec = 10 instance (Read k, Read a, Ord k) => Read (History k a) where readPrec = parens . prec app_prec $ do Ident "transcribe" <- lexP l <- step readPrec pure (transcribe l) where app_prec = 10 readListPrec = readListPrecDefault -- | /O(1)/. A history of nothing. -- -- > mu origin := [] -- origin :: History k a origin = History I.empty M.empty -- | /O(log n)/. A new event makes history; its predecessor forgotten. -- -- > mu (event k a h) := (k, a) : mu (erase k h) -- event :: Ord k => k -> a -> History k a -> History k a event k a History{annals,recorded} = History { annals = I.insert ik (k, a) . maybe id I.delete mseen $ annals , recorded = recorded' } where ik = maybe 0 (\((i, _), _) -> pred i) (I.minViewWithKey annals) (mseen, recorded') = M.insertLookupWithKey (\_ x _ -> x) k ik recorded -- | /O(log n)/. Erase an event from history. -- -- > mu (erase k h) := filter ((k /=) . fst) (mu h) -- erase :: Ord k => k -> History k a -> History k a erase k History{annals,recorded} = History { annals = maybe id I.delete mseen annals , recorded = recorded' } where (mseen, recorded') = M.updateLookupWithKey (\_ _ -> Nothing) k recorded -- | /O(log n)/. Recall an event. recall :: Ord k => k -> History k a -> Maybe a recall k History{annals,recorded} = do ik <- M.lookup k recorded (_, a) <- I.lookup ik annals pure a -- | /O(n)/. Read history, starting with the modern day. @ledger@ is @mu@. ledger :: History k a -> [(k, a)] ledger = I.elems . annals -- | /O(n * log n)/. Transcribe a ledger. transcribe :: Ord k => [(k, a)] -> History k a transcribe = foldr (uncurry event) origin xmonad-contrib-0.18.0/XMonad/Util/Image.hs0000644000000000000000000000714207346545000016402 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Image -- Description : Utilities for manipulating @[[Bool]]@ as images. -- Copyright : (c) 2010 Alejandro Serrano -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : trupill@gmail.com -- Stability : unstable -- Portability : unportable -- -- Utilities for manipulating [[Bool]] as images -- ----------------------------------------------------------------------------- module XMonad.Util.Image ( -- * Usage: -- $usage Placement(..), iconPosition, drawIcon, ) where import XMonad import XMonad.Prelude import XMonad.Util.Font (stringToPixel) -- | Placement of the icon in the title bar data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner | OffsetRight Int Int -- ^ An exact amount of pixels from the right left corner | CenterLeft Int -- ^ Centered in the y-axis, an amount of pixels from the left | CenterRight Int -- ^ Centered in the y-axis, an amount of pixels from the right deriving (Show, Read) -- $usage -- This module uses matrices of boolean values as images. When drawing them, -- a True value tells that we want the fore color, and a False value that we -- want the background color to be painted. -- In the module we suppose that those matrices are represented as [[Bool]], -- so the lengths of the inner lists must be the same. -- -- See "XMonad.Layout.Decoration" for usage examples -- | Gets the ('width', 'height') of an image imageDims :: [[Bool]] -> (Int, Int) imageDims img = (length (fromMaybe [] (listToMaybe img)), length img) -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing -- the image given its 'Placement' iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position) iconPosition Rectangle{} (OffsetLeft x y) _ = (fi x, fi y) iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon = let (icon_w, _) = imageDims icon in (fi w - fi x - fi icon_w, fi y) iconPosition (Rectangle _ _ _ h) (CenterLeft x) icon = let (_, icon_h) = imageDims icon in (fi x, fi (h `div` 2) - fi (icon_h `div` 2)) iconPosition (Rectangle _ _ w h) (CenterRight x) icon = let (icon_w, icon_h) = imageDims icon in (fi w - fi x - fi icon_w, fi (h `div` 2) - fi (icon_h `div` 2)) -- | Converts an image represented as [[Bool]] to a series of points -- to be painted (the ones with True values) iconToPoints :: [[Bool]] -> [Point] iconToPoints icon = let labels_inside = map (zip (iterate (1+) 0)) icon filtered_inside = map (\l -> [x | (x, t) <- l, t]) labels_inside labels_outside = zip (iterate (1+) 0) filtered_inside in [Point x y | (y, l) <- labels_outside, x <- l] -- | Displaces a point ('a', 'b') along a vector ('x', 'y') movePoint :: Position -> Position -> Point -> Point movePoint x y (Point a b) = Point (a + x) (b + y) -- | Displaces a list of points along a vector 'x', 'y' movePoints :: Position -> Position -> [Point] -> [Point] movePoints x y = map (movePoint x y) -- | Draw an image into a X surface drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String ->String -> Position -> Position -> [[Bool]] -> m () drawIcon dpy drw gc fc bc x y icon = do let (i_w, i_h) = imageDims icon fcolor <- stringToPixel dpy fc bcolor <- stringToPixel dpy bc io $ setForeground dpy gc bcolor io $ fillRectangle dpy drw gc x y (fi i_w) (fi i_h) io $ setForeground dpy gc fcolor io $ drawPoints dpy drw gc (movePoints x y (iconToPoints icon)) coordModeOrigin xmonad-contrib-0.18.0/XMonad/Util/Invisible.hs0000644000000000000000000000314507346545000017303 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A data type to store the layout state -- ----------------------------------------------------------------------------- module XMonad.Util.Invisible ( -- * Usage: -- $usage Invisible (..) , whenIJust , fromIMaybe ) where import Control.Monad.Fail -- $usage -- A wrapper data type to store layout state that shouldn't be persisted across -- restarts. A common wrapped type to use is @Maybe a@. -- Invisible derives trivial definitions for Read and Show, so the wrapped data -- type need not do so. newtype Invisible m a = I (m a) deriving (Monad, MonadFail, Applicative, Functor) instance (Functor m, Monad m, MonadFail m) => Read (Invisible m a) where readsPrec _ s = [(Control.Monad.Fail.fail "Read Invisible", s)] instance Monad m => Show (Invisible m a) where show _ = "" whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m () whenIJust (I (Just x)) f = f x whenIJust (I Nothing) _ = return () fromIMaybe :: a -> Invisible Maybe a -> a fromIMaybe _ (I (Just x)) = x fromIMaybe a (I Nothing) = a xmonad-contrib-0.18.0/XMonad/Util/Loggers.hs0000644000000000000000000005155607346545000016772 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Loggers -- Description : A collection of simple logger functions and formatting utilities. -- Copyright : (c) Brent Yorgey, Wirt Wolff -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A collection of simple logger functions and formatting utilities -- 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. ----------------------------------------------------------------------------- module XMonad.Util.Loggers ( -- * Usage -- $usage Logger -- * System Loggers -- $system , aumixVolume , battery , date , loadAvg , maildirNew, maildirUnread , logCmd , logFileCount -- * XMonad Loggers -- $xmonad , logCurrent, logLayout , logTitle, logTitles, logTitles' , logClassname, logClassnames, logClassnames' , logConst, logDefault, (.|) -- * XMonad: Screen-specific Loggers -- $xmonad-screen , logCurrentOnScreen, logLayoutOnScreen , logTitleOnScreen, logClassnameOnScreen, logWhenActive , logTitlesOnScreen, logTitlesOnScreen' , logClassnamesOnScreen, logClassnamesOnScreen' , TitlesFormat(..) , ClassnamesFormat(..) -- * Formatting Utilities -- $format , onLogger , wrapL, fixedWidthL , logSp, padL , shortenL , dzenColorL, xmobarColorL ) where import XMonad (Default, gets, liftIO, Window) import XMonad.Core import qualified XMonad.StackSet as W import XMonad.Hooks.StatusBar.PP import XMonad.Hooks.UrgencyHook (readUrgents) import XMonad.Util.Font (Align (..)) import XMonad.Util.NamedWindows (getName, getNameWMClass) import Control.Exception as E import XMonad.Prelude (find, fromMaybe, isPrefixOf, isSuffixOf, WindowScreen) import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) import System.Directory (getDirectoryContents) import System.IO (hGetLine) import System.Process (runInteractiveCommand) econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- Use this module by importing it into your @xmonad.hs@: -- -- > import XMonad.Util.Loggers -- -- Then, add one or more loggers to the -- 'XMonad.Hooks.StatusBar.PP.ppExtras' field of your -- "XMonad.Hooks.StatusBar.PP", possibly with extra formatting . -- For example: -- -- > 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 -- @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.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.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 PP. -- -- Additional loggers welcome! -- | 'Logger' is just a convenient synonym for @X (Maybe String)@. type Logger = X (Maybe String) -- $system -- | Get the current volume with @aumix@. aumixVolume :: Logger aumixVolume = logCmd "aumix -vq" -- | 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 @acpi@ and @sed@ are installed.) battery :: Logger 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 -- by the C library function strftime; for example, -- @date \"%a %b %d\"@ might display something like @Tue Feb 19@. -- For more information see something like -- . date :: String -> Logger date fmt = io $ Just . formatTime defaultTimeLocale fmt <$> getCurrentTime -- | Get the load average. This assumes that you have a -- 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 "uptime | sed 's/.*: //; s/,//g'" -- | Create a 'Logger' from an arbitrary shell command. logCmd :: String -> Logger logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c fmap Just (hGetLine out) `E.catch` econst Nothing -- no need to waitForProcess, we ignore SIGCHLD -- | Get a count of filtered files in a directory. -- See 'maildirUnread' and 'maildirNew' source for usage examples. logFileCount :: FilePath -- ^ directory in which to count files -> (String -> Bool) -- ^ predicate to match if file should be counted -> Logger logFileCount d p = do c <- liftIO ( getDirectoryContents d) let n = length $ Prelude.filter p c case n of 0 -> return Nothing _ -> return $ Just $ show n -- | Get a count of unread mails in a maildir. For maildir format -- details, to write loggers for other classes of mail, see -- and 'logFileCount'. maildirUnread :: FilePath -> Logger maildirUnread mdir = logFileCount (mdir ++ "/cur/") (isSuffixOf ",") -- | Get a count of new mails in a maildir. maildirNew :: FilePath -> Logger maildirNew mdir = logFileCount (mdir ++ "/new/") (not . isPrefixOf ".") -- $xmonad -- -- A very small sample of what you can log since you have access to X. For -- example you can loggerize the number of windows on each workspace, or -- titles on other workspaces, or the id of the previously focused workspace.... -- | Internal function to get a wrapped title string from a window fetchWindowTitle :: Window -> X String fetchWindowTitle = fmap show . getName -- | Get the title (name) of the focused window. logTitle :: Logger logTitle = logWindowInfoFocusedWindow fetchWindowTitle -- | Get the titles of all windows on the visible workspace of the given -- screen and format them according to the given functions. -- -- ==== __Example__ -- -- > myXmobarPP :: X PP -- > myXmobarPP = pure $ def -- > { ppOrder = [ws, l, _, wins] -> [ws, l, wins] -- > , ppExtras = [logTitles formatFocused formatUnfocused] -- > } -- > where -- > formatFocused = wrap "[" "]" . xmobarColor "#ff79c6" "" . shorten 50 . xmobarStrip -- > formatUnfocused = wrap "(" ")" . xmobarColor "#bd93f9" "" . shorten 30 . xmobarStrip -- logTitlesOnScreen :: ScreenId -- ^ Screen to log the titles on -> (String -> String) -- ^ Formatting for the focused window -> (String -> String) -- ^ Formatting for the unfocused window -> Logger logTitlesOnScreen sid formatFoc formatUnfoc = logWindowInfoOnScreen fetchWindowTitle sid formatFoc formatUnfoc formatUnfoc -- | Like 'logTitlesOnScreen' but with support for urgent windows. To -- be used with "XMonad.Hooks.UrgencyHook". logTitlesOnScreen' :: ScreenId -> TitlesFormat -> Logger logTitlesOnScreen' sid (TitlesFormat formatFoc formatUnfoc formatUrg) = logWindowInfoOnScreen fetchWindowTitle sid formatFoc formatUnfoc formatUrg -- | Like 'logTitlesOnScreen', but directly use the "focused" screen -- (the one with the currently focused workspace). logTitles :: (String -> String) -> (String -> String) -> Logger logTitles formatFoc formatUnfoc = logWindowInfoFocusedScreen fetchWindowTitle formatFoc formatUnfoc formatUnfoc -- | Variant of 'logTitles', but with support for urgent windows. logTitles' :: TitlesFormat -> Logger logTitles' (TitlesFormat formatFoc formatUnfoc formatUrg) = logWindowInfoFocusedScreen fetchWindowTitle formatFoc formatUnfoc formatUrg -- | Formatting applied to the titles of certain windows. data TitlesFormat = TitlesFormat { focusedFormat :: String -> String -- ^ Focused formatting. , unfocusedFormat :: String -> String -- ^ Unfocused formatting. , urgentFormat :: String -> String -- ^ Formatting when urgent. } -- | How to format these titles by default when using 'logTitles'' and -- 'logTitlesOnScreen''. instance Default TitlesFormat where def = TitlesFormat { focusedFormat = xmobarFocusedFormat , unfocusedFormat = xmobarWsFormat , urgentFormat = xmobarUrgentFormat } -- | Internal function to get a wrapped classname string from a window fetchWindowClassname :: Window -> X String fetchWindowClassname = fmap show . getNameWMClass -- | Get the classname of the focused window. logClassname :: Logger logClassname = logWindowInfoFocusedWindow fetchWindowClassname -- | Get the classnames of all windows on the visible workspace of the given -- screen and format them according to the given functions. logClassnamesOnScreen :: ScreenId -- ^ Screen to log the classnames on -> (String -> String) -- ^ Formatting for the focused window -> (String -> String) -- ^ Formatting for the unfocused window -> Logger logClassnamesOnScreen sid formatFoc formatUnfoc = logWindowInfoOnScreen fetchWindowClassname sid formatFoc formatUnfoc formatUnfoc -- | Like 'logClassnamesOnScreen' but with support for urgent windows. To -- be used with "XMonad.Hooks.UrgencyHook". logClassnamesOnScreen' :: ScreenId -> ClassnamesFormat -> Logger logClassnamesOnScreen' sid (ClassnamesFormat formatFoc formatUnfoc formatUrg) = logWindowInfoOnScreen fetchWindowClassname sid formatFoc formatUnfoc formatUrg -- | Like 'logClassnamesOnScreen', but directly use the "focused" screen -- (the one with the currently focused workspace). logClassnames :: (String -> String) -> (String -> String) -> Logger logClassnames formatFoc formatUnfoc = logWindowInfoFocusedScreen fetchWindowClassname formatFoc formatUnfoc formatUnfoc -- | Variant of 'logClassnames', but with support for urgent windows. logClassnames' :: ClassnamesFormat -> Logger logClassnames' (ClassnamesFormat formatFoc formatUnfoc formatUrg) = logWindowInfoFocusedScreen fetchWindowClassname formatFoc formatUnfoc formatUrg -- | Formatting applied to the classnames of certain windows. data ClassnamesFormat = ClassnamesFormat { focusedFormatClassname :: String -> String -- ^ Focused formatting. , unfocusedFormatClassname :: String -> String -- ^ Unfocused formatting. , urgentFormatClassname :: String -> String -- ^ Formatting when urgent. } -- | How to format these classnames by default when using 'logClassnames'' and -- 'logClassnamesOnScreen''. instance Default ClassnamesFormat where def = ClassnamesFormat { focusedFormatClassname = xmobarFocusedFormat , unfocusedFormatClassname = xmobarWsFormat , urgentFormatClassname = xmobarUrgentFormat } -- | Internal function to get the specified window information for all windows on -- the visible workspace of the given screen and format them according to the -- given functions. logWindowInfoOnScreen :: (Window -> X String) -> ScreenId -> (String -> String) -> (String -> String) -> (String -> String) -> Logger logWindowInfoOnScreen getWindowInfo sid formatFoc formatUnfoc formatUrg = (`withScreen` sid) $ \screen -> do let focWin = fmap W.focus . W.stack . W.workspace $ screen urgWins <- readUrgents logWindowInfoOnScreenWorker getWindowInfo screen $ \win name -> if | Just win == focWin -> formatFoc name | win `elem` urgWins -> formatUrg name | otherwise -> formatUnfoc name -- | Internal helper function for 'logWindowInfoOnScreen'. logWindowInfoOnScreenWorker :: (Window -> X String) -> WindowScreen -> (Window -> String -> String) -> Logger logWindowInfoOnScreenWorker getWindowInfo screen logger = do let wins = maybe [] W.integrate . W.stack . W.workspace $ screen winNames <- traverse getWindowInfo wins pure . Just . unwords $ zipWith logger wins winNames -- | Internal. Like 'logWindowInfoOnScreen', but directly use the "focused" screen -- (the one with the currently focused workspace). logWindowInfoFocusedScreen :: (Window -> X String) -> (String -> String) -> (String -> String) -> (String -> String) -> Logger logWindowInfoFocusedScreen getWindowInfo formatFoc formatUnfoc formatUrg = do sid <- gets $ W.screen . W.current . windowset logWindowInfoOnScreen getWindowInfo sid formatFoc formatUnfoc formatUrg -- | Internal function to get the specified information for the currently focused window logWindowInfoFocusedWindow :: (Window -> X String) -> Logger logWindowInfoFocusedWindow getWindowInfo = withWindowSet $ traverse getWindowInfo . W.peek -- | Internal formatting helpers xmobarWsFormat, xmobarFocusedFormat, xmobarUrgentFormat :: String -> String xmobarWsFormat = xmobarRaw . shorten 30 . xmobarStrip xmobarFocusedFormat = wrap "[" "]" . xmobarWsFormat xmobarUrgentFormat = wrap "!" "!" . xmobarWsFormat -- | Get the name of the current layout. logLayout :: Logger logLayout = withWindowSet $ return . Just . ld where ld = description . W.layout . W.workspace . W.current -- | Get the name of the current workspace. logCurrent :: Logger logCurrent = withWindowSet $ return . Just . W.currentTag -- | Log the given string, as is. logConst :: String -> Logger logConst = return . Just -- | If the first logger returns @Nothing@, the default logger is used. -- For example, to display a quote when no windows are on the screen, -- you can do: -- -- > logDefault logTitle (logConst "Hey, you, you're finally awake.") logDefault :: Logger -> Logger -> Logger logDefault l d = l >>= maybe d logConst -- | An infix operator for 'logDefault', which can be more convenient to -- combine multiple loggers. -- -- > logTitle .| logWhenActive 0 (logConst "*") .| logConst "There's nothing here" (.|) :: Logger -> Logger -> Logger (.|) = logDefault -- $xmonad-screen -- It is also possible to bind loggers like 'logTitle' to a specific screen. For -- example, using @logTitleOnScreen 1@ will log the title of the focused window -- on screen 1, even if screen 1 is not currently active. -- | Only display the 'Logger' if the screen with the given 'ScreenId' is -- active. -- For example, this can be used to create a marker that is only displayed -- when the primary screen is active. -- -- > logWhenActive 0 (logConst "*") logWhenActive :: ScreenId -> Logger -> Logger logWhenActive n l = do c <- withWindowSet $ return . W.screen . W.current if n == c then l else return Nothing -- | Get the title (name) of the focused window, on the given screen. logTitleOnScreen :: ScreenId -> Logger logTitleOnScreen = logWindowInfoFocusedWindowOnScreen fetchWindowTitle -- | Get the classname of the focused window, on the given screen. logClassnameOnScreen :: ScreenId -> Logger logClassnameOnScreen = logWindowInfoFocusedWindowOnScreen fetchWindowClassname -- | Internal function to get the specified information for the focused window, -- on the given screen. logWindowInfoFocusedWindowOnScreen :: (Window -> X String) -> ScreenId -> Logger logWindowInfoFocusedWindowOnScreen getWindowInfo = withScreen $ traverse getWindowInfo . (W.focus <$>) . W.stack . W.workspace -- | Get the name of the visible workspace on the given screen. logCurrentOnScreen :: ScreenId -> Logger logCurrentOnScreen = withScreen $ logConst . W.tag . W.workspace -- | Get the name of the current layout on the given screen. logLayoutOnScreen :: ScreenId -> Logger logLayoutOnScreen = withScreen $ logConst . description . W.layout . W.workspace -- | A helper function to create screen-specific loggers. withScreen :: (WindowScreen -> Logger) -> ScreenId -> Logger withScreen f n = do ss <- withWindowSet $ return . W.screens case find ((== n) . W.screen) ss of Just s -> f s Nothing -> pure Nothing -- $format -- Combine logger formatting functions to make your -- 'XMonad.Hooks.StatusBar.PP.ppExtras' more colorful and readable. -- (For convenience, you can use '<$>' instead of \'.\' or \'$\' in hard to read -- formatting lines. -- For example: -- -- > myPP = def { -- > -- skipped -- > , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"] -- > , ppOrder = \(ws:l:_:xs) -> [l,ws] ++ xs -- > } -- > where -- > -- lTitle = fixedWidthL AlignCenter "." 99 . dzenColorL "cornsilk3" "" . padL . shortenL 80 $ logTitle -- > -- or something like: -- > lTitle = fixedWidthL AlignCenter "." 99 <$> dzenColorL "cornsilk3" "" <$> padL . shortenL 80 $ logTitle -- > -- > 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 -- /after/ the length adjustment, or include \"invisible\" characters -- in the length specification, e.g. in the above \'^fg(cornsilk3)\' and -- \'^fg()' yields 19 invisible and 80 visible characters. -- | Use a string formatting function to edit a 'Logger' string. -- For example, to create a tag function to prefix or label loggers, -- as in \'tag: output\', use: -- -- > tagL l = onLogger $ wrap (l ++ ": ") "" -- > -- > tagL "bat" battery -- > tagL "load" loadAvg -- -- If you already have a (String -> String) function you want to -- apply to a logger: -- -- > revL = onLogger trim -- -- See formatting utility source code for more 'onLogger' usage examples. onLogger :: (String -> String) -> Logger -> Logger onLogger = fmap . fmap -- | Wrap a logger's output in delimiters, unless it is @X (Nothing)@ -- or @X (Just \"\")@. Some examples: -- -- > wrapL " | " " | " (date "%a %d %b") -- ' | Tue 19 Feb | ' -- > -- > wrapL "bat: " "" battery -- ' bat: battery_logger_output' wrapL :: String -> String -> Logger -> Logger wrapL l r = onLogger $ wrap l r -- | Make a logger's output constant width by padding with the given string, -- /even if the logger is/ @X (Nothing)@ /or/ @X (Just \"\")@. Useful to -- reduce visual noise as a title logger shrinks and grows, to use a fixed -- width for a logger that sometimes becomes Nothing, or even to create -- fancy spacers or character based art effects. -- -- It fills missing logger output with a repeated character like \".\", -- \":\" or pattern, like \" -.-\". The cycling padding string is reversed on -- the left of the logger output. This is mainly useful with AlignCenter. fixedWidthL :: Align -- ^ AlignCenter, AlignRight, or AlignLeft -> String -- ^ String to cycle to pad missing logger output -> Int -- ^ Fixed length to output (including invisible formatting characters) -> Logger -> Logger fixedWidthL a str n logger = do mbl <- logger let l = fromMaybe "" mbl case a of AlignCenter -> toL (take n $ padhalf l ++ l ++ cs) AlignRight -> toL (reverse (take n $ reverse l ++ cs)) _ -> toL (take n $ l ++ cs) where toL = return . Just cs = cycle str padhalf x = reverse $ take ((n - length x) `div` 2) cs -- | Create a \"spacer\" logger, e.g. @logSp 3 -- loggerizes \' \'@. -- For more complex \"spacers\", use 'fixedWidthL' with @return Nothing@. logSp :: Int -> Logger logSp n = return . Just . take n $ cycle " " -- | Pad a logger's output with a leading and trailing space, unless it -- is @X (Nothing)@ or @X (Just \"\")@. padL :: Logger -> Logger padL = onLogger pad -- | Limit a logger's length, adding \"...\" if truncated. shortenL :: Int -> Logger -> Logger shortenL = onLogger . shorten -- | Color a logger's output with dzen foreground and background colors. -- -- > dzenColorL "green" "#2A4C3F" battery dzenColorL :: String -> String -> Logger -> Logger dzenColorL fg bg = onLogger $ dzenColor fg bg -- | Color a logger's output with xmobar foreground and background colors. -- -- > xmobarColorL "#6A5ACD" "gray6" loadAverage xmobarColorL :: String -> String -> Logger -> Logger xmobarColorL fg bg = onLogger $ xmobarColor fg bg -- todo -- * dynamicLogXinerama logger? Or sorted onscreen Id's with "current" indicator? -- is logCurrent really useful at all? -- -- * ppVisible, etc. Resolve code dup. somehow. Refactor DynamicLog so can -- be used for regular PP stuff /and/ loggers? -- -- * fns for "ppExtras as a whole", combine loggers more nicely. -- -- * parsers to use with fixedWidthL to be smarter about invisible characters? xmonad-contrib-0.18.0/XMonad/Util/Loggers/0000755000000000000000000000000007346545000016422 5ustar0000000000000000xmonad-contrib-0.18.0/XMonad/Util/Loggers/NamedScratchpad.hs0000644000000000000000000001345207346545000022004 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Loggers.NamedScratchpad -- Description : A collection of Loggers for "XMonad.Util.NamedScratchpad". -- Copyright : (c) Brandon S Allbery -- License : BSD-style (see LICENSE) -- -- Maintainer : Brandon S Allbery -- Stability : unstable -- Portability : unportable -- -- "XMonad.Util.Loggers" for "XMonad.Util.NamedScratchpad" -- ----------------------------------------------------------------------------- module XMonad.Util.Loggers.NamedScratchpad (-- * Usage -- $usage nspTrackStartup ,nspTrackHook ,nspActiveIcon ,nspActive ,nspActive') where import XMonad.Core import Graphics.X11.Xlib (Window) import Graphics.X11.Xlib.Extras (Event(..)) import XMonad.Util.Loggers (Logger) import XMonad.Util.NamedScratchpad (NamedScratchpad(..)) import qualified XMonad.Util.ExtensibleState as XS import XMonad.Prelude (All (..), chr, foldM, forM) import qualified Data.IntMap as M import qualified XMonad.StackSet as W (allWindows) -- $usage -- 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.StatusBar.PP.ppExtras'. -- -- You must add 'nspTrackStartup' to your 'startupHook' to initialize -- 'NamedScratchpad' tracking and to detect any currently running -- 'NamedScratchpad's on restart, and 'nspTrackHook' to your 'handleEventHook' -- to track the coming and going of 'NamedScratchpad's. -- -- Why would you want to do this? If you aren't using 'EwmhDesktops', this -- gives you a way to see what 'NamedScratchpad's are running. If you are -- using 'EwmhDesktops' then you can get that from a taskbar... but you may -- have noticed that selecting the window from the taskbar moves you to -- the 'NSP' workspace instead of moving the window to the current workspace. -- (This is difficult to change; "minimizing" by moving it back to 'NSP' -- is even harder.) -- I hide the 'NamedScratchpad's from the taskbar and use this to track -- them instead (see "XMonad.Util.NoTaskbar"). -- The extension data for tracking NSP windows newtype NSPTrack = NSPTrack [Maybe Window] instance ExtensionClass NSPTrack where initialValue = NSPTrack [] -- | 'startupHook' to initialize scratchpad activation tracking -- -- > , startupHook = ... <> nspTrackStartup scratchpads -- -- If you kickstart the 'logHook', do it /after/ 'nspTrackStartup'! nspTrackStartup :: [NamedScratchpad] -> X () nspTrackStartup ns = do let ns'i = M.fromList $ zip [0..] $ map (const Nothing) ns ns' <- withWindowSet $ foldM (isSp ns) ns'i . W.allWindows XS.put (NSPTrack (map snd $ M.toAscList ns')) isSp :: [NamedScratchpad] -> M.IntMap (Maybe Window) -> Window -> X (M.IntMap (Maybe Window)) isSp ns ws w = do n <- runQuery (scratchpadWindow ns) w return $ case n of Nothing -> ws Just n' -> M.insert n' (Just w) ws scratchpadWindow :: [NamedScratchpad] -> Query (Maybe Int) scratchpadWindow ns = foldM sp' Nothing (zip [0..] ns) where sp' :: Maybe Int -> (Int,NamedScratchpad) -> Query (Maybe Int) sp' r@(Just _) _ = return r sp' Nothing (n,NS _ _ q _) = q >>= \p -> return $ if p then Just n else Nothing -- | 'handleEventHook' to track scratchpad activation/deactivation -- -- > , handleEventHook = ... <> nspTrackHook scratchpads nspTrackHook :: [NamedScratchpad] -> Event -> X All 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 NSPTrack ws <- XS.get 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' return (All True) nspTrackHook _ _ = return (All True) -- | 'Logger' for scratchpads' state, using Unicode characters as "icons". -- -- > , ppExtras = [..., nspActive' iconChars showActive showInactive, ...] nspActiveIcon :: [Char] -> (String -> String) -> (String -> String) -> Logger nspActiveIcon icns act inact = do NSPTrack ws <- XS.get return $ if null ws then Nothing else let icon' n = if n < length icns then icns !! n else '\NUL' icon n = let c = icon' n in [if c == '\NUL' then chr (0x2460 + n) else c] ckact n w = let icn = icon n in case w of Nothing -> inact icn Just _ -> act icn s = unwords $ zipWith ckact [0..] ws in Just s -- | 'Logger' with String-s (and no defaults) -- -- > , ppExtras = [..., nspActive iconStrs showActive showInactive, ...] nspActive :: [String] -> (String -> String) -> (String -> String) -> Logger nspActive icns act inact = do NSPTrack ws <- XS.get return $ if null ws then Nothing else let ckact n w = let icn = icns !! n in case w of Nothing -> inact icn Just _ -> act icn s = unwords $ zipWith ckact [0..] ws in Just s -- | Variant of the above getting the String-s from the 'NamedScratchpad's nspActive' :: [NamedScratchpad] -> (String -> String) -> (String -> String) -> Logger nspActive' ns = nspActive (map name ns) xmonad-contrib-0.18.0/XMonad/Util/Minimize.hs0000644000000000000000000000207207346545000017136 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Minimize -- Description : Common utilities for window minimizing\/maximizing. -- Copyright : (c) Bogdan Sinitsyn (2016) -- License : BSD3-style (see LICENSE) -- -- Maintainer : bogdan.sinitsyn@gmail.com -- Stability : unstable -- Portability : not portable -- -- Stores some common utilities for modules used for window minimizing/maximizing -- ----------------------------------------------------------------------------- module XMonad.Util.Minimize ( RectMap , Minimized(..) ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M type RectMap = M.Map Window (Maybe W.RationalRect) data Minimized = Minimized { rectMap :: RectMap , minimizedStack :: [Window] } deriving (Eq, Read, Show) instance ExtensionClass Minimized where initialValue = Minimized { rectMap = M.empty , minimizedStack = [] } extensionType = PersistentExtension xmonad-contrib-0.18.0/XMonad/Util/NamedActions.hs0000644000000000000000000002742207346545000017730 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# 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 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- A wrapper for keybinding configuration that can list the available -- keybindings. -- -- Note that xmonad>=0.11 has by default a list of the default keybindings -- bound to @M-S-/@ or @M-?@. -------------------------------------------------------------------- module XMonad.Util.NamedActions ( -- * Usage: -- $usage sendMessage', spawn', submapName, addDescrKeys, addDescrKeys', xMessage, showKmSimple, showKm, noName, oneName, addName, separator, subtitle, (^++^), NamedAction(..), HasName, defaultKeysDescr ) where import XMonad.Actions.Submap(submap) import XMonad.Prelude (groupBy, keyToString) import XMonad import Control.Arrow(Arrow((&&&), second)) import System.Exit(exitSuccess) import qualified Data.Map as M import qualified XMonad.StackSet as W -- $usage -- Here is an example config that demonstrates the usage of 'sendMessage'', -- 'mkNamedKeymap', 'addDescrKeys', and '^++^' -- -- > import XMonad -- > import XMonad.Util.NamedActions -- > import XMonad.Util.EZConfig -- > -- > main = xmonad $ addDescrKeys ((mod4Mask, xK_F1), xMessage) myKeys -- > def { modMask = mod4Mask } -- > -- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $ -- > [("M-x a", addName "useless message" $ spawn "xmessage foo"), -- > ("M-c", sendMessage' Expand)] -- > ^++^ -- > [("", spawn "mpc toggle" :: X ()), -- > ("", spawn "mpc next")] -- -- Using '^++^', you can combine bindings whose actions are @X ()@ -- as well as actions that have descriptions. However you cannot mix the two in -- a single list, unless each is prefixed with 'addName' or 'noName'. -- -- If you don't like EZConfig, you can still use '^++^' with the basic XMonad -- keybinding configuration too. -- -- Also note the unfortunate necessity of a type annotation, since 'spawn' is -- too general. -- TODO: squeeze titles that have no entries (consider titles containing \n) -- -- Output to Multiple columns -- -- Devin Mullin's suggestions: -- -- Reduce redundancy wrt mkNamedSubmaps, mkSubmaps and mkNamedKeymap to have a -- HasName context (and leave mkKeymap as a specific case of it?) -- Currently kept separate to aid error messages, common lines factored out -- -- Suggestions for UI: -- -- - An IO () -> IO () that wraps the main xmonad action and wrests control -- from it if the user asks for --keys. -- -- Just a separate binary: keep this as the only way to show keys for simplicity -- -- - An X () that toggles a cute little overlay like the ? window for gmail -- and reader. -- -- Add dzen binding deriving instance Show XMonad.Resize deriving instance Show XMonad.IncMasterN -- | '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) -- | '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 () instance HasName (X ()) where getAction = id instance HasName (IO ()) where getAction = io instance HasName [Char] where getAction _ = return () showName = (:[]) instance HasName (X (),String) where showName = (:[]) . snd getAction = fst instance HasName (X (),[String]) where showName = snd getAction = fst -- show only the outermost description instance HasName (NamedAction,String) where showName = (:[]) . snd getAction = getAction . fst instance HasName NamedAction where showName (NamedAction x) = showName x getAction (NamedAction x) = getAction x -- | An existential wrapper so that different types can be combined in lists, -- and maps data NamedAction = forall a. HasName a => NamedAction a -- | 'submap', but propagate the descriptions of the actions. Does this belong -- in "XMonad.Actions.Submap"? submapName :: (HasName a) => [((KeyMask, KeySym), a)] -> NamedAction submapName = NamedAction . (submap . M.map getAction . M.fromList &&& showKm) . map (second NamedAction) -- | Combine keymap lists with actions that may or may not have names (^++^) :: (HasName b, HasName b1) => [(d, b)] -> [(d, b1)] -> [(d, NamedAction)] a ^++^ b = map (second NamedAction) a ++ map (second NamedAction) b showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] showKmSimple = concatMap (\(k,e) -> if snd k == 0 then "":showName e else map ((keyToString k ++) . smartSpace) $ showName e) smartSpace :: String -> String smartSpace [] = [] smartSpace xs = ' ':xs _test :: String _test = unlines $ showKm $ defaultKeysDescr XMonad.def { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.def } showKm :: [((KeyMask, KeySym), NamedAction)] -> [String] showKm keybindings = padding $ do (k,e) <- keybindings 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 getMax = map (maximum . map (length . fst)) in concat . (zipWith expand <*> getMax) . groupBy (const $ not . null . fst) -- | 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" $ xmessage $ unlines $ showKm x -- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding -- to run an action for showing the keybindings. addDescrKeys :: (HasName b1, HasName b) => ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b) -> (XConfig Layout -> [((KeyMask, KeySym), b1)]) -> XConfig l -> XConfig l addDescrKeys k ks = addDescrKeys' k (\l -> defaultKeysDescr l ^++^ ks l) -- | Without merging with 'defaultKeysDescr' addDescrKeys' :: (HasName b) => ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b) -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)]) -> XConfig l -> XConfig l addDescrKeys' (k,f) ks conf = let shk l = f $ [(k,f $ ks l)] ^++^ ks l keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)] in conf { keys = keylist <> keys conf } -- | A version of the default keys from the default configuration, but with -- 'NamedAction' instead of @X ()@ defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] defaultKeysDescr conf@XConfig{XMonad.modMask = modm} = [ 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 , ((modm .|. shiftMask, xK_p ), addName "Launch gmrun" $ spawn "gmrun") -- %! Launch gmrun , ((modm .|. shiftMask, xK_c ), addName "Close the focused window" kill) -- %! Close the focused window , subtitle "changing layouts" , ((modm, xK_space ), sendMessage' NextLayout) -- %! Rotate through the available layout algorithms , ((modm .|. shiftMask, xK_space ), addName "Reset the layout" $ setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default , separator , ((modm, xK_n ), addName "Refresh" refresh) -- %! Resize viewed windows to the correct size , subtitle "move focus up or down the window stack" , ((modm, xK_Tab ), addName "Focus down" $ windows W.focusDown) -- %! Move focus to the next window , ((modm .|. shiftMask, xK_Tab ), addName "Focus up" $ windows W.focusUp ) -- %! Move focus to the previous window , ((modm, xK_j ), addName "Focus down" $ windows W.focusDown) -- %! Move focus to the next window , ((modm, xK_k ), addName "Focus up" $ windows W.focusUp ) -- %! Move focus to the previous window , ((modm, xK_m ), addName "Focus the master" $ windows W.focusMaster ) -- %! Move focus to the master window , subtitle "modifying the window order" , ((modm, xK_Return), addName "Swap with the master" $ windows W.swapMaster) -- %! Swap the focused window and the master window , ((modm .|. shiftMask, xK_j ), addName "Swap down" $ windows W.swapDown ) -- %! Swap the focused window with the next window , ((modm .|. shiftMask, xK_k ), addName "Swap up" $ windows W.swapUp ) -- %! Swap the focused window with the previous window , subtitle "resizing the master/slave ratio" , ((modm, xK_h ), sendMessage' Shrink) -- %! Shrink the master area , ((modm, xK_l ), sendMessage' Expand) -- %! Expand the master area , subtitle "floating layer support" , ((modm, xK_t ), addName "Push floating to tiled" $ withFocused $ windows . W.sink) -- %! Push window back into tiling , subtitle "change the number of windows in the master area" , ((modm , xK_comma ), sendMessage' (IncMasterN 1)) -- %! Increment the number of windows in the master area , ((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 exitSuccess) -- %! Quit xmonad , ((modm , xK_q ), addName "Restart" $ spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad ] -- mod-[1..9] %! Switch to workspace N -- mod-shift-[1..9] %! Move client to workspace N ++ subtitle "switching workspaces": [((m .|. modm, k), addName (n ++ i) $ windows $ f i) | (f, m, n) <- [(W.greedyView, 0, "Switch to workspace "), (W.shift, shiftMask, "Move client to workspace ")] , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 ++ subtitle "switching screens" : [((m .|. modm, key), addName (n ++ show sc) $ screenWorkspace sc >>= flip whenJust (windows . f)) | (f, m, n) <- [(W.view, 0, "Switch to screen number "), (W.shift, shiftMask, "Move client to screen number ")] , (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] -- | For a prettier presentation: keymask, keysym of 0 are reserved for this -- purpose: they do not happen, afaik, and keysymToString 0 would raise an -- error otherwise separator :: ((KeyMask,KeySym), NamedAction) separator = ((0,0), NamedAction (return () :: X (),[] :: [String])) subtitle :: String -> ((KeyMask, KeySym), NamedAction) subtitle x = ((0,0), NamedAction $ x ++ ":") -- | These are just the @NamedAction@ constructor but with a more specialized -- type, so that you don't have to supply any annotations, for ex coercing -- spawn to @X ()@ from the more general @MonadIO m => m ()@ noName :: X () -> NamedAction noName = NamedAction oneName :: (X (), String) -> NamedAction oneName = NamedAction addName :: String -> X () -> NamedAction addName = flip (curry NamedAction) xmonad-contrib-0.18.0/XMonad/Util/NamedScratchpad.hs0000644000000000000000000006432107346545000020403 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedScratchpad -- Description : Toggle arbitrary windows to and from the current workspace. -- Copyright : (c) Konstantin Sobolev -- License : BSD-style (see LICENSE) -- -- Maintainer : Konstantin Sobolev -- Stability : unstable -- Portability : unportable -- -- Named scratchpads that support several arbitrary applications at the same time. -- ----------------------------------------------------------------------------- module XMonad.Util.NamedScratchpad ( -- * Usage -- $usage NamedScratchpad(..), scratchpadWorkspaceTag, nonFloating, defaultFloating, customFloating, NamedScratchpads, namedScratchpadAction, spawnHereNamedScratchpadAction, customRunNamedScratchpadAction, allNamedScratchpadAction, namedScratchpadManageHook, nsHideOnFocusLoss, nsSingleScratchpadPerWorkspace, -- * Dynamic Scratchpads -- $dynamic-scratchpads dynamicNSPAction, toggleDynamicNSP, -- * Exclusive Scratchpads -- $exclusive-scratchpads addExclusives, -- ** Keyboard related resetFocusedNSP, -- ** Mouse related setNoexclusive, resizeNoexclusive, floatMoveNoexclusive, -- * Deprecations namedScratchpadFilterOutWorkspace, namedScratchpadFilterOutWorkspacePP, ) where import Data.Map.Strict (Map, (!?)) import XMonad import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) import XMonad.Actions.SpawnOn (spawnHere) import XMonad.Actions.TagWindows (addTag, delTag) import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Hooks.RefocusLast (withRecentsIn) import XMonad.Hooks.StatusBar.PP (PP, ppSort) import XMonad.Prelude (appEndo, filterM, findM, foldl', for_, liftA2, unless, void, when, (<=<)) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -- $usage -- Allows to have several floating scratchpads running different applications. -- Bind a key to 'namedScratchpadAction'. -- Pressing it will spawn configured application, or bring it to the current -- workspace if it already exists. -- Pressing the key with the application on the current workspace will -- send it to a hidden workspace called @NSP@. -- -- If you already have a workspace called @NSP@, it will use that. -- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your -- @dynamicLog@ settings to filter it out if you like. -- -- Create named scratchpads configuration in your xmonad.hs like this: -- -- > import XMonad.StackSet as W -- > import XMonad.ManageHook -- > import XMonad.Util.NamedScratchpad -- > -- > scratchpads = [ -- > -- run htop in xterm, find it by title, use default floating window placement -- > NS "htop" "xterm -e htop" (title =? "htop") defaultFloating , -- > -- > -- run stardict, find it by class name, place it in the floating window -- > -- 1/6 of screen width from the left, 1/6 of screen height -- > -- from the top, 2/3 of screen width by 2/3 of screen height -- > NS "stardict" "stardict" (className =? "Stardict") -- > (customFloating $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) , -- > -- > -- run gvim, find by role, don't float -- > NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") nonFloating -- > ] where role = stringProperty "WM_WINDOW_ROLE" -- -- Add keybindings: -- -- > , ((modm .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop") -- > , ((modm .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict") -- > , ((modm .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes") -- -- ... and a manage hook: -- -- > , manageHook = namedScratchpadManageHook scratchpads -- -- For detailed instruction on editing the key binding see -- -- -- For some applications (like displaying your workspaces in a status bar) it -- is convenient to filter out the @NSP@ workspace when looking at all -- workspaces. For this, you can use 'XMonad.Hooks.StatusBar.PP.filterOutWsPP', -- or 'XMonad.Util.WorkspaceCompare.filterOutWs' together with -- 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort' if your status bar gets -- the list of workspaces from EWMH. See the documentation of these functions -- for examples. -- -- If you want to explore this module further, scratchpads can come in -- many forms and flavours: -- -- + \"Regular\" scratchpads: they can be predefined and -- summoned/banished with a key press. These are the scratchpads -- that you have seen above. -- -- + [Dynamic scratchpads](#g:dynamic-scratchpads), which allow you to -- dynamically declare existing windows as scratchpads. These can -- be treated as a separate type of scratchpad. -- -- + [Exclusive](#g:exclusive-scratchpads) scratchpads, which can be -- seen as a property of already existing scratchpads. Marking -- scratchpads as exclusive will not allow them to be shown on the -- same workspace; the scratchpad being brought up will hide the -- others. -- -- See the relevant sections in the documentation for more information. -- -- Further, there is also a @logHook@ that you can use to hide -- scratchpads when they lose focus; this is functionality akin to what -- some dropdown terminals provide. See the documentation of -- 'nsHideOnFocusLoss' for an example how to set this up. -- -- | Single named scratchpad configuration data NamedScratchpad = NS { name :: String -- ^ Scratchpad name , cmd :: String -- ^ Command used to run application , query :: Query Bool -- ^ Query to find already running application , hook :: ManageHook -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@ } -- | The NSP state. data NSPState = NSPState { nspExclusives :: !(Map String NamedScratchpads) -- ^ Associates the name of a scratchpad to some list of scratchpads -- that should be mutually exclusive to it. , nspScratchpads :: !(Map String NamedScratchpad) -- ^ Associates a name to an entire scratchpad. } instance ExtensionClass NSPState where initialValue :: NSPState initialValue = NSPState mempty mempty -- | Try to: -- -- (i) Fill the 'nspScratchpads' portion of the 'NSPState' with the -- given list of scratchpads. In case that particular map of the -- state is already non-empty, don't do anything and return that -- state. -- -- (ii) Replace possibly dummy scratchpads in @nspExclusives@ with -- proper values. For convenience, the user may specify -- exclusive scratchpads by name in the startup hook. However, -- we don't necessarily have all information then to immediately -- turn these into proper NamedScratchpads. As such, we thinly -- wrap the names into an NSP skeleton, to be filled in later. -- This function, to be executed _before_ -- 'someNamedScratchpadAction' is the (latest) point where that -- happens. fillNSPState :: NamedScratchpads -> X NSPState fillNSPState nsps = do nsp@(NSPState exs scratches) <- XS.get if null scratches then let nspState = NSPState (fillOut exs) nspScratches in nspState <$ XS.put nspState else pure nsp where -- @fillNSPState@ only runs once, so the complexity here is probably -- not a big deal. nspScratches :: Map String NamedScratchpad nspScratches = Map.fromList $ zip (map name nsps) nsps fillOut :: Map String [NamedScratchpad] -> Map String [NamedScratchpad] fillOut exs = foldl' (\nspMap n -> Map.map (replaceWith n) nspMap) exs nsps replaceWith :: NamedScratchpad -> [NamedScratchpad] -> [NamedScratchpad] replaceWith n = map (\x -> if name x == name n then n else x) -- | Manage hook that makes the window non-floating nonFloating :: ManageHook nonFloating = idHook -- | Manage hook that makes the window floating with the default placement defaultFloating :: ManageHook defaultFloating = doFloat -- | Manage hook that makes the window floating with custom placement customFloating :: W.RationalRect -> ManageHook customFloating = doRectFloat -- | @isNSP win nsps@ checks whether the window @win@ is any scratchpad -- in @nsps@. isNSP :: Window -> NamedScratchpads -> X Bool isNSP w = fmap or . traverse ((`runQuery` w) . query) -- | Named scratchpads configuration type NamedScratchpads = [NamedScratchpad] -- | Runs application which should appear in specified scratchpad runApplication :: NamedScratchpad -> X () runApplication = spawn . cmd -- | Runs application which should appear in a specified scratchpad on the workspace it was launched on runApplicationHere :: NamedScratchpad -> X () runApplicationHere = spawnHere . cmd -- | Action to pop up specified named scratchpad -- -- Note [Ignored Arguments]: Most of the time, this function ignores its -- first argument and uses 'NSPState' instead. The only time when it -- does not is when no other window has been opened before in the -- running xmonad instance. If this is not your use-case, you can -- safely call this function with an empty list. namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration -> String -- ^ Scratchpad name -> X () namedScratchpadAction = customRunNamedScratchpadAction runApplication -- | Action to pop up specified named scratchpad, initially starting it on the current workspace. -- -- This function /almost always/ ignores its first argument; see Note -- [Ignored Arguments] for 'namedScratchpadAction'. spawnHereNamedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration -> String -- ^ Scratchpad name -> X () spawnHereNamedScratchpadAction = customRunNamedScratchpadAction runApplicationHere -- | Action to pop up specified named scratchpad, given a custom way to initially start the application. -- -- This function /almost always/ ignores its second argument; see Note -- [Ignored Arguments] for 'namedScratchpadAction'. customRunNamedScratchpadAction :: (NamedScratchpad -> X ()) -- ^ Function initially running the application, given the configured @scratchpad@ cmd -> NamedScratchpads -- ^ Named scratchpads configuration -> String -- ^ Scratchpad name -> X () customRunNamedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ NE.head ws) -- | Like 'namedScratchpadAction', but execute the action for all -- scratchpads that match the query. -- -- This function /almost always/ ignores its first argument; see Note -- [Ignored Arguments] for 'namedScratchpadAction'. allNamedScratchpadAction :: NamedScratchpads -> String -> X () allNamedScratchpadAction = someNamedScratchpadAction mapM_ runApplication -- | A @logHook@ to hide scratchpads when they lose focus. This can be -- useful for e.g. dropdown terminals. Note that this also requires you -- to use the 'XMonad.Hooks.RefocusLast.refocusLastLogHook'. -- -- ==== __Example__ -- -- > import XMonad.Hooks.RefocusLast (refocusLastLogHook) -- > import XMonad.Util.NamedScratchpad -- > -- > main = xmonad $ def -- > { logHook = refocusLastLogHook -- > >> nsHideOnFocusLoss myScratchpads -- > -- enable hiding for all of @myScratchpads@ -- > } nsHideOnFocusLoss :: NamedScratchpads -> X () nsHideOnFocusLoss scratches = nsHideOnCondition $ \ lastFocus _curFoc _ws hideScratch -> whenX (isNSP lastFocus scratches) $ hideScratch lastFocus -- | A @logHook@ to have only one active scratchpad on a workspace. This can -- be useful when working with multiple floating scratchpads which would -- otherwise be stacked. Note that this also requires you to use the -- 'XMonad.Hooks.RefocusLast.refocusLastLogHook'. -- -- ==== __Example__ -- -- > import XMonad.Hooks.RefocusLast (refocusLastLogHook) -- > import XMonad.Util.NamedScratchpad -- > -- > main = xmonad $ def -- > { logHook = refocusLastLogHook -- > >> nsHideOnNewScratchpad myScratchpads -- > -- enable hiding for all of @myScratchpads@ -- > } nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X () nsSingleScratchpadPerWorkspace scratches = nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do allScratchesButCurrent <- filterM (liftA2 (<||>) (pure . (/= curFocus)) (`isNSP` scratches)) (W.index winSet) whenX (isNSP curFocus scratches) $ for_ allScratchesButCurrent hideScratch -- | Hide scratchpads according to some condition. See 'nsHideOnFocusLoss' and -- 'nsSingleScratchpadPerWorkspace' for usage examples. nsHideOnCondition :: ( Window -- Last focus. -> Window -- Current focus. -> WindowSet -- Current windowset. -> (Window -> X ()) -- A function to hide the named scratchpad. -> X ()) -> X () nsHideOnCondition cond = withWindowSet $ \winSet -> do let cur = W.currentTag winSet withRecentsIn cur () $ \lastFocus curFocus -> do let hideScratch :: Window -> X () hideScratch win = shiftToNSP (W.workspaces winSet) ($ win) isWorthy = -- Check for the window being on the current workspace; if there -- is no history (i.e., curFocus ≡ lastFocus), don't do anything -- because the potential scratchpad is definitely focused. lastFocus `elem` W.index winSet && lastFocus /= curFocus -- Don't do anything on the NSP workspace, lest the world explodes. && cur /= scratchpadWorkspaceTag when isWorthy $ cond lastFocus curFocus winSet hideScratch -- | Execute some action on a named scratchpad. -- -- This function /almost always/ ignores its third argument; see Note -- [Ignored Arguments] for 'namedScratchpadAction'. someNamedScratchpadAction :: ((Window -> X ()) -> NE.NonEmpty Window -> X ()) -> (NamedScratchpad -> X ()) -> NamedScratchpads -> String -> X () someNamedScratchpadAction f runApp _ns scratchpadName = do NSPState{ nspScratchpads } <- fillNSPState _ns -- See Note [Filling NSPState] case nspScratchpads !? scratchpadName of Just conf -> withWindowSet $ \winSet -> do let focusedWspWindows = W.index winSet allWindows = W.allWindows winSet matchingOnCurrent <- filterM (runQuery (query conf)) focusedWspWindows matchingOnAll <- filterM (runQuery (query conf)) allWindows case NE.nonEmpty matchingOnCurrent of -- no matching window on the current workspace -> scratchpad not running or in background Nothing -> do -- summon the scratchpad case NE.nonEmpty matchingOnAll of Nothing -> runApp conf Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins -- check for exclusive scratchpads to hide hideUnwanted (name conf) -- matching window running on current workspace -> window should be shifted to scratchpad workspace Just wins -> shiftToNSP (W.workspaces winSet) (`f` wins) Nothing -> return () {- Note [Filling NSPState] We have to potentially populate the state with the given scratchpads here, in case the manageHook didn't run yet and it's still empty. For backwards compatibility, 3fc830aa09368dca04df24bf7ec4ac817f2de479 introduced an internal state that's filled in the namedScratchpadManageHook. A priori, this means that we would need some kind of MapRequestEvent to happen before processing scratchpads, since the manageHook doesn't run otherwise, leaving the extensible state empty until then. When trying to open a scratchpad right after starting xmonad—i.e., before having opened a window—we thus have to populate the NSPState before looking for scratchpads. Related: https://github.com/xmonad/xmonad-contrib/issues/728 -} -- | Tag of the scratchpad workspace scratchpadWorkspaceTag :: String scratchpadWorkspaceTag = "NSP" -- | Manage hook to use with named scratchpads namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration -> ManageHook namedScratchpadManageHook nsps = do ns <- Map.elems . nspScratchpads <$> liftX (fillNSPState nsps) composeAll $ fmap (\c -> query c --> hook c) ns -- | Shift some windows to the scratchpad workspace according to the -- given function. The workspace is created if necessary. shiftToNSP :: [WindowSpace] -> ((Window -> X ()) -> X ()) -> X () shiftToNSP ws f = do unless (any ((scratchpadWorkspaceTag ==) . W.tag) ws) $ addHiddenWorkspace scratchpadWorkspaceTag f (windows . W.shiftWin scratchpadWorkspaceTag) ------------------------------------------------------------------------ -- Dynamic scratchpad functionality -- $dynamic-scratchpads -- -- Dynamic scratchpads allow you to declare existing windows as -- scratchpads. You can bind a key to make a window start/stop being a -- scratchpad, and another key to toggle its visibility. Because -- dynamic scratchpads are based on existing windows, they have some -- caveats in comparison to "normal" scratchpads: -- -- * @xmonad@ has no way of knowing /how/ windows were spawned and -- thus one is not able to "start" dynamic scratchpads again after -- the associated window has been closed. -- -- * If you already have an active dynamic scratchpad @"dyn1"@ and you -- call 'toggleDynamicNSP' with another window, that window will -- henceforth occupy the @"dyn1"@ scratchpad. If you still need the -- old window, you might have to travel to your scratchpad workspace -- ('scratchpadWorkspaceTag') in order to retrieve it. -- -- As an example, the following snippet contains keybindings for two -- dynamic scratchpads, called @"dyn1"@ and @"dyn2"@: -- -- > import XMonad.Util.NamedScratchpads -- > -- > , ("M-s-a", withFocused $ toggleDynamicNSP "dyn1") -- > , ("M-s-b", withFocused $ toggleDynamicNSP "dyn2") -- > , ("M-a" , dynamicNSPAction "dyn1") -- > , ("M-b" , dynamicNSPAction "dyn2") -- -- | A 'NamedScratchpad' representing a "dynamic" scratchpad; i.e., a -- scratchpad based on an already existing window. mkDynamicNSP :: String -> Window -> NamedScratchpad mkDynamicNSP s w = NS { name = s , cmd = "" -- we are never going to spawn a dynamic scratchpad , query = (w ==) <$> ask , hook = mempty -- cmd is never called so this will never run } -- | Make a window a dynamic scratchpad addDynamicNSP :: String -> Window -> X () addDynamicNSP s w = XS.modify $ \(NSPState exs ws) -> NSPState exs (Map.insert s (mkDynamicNSP s w) ws) -- | Make a window stop being a dynamic scratchpad removeDynamicNSP :: String -> X () removeDynamicNSP s = XS.modify $ \(NSPState exs ws) -> NSPState exs (Map.delete s ws) -- | Toggle the visibility of a dynamic scratchpad. dynamicNSPAction :: String -> X () dynamicNSPAction = customRunNamedScratchpadAction (const $ pure ()) [] -- | Either create a dynamic scratchpad out of the given window, or stop -- a window from being one if it already is. toggleDynamicNSP :: String -> Window -> X () toggleDynamicNSP s w = do NSPState{ nspScratchpads } <- XS.get case nspScratchpads !? s of Nothing -> addDynamicNSP s w Just nsp -> ifM (runQuery (query nsp) w) (removeDynamicNSP s) (addDynamicNSP s w) ----------------------------------------------------------------------- -- Exclusive scratchpads -- $exclusive-scratchpads -- -- Exclusive scratchpads allow you to hide certain scratchpads in -- relation to others. There can be multiple groups of pairwise -- exclusive scratchpads; whenever one such scratchpad gets called, it -- will hide all other scratchpads on the focused workspace that are in -- this group. -- -- For example, having defined "Calc", "Mail", and "Term" scratchpads, -- you can use 'addExclusives' to make some of them dislike each other: -- -- > myExclusives = addExclusives -- > [ ["Calc", "Mail"] -- > , ["Mail", "Term"] -- > ] -- -- You now have to add @myExclusives@ to you startupHook: -- -- > main :: IO -- > main = xmonad . … . $ def -- > { … -- > , startupHook = myStartupHook >> myExclusives -- > } -- -- This will hide the "Mail" scratchpad whenever the "Calc" scratchpad -- is brought up, and vice-versa. Likewise, "Mail" and "Term" behave in -- this way, but "Calc" and "Term" may peacefully coexist. -- -- If you move a scratchpad it still gets hidden when you fetch a -- scratchpad of the same family. To change that behaviour—and make -- windows not exclusive anymore when they get resized or moved—add -- these mouse bindings (see -- "XMonad.Doc.Extending#Editing_mouse_bindings"): -- -- > , ((mod4Mask, button1), floatMoveNoexclusive) -- > , ((mod4Mask, button3), resizeNoexclusive) -- -- To reset a moved scratchpad to the original position that you set -- with its hook, focus is and then call 'resetFocusedNSP'. For -- example, if you want to extend @M-\@ to reset the placement -- when a scratchpad is in focus but keep the default behaviour for -- tiled windows, set these key bindings: -- -- > , ((modMask, xK_Return), windows W.swapMaster >> resetFocusedNSP) -- | Make some scratchpads exclusive. addExclusives :: [[String]] -> X () addExclusives exs = do NSPState _ ws <- XS.get -- Re-initialise `ws' to nothing, so we can react to changes in case -- of a restart. See 'fillNSPState' for more details on filling. XS.put (NSPState (foldl' (go []) mempty exs) mempty) unless (null ws) $ void (fillNSPState (Map.elems ws)) where -- Ignoring that this is specialised to NSPs, it works something like -- >>> foldl' (go []) mempty [[1, 2], [3, 4], [1, 3]] -- fromList [(1, [3, 2]), (2, [1]), (3, [1, 4]), (4, [3])] go _ m [] = m go ms m (n : ns) = go (n : ms) (Map.insertWith (<>) n (mkNSP (ms <> ns)) m) ns mkNSP = map (\n -> NS n mempty (pure False) mempty) -- | @setNoexclusive w@ makes the window @w@ lose its exclusivity -- features. setNoexclusive :: Window -> X () setNoexclusive w = do NSPState _ ws <- XS.get whenX (isNSP w (Map.elems ws)) $ addTag "_NSP_NOEXCLUSIVE" w -- | If the focused window is a scratchpad, the scratchpad gets reset to -- the original placement specified with the hook and becomes exclusive -- again. resetFocusedNSP :: X () resetFocusedNSP = do NSPState _ (Map.elems -> ws) <- XS.get withFocused $ \w -> do mbWin <- findM ((`runQuery` w) . query) ws whenJust mbWin $ \win -> do (windows . appEndo <=< runQuery (hook win)) w hideUnwanted (name win) delTag "_NSP_NOEXCLUSIVE" w -- | @hideUnwanted nspWindow@ hides all windows that @nspWindow@ does -- not like; i.e., windows that are in some kind of exclusivity contract -- with it. -- -- A consistency assumption for this is that @nspWindow@ must be the -- currently focused window. For this to take effect, @nspWindow@ must -- not have set the @_NSP_NOEXCLUSIVE@ property, neither must any -- exclusive window we'd like to hide. hideUnwanted :: String -> X () hideUnwanted nspWindow = withWindowSet $ \winSet -> do NSPState{ nspExclusives } <- XS.get whenJust (nspExclusives !? nspWindow) $ \unwanted -> withFocused $ \w -> whenX (runQuery notIgnored w) $ do for_ (W.index winSet) $ \win -> whenX (runQuery (isUnwanted unwanted) win) $ shiftToNSP (W.workspaces winSet) ($ win) where notIgnored :: Query Bool notIgnored = notElem "_NSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS" isUnwanted :: [NamedScratchpad] -> Query Bool isUnwanted = (notIgnored <&&>) . foldr (\nsp qs -> qs <||> query nsp) (pure False) -- | Float and drag the window; make it lose its exclusivity status in -- the process. floatMoveNoexclusive :: Window -- ^ Window which should be moved -> X () floatMoveNoexclusive = mouseHelper mouseMoveWindow -- | Resize window and make it lose its exclusivity status in the -- process. resizeNoexclusive :: Window -- ^ Window which should be resized -> X () resizeNoexclusive = mouseHelper mouseResizeWindow mouseHelper :: (Window -> X a) -> Window -> X () mouseHelper f w = setNoexclusive w >> focus w >> f w >> windows W.shiftMaster ------------------------------------------------------------------------ -- Deprecations -- | Transforms a workspace list containing the NSP workspace into one that -- doesn't contain it. Intended for use with logHooks. namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag) {-# DEPRECATED namedScratchpadFilterOutWorkspace "Use XMonad.Util.WorkspaceCompare.filterOutWs [scratchpadWorkspaceTag] instead" #-} -- | Transforms a pretty-printer into one not displaying the NSP workspace. -- -- A simple use could be: -- -- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ 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 . namedScratchpadFilterOutWorkspacePP . marshallPP screen . pp $ handle -- > in log 0 hLeft >> log 1 hRight namedScratchpadFilterOutWorkspacePP :: PP -> PP namedScratchpadFilterOutWorkspacePP pp = pp { ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp) } {-# DEPRECATED namedScratchpadFilterOutWorkspacePP "Use XMonad.Hooks.StatusBar.PP.filterOutWsPP [scratchpadWorkspaceTag] instead" #-} xmonad-contrib-0.18.0/XMonad/Util/NamedWindows.hs0000644000000000000000000000512407346545000017755 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedWindows -- Description : Associate the X titles of windows with them. -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- This module allows you to associate the X titles of windows with -- them. -- ----------------------------------------------------------------------------- module XMonad.Util.NamedWindows ( -- * Usage -- $usage NamedWindow, getName, getNameWMClass, withNamedWindow, unName ) where import Control.Exception as E import XMonad.Prelude ( fromMaybe, listToMaybe, (>=>) ) import qualified XMonad.StackSet as W ( peek ) import XMonad -- $usage -- See "XMonad.Layout.Tabbed" for an example of its use. data NamedWindow = NW !String !Window instance Eq NamedWindow where (NW s _) == (NW s' _) = s == s' instance Ord NamedWindow where compare (NW s _) (NW s' _) = compare s s' instance Show NamedWindow where show (NW n _) = n getName :: Window -> X NamedWindow getName w = withDisplay $ \d -> do -- TODO, this code is ugly and convoluted -- clean it up let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy) getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) `E.catch` \(SomeException _) -> getTextProperty d w wM_NAME copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop 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) (getName >=> f) xmonad-contrib-0.18.0/XMonad/Util/NoTaskbar.hs0000644000000000000000000000325607346545000017246 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) import Graphics.X11.Xlib.Extras (changeProperty32 ,propModePrepend) import Control.Monad.Reader (ask) -- $usage -- Utility functions to hide windows from pagers and taskbars. Mostly useful -- when EWMH doesn't do what you intend (e.g. for 'NamedScratchpad' windows you -- probably don't want to be dumped into the 'NSP' workspace). -- | A 'ManageHook' to mark a window to not be shown in pagers or taskbars. noTaskbar :: ManageHook noTaskbar = ask >>= (>> idHook) . liftX . markNoTaskbar -- | An 'X' action to mark a window to not be shown in pagers or taskbars. markNoTaskbar :: Window -> X () markNoTaskbar w = withDisplay $ \d -> do ws <- getAtom "_NET_WM_STATE" 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] xmonad-contrib-0.18.0/XMonad/Util/Parser.hs0000644000000000000000000002526007346545000016615 0ustar0000000000000000{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.Parser -- Description : A parser combinator library for xmonad -- Copyright : (c) 2021 Tony Zorman -- License : BSD3 -- Maintainer : Tony Zorman -- Stability : experimental -- Portability : non-portable -- -- A small wrapper around the 'ReadP' parser combinator in @base@, -- providing a more intuitive behaviour. While it's theoretically nice -- that 'ReadP' is actually commutative, this makes a lot of parsing -- operations rather awkward—more often than not, one only wants the -- argument that's parsed "first". -- -- Due to the left-biased nature of the chosen semigroup implementation, -- using functions like 'many' or 'optional' from "Control.Applicative" -- now yields more consistent behaviour with other parser combinator -- libraries. -- -------------------------------------------------------------------- module XMonad.Util.Parser ( -- * Usage -- $usage -- * Running Parser, runParser, -- * Primitive Parsers pfail, eof, num, char, string, skipSpaces, get, look, gather, -- * Combining Parsers satisfy, choice, count, between, option, optionally, skipMany, skipMany1, many1, sepBy, sepBy1, endBy, endBy1, munch, munch1, chainr, chainr1, chainl, chainl1, manyTill, ) where import XMonad.Prelude import qualified Text.ParserCombinators.ReadP as ReadP import Data.Coerce (coerce) import Data.String (IsString (fromString)) import Text.ParserCombinators.ReadP (ReadP, (<++)) {- $usage NOTE: This module is mostly intended for developing of other modules. If you are a users, you probably won't find much use here—you have been warned. The high-level API tries to stay as close to 'ReadP' as possible. If you are familiar with that then no functions here should surprise you. One notable usability difference when forcing left-biasedness is /when/ one wants to disambiguate a parse. For normal 'ReadP' usage this happens after the actual parsing stage by going through the list of successful parses. For 'Parser' it does when constructing the relevant combinators, leading to only one successful parse. As an example, consider the 'ReadP'-based parser > pLangle = ReadP.string "<" > pLongerSequence = ReadP.char '<' *> ReadP.string "f" <* ReadP.char '>' > pCombination = pLangle ReadP.+++ pLongerSequence Parsing the string @"\"@ will return >>> ReadP.readP_to_S pCombination "" [("<","f>"),("f","")] One would now need to, for example, filter for the second (leftover) string being empty and take the head of the resulting list (which may still have more than one element). With 'Parser', the same situation would look like the following > pLangle' = string "<" > pLongerSequence' = char '<' *> string "f" <* char '>' > pCombination' = pLongerSequence' <> pLangle' Notice how @pLangle'@ and @pLongerSequence'@ have traded places—since we are not forcing @pLangle'@ to consume the entire string and @(<>)@ is left-biased, @pLongerSequence'@ parses a superset of @pLangle'@! Running @runParser pCombination'@ now yields the expected result: >>> runParser pCombination' "" Just "f" One might also define @pLangle'@ as @string "<" <* eof@, which would enable a definition of @pCombination' = pLangle' <> pLongerSequence'@. For example uses, see "XMonad.Util.EZConfig" or "XMonad.Prompt.OrgMode". -} -- Parser :: Type -> Type newtype Parser a = Parser (ReadP a) deriving newtype (Functor, Applicative, Monad) instance Semigroup (Parser a) where -- | Local, exclusive, left-biased choice: If left parser locally -- produces any result at all, then right parser is not used. (<>) :: Parser a -> Parser a -> Parser a (<>) = coerce ((<++) @a) {-# INLINE (<>) #-} instance Monoid (Parser a) where -- | A parser that always fails. mempty :: Parser a mempty = Parser empty {-# INLINE mempty #-} instance Alternative Parser where empty :: Parser a empty = mempty {-# INLINE empty #-} (<|>) :: Parser a -> Parser a -> Parser a (<|>) = (<>) {-# INLINE (<|>) #-} -- | When @-XOverloadedStrings@ is on, treat a string @s@ as the parser -- @'string' s@, when appropriate. This allows one to write things like -- @"a" *> otherParser@ instead of @'string' "a" *> otherParser@. instance a ~ String => IsString (Parser a) where fromString :: String -> Parser a fromString = string {-# INLINE fromString #-} -- | Run a parser on a given string. runParser :: Parser a -> String -> Maybe a runParser (Parser p) = fmap fst . listToMaybe . ReadP.readP_to_S p {-# INLINE runParser #-} -- | Always fails pfail :: Parser a pfail = empty {-# INLINE pfail #-} -- | Consume and return the next character. Fails if there is no input -- left. get :: Parser Char get = coerce ReadP.get {-# INLINE get #-} -- | Look-ahead: return the part of the input that is left, without -- consuming it. look :: Parser String look = coerce ReadP.look {-# INLINE look #-} -- | Transform a parser into one that does the same, but in addition -- returns the exact characters read. -- -- >>> runParser ( string "* " $> True) "* hi" -- Just True -- >>> runParser (gather $ string "* " $> True) "* hi" -- Just ("* ",True) gather :: forall a. Parser a -> Parser (String, a) gather = coerce (ReadP.gather @a) {-# INLINE gather #-} -- | Succeeds if and only if we are at the end of input. eof :: Parser () eof = coerce ReadP.eof {-# INLINE eof #-} -- | Parse an integral number. num :: (Read a, Integral a) => Parser a num = read <$> munch1 isDigit {-# INLINE num #-} -- | Parse and return the specified character. char :: Char -> Parser Char char = coerce ReadP.char {-# INLINE char #-} -- | Parse and return the specified string. string :: String -> Parser String string = coerce ReadP.string {-# INLINE string #-} -- | Skip all whitespace. skipSpaces :: Parser () skipSpaces = coerce ReadP.skipSpaces {-# INLINE skipSpaces #-} -- | Consume and return the next character if it satisfies the specified -- predicate. satisfy :: (Char -> Bool) -> Parser Char satisfy = coerce ReadP.satisfy {-# INLINE satisfy #-} -- | Combine all parsers in the given list in a left-biased way. choice :: [Parser a] -> Parser a choice = foldl' (<>) mempty {-# INLINE choice #-} -- | @count n p@ parses @n@ occurrences of @p@ in sequence and returns a -- list of results. count :: Int -> Parser a -> Parser [a] count = replicateM {-# INLINE count #-} -- | @between open close p@ parses @open@, followed by @p@ and finally -- @close@. Only the value of @p@ is returned. between :: Parser open -> Parser close -> Parser a -> Parser a between open close p = open *> p <* close {-# INLINE between #-} -- | @option def p@ will try to parse @p@ and, if it fails, simply -- return @def@ without consuming any input. option :: a -> Parser a -> Parser a option def p = p <|> pure def {-# INLINE option #-} -- | @optionally p@ optionally parses @p@ and always returns @()@. optionally :: Parser a -> Parser () optionally p = void p <|> pure () {-# INLINE optionally #-} -- | Like 'many', but discard the result. skipMany :: Parser a -> Parser () skipMany = void . many {-# INLINE skipMany #-} -- | Like 'many1', but discard the result. skipMany1 :: Parser a -> Parser () skipMany1 p = p *> skipMany p {-# INLINE skipMany1 #-} -- | Parse the first zero or more characters satisfying the predicate. -- Always succeeds; returns an empty string if the predicate returns -- @False@ on the first character of input. munch :: (Char -> Bool) -> Parser String munch = coerce ReadP.munch {-# INLINE munch #-} -- | Parse the first one or more characters satisfying the predicate. -- Fails if none, else succeeds exactly once having consumed all the -- characters. munch1 :: (Char -> Bool) -> Parser String munch1 = coerce ReadP.munch1 {-# INLINE munch1 #-} -- | @endBy p sep@ parses zero or more occurrences of @p@, separated and -- ended by @sep@. endBy :: Parser a -> Parser sep -> Parser [a] endBy p sep = many (p <* sep) {-# INLINE endBy #-} -- | @endBy p sep@ parses one or more occurrences of @p@, separated and -- ended by @sep@. endBy1 :: Parser a -> Parser sep -> Parser [a] endBy1 p sep = many1 (p <* sep) {-# INLINE endBy1 #-} -- | Parse one or more occurrences of the given parser. many1 :: Parser a -> Parser [a] many1 = some {-# INLINE many1 #-} -- | @sepBy p sep@ parses zero or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. sepBy :: Parser a -> Parser sep -> Parser [a] sepBy p sep = sepBy1 p sep <> pure [] {-# INLINE sepBy #-} -- | @sepBy1 p sep@ parses one or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. sepBy1 :: Parser a -> Parser sep -> Parser [a] sepBy1 p sep = liftA2 (:) p (many (sep *> p)) {-# INLINE sepBy1 #-} -- | @chainr p op x@ parses zero or more occurrences of @p@, separated -- by @op@. Returns a value produced by a /right/ associative -- application of all functions returned by @op@. If there are no -- occurrences of @p@, @x@ is returned. chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainr p op x = option x (chainr1 p op) {-# INLINE chainr #-} -- | Like 'chainr', but parses one or more occurrences of @p@. chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a chainr1 p op = scan where scan :: Parser a scan = p >>= rest rest :: a -> Parser a rest x = option x $ do f <- op f x <$> scan {-# INLINE chainr1 #-} -- | @chainl p op x@ parses zero or more occurrences of @p@, separated -- by @op@. Returns a value produced by a /left/ associative -- application of all functions returned by @op@. If there are no -- occurrences of @p@, @x@ is returned. chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a chainl p op x = option x (chainl1 p op) {-# INLINE chainl #-} -- | Like 'chainl', but parses one or more occurrences of @p@. chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a chainl1 p op = scan where scan :: Parser a scan = p >>= rest rest :: a -> Parser a rest x = option x $ do f <- op y <- p rest (f x y) {-# INLINE chainl1 #-} -- | @manyTill p end@ parses zero or more occurrences of @p@, until -- @end@ succeeds. Returns a list of values returned by @p@. manyTill :: forall a end. Parser a -> Parser end -> Parser [a] manyTill p end = scan where scan :: Parser [a] scan = end $> [] <|> liftA2 (:) p scan {-# INLINE manyTill #-} xmonad-contrib-0.18.0/XMonad/Util/Paste.hs0000644000000000000000000000735707346545000016444 0ustar0000000000000000{- | Module : XMonad.Util.Paste Description : A module for sending key presses to windows. Copyright : (C) 2008 Jérémy Bobbio, gwern License : BSD3 Maintainer : none Stability : unstable Portability : unportable A module for sending key presses to windows. This modules provides generalized and specialized functions for this task. -} module XMonad.Util.Paste ( -- * Usage -- $usage pasteSelection, pasteString, pasteChar, sendKey, sendKeyWindow, noModMask ) where import XMonad (io, theRoot, withDisplay, X ()) import Graphics.X11 import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent) import Control.Monad.Reader (asks) import XMonad.Operations (withFocused) import XMonad.Prelude (isUpper, fromMaybe) import XMonad.Util.XSelection (getSelection) import XMonad.Util.EZConfig (parseKey) import XMonad.Util.Parser (runParser) {- $usage Import this module into your @xmonad.hs@ as usual: > import XMonad.Util.Paste And use the functions. They all return 'X' (), and so are appropriate for use as keybindings. Example: > , ((m, xK_d), pasteString "foo bar") ] Don't expect too much of the functions; they probably don't work on complex texts. -} -- | Paste the current X mouse selection. Note that this uses 'getSelection' from -- "XMonad.Util.XSelection" and so is heir to its flaws. pasteSelection :: X () pasteSelection = getSelection >>= pasteString -- | Send a string to the window which is currently focused. This function correctly -- handles capitalization. Warning: in dealing with capitalized characters, this assumes a QWERTY layout. pasteString :: String -> X () pasteString = mapM_ (\x -> if isUpper x || x `elem` "~!@#$%^&*()_+{}|:\"<>?" then pasteChar shiftMask x else pasteChar noModMask x) {- | Send a character to the current window. This is more low-level. Remember that you must handle the case of capitalization appropriately. That is, from the window's perspective: > pasteChar mod2Mask 'F' ~> "f" You would want to do something like: > pasteChar shiftMask 'F' Note that this function will probably have trouble with any 'Char' outside ASCII. -} pasteChar :: KeyMask -> Char -> X () pasteChar m c = sendKey m $ fromMaybe (unicodeToKeysym c) $ runParser parseKey [c] -- | Send a key with a modifier to the currently focused window. sendKey :: KeyMask -> KeySym -> X () sendKey = (withFocused .) . sendKeyWindow -- | The primitive. Allows you to send any combination of 'KeyMask' and 'KeySym' to any 'Window' you specify. sendKeyWindow :: KeyMask -> KeySym -> Window -> X () sendKeyWindow mods key w = withDisplay $ \d -> do rootw <- asks theRoot keycode <- io $ keysymToKeycode d key io $ allocaXEvent $ \ev -> do setEventType ev keyPress setKeyEvent ev w rootw none mods keycode True 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-contrib-0.18.0/XMonad/Util/PositionStore.hs0000644000000000000000000000622707346545000020204 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- 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. -- ----------------------------------------------------------------------------- module XMonad.Util.PositionStore ( getPosStore, modifyPosStore, posStoreInsert, posStoreMove, posStoreQuery, posStoreRemove, PositionStore, ) where import XMonad import qualified XMonad.Util.ExtensibleState as XS import qualified Data.Map as M -- Store window positions relative to the upper left screen edge -- 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. newtype PositionStore = PS (M.Map Window PosStoreRectangle) deriving (Read,Show) data PosStoreRectangle = PSRectangle Double Double Double Double deriving (Read,Show) instance ExtensionClass PositionStore where initialValue = PS M.empty extensionType = PersistentExtension getPosStore :: X PositionStore getPosStore = XS.get modifyPosStore :: (PositionStore -> PositionStore) -> X () modifyPosStore = XS.modify posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore posStoreInsert (PS posStoreMap) w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) = let offsetX = x - srX offsetY = y - srY in PS $ M.insert w (PSRectangle (fromIntegral offsetX / fromIntegral srWh) (fromIntegral offsetY / fromIntegral srHt) (fromIntegral wh / fromIntegral srWh) (fromIntegral ht / fromIntegral srHt)) posStoreMap posStoreRemove :: PositionStore -> Window -> PositionStore posStoreRemove (PS posStoreMap) w = PS $ M.delete w posStoreMap posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle posStoreQuery (PS posStoreMap) w (Rectangle srX srY srWh srHt) = do (PSRectangle x y wh ht) <- M.lookup w posStoreMap let realWh = fromIntegral srWh * wh realHt = fromIntegral srHt * ht realOffsetX = fromIntegral srWh * x realOffsetY = fromIntegral srHt * y return (Rectangle (srX + round realOffsetX) (srY + round realOffsetY) (round realWh) (round realHt)) posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore posStoreMove posStore w x y oldSr newSr = 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-contrib-0.18.0/XMonad/Util/Process.hs0000644000000000000000000000304007346545000016767 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : XMonad.Util.Process -- Description : Utilities for unix processes. -- Copyright : (c) 2022 Tomáš Janoušek -- License : BSD3 -- Maintainer : Tomáš Janoušek -- -- This module should not be directly used by users, it's just common code for -- other modules. -- module XMonad.Util.Process ( getPPIDOf, getPPIDChain, ) where import Control.Exception (SomeException, handle) import System.Posix.Types (ProcessID) import qualified Data.ByteString.Char8 as B import XMonad.Prelude (fi) -- | Get the parent process id (PPID) of a given process. getPPIDOf :: ProcessID -> IO (Maybe ProcessID) getPPIDOf pid = handle (\(_ :: SomeException) -> pure Nothing) (parse <$> B.readFile ("/proc/" <> show pid <> "/stat")) where -- Parse PPID out of /proc/*/stat, being careful not to trip over -- processes with names like ":-) 1 2 3 4 5 6". -- Inspired by https://gitlab.com/procps-ng/procps/-/blob/bcce3e440a1e1ee130c7371251a39c031519336a/proc/readproc.c#L561 parse stat = case B.words $ snd $ B.spanEnd (/= ')') stat of _ : (B.readInt -> Just (ppid, "")) : _ -> Just (fi ppid) _ -> Nothing -- | Get the chain of parent processes of a given pid. Starts with the given -- pid and continues up until the parent of all. getPPIDChain :: ProcessID -> IO [ProcessID] getPPIDChain pid = (pid :) <$> (maybe (pure []) getPPIDChain =<< getPPIDOf pid) xmonad-contrib-0.18.0/XMonad/Util/PureX.hs0000644000000000000000000002541207346545000016423 0ustar0000000000000000{-# LANGUAGE DerivingVia, GeneralizedNewtypeDeriving, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.PureX -- Description : Composable @X@ actions. -- Copyright : L. S. Leary 2018 -- License : BSD3-style (see LICENSE) -- -- Maintainer : L. S. Leary -- Stability : unstable -- Portability : not portable -- -- Unlike the opaque @IO@ actions that @X@ actions can wrap, regular reads from -- the 'XConf' and modifications to the 'XState' are fundamentally pure—contrary -- to the current treatment of such actions in most xmonad code. Pure -- modifications to the 'WindowSet' can be readily composed, but due to the need -- for those modifications to be properly handled by 'windows', other pure -- changes to the @XState@ cannot be interleaved with those changes to the -- @WindowSet@ without superfluous refreshes, hence breaking composability. -- -- This module aims to rectify that situation by drawing attention to it and -- providing 'PureX': a pure type with the same monadic interface to state as -- @X@. The 'XLike' typeclass enables writing actions generic over the two -- monads; if pure, existing @X@ actions can be generalised with only a change -- to the type signature. Various other utilities are provided, in particular -- the 'defile' function which is needed by end-users. -- ----------------------------------------------------------------------------- -- --< Imports & Exports >-- {{{ module XMonad.Util.PureX ( -- * Usage -- $Usage PureX, XLike(..), defile, windowBracket', handlingRefresh, runPureX, toXLike, -- * Utility -- ** Generalised when* functions when', whenM', whenJust', -- ** Infix operators (), -- ** @WindowSet@ operations withWindowSet', withFocii, modify'', modifyWindowSet', getStack, putStack, peek, focusWindow, focusNth, view, greedyView, invisiView, shift, shiftWin, curScreen, curWorkspace, curTag, curScreenId, ) where -- xmonad import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Actions.FocusNth -- mtl import Control.Monad.State import Control.Monad.Reader -- }}} -- --< Usage >-- {{{ -- $Usage -- -- The suggested pattern of usage for this module is to write composable, pure -- actions as @XLike m => m Any@ or @PureX Any@ values, where the encapsulated -- @Any@ value encodes whether or not a refresh is needed to properly institute -- changes. These values can then be combined monoidally (i.e. with '<>' AKA -- '<+>') or with operators such as '<*', '*>', '' to build seamless -- new actions. The end user can run and handle the effects of the pure actions -- in the @X@ monad by applying the @defile@ function, which you may want to -- re-export. Alternatively, if an action does not make stackset changes that -- need to be handled by @windows@, it can be written with as an -- @XLike m => m ()@ and used directly. -- -- Unfortunately since layouts must handle messages in the @X@ monad, this -- approach does not quite apply to actions involving them. However a relatively -- direct translation to impure actions is possible: you can write composable, -- refresh-tracking actions as @X Any@ values, making sure to eschew -- refresh-inducing functions like @windows@ and @sendMessage@ in favour of -- 'modifyWindowSet' and utilities provided by "XMonad.Actions.MessageFeedback". -- The 'windowBracket_' function recently added to "XMonad.Operations" is the -- impure analogue of @defile@. Note that @PureX Any@ actions can be composed -- into impure ones after applying 'toX'; don't use @defile@ for this. E.g. -- -- > windowBracket_ (composableImpureAction <> toX composablePureAction) -- -- Although both @X@ and @PureX@ have Monoid instances over monoidal values, -- @(XLike m, Monoid a)@ is not enough to infer @Monoid (m a)@ (due to the -- open-world assumption). Hence a @Monoid (m Any)@ constraint may need to be -- used when working with @XLike m => m Any@ where no context is forcing @m@ to -- unify with @X@ or @PureX@. This can also be avoided by working with -- @PureX Any@ values and generalising them with 'toXLike' where necessary. -- -- @PureX@ also enables a more monadic style when writing windowset operations; -- see the implementation of the utilities in this module for examples. -- For an example of a whole module written in terms of this one, see -- "XMonad.Hooks.RefocusLast". -- -- }}} -- --< Core >-- {{{ -- | The @PureX@ newtype over @ReaderT XConf (State XState) a@. newtype PureX a = PureX (ReaderT XConf (State XState) a) deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState) deriving (Semigroup, Monoid) via Ap PureX a -- | The @XLike@ typeclass over monads reading @XConf@ values and tracking -- @XState@ state. class (MonadReader XConf m, MonadState XState m) => XLike m where toX :: m a -> X a instance XLike X where toX = id instance XLike PureX where toX = toXLike -- | Consume a @PureX a@. runPureX :: PureX a -> XConf -> XState -> (a, XState) runPureX (PureX m) = runState . runReaderT m -- | 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 -- | A generalisation of 'windowBracket'. Handles refreshing for an action that -- __performs no refresh of its own__ but can indicate that it needs one -- through a return value that's tested against the supplied predicate. The -- action can interleave changes to the @WindowSet@ with @IO@ or changes to -- the @XState@. windowBracket' :: XLike m => (a -> Bool) -> m a -> X a windowBracket' p = windowBracket p . toX -- | A version of @windowBracket'@ specialised to take a @PureX Any@ action and -- handle windowset changes with a refresh when the @Any@ holds @True@. -- Analogous to 'windowBracket_'. Don't bake this into your action; it's for -- the end-user. defile :: PureX Any -> X () defile = void . windowBracket' getAny -- | A version of @windowBracket@ specialised to take an @X ()@ action and -- perform a refresh handling any changes it makes. handlingRefresh :: X () -> X () handlingRefresh = windowBracket (const True) -- }}} -- --< Utility >-- {{{ -- | A 'when' that accepts a monoidal return value. when' :: (Monad m, Monoid a) => Bool -> m a -> m a when' b ma = if b then ma else return mempty -- | A @whenX@/@whenM@ that accepts a monoidal return value. whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a 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 whenJust' = flip $ maybe (return mempty) -- | Akin to @<*@. Discarding the wrapped value in the second argument either -- way, keep its effects iff the first argument returns @Any True@. ( m Any -> m a -> m Any ifthis @. Combines applicative effects left-to-right -- and wrapped @Bool@s with @&&@ (instead of @||@). (&>) :: Applicative f => f Any -> f Any -> f Any (&>) = liftA2 $ \(Any b1) (Any b2) -> Any (b1 && b2) infixl 1 &> -- | A generalisation of 'withWindowSet'. withWindowSet' :: XLike m => (WindowSet -> m a) -> m a withWindowSet' = (=<< gets windowset) -- | If there is a current tag and a focused window, perform an operation with -- them, otherwise return mempty. withFocii :: (XLike m, Monoid a) => (WorkspaceId -> Window -> m a) -> m a withFocii f = join $ (whenJust' <$> peek) <*> (f <$> curTag) -- | A generalisation of 'modifyWindowSet'. modifyWindowSet' :: XLike m => (WindowSet -> WindowSet) -> m () modifyWindowSet' f = modify $ \xs -> xs { windowset = f (windowset xs) } -- | A variant of @W.modify@ and @W.modify'@ handling the @Nothing@ and @Just@ -- cases uniformly. modify'' :: (Maybe (W.Stack a) -> Maybe (W.Stack a)) -> (W.StackSet i l a s sd -> W.StackSet i l a s sd) modify'' f = W.modify (f Nothing) (f . Just) -- | Get the stack from the current workspace. getStack :: XLike m => m (Maybe (W.Stack Window)) getStack = W.stack <$> curWorkspace -- | Set the stack on the current workspace. putStack :: XLike m => Maybe (W.Stack Window) -> m () putStack mst = modifyWindowSet' . modify'' $ const mst -- | Get the focused window if there is one. peek :: XLike m => m (Maybe Window) peek = withWindowSet' (return . W.peek) -- | Get the current screen. curScreen :: XLike m => m WindowScreen curScreen = withWindowSet' (return . W.current) -- | Get the current workspace. curWorkspace :: XLike m => m WindowSpace curWorkspace = W.workspace <$> curScreen -- | Get the current tag. curTag :: XLike m => m WorkspaceId curTag = W.tag <$> curWorkspace -- | Get the current @ScreenId@. curScreenId :: XLike m => m ScreenId curScreenId = W.screen <$> curScreen -- | Internal. Refresh-tracking logic of view operations. viewWith :: XLike m => (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any viewWith viewer tag = do itag <- curTag when' (tag /= itag) $ do modifyWindowSet' (viewer tag) Any . (tag ==) <$> curTag -- | A version of @W.view@ that tracks the need to refresh. view :: XLike m => WorkspaceId -> m Any view = viewWith W.view -- | A version of @W.greedyView@ that tracks the need to refresh. greedyView :: XLike m => WorkspaceId -> m Any greedyView = viewWith W.greedyView -- | View a workspace if it's not visible. An alternative to @view@ and -- @greedyView@ that—rather than changing the current screen or affecting -- another—opts not to act. invisiView :: XLike m => WorkspaceId -> m Any invisiView = viewWith $ \tag ws -> if tag `elem` (W.tag . W.workspace <$> W.current ws : W.visible ws) then W.view tag ws else ws -- | A refresh-tracking version of @W.Shift@. shift :: XLike m => WorkspaceId -> m Any shift tag = withFocii $ \ctag fw -> when' (tag /= ctag) $ do modifyWindowSet' (W.shiftWin tag fw) 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-contrib-0.18.0/XMonad/Util/Rectangle.hs0000644000000000000000000002074607346545000017271 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Rectangle -- Description : A module for handling pixel rectangles. -- Copyright : (c) 2018 Yclept Nemo -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A module for handling pixel rectangles: 'Rectangle'. -- ----------------------------------------------------------------------------- module XMonad.Util.Rectangle ( -- * Usage -- $usage PointRectangle (..) , pixelsToIndices, pixelsToCoordinates , indicesToRectangle, coordinatesToRectangle , empty , intersects , supersetOf , difference , withBorder , center , toRatio ) where import XMonad import XMonad.Prelude (fi) import qualified XMonad.StackSet as W import Data.Ratio -- $usage -- > import XMonad.Util.Rectangle as R -- > R.empty (Rectangle 0 0 1024 768) -- | Rectangle as two points. What those points mean depends on the conversion -- function. data PointRectangle a = PointRectangle { point_x1::a -- ^ Point nearest to the origin. , point_y1::a , point_x2::a -- ^ Point furthest from the origin. , point_y2::a } deriving (Eq,Read,Show) -- | There are three possible ways to convert rectangles to pixels: -- -- * Consider integers as "gaps" between pixels; pixels range from @(N,N+1)@, -- exclusively: @(0,1)@, @(1,2)@, and so on. This leads to interval ambiguity: -- whether an integer endpoint contains a pixel depends on which direction the -- interval approaches the pixel. Consider the adjacent pixels @(0,1)@ and -- @(1,2)@ where @1@ can refer to either pixel @(0,1)@ or pixel @(1,2)@. -- -- * Consider integers to demarcate the start of each pixel; pixels range from -- @[N,N+1)@: @[0,1)@, @[1,2)@, and so on - or equivalently: @(N,N+1]@. This is -- the most flexible coordinate system, and the convention used by the -- 'Rectangle' type. -- -- * Consider integers to demarcate the center of each pixel; pixels range from -- @[N,N+1]@, as though each real-valued coordinate had been rounded (either -- down or up) to the nearest integers. So each pixel, from zero, is listed as: -- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this -- considers pixels as row/colum indices. While easiest to reason with, -- 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 px py dx dy) = PointRectangle (fromIntegral px) (fromIntegral py) (fromIntegral px + fromIntegral dx - 1) (fromIntegral py + fromIntegral dy - 1) -- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles. pixelsToCoordinates :: Rectangle -> PointRectangle Integer pixelsToCoordinates (Rectangle px py dx dy) = PointRectangle (fromIntegral px) (fromIntegral py) (fromIntegral px + fromIntegral dx) (fromIntegral py + fromIntegral dy) -- | Invert 'pixelsToIndices'. indicesToRectangle :: PointRectangle Integer -> Rectangle indicesToRectangle (PointRectangle x1 y1 x2 y2) = Rectangle (fromIntegral x1) (fromIntegral y1) (fromIntegral $ x2 - x1 + 1) (fromIntegral $ y2 - y1 + 1) -- | Invert 'pixelsToCoordinates'. coordinatesToRectangle :: PointRectangle Integer -> Rectangle coordinatesToRectangle (PointRectangle x1 y1 x2 y2) = Rectangle (fromIntegral x1) (fromIntegral y1) (fromIntegral $ x2 - x1) (fromIntegral $ y2 - y1) -- | True if either the 'rect_width' or 'rect_height' fields are zero, i.e. the -- rectangle has no area. empty :: Rectangle -> Bool empty (Rectangle _ _ _ 0) = True empty (Rectangle _ _ 0 _) = True 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 -- an empty rectangle will never intersect that rectangle - including the same -- empty rectangle. intersects :: Rectangle -> Rectangle -> Bool intersects r1 r2 | empty r1 || empty r2 = False | otherwise = r1_x1 < r2_x2 && r1_x2 > r2_x1 && r1_y1 < r2_y2 && r1_y2 > r2_y1 where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1 PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2 -- | True if the first rectangle contains at least all the points of the second -- rectangle. Any rectangle containing the initial points of an empty rectangle -- will be a superset of that rectangle - including the same empty rectangle. supersetOf :: Rectangle -> Rectangle -> Bool supersetOf r1 r2 = r1_x1 <= r2_x1 && r1_y1 <= r2_y1 && r1_x2 >= r2_x2 && r1_y2 >= r2_y2 where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1 PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2 -- | Return the smallest set of rectangles resulting from removing all the -- points of the second rectangle from those of the first, i.e. @r1 - r2@, such -- that @0 <= l <= 4@ where @l@ is the length of the resulting list. difference :: Rectangle -> Rectangle -> [Rectangle] difference r1 r2 | r1 `intersects` r2 = map coordinatesToRectangle $ concat [rt,rr,rb,rl] | otherwise = [r1] 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 = [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1 | r2_y1 > r1_y1 && r2_y1 < r1_y2] -- right rr = [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2 | r2_x2 > r1_x1 && r2_x2 < r1_x2] -- bottom rb = [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2 | r2_y2 > r1_y1 && r2_y2 < r1_y2] -- left 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. -- Origin is top-left, and yes, negative borders are allowed. withBorder :: Integer -- ^ Top border. -> Integer -- ^ Bottom border. -> Integer -- ^ Right border. -> Integer -- ^ Left border. -> Integer -- ^ Smallest allowable rectangle dimensions, i.e. -- width/height, with values @<0@ defaulting to @0@. -> Rectangle -> Rectangle withBorder t b r l i (Rectangle x y w h) = let -- conversions w' = fromIntegral w h' = fromIntegral h -- minimum window dimensions i' = max i 0 iw = min i' w' ih = min i' h' -- maximum border dimensions bh = w' - iw bv = h' - ih -- scaled border ratios rh = if l + r <= 0 then 1 else min 1 $ bh % (l + r) rv = if t + b <= 0 then 1 else min 1 $ bv % (t + b) -- scaled border pixels t' = truncate $ rv * fromIntegral t b' = truncate $ rv * fromIntegral b r' = truncate $ rh * fromIntegral r l' = truncate $ rh * fromIntegral l in Rectangle (x + l') (y + t') (w - r' - fromIntegral l') (h - b' - fromIntegral t') -- | 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 -- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip -- conversion may not result in the original value. The first 'Rectangle' is -- scaled to the second: -- -- >>> (Rectangle 2 2 6 6) `toRatio` (Rectangle 0 0 10 10) -- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5) toRatio :: Rectangle -> Rectangle -> W.RationalRect toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) = W.RationalRect ((fi x1 - fi x2) / fi w2) ((fi y1 - fi y2) / fi h2) (fi w1 / fi w2) (fi h1 / fi h2) xmonad-contrib-0.18.0/XMonad/Util/RemoteWindows.hs0000644000000000000000000000662607346545000020174 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.RemoteWindows -- Description : A module to find out whether the window is remote or local. -- Copyright : (c) Anton Vorontsov 2014 -- License : BSD-style (as xmonad) -- -- Maintainer : Anton Vorontsov -- Stability : unstable -- Portability : unportable -- -- This module implements a proper way of finding out whether the window -- is remote or local. -- -- Just checking for a hostname and WM_CLIENT_MACHINE being equal is often -- not enough because the hostname is a changing subject (without any -- established notification mechanisms), and thus WM_CLIENT_MACHINE and -- the hostname can diverge even for a local window. -- -- This module solves the problem. As soon as there is a new window -- created, we check the hostname and WM_CLIENT_MACHINE, and then we cache -- the result into the XMONAD_REMOTE property. -- -- Notice that XMonad itself does not know anything about hostnames, nor -- does it have any dependency on Network.* modules. For this module it is -- not a problem: you can provide a mean to get the hostname through your -- config file (see usage). Or, if you don't like the hassle of handling -- dynamic hostnames (suppose your hostname never changes), it is also -- fine: this module will fallback to using environment variables. -- ----------------------------------------------------------------------------- module XMonad.Util.RemoteWindows ( -- $usage isLocalWindow , manageRemote , manageRemoteG ) where import XMonad import XMonad.Util.WindowProperties import XMonad.Prelude import System.Posix.Env -- $usage -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Util.RemoteWindows -- > import Network.BSD -- > -- > main = xmonad def -- > { manageHook = manageRemote =<< io getHostName } guessHostName :: IO String guessHostName = pickOneMaybe <$> (getEnv `mapM` vars) where pickOneMaybe = last . (mzero:) . take 1 . catMaybes vars = ["XAUTHLOCALHOSTNAME","HOST","HOSTNAME"] setRemoteProp :: Window -> String -> X () setRemoteProp w host = do d <- asks display p <- getAtom "XMONAD_REMOTE" v <- hasProperty (Machine host) w 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, -- it checks XMONAD_REMOTE property. If it does not exist (i.e. the -- manageRemote hook was not deployed in user's config), it falls back to -- checking environment variables and assuming that hostname never -- changes. isLocalWindow :: Window -> X Bool isLocalWindow w = getProp32s "XMONAD_REMOTE" w >>= \case Just [y] -> return $ y == 0 _ -> io guessHostName >>= \host -> hasProperty (Machine host) w -- | Use this hook to let XMonad properly track remote/local windows. For -- example, @manageHook = manageRemote =<< io getHostName@. manageRemote :: String -> ManageHook manageRemote host = ask >>= \w -> liftX (setRemoteProp w host) >> return mempty -- | Use this hook if you want to manage XMONAD_REMOTE properties, but -- don't want to use an external getHostName in your config. That way you -- are retreating to environment variables. manageRemoteG :: ManageHook manageRemoteG = manageRemote =<< io guessHostName xmonad-contrib-0.18.0/XMonad/Util/Replace.hs0000644000000000000000000000763507346545000016742 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Replace -- Description : Implements a @--replace@ flag outside of core. -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- Implements a @--replace@ behavior outside of core. -- ----------------------------------------------------------------------------- -- refer to core patches: -- http://article.gmane.org/gmane.comp.lang.haskell.xmonad/8358 module XMonad.Util.Replace ( -- * Usage -- $usage replace -- * Notes -- $shortcomings -- ** Implementing a @--replace@ flag -- $getArgs ) where import XMonad import XMonad.Prelude -- $usage -- You must run the 'replace' action before starting xmonad proper, this -- results in xmonad replacing the currently running WM regardless of the -- arguments it is run with: -- -- > import XMonad -- > import XMonad.Util.Replace -- > main = do -- > replace -- > xmonad $ def { .... } -- -- $shortcomings -- This doesn't seem to work for replacing WMs that have been started -- from within xmonad, such as with @'restart' "openbox" False@, but no other -- WMs that implements --replace manage this either. 'replace' works for -- replacing metacity when the full gnome-session is started at least. -- $getArgs -- You can use 'System.Environment.getArgs' to watch for an explicit -- @--replace@ flag: -- -- > import XMonad -- > import XMonad.Util.Replace (replace) -- > import Control.Monad (when) -- > import System.Environment (getArgs) -- > -- > main = do -- > args <- getArgs -- > when ("--replace" `elem` args) replace -- > xmonad $ def { .... } -- -- -- Note that your @~\/.xmonad/xmonad-$arch-$os@ binary is not run with the same -- flags as the @xmonad@ binary that calls it. You may be able to work around -- this by running your @~\/.xmonad/xmonad-$arch-$os@ binary directly, which is -- otherwise not recommended. -- | @replace@ must be run before xmonad starts to signals to compliant window -- managers that they must exit and let xmonad take over. replace :: IO () replace = do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt -- check for other WM 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." -- prepare to receive destroyNotify for old WM selectInput dpy currentWmSnOwner structureNotifyMask -- create off-screen window netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True set_event_mask attributes propertyChangeMask let screen = defaultScreenOfDisplay dpy let visual = defaultVisualOfScreen screen let attrmask = cWOverrideRedirect .|. cWEventMask 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..." 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... " fix $ \again -> do evt <- allocaXEvent $ \event -> do windowEvent dpy currentWmSnOwner structureNotifyMask event get_EventType event when (evt /= destroyNotify) again putStrLn "done" closeDisplay dpy xmonad-contrib-0.18.0/XMonad/Util/Run.hs0000644000000000000000000004450707346545000016132 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Run -- Description : Several commands, as well as an EDSL, to run external processes. -- Copyright : (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu -- 2022 Tony Zorman -- License : BSD-style (see LICENSE) -- -- Maintainer : Tony Zorman -- Stability : unstable -- Portability : unportable -- -- This module provides several commands to run an external process. -- Additionally, it provides an abstraction—particularly geared towards -- programs like terminals or Emacs—to specify these processes from -- XMonad in a compositional way. -- -- Originally, this module was composed of functions formerly defined in -- "XMonad.Util.Dmenu" (by Spencer Janssen), "XMonad.Util.Dzen" (by -- glasser\@mit.edu) and @XMonad.Util.RunInXTerm@ (by Andrea Rossato). ----------------------------------------------------------------------------- module XMonad.Util.Run ( -- * Usage -- $usage runProcessWithInput, runProcessWithInputAndWait, safeSpawn, safeSpawnProg, unsafeSpawn, runInTerm, safeRunInTerm, seconds, spawnPipe, spawnPipeWithLocaleEncoding, spawnPipeWithUtf8Encoding, spawnPipeWithNoEncoding, -- * Compositionally Spawning Processes #EDSL# -- $EDSL -- ** Configuration and Running ProcessConfig (..), Input, spawnExternalProcess, proc, getInput, toInput, -- ** Programs inEditor, inTerm, termInDir, inProgram, -- ** General Combinators (>->), (>-$), (>&&>), (>||>), inWorkingDir, eval, execute, executeNoQuote, setXClass, asString, -- ** Emacs Integration EmacsLib (..), setFrameName, withEmacsLibs, inEmacs, elispFun, asBatch, require, progn, quote, findFile, list, saveExcursion, -- * Re-exports hPutStr, hPutStrLn, ) where import XMonad import XMonad.Prelude import qualified XMonad.Util.ExtensibleConf as XC import Codec.Binary.UTF8.String (encodeString) import Control.Concurrent (threadDelay) import System.Directory (getDirectoryContents) import System.IO import System.Posix.IO import System.Posix.Process (createSession, executeFile, forkProcess) import System.Process (runInteractiveProcess) {- $usage You can use this module by importing it in your @xmonad.hs@ > import XMonad.Util.Run It then all depends on what you want to do: - If you want to compositionally spawn programs, see [the relevant extended documentation](#g:EDSL). - For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh". - For an example usage of 'runProcessWithInput' see "XMonad.Util.Dmenu", or "XMonad.Prompt.Shell". - For an example usage of 'runProcessWithInputAndWait' see "XMonad.Util.Dzen". -} -- | Returns the output. runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String runProcessWithInput cmd args input = io $ do (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing hPutStr pin input hClose pin output <- hGetContents pout when (output == output) $ return () hClose pout hClose perr -- no need to waitForProcess, we ignore SIGCHLD return output -- | Wait is in μ (microseconds) runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m () runProcessWithInputAndWait cmd args input timeout = io $ do _ <- xfork $ do (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing hPutStr pin input hFlush pin threadDelay timeout hClose pin hClose pout hClose perr -- no need to waitForProcess, we ignore SIGCHLD return () return () -- | Multiplies by ONE MILLION, for functions that take microseconds. -- -- Use like: -- -- > (5.5 `seconds`) -- -- In GHC 7 and later, you must either enable the PostfixOperators extension -- (by adding -- -- > {-# LANGUAGE PostfixOperators #-} -- -- to the top of your file) or use seconds in prefix form: -- -- > seconds 5.5 seconds :: Rational -> Int seconds = fromEnum . (* 1000000) {- | 'safeSpawn' bypasses 'spawn', because spawn passes strings to \/bin\/sh to be interpreted as shell commands. This is often what one wants, but in many cases the passed string will contain shell metacharacters which one does not want interpreted as such (URLs particularly often have shell metacharacters like \'&\' in them). In this case, it is more useful to specify a file or program to be run and a string to give it as an argument so as to bypass the shell and be certain the program will receive the string as you typed it. Examples: > , ((modm, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png") > , ((modm, xK_d ), safeSpawn "firefox" []) Note that the unsafeSpawn example must be unsafe and not safe because it makes use of shell interpretation by relying on @$HOME@ and interpolation, whereas the safeSpawn example can be safe because Firefox doesn't need any arguments if it is just being started. -} safeSpawn :: MonadIO m => FilePath -> [String] -> m () safeSpawn prog args = io $ void_ $ forkProcess $ do uninstallSignalHandlers _ <- createSession executeFile (encodeString prog) True (map encodeString args) Nothing where void_ = (>> return ()) -- TODO: replace with Control.Monad.void / void not in ghc6 apparently -- | Simplified 'safeSpawn'; only takes a program (and no arguments): -- -- > , ((modm, xK_d ), safeSpawnProg "firefox") safeSpawnProg :: MonadIO m => FilePath -> m () safeSpawnProg = flip safeSpawn [] -- | An alias for 'spawn'; the name emphasizes that one is calling out to a -- Turing-complete interpreter which may do things one dislikes; for details, see 'safeSpawn'. unsafeSpawn :: MonadIO m => String -> m () unsafeSpawn = spawn -- | Open a terminal emulator. The terminal emulator is specified in the default configuration as xterm by default. It is then -- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn' unsafeRunInTerm, runInTerm :: String -> String -> X () unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command runInTerm = unsafeRunInTerm -- | Run a given program in the preferred terminal emulator; see 'runInTerm'. This makes use of 'safeSpawn'. 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. Note that the 'Handle' -- is a text 'Handle' using the current locale encoding. spawnPipe :: MonadIO m => String -> m Handle spawnPipe = spawnPipeWithLocaleEncoding -- | Same as 'spawnPipe'. spawnPipeWithLocaleEncoding :: MonadIO m => String -> m Handle spawnPipeWithLocaleEncoding = spawnPipe' localeEncoding -- | Same as 'spawnPipe', but forces the UTF-8 encoding regardless of locale. spawnPipeWithUtf8Encoding :: MonadIO m => String -> m Handle spawnPipeWithUtf8Encoding = spawnPipe' utf8 -- | Same as 'spawnPipe', but forces the 'char8' encoding, so unicode strings -- need 'Codec.Binary.UTF8.String.encodeString'. Should never be needed, but -- some X functions return already encoded Strings, so it may possibly be -- useful for someone. spawnPipeWithNoEncoding :: MonadIO m => String -> m Handle spawnPipeWithNoEncoding = spawnPipe' char8 spawnPipe' :: MonadIO m => TextEncoding -> String -> m Handle spawnPipe' encoding x = io $ do (rd, wr) <- createPipe setFdOption wr CloseOnExec True h <- fdToHandle wr hSetEncoding h encoding hSetBuffering h LineBuffering _ <- xfork $ do _ <- dupTo rd stdInput executeFile "/bin/sh" False ["-c", encodeString x] Nothing closeFd rd return h {- $EDSL To use the provided EDSL, you must first add the 'spawnExternalProcess' combinator to your xmonad configuration, like so: > main = xmonad $ … $ spawnExternalProcess def $ … $ def See 'ProcessConfig' for a list of all default configuration options, in case you'd like to change them—especially if you want to make use of the Emacs integration. After that, the real fun begins! The format for spawning these processes is always the same: a call to 'proc', its argument being a bunch of function calls, separated by the pipe operator '(>->)'. You can just bind the resulting function to a key; no additional plumbing required. For example, using "XMonad.Util.EZConfig" syntax and with @terminal = "alacritty"@ in you XMonad configuration, spawning a @ghci@ session with a special class name, "calculator", would look like > ("M-y", proc $ inTerm >-> setXClass "calculator" >-> execute "ghci") which would translate, more or less, to @\/usr\/bin\/sh -c "alacritty --class calculator -e ghci"@. The usefulness of this notation becomes apparent with more complicated examples: > proc $ inEmacs > >-> withEmacsLibs [OwnFile "mailboxes"] > >-> execute (elispFun "notmuch") > >-> setFrameName "mail" This is equivalent to spawning > emacs -l /home/slot/.config/emacs/lisp/mailboxes.el > -e '(notmuch)' > -F '(quote (name . "mail"))' Notice how we did not have to specify the whole path to @mailboxes.el@, since we had set the correct 'emacsLispDir' upon starting xmonad. This becomes especially relevant when running Emacs in batch mode, where one has to include [M,Non-GNU]ELPA packages in the call, whose exact names may change at any time. Then the following > do url <- getSelection -- from XMonad.Util.XSelection > proc $ inEmacs > >-> withEmacsLibs [ElpaLib "dash", ElpaLib "s", OwnFile "arXiv-citation"] > >-> asBatch > >-> execute (elispFun $ "arXiv-citation" <> asString url) becomes > emacs -L /home/slot/.config/emacs/elpa/dash-20220417.2250 > -L /home/slot/.config/emacs/elpa/s-20210616.619 > -l /home/slot/.config/emacs/lisp/arXiv-citation.el > --batch > -e '(arXiv-citation "")' which would be quite bothersome to type indeed! A blog post going into some more detail and also explaining how to integrate this new language with the "XMonad.Util.NamedScratchpad" module is available . -} ----------------------------------------------------------------------- -- Types and whatnot -- | Additional information that might be useful when spawning external -- programs. data ProcessConfig = ProcessConfig { editor :: !String -- ^ Default editor. Defaults to @"emacsclient -c -a ''"@. , emacsLispDir :: !FilePath -- ^ Directory for your custom Emacs lisp files. Probably -- @user-emacs-directory@ or @user-emacs-directory/lisp@. Defaults -- to @"~\/.config\/emacs\/lisp\/"@ , emacsElpaDir :: !FilePath -- ^ Directory for all packages from [M,Non-GNU]ELPA; probably -- @user-emacs-directory/elpa@. Defaults to -- @"~\/.config\/emacs\/elpa"@. , emacs :: !String -- ^ /Standalone/ Emacs executable; this should not be @emacsclient@ -- since, for example, the client does not support @--batch@ mode. -- Defaults to @"emacs"@. } -- | Given a 'ProcessConfig', remember it for spawning external -- processes later on. spawnExternalProcess :: ProcessConfig -> XConfig l -> XConfig l spawnExternalProcess = XC.modifyDef . const instance Default ProcessConfig where def :: ProcessConfig def = ProcessConfig { editor = "emacsclient -c -a ''" , emacsLispDir = "~/.config/emacs/lisp/" , emacsElpaDir = "~/.config/emacs/elpa/" , emacs = "emacs" } -- | Convenient type alias. type Input = ShowS ----------------------------------------------------------------------- -- Combinators -- | Combine inputs together. (>->) :: X Input -> X Input -> X Input (>->) = (<>) infixr 3 >-> -- | Combine an input with an ordinary string. (>-$) :: X Input -> X String -> X Input (>-$) xi xs = xi >-> fmap mkDList xs infixr 3 >-$ -- | @a >&&> b@ glues the different inputs @a@ and @b@ by means of @&&@. -- For example, -- -- @ -- pure "do something" >&&> pure "do another thing" -- @ -- -- would result in @do something && do another thing@ being executed by a -- shell. (>&&>) :: X Input -> X Input -> X Input a >&&> b = a <> toInput " && " <> b infixr 2 >&&> -- | Like '(>&&>)', but with @||@. (>||>) :: X Input -> X Input -> X Input a >||> b = a <> toInput " || " <> b infixr 2 >||> -- | Spawn a completed input. proc :: X Input -> X () proc xi = spawn =<< getInput xi -- | Create an effectful 'Input' from a 'String'. toInput :: String -> X Input toInput = pure . mkDList -- | Get the completed input string. getInput :: X Input -> X String getInput xi = xi <&> ($ "") -- | Use the 'editor'. inEditor :: X Input inEditor = XC.withDef $ \ProcessConfig{editor} -> pure $ mkDList editor -- | Use the 'XMonad.Core.XConfig.terminal'. inTerm :: X Input inTerm = asks $ mkDList . terminal . config -- | Execute the argument. Current /thing/ must support a @-e@ option. -- For programs such as Emacs, 'eval' may be the safer option; while -- @emacsclient@ supports @-e@, the @emacs@ executable itself does not. -- -- Note that this function always wraps its argument in single quotes; -- see 'executeNoQuote' for an alternative. execute :: String -> X Input execute this = pure ((" -e " <> tryQuote this) <>) -- | Like 'execute', but doesn't wrap its argument in single quotes. executeNoQuote :: String -> X Input executeNoQuote this = pure ((" -e " <> this) <>) -- | Eval(uate) the argument. Current /thing/ must support a @--eval@ -- option. eval :: String -> X Input eval this = pure ((" --eval " <> tryQuote this) <>) -- | Use 'emacs'. inEmacs :: X Input inEmacs = XC.withDef $ \ProcessConfig{emacs} -> pure $ mkDList emacs -- | Use the given program. inProgram :: String -> X Input inProgram = pure . mkDList -- | Spawn /thing/ in the current working directory. /thing/ must -- support a @--working-directory@ option. inWorkingDir :: X Input inWorkingDir = pure (" --working-directory " <>) -- | Set a frame name for the @emacsclient@. -- -- Note that this uses the @-F@ option to set the -- -- alist, which the @emacs@ executable does not support. setFrameName :: String -> X Input setFrameName n = pure ((" -F '(quote (name . \"" <> n <> "\"))' ") <>) -- | Set the appropriate X class for a window. This will more often -- than not actually be the -- . setXClass :: String -> X Input setXClass = pure . mkDList . (" --class " <>) -- | Spawn the 'XMonad.Core.XConfig.terminal' in some directory; it must -- support the @--working-directory@ option. termInDir :: X Input termInDir = inTerm >-> inWorkingDir ----------------------------------------------------------------------- -- Emacs -- | Transform the given input into an elisp function; i.e., surround it -- with parentheses. -- -- >>> elispFun "arxiv-citation URL" -- " '( arxiv-citation URL )' " elispFun :: String -> String elispFun f = " '( " <> f <> " )' " -- | Treat an argument as a string; i.e., wrap it with quotes. -- -- >>> asString "string" -- " \"string\" " asString :: String -> String asString s = " \"" <> s <> "\" " -- | Wrap the given commands in a @progn@. The given commands need not -- be wrapped in parentheses (but can); this will be done by the -- function. For example: -- -- >>> progn [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"] -- "(progn (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))" progn :: [String] -> String progn = inParens . ("progn " <>) . unwords . map inParens -- | Require a package. -- -- >>> require "arxiv-citation" -- "(require (quote arxiv-citation))" require :: String -> String require = inParens . ("require " <>) . quote -- | Quote a symbol. -- -- >>> quote "new-process" -- "(quote new-process)" quote :: String -> String quote = inParens . ("quote " <>) -- | Call @find-file@. -- -- >>> findFile "/path/to/file" -- "(find-file \"/path/to/file\" )" findFile :: String -> String findFile = inParens . ("find-file" <>) . asString -- | Make a list of the given inputs. -- -- >>> list ["foo", "bar", "baz", "qux"] -- "(list foo bar baz qux)" list :: [String] -> String list = inParens . ("list " <>) . unwords -- | Like 'progn', but with @save-excursion@. -- -- >>> saveExcursion [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"] -- "(save-excursion (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))" saveExcursion :: [String] -> String saveExcursion = inParens . ("save-excursion " <>) . unwords . map inParens ----------------------------------------------------------------------- -- Batch mode -- | Tell Emacs to enable batch-mode. asBatch :: X Input asBatch = pure (" --batch " <>) -- | An Emacs library. data EmacsLib = OwnFile !String -- ^ A /file/ from 'emacsLispDir'. | ElpaLib !String -- ^ A /directory/ in 'emacsElpaDir'. | Special !String -- ^ Special /files/; these will not be looked up somewhere, but -- forwarded verbatim (as a path). -- | Load some Emacs libraries. This is useful when executing scripts -- in batch mode. withEmacsLibs :: [EmacsLib] -> X Input withEmacsLibs libs = XC.withDef $ \ProcessConfig{emacsLispDir, emacsElpaDir} -> do lispDir <- mkAbsolutePath emacsLispDir elpaDir <- mkAbsolutePath emacsElpaDir lisp <- liftIO $ getDirectoryContents lispDir elpa <- liftIO $ getDirectoryContents elpaDir let getLib :: EmacsLib -> Maybe String = \case OwnFile f -> (("-l " <> lispDir) <>) <$> find (f `isPrefixOf`) lisp ElpaLib d -> (("-L " <> elpaDir) <>) <$> find ((d <> "-") `isPrefixOf`) elpa Special f -> Just $ " -l " <> f pure . mkDList . unwords . mapMaybe getLib $ libs ----------------------------------------------------------------------- -- Util mkDList :: String -> ShowS mkDList = (<>) . (<> " ") inParens :: String -> String inParens s = case s of '(' : _ -> s _ -> "(" <> s <> ")" tryQuote :: String -> String tryQuote s = case dropWhile (== ' ') s of '\'' : _ -> s _ -> "'" <> s <> "'" xmonad-contrib-0.18.0/XMonad/Util/Scratchpad.hs0000644000000000000000000001122707346545000017433 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Scratchpad -- Description : Very handy hotkey-launched toggleable floating terminal window. -- Copyright : (c) Braden Shepherdson 2008 -- License : BSD-style (as xmonad) -- -- Maintainer : Braden.Shepherdson@gmail.com -- Stability : unstable -- Portability : unportable -- -- Very handy hotkey-launched floating terminal window. -- ----------------------------------------------------------------------------- module XMonad.Util.Scratchpad {-# DEPRECATED "Use XMonad.Util.NamedScratchpad instead" #-} ( -- * Usage -- $usage scratchpadSpawnAction ,scratchpadSpawnActionTerminal ,scratchpadSpawnActionCustom ,scratchpadManageHookDefault ,scratchpadManageHook ,scratchpadFilterOutWorkspace ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.NamedScratchpad import XMonad.Util.WorkspaceCompare (filterOutWs) -- $usage -- Bind a key to 'scratchpadSpawnAction' -- Pressing it will spawn the terminal, or bring it to the current -- workspace if it already exists. -- Pressing the key with the terminal on the current workspace will -- send it to a hidden workspace called @NSP@. -- -- If you already have a workspace called @NSP@, it will use that. -- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your -- @dynamicLog@ settings to filter it out if you like. -- -- A tool like detach () turns it -- into a launchpad for X apps. -- -- By default, your xmonad terminal is used. -- The default ManageHook uses a centered, half-screen-wide, -- quarter-screen-tall window. -- The key, position and size are configurable. -- -- The terminal application must support the @-name@ argument. -- Known supported terminals: rxvt, rxvt-unicode, xterm. -- Most others are likely to follow the lead set by xterm. -- -- Bind the following to a key in your xmonad.hs keybindings: -- -- > scratchpadSpawnAction conf -- -- Where @conf@ is the configuration. -- -- And add one of the @scratchpadManageHook*@s to your ManageHook list. -- The default rectangle is half the screen wide and a quarter of the -- screen tall, centered. -- -- | Action to pop up the terminal, for the user to bind to a custom key. scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal -> X () scratchpadSpawnAction conf = scratchpadSpawnActionCustom $ terminal conf ++ " -name scratchpad" -- | Action to pop up the terminal, with a directly specified terminal. scratchpadSpawnActionTerminal :: String -- ^ Name of the terminal program -> X () scratchpadSpawnActionTerminal term = scratchpadSpawnActionCustom $ term ++ " -name scratchpad" -- | Action to pop up any program with the user specifying how to set -- its resource to \"scratchpad\". For example, with gnome-terminal: -- -- > scratchpadSpawnActionCustom "gnome-terminal --disable-factory --name scratchpad" scratchpadSpawnActionCustom :: String -- ^ Command to spawn a program with resource \"scratchpad\" -> X () scratchpadSpawnActionCustom c = namedScratchpadAction [NS "scratchpad" c scratchpadQuery nonFloating] "scratchpad" -- factored out since this is common to both the ManageHook and the action scratchpadQuery :: Query Bool scratchpadQuery = resource =? "scratchpad" -- | The ManageHook, with the default rectangle: -- Half the screen wide, a quarter of the screen tall, centered. scratchpadManageHookDefault :: ManageHook scratchpadManageHookDefault = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating scratchpadDefaultRect)] -- | The ManageHook, with a user-specified StackSet.RationalRect, -- e.g., for a terminal 4/10 of the screen width from the left, half -- the screen height from the top, and 6/10 of the screen width by -- 3/10 the screen height, use: -- -- > scratchpadManageHook (W.RationalRect 0.4 0.5 0.6 0.3) scratchpadManageHook :: W.RationalRect -- ^ User-specified screen rectangle. -> ManageHook scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating rect)] -- | Transforms a workspace list containing the NSP workspace into one that -- doesn't contain it. Intended for use with 'logHook's (see -- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops" -- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort'). scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] scratchpadFilterOutWorkspace = filterOutWs [scratchpadWorkspaceTag] scratchpadDefaultRect :: W.RationalRect scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25 xmonad-contrib-0.18.0/XMonad/Util/SessionStart.hs0000644000000000000000000000373407346545000020024 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.SessionStart -- Description : A module for detectiong session startup. -- Copyright : (c) Markus Ongyerth 2017 -- License : BSD3-style (see LICENSE) -- -- Maintainer : markus@ongy.net -- Stability : unstable -- Portability : not portable -- -- A module for detectiong session startup. Useful to start -- status bars, compositors and session initialization. -- This is a more general approach than spawnOnce and allows spawnOn etc. ----------------------------------------------------------------------------- module XMonad.Util.SessionStart ( doOnce , isSessionStart , setSessionStarted ) where import XMonad.Prelude (when) import XMonad import qualified XMonad.Util.ExtensibleState as XS -- --------------------------------------------------------------------- -- $usage -- -- Add 'setSessionStarted' at the end of the 'startupHook' to set the -- flag. -- -- 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. -- --------------------------------------------------------------------- newtype SessionStart = SessionStart { unSessionStart :: Bool } deriving (Read, Show) instance ExtensionClass SessionStart where initialValue = SessionStart True extensionType = PersistentExtension -- | Use this to only do a part of your hook on session start doOnce :: X () -> X () doOnce act = do startup <- isSessionStart when startup act -- | Query if the current startup is the session start isSessionStart :: X Bool isSessionStart = unSessionStart <$> XS.get -- This should become a noop/be deprecated when merged into master, and -- the flag should be set when the state file is loaded. -- | This currently has to be added to the end of the startup hook to -- set the flag. setSessionStarted :: X () setSessionStarted = XS.put $ SessionStart False xmonad-contrib-0.18.0/XMonad/Util/SpawnNamedPipe.hs0000644000000000000000000000466607346545000020243 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.SpawnNamedPipe -- Description : A module for spawning a pipe whose handle lives in the XMonad state. -- Copyright : (c) Christian Wills 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : cwills.dev@gmail.com -- Stability : unstable -- Portability : not portable -- -- A module for spawning a pipe whose 'Handle' lives in the Xmonad state. -- ----------------------------------------------------------------------------- module XMonad.Util.SpawnNamedPipe ( -- * Usage -- $usage spawnNamedPipe , getNamedPipe ) where import XMonad import XMonad.Util.Run import System.IO import qualified XMonad.Util.ExtensibleState as XS import XMonad.Prelude import qualified Data.Map as Map -- $usage -- This module makes it possible to spawn a pipe to Dzen2 in the startupHook -- and write to it from inside the logHook without the need for global -- variables. -- -- > import XMonad.Util.SpawnNamedPipe -- > import Data.Maybe -- > -- > -- StartupHook -- > startupHook' = spawnNamedPipe "dzen2" "dzenPipe" -- > -- > -- LogHook -- > logHook' = do -- > mh <- getNamedPipeHandle "dzenPipe" -- > dynamicLogWithPP $ def { -- > ppOutput = maybe (\s -> return ()) (hPutStrLn) mh} -- > -- > -- Main -- > main = xmonad $ def { startupHook = startupHook' -- > , logHook = logHook'} -- newtype NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle } deriving (Show) instance ExtensionClass NamedPipes where 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'. spawnNamedPipe :: String -> String -> X () spawnNamedPipe cmd name = do b <- XS.gets (Map.member name . pipeMap) unless b $ do 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. getNamedPipe :: String -> X (Maybe Handle) getNamedPipe name = XS.gets (Map.lookup name . pipeMap) xmonad-contrib-0.18.0/XMonad/Util/SpawnOnce.hs0000644000000000000000000000505607346545000017257 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : spencerjanssen@gmail.com -- Stability : unstable -- Portability : not portable -- -- A module for spawning a command once, and only once. Useful to start -- status bars and make session settings inside startupHook. See also -- "XMonad.Util.SessionStart" for a different and more flexible way to -- run commands only on first startup. -- ----------------------------------------------------------------------------- module XMonad.Util.SpawnOnce (spawnOnce, -- * 'SpawnOn' helpers -- $spawnon manageSpawn, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where import XMonad import XMonad.Actions.SpawnOn import Data.Set as Set import qualified XMonad.Util.ExtensibleState as XS import XMonad.Prelude newtype SpawnOnce = SpawnOnce { unspawnOnce :: Set String } deriving (Read, Show) instance ExtensionClass SpawnOnce where initialValue = SpawnOnce Set.empty extensionType = PersistentExtension doOnce :: (String -> X ()) -> String -> X () doOnce f s = do b <- XS.gets (Set.member s . unspawnOnce) unless b $ do f s XS.modify (SpawnOnce . Set.insert s . unspawnOnce) -- | The first time 'spawnOnce' is executed on a particular command, -- that command is executed. Subsequent invocations for a command do -- nothing. spawnOnce :: String -> X () spawnOnce = doOnce spawn -- $spawnon -- These functions combine 'spawnOnce' with their relatives in -- "XMonad.Actions.SpawnOn". You must add 'manageSpawn' to your -- @manageHook@ for them to work, as with @SpawnOn@. -- | Like 'spawnOnce' but launches the application on the given workspace. spawnOnOnce :: WorkspaceId -> String -> X () spawnOnOnce ws = 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 = 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 = doOnce (spawnAndDo mh) xmonad-contrib-0.18.0/XMonad/Util/Stack.hs0000644000000000000000000003335007346545000016425 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Stack -- Description : Utility functions for manipulating @Maybe Stack@s. -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Utility functions for manipulating @Maybe Stack@s. -- ----------------------------------------------------------------------------- module XMonad.Util.Stack ( -- * Usage -- | This is a developer-oriented module, intended to be used -- for writing new extentions. Zipper , emptyZ , singletonZ -- * Conversions , fromIndex , toIndex , fromTags , toTags , zipperFocusedAtFirstOf -- * 'Zipper' manipulation functions -- ** Insertion, movement , insertUpZ , insertDownZ , swapUpZ , swapDownZ , swapMasterZ -- ** Focus movement , focusUpZ , focusDownZ , focusMasterZ , findS , findZ -- ** Extraction , getFocusZ , getIZ -- ** Sorting , sortZ , sortByZ -- ** Maps , mapZ , mapZ_ , mapZM , mapZM_ , onFocusedZ , onFocusedZM , onIndexZ , onIndexZM -- ** Filters , filterZ , filterZ_ , deleteFocusedZ , deleteIndexZ -- ** Folds , foldrZ , foldlZ , foldrZ_ , foldlZ_ , elemZ -- * Other utility functions , getI , tagBy , fromE , mapE , mapE_ , mapEM , mapEM_ , reverseS , reverseZ ) where import qualified XMonad.StackSet as W import XMonad.Prelude (guard, sortBy, (!?), (<|>)) type Zipper a = Maybe (W.Stack a) emptyZ :: Zipper a emptyZ = Nothing singletonZ :: a -> Zipper a singletonZ a = Just $ W.Stack a [] [] -- * Conversions -- | Create a stack from a list, and the 0-based index of the focused element. -- If the index is out of bounds, focus will go to the first element. fromIndex :: [a] -> Int -> Zipper a fromIndex as i = fromTags $ zipWith ($) (replicate i Left ++ [Right] ++ repeat Left) as -- | Turn a stack into a list and the index of its focused element. toIndex :: Zipper a -> ([a], Maybe Int) toIndex Nothing = ([], Nothing) toIndex (Just s) = (W.integrate s, Just $ length $ W.up s) -- | Create a stack from a list of 'Either'-tagged values. Focus will go to -- the first 'Right' value, or if there is none, to the first 'Left' one. fromTags :: [Either a a] -> Zipper a fromTags = finalize . foldr step ([], Nothing, []) where step (Right a) (u, Just f, d) = ([], Just a, u++f:d) step (Right a) (u, Nothing, d) = (u, Just a, d) step (Left a) (u, Just f, d) = (a:u, Just f, d) step (Left a) (u, Nothing, d) = (u, Nothing, a:d) finalize (u, Just f, d) = Just $ W.Stack f (reverse u) d finalize (u, Nothing, a:d) = Just $ W.Stack a (reverse u) d finalize (_, Nothing, []) = Nothing -- | Turn a stack into an 'Either'-tagged list. The focused element -- will be tagged with 'Right', the others with 'Left'. toTags :: Zipper a -> [Either a a] toTags Nothing = [] toTags (Just s) = map Left (reverse . W.up $ s) ++ [Right . W.focus $ s] ++ map Left (W.down s) -- | @differentiate zs xs@ takes the first @z@ from @z2 that also belongs to -- @xs@ and turns @xs@ into a stack with @z@ being the current element. Acts -- as 'XMonad.StackSet.differentiate' if @zs@ and @xs@ don't intersect. zipperFocusedAtFirstOf :: Eq q => [q] -> [q] -> Zipper q zipperFocusedAtFirstOf [] xs = W.differentiate xs zipperFocusedAtFirstOf (z : zs) xs | z `elem` xs = Just $ W.Stack { W.focus = z , W.up = reverse $ takeWhile (/= z) xs , W.down = drop 1 $ dropWhile (/= z) xs } | otherwise = zipperFocusedAtFirstOf zs xs -- * Zipper functions -- ** Insertion, movement -- | Insert an element before the focused one, and focus it insertUpZ :: a -> Zipper a -> Zipper a insertUpZ a Nothing = W.differentiate [a] insertUpZ a (Just s) = Just s { W.focus = a , W.down = W.focus s : W.down s } -- | Insert an element after the focused one, and focus it insertDownZ :: a -> Zipper a -> Zipper a insertDownZ a Nothing = W.differentiate [a] insertDownZ a (Just s) = Just s { W.focus = a, W.up = W.focus s : W.up s } -- | Swap the focused element with the previous one swapUpZ :: Zipper a -> Zipper a swapUpZ Nothing = Nothing swapUpZ (Just s) | u:up <- W.up s = Just s { W.up = up, W.down = u:W.down s} swapUpZ (Just s) = Just s { W.up = reverse (W.down s), W.down = [] } -- | Swap the focused element with the next one swapDownZ :: Zipper a -> Zipper a swapDownZ Nothing = Nothing swapDownZ (Just s) | d:down <- W.down s = Just s { W.down = down, W.up = d:W.up s } swapDownZ (Just s) = Just s { W.up = [], W.down = reverse (W.up s) } -- | Swap the focused element with the first one swapMasterZ :: Zipper a -> Zipper a swapMasterZ Nothing = Nothing swapMasterZ (Just (W.Stack f up down)) = Just $ W.Stack f [] (reverse up ++ down) -- ** Focus movement -- | Move the focus to the previous element focusUpZ :: Zipper a -> Zipper a focusUpZ Nothing = Nothing focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s) focusUpZ (Just s) | null $ W.down s = Just s focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (drop 1 (reverse down) ++ [f]) [] -- | Move the focus to the next element focusDownZ :: Zipper a -> Zipper a focusDownZ Nothing = Nothing focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down focusDownZ (Just s) | null $ W.up s = Just s focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (drop 1 (reverse up) ++ [f]) -- | Move the focus to the first element focusMasterZ :: Zipper a -> Zipper a focusMasterZ Nothing = Nothing focusMasterZ (Just (W.Stack f up down)) | not $ null up = Just $ W.Stack (last up) [] (drop 1 (reverse up) ++ [f] ++ down) focusMasterZ (Just s) = Just s -- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to -- @Nothing@. findS :: (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) $ W.Stack u ups (W.focus s : W.down s) | otherwise = Nothing -- | Refocus a @Zipper a@ on an element satisfying the predicate, or fail to -- @Nothing@. findZ :: (a -> Bool) -> Zipper a -> Zipper a findZ _ Nothing = Nothing findZ p (Just st) = findS p st -- ** Extraction -- | Get the focused element getFocusZ :: Zipper a -> Maybe a getFocusZ = fmap W.focus -- | Get the element at a given index getIZ :: Int -> Zipper a -> Maybe a getIZ i = getI i . W.integrate' -- ** Sorting -- | Sort a stack of elements supporting 'Ord' sortZ :: Ord a => Zipper a -> Zipper a sortZ = sortByZ compare -- | Sort a stack with an arbitrary sorting function sortByZ :: (a -> a -> Ordering) -> Zipper a -> Zipper a sortByZ f = fromTags . sortBy (adapt f) . toTags where adapt g e1 e2 = g (fromE e1) (fromE e2) -- ** Maps -- | 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 = fromTags . map (mapE f) . toTags -- | 'mapZ' without the 'Bool' argument mapZ_ :: (a -> b) -> Zipper a -> Zipper b mapZ_ = mapZ . const -- | Monadic version of 'mapZ' mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b) mapZM f as = fromTags <$> (mapM (mapEM f) . toTags) as -- | Monadic version of 'mapZ_' mapZM_ :: Monad m => (a -> m b) -> Zipper a -> m (Zipper b) mapZM_ = mapZM . const -- | Apply a function to the focused element onFocusedZ :: (a -> a) -> Zipper a -> Zipper a onFocusedZ f = mapZ $ \b a -> if b then f a else a -- | Monadic version of 'onFocusedZ' onFocusedZM :: Monad m => (a -> m a) -> Zipper a -> m (Zipper a) onFocusedZM f = mapZM $ \b a -> if b then f a else return a -- | Apply a function to the element at the given index onIndexZ :: Int -> (a -> a) -> Zipper a -> Zipper a onIndexZ i _ as | i < 0 = as onIndexZ i f as = case splitAt i $ toTags as of (before, []) -> fromTags before (before, a:after) -> fromTags $ before ++ mapE (const f) a : after -- | Monadic version of 'onIndexZ' onIndexZM :: Monad m => Int -> (a -> m a) -> Zipper a -> m (Zipper a) onIndexZM i f as = case splitAt i $ toTags as of (before, []) -> return $ fromTags before (before, a:after) -> do a' <- mapEM (const f) a return $ fromTags $ before ++ a' : after -- ** Filters -- | Fiter a stack according to a predicate. The refocusing behavior -- mimics XMonad's usual one. The boolean argument indicates whether the current -- element is the focused one. filterZ :: (Bool -> a -> Bool) -> Zipper a -> Zipper a filterZ _ Nothing = Nothing filterZ p (Just s) = case ( p True (W.focus s) , filter (p False) (W.up s) , filter (p False) (W.down s) ) of (True, up', down') -> Just s { W.up = up', W.down = down' } (False, [], []) -> Nothing (False, f:up', []) -> Just s { W.focus = f, W.up = up', W.down = [] } (False, up', f:down') -> Just s { W.focus = f , W.up = up' , W.down = down' } -- | 'filterZ' without the 'Bool' argument filterZ_ :: (a -> Bool) -> Zipper a -> Zipper a filterZ_ = filterZ . const -- | Delete the focused element deleteFocusedZ :: Zipper a -> Zipper a deleteFocusedZ = filterZ (\b _ -> not b) -- | Delete the ith element deleteIndexZ :: Int -> Zipper a -> Zipper a deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z number j = mapE (\_ a -> (j,a)) in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered -- ** Folds -- | Analogous to 'foldr'. The 'Bool' argument to the step functions indicates -- whether the current element is the focused one foldrZ :: (Bool -> a -> b -> b) -> b -> Zipper a -> b foldrZ _ b Nothing = b foldrZ f b (Just s) = let b1 = foldr (f False) b (W.down s) b2 = f True (W.focus s) b1 b3 = foldl (flip $ f False) b2 (W.up s) in b3 -- | Analogous to 'foldl'. The 'Bool' argument to the step functions indicates -- whether the current element is the focused one foldlZ :: (Bool -> b -> a -> b) -> b -> Zipper a -> b foldlZ _ b Nothing = b foldlZ f b (Just s) = let b1 = foldr (flip $ f False) b (W.up s) b2 = f True b1 (W.focus s) b3 = foldl (f False) b2 (W.down s) in b3 -- | 'foldrZ' without the 'Bool' argument. foldrZ_ :: (a -> b -> b) -> b -> Zipper a -> b foldrZ_ = foldrZ . const -- | 'foldlZ' without the 'Bool' argument. foldlZ_ :: (b -> a -> b) -> b -> Zipper a -> b foldlZ_ = foldlZ . const -- | Find whether an element is present in a stack. elemZ :: Eq a => a -> Zipper a -> Bool elemZ a = foldlZ_ step False where step True _ = True step False a' = a' == a -- * Other utility functions -- | Safe version of '!!' getI :: Int -> [a] -> Maybe a 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' -- in a 'Left'. mapE :: (Bool -> a -> b) -> Either a a -> Either b b mapE f (Left a) = Left $ f False a mapE f (Right a) = Right $ f True a mapE_ :: (a -> b) -> Either a a -> Either b b mapE_ = mapE . const -- | Monadic version of 'mapE' mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b) 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 -- | Get the @a@ from an @Either a a@ fromE :: Either a a -> a fromE (Right a) = a fromE (Left a) = a -- | Tag the element with 'Right' if the property is true, 'Left' otherwise tagBy :: (a -> Bool) -> a -> Either a a tagBy p a = if p a then Right a else Left a -- | Reverse a @Stack a@; O(1). reverseS :: W.Stack a -> W.Stack a reverseS (W.Stack foc ups downs) = W.Stack foc downs ups -- | Reverse a @Zipper a@; O(1). reverseZ :: Zipper a -> Zipper a reverseZ = (reverseS <$>) xmonad-contrib-0.18.0/XMonad/Util/StringProp.hs0000644000000000000000000000414607346545000017470 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -- -- Maintainer : Nicolas Pouillard -- Stability : unstable -- Portability : unportable -- -- 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. module XMonad.Util.StringProp ( StringProp, getStringProp, setStringProp, getStringListProp, setStringListProp, ) where import XMonad import Foreign.C.String (castCCharToChar,castCharToCChar) type StringProp = String withStringProp :: (MonadIO m) => StringProp -> Display -> (Window -> Atom -> m b) -> m b withStringProp prop dpy f = do rootw <- io $ rootWindow dpy $ defaultScreen dpy a <- io $ internAtom dpy prop False f rootw a -- | Set the value of a string property. setStringProp :: (MonadIO m) => Display -> StringProp -> [Char] -> m () setStringProp dpy prop string = withStringProp prop dpy $ \rootw a -> io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string -- | Get the name of a string property and returns it as a 'Maybe'. getStringProp :: (MonadIO m) => Display -> StringProp -> m (Maybe [Char]) getStringProp dpy prop = withStringProp prop dpy $ \rootw a -> do p <- io $ getWindowProperty8 dpy a rootw return $ map castCCharToChar <$> p -- | 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 <$> getStringProp dpy prop -- | Given a property name and a list, sets the value of this property with -- the list given as argument. setStringListProp :: (MonadIO m) => Display -> StringProp -> [String] -> m () setStringListProp dpy prop str = setStringProp dpy prop (unwords str) xmonad-contrib-0.18.0/XMonad/Util/Themes.hs0000644000000000000000000004312107346545000016602 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Themes -- Description : A collection of themes for decorated layouts. -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A (hopefully) growing collection of themes for decorated layouts. -- ----------------------------------------------------------------------------- module XMonad.Util.Themes ( -- * Usage -- $usage listOfThemes , ppThemeInfo , xmonadTheme , smallClean , adwaitaTheme , adwaitaDarkTheme , robertTheme , darkTheme , deiflTheme , oxymor00nTheme , donaldTheme , wfarrTheme , kavonForestTheme , kavonLakeTheme , kavonPeacockTheme , kavonVioGreenTheme , kavonBluesTheme , kavonAutumnTheme , kavonFireTheme , kavonChristmasTheme , ThemeInfo (..) ) where import XMonad.Layout.Decoration -- $usage -- This module stores some user contributed themes which can be used -- with decorated layouts (such as Tabbed). (Note that these themes -- only apply to decorated layouts, such as those found in -- "XMonad.Layout.Tabbed" and "XMonad.Layout.DecorationMadness"; they -- do not apply to xmonad as a whole.) -- -- If you want to use one of them with one of your decorated layouts, -- you need to substitute def with, for instance, (theme smallClean). -- -- Here is an example: -- -- > import XMonad -- > import XMonad.Util.Themes -- > import XMonad.Layout.Tabbed -- > -- > myLayout = tabbed shrinkText (theme smallClean) -- > -- > main = xmonad def {layoutHook = myLayout} -- -- If you have a theme you would like to share, adding it to this -- module is very easy. -- -- You can use 'xmonadTheme' or 'smallClean' as a template. -- -- At the present time only the 'themeName' field is used. But please -- provide all the other information, which will be used at a later -- time. -- -- Please, remember to add your theme to the list of exported -- functions, and to the 'listOfThemes'. -- -- Thanks for your contribution! data ThemeInfo = TI { themeName :: String , themeAuthor :: String , themeDescription :: String , theme :: Theme } newTheme :: ThemeInfo newTheme = TI "" "" "" def ppThemeInfo :: ThemeInfo -> String ppThemeInfo t = themeName t `add` themeDescription t `add` "by" `add` themeAuthor t where "" `add` x = x x `add` y = x ++ " - " ++ y listOfThemes :: [ThemeInfo] listOfThemes = [ xmonadTheme , smallClean , adwaitaTheme , adwaitaDarkTheme , darkTheme , deiflTheme , oxymor00nTheme , robertTheme , donaldTheme , wfarrTheme , kavonForestTheme , kavonLakeTheme , kavonPeacockTheme , kavonVioGreenTheme , kavonBluesTheme , kavonAutumnTheme , kavonFireTheme , kavonChristmasTheme ] -- | The default xmonad theme, by David Roundy. xmonadTheme :: ThemeInfo xmonadTheme = newTheme { themeName = "xmonadTheme" , themeAuthor = "David Roundy" , themeDescription = "The default xmonad theme" , theme = def } -- | Small decorations with a Ion3 remembrance, by Andrea Rossato. smallClean :: ThemeInfo smallClean = newTheme { themeName = "smallClean" , themeAuthor = "Andrea Rossato" , themeDescription = "Small decorations with a Ion3 remembrance" , theme = def { activeColor = "#8a999e" , inactiveColor = "#545d75" , activeBorderColor = "white" , inactiveBorderColor = "grey" , activeTextColor = "white" , inactiveTextColor = "grey" , decoHeight = 14 } } -- | Matching decorations for Adwaita GTK theme adwaitaTheme :: ThemeInfo adwaitaTheme = newTheme { themeName = "adwaitaTheme" , themeAuthor = "Alex Griffin" , themeDescription = "Matching decorations for Adwaita GTK theme" , theme = def { activeColor = "#dfdcd8" , inactiveColor = "#f6f5f4" , urgentColor = "#3584e4" , activeBorderColor = "#bfb8b1" , inactiveBorderColor = "#cdc7c2" , urgentBorderColor = "#1658a7" , activeTextColor = "#2e3436" , inactiveTextColor = "#929595" , urgentTextColor = "#ffffff" , fontName = "xft:Cantarell:bold:size=11" , decoWidth = 400 , decoHeight = 35 } } -- | Matching decorations for Adwaita-dark GTK theme adwaitaDarkTheme :: ThemeInfo adwaitaDarkTheme = newTheme { themeName = "adwaitaDarkTheme" , themeAuthor = "Alex Griffin" , themeDescription = "Matching decorations for Adwaita-dark GTK theme" , theme = def { activeColor = "#2d2d2d" , inactiveColor = "#353535" , urgentColor = "#15539e" , activeBorderColor = "#070707" , inactiveBorderColor = "#1c1c1c" , urgentBorderColor = "#030c17" , activeTextColor = "#eeeeec" , inactiveTextColor = "#929291" , urgentTextColor = "#ffffff" , fontName = "xft:Cantarell:bold:size=11" , decoWidth = 400 , decoHeight = 35 } } -- | Don's preferred colors - from DynamicLog...;) donaldTheme :: ThemeInfo donaldTheme = newTheme { themeName = "donaldTheme" , themeAuthor = "Andrea Rossato" , themeDescription = "Don's preferred colors - from DynamicLog...;)" , theme = def { activeColor = "#2b4f98" , inactiveColor = "#cccccc" , activeBorderColor = "#2b4f98" , inactiveBorderColor = "#cccccc" , activeTextColor = "white" , inactiveTextColor = "black" , decoHeight = 16 } } -- | Ffrom Robert Manea's prompt theme. robertTheme :: ThemeInfo robertTheme = newTheme { themeName = "robertTheme" , themeAuthor = "Andrea Rossato" , themeDescription = "From Robert Manea's prompt theme" , theme = def { activeColor = "#aecf96" , inactiveColor = "#111111" , activeBorderColor = "#aecf96" , inactiveBorderColor = "#111111" , activeTextColor = "black" , inactiveTextColor = "#d5d3a7" , fontName = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859" , decoHeight = 16 } } -- | Dark Theme, by Lucian Poston. darkTheme :: ThemeInfo darkTheme = newTheme { themeName = "darkTheme" , themeAuthor = "Lucian Poston" , themeDescription = "Dark Theme" , theme = def { inactiveBorderColor = "#202030" , activeBorderColor = "#a0a0d0" , inactiveColor = "#000000" , activeColor = "#000000" , inactiveTextColor = "#607070" , activeTextColor = "#a0d0d0" , decoHeight = 15 } } -- | deifl\'s Theme, by deifl. deiflTheme :: ThemeInfo deiflTheme = newTheme { themeName = "deiflTheme" , themeAuthor = "deifl" , themeDescription = "deifl's Theme" , theme = def { inactiveBorderColor = "#708090" , activeBorderColor = "#5f9ea0" , activeColor = "#000000" , inactiveColor = "#333333" , inactiveTextColor = "#888888" , activeTextColor = "#87cefa" , fontName = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*" , decoHeight = 15 } } -- | oxymor00n\'s theme, by Tom Rauchenwald. oxymor00nTheme :: ThemeInfo oxymor00nTheme = newTheme { themeName = "oxymor00nTheme" , themeAuthor = "Tom Rauchenwald" , themeDescription = "oxymor00n's theme" , theme = def { inactiveBorderColor = "#000" , activeBorderColor = "aquamarine3" , activeColor = "aquamarine3" , inactiveColor = "DarkSlateGray4" , inactiveTextColor = "#222" , activeTextColor = "#222" -- This font can be found in the package ttf-alee -- on debian-systems , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*" , decoHeight = 15 , urgentColor = "#000" , urgentTextColor = "#63b8ff" } } wfarrTheme :: ThemeInfo wfarrTheme = newTheme { themeName = "wfarrTheme" , themeAuthor = "Will Farrington" , themeDescription = "A nice blue/black theme." , theme = def { activeColor = "#4c7899" , inactiveColor = "#333333" , activeBorderColor = "#285577" , inactiveBorderColor = "#222222" , activeTextColor = "#ffffff" , inactiveTextColor = "#888888" , fontName = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1" , decoHeight = 12 } } -- | Forest colours, by Kathryn Andersen kavonForestTheme :: ThemeInfo kavonForestTheme = newTheme { themeName = "kavonForestTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Forest colours" , theme = def { activeColor = "#115422" , activeBorderColor = "#1a8033" , activeTextColor = "white" , inactiveColor = "#543211" , inactiveBorderColor = "#804c19" , inactiveTextColor = "#ffcc33" } } -- | Lake (blue/green) colours, by Kathryn Andersen kavonLakeTheme :: ThemeInfo kavonLakeTheme = newTheme { themeName = "kavonLakeTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Lake (blue/green) colours" , theme = def { activeColor = "#001166" , activeBorderColor = "#1f3999" , activeTextColor = "white" , inactiveColor = "#09592a" , inactiveBorderColor = "#198044" , inactiveTextColor = "#73e6a3" } } -- | Peacock colours, by Kathryn Andersen kavonPeacockTheme :: ThemeInfo kavonPeacockTheme = newTheme { themeName = "kavonPeacockTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Peacock colours" , theme = def { activeColor = "#190f4c" , activeBorderColor = "#2b1980" , activeTextColor = "white" , inactiveColor = "#225173" , inactiveBorderColor = "#2a638c" , inactiveTextColor = "#8fb2cc" } } -- | Violet-Green colours, by Kathryn Andersen kavonVioGreenTheme :: ThemeInfo kavonVioGreenTheme = newTheme { themeName = "kavonVioGreenTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Violet-Green colours" , theme = def { activeColor = "#37174c" , activeBorderColor = "#333399" , activeTextColor = "white" , inactiveColor = "#174c17" , inactiveBorderColor = "#336633" , inactiveTextColor = "#aaccaa" } } -- | Blue colours, by Kathryn Andersen kavonBluesTheme :: ThemeInfo kavonBluesTheme = newTheme { themeName = "kavonBluesTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Blue colours" , theme = def { activeColor = "#000066" , activeBorderColor = "#111199" , activeTextColor = "white" , inactiveColor = "#9999ee" , inactiveBorderColor = "#6666cc" , inactiveTextColor = "black" } } -- | Christmas colours, by Kathryn Andersen kavonChristmasTheme :: ThemeInfo kavonChristmasTheme = newTheme { themeName = "kavonChristmasTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Christmas (green + red) colours" , theme = def { activeColor = "#660000" , activeBorderColor = "#990000" , activeTextColor = "white" , inactiveColor = "#006600" , inactiveBorderColor = "#003300" , inactiveTextColor = "#99bb99" } } -- | Autumn colours, by Kathryn Andersen kavonAutumnTheme :: ThemeInfo kavonAutumnTheme = newTheme { themeName = "kavonAutumnTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Autumn (brown + red) colours" , theme = def { activeColor = "#660000" , activeBorderColor = "#990000" , activeTextColor = "white" , inactiveColor = "#542d11" , inactiveBorderColor = "#804d1A" , inactiveTextColor = "#ffcc33" } } -- | Fire colours, by Kathryn Andersen kavonFireTheme :: ThemeInfo kavonFireTheme = newTheme { themeName = "kavonFireTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Fire (orange + red) colours" , theme = def { activeColor = "#660000" , activeBorderColor = "#990000" , activeTextColor = "white" , inactiveColor = "#ff8000" , inactiveBorderColor = "#d9b162" , inactiveTextColor = "black" } } xmonad-contrib-0.18.0/XMonad/Util/Timer.hs0000644000000000000000000000361607346545000016442 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Timer -- Description : A module for setting up timers. -- Copyright : (c) Andrea Rossato and David Roundy 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A module for setting up timers ----------------------------------------------------------------------------- module XMonad.Util.Timer ( -- * Usage -- $usage startTimer , handleTimer , TimerId ) where import Control.Concurrent import Data.Unique import XMonad import XMonad.Prelude (listToMaybe) -- $usage -- This module can be used to setup a timer to handle deferred events. -- See "XMonad.Layout.ShowWName" for an usage example. type TimerId = Int -- | Start a timer, which will send a ClientMessageEvent after some -- time (in seconds). startTimer :: Rational -> X TimerId startTimer s = io $ do u <- hashUnique <$> newUnique xfork $ do d <- openDisplay "" rw <- rootWindow d $ defaultScreen d threadDelay (fromEnum $ s * 1000000) a <- internAtom d "XMONAD_TIMER" False allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw a 32 (fromIntegral u) 0 sendEvent d rw False structureNotifyMask e sync d False return u -- | 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 d <- asks display a <- io $ internAtom d "XMONAD_TIMER" False if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action | otherwise -> return Nothing handleTimer _ _ _ = return Nothing xmonad-contrib-0.18.0/XMonad/Util/TreeZipper.hs0000644000000000000000000001357107346545000017454 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.TreeSelect -- Description : Zipper over "Data.Tree". -- Copyright : (c) Tom Smeets -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tom Smeets -- Stability : unstable -- Portability : unportable -- -- over the "Data.Tree" data structure. -- This module is based on . -- ----------------------------------------------------------------------------- module XMonad.Util.TreeZipper( -- * Data structure TreeZipper(..) , cursor -- * Conversion , fromForest , toForest , getSubForest -- * Navigation , rootNode , parent , children , nextChild , previousChild -- * Utils , nodeDepth , nodeIndex , followPath , findChild , isLeaf , isRoot , isLast , isFirst ) where import Data.Tree -- | A over the "Data.Tree" data structure. data TreeZipper a = TreeZipper { tz_current :: Tree a -- ^ the currently focused sub-tree under the cursor , tz_before :: Forest a -- ^ all sub-tree's to the /left/ of the cursor that have the same parent , tz_after :: Forest a -- ^ all sub-tree's to the /right/ of the cursor that have the same parent , tz_parents :: [(Forest a, a, Forest a)] -- ^ list zippers for each parent level, the first element is the current parent } -- ^ Very crappy visualization of the 'TreeZipper' data structure -- -- @ -- (tz_parents) -- ([*], *, [*]) -- ([*, *], *, []) -- ([], * [*, *]) -- | | | -- +-------+--------+-------+------+ +-*-+ * -- | | | | | | | -- (tz_before) (tz_current) (tz_after) * * -- | | | | -- +-*-+ * * * -- | | -- * * -- @ -- | Get the highlighted value cursor :: TreeZipper a -> a cursor = rootLabel . tz_current -- | Create a 'TreeZipper' from a list of 'Data.Tree.Tree's focused on the first element fromForest :: Forest a -> TreeZipper a fromForest [] = error "XMonad.Util.TreeZipper.fromForest: can't create a TreeZipper from an empty list!" fromForest (x:xs) = TreeZipper { tz_current = x , tz_before = [] , tz_after = xs , tz_parents = [] } -- | Convert the entire zipper back to a 'Data.Tree.Forest' toForest :: TreeZipper a -> Forest a toForest = getSubForest . rootNode -- | Create a 'Data.Tree.Forest' from all the children of the current parent getSubForest :: TreeZipper a -> Forest a getSubForest TreeZipper{..} = reverse tz_before ++ tz_current : tz_after -- | Go to the upper most node such that -- nothing is before nor above the cursor rootNode :: TreeZipper a -> TreeZipper a rootNode = f where f z = maybe (g z) f $ parent z g z = maybe z g $ previousChild z -- | Move to the parent node parent :: TreeZipper a -> Maybe (TreeZipper a) parent t = case tz_parents t of (xs,a,ys) : ps -> Just TreeZipper { tz_current = Node a (reverse (tz_before t) ++ tz_current t : tz_after t) , tz_before = xs , tz_after = ys , tz_parents = ps } [] -> Nothing -- | Move the cursor one level down to the first node children :: TreeZipper a -> Maybe (TreeZipper a) children z = case subForest $ tz_current z of (n:xs) -> Just TreeZipper { tz_current = n , tz_before = [] , tz_after = xs , tz_parents = (tz_before z, cursor z, tz_after z) : tz_parents z } [] -> Nothing -- | Go to the next child node nextChild :: TreeZipper a -> Maybe (TreeZipper a) nextChild z = case tz_after z of (n:xs) -> Just TreeZipper { tz_current = n , tz_before = tz_current z : tz_before z , tz_after = xs , tz_parents = tz_parents z } [] -> Nothing -- | Go to the previous child node previousChild :: TreeZipper a -> Maybe (TreeZipper a) previousChild z = case tz_before z of (n:xs) -> Just TreeZipper { tz_current = n , tz_before = xs , tz_after = tz_current z : tz_after z , tz_parents = tz_parents z } [] -> Nothing -- | How many nodes are above this one? nodeDepth :: TreeZipper a -> Int nodeDepth = length . tz_parents -- | How many nodes are before the cursor? (on the current level) nodeIndex :: TreeZipper a -> Int nodeIndex = length . tz_before -- | follow a Path specified by the list of nodes followPath :: Eq b => (a -> b) -> [b] -> TreeZipper a -> Maybe (TreeZipper a) followPath _ [] z = Just z followPath f [x] z = findChild (\y -> f y == x) z followPath f (x:xs) z = findChild (\y -> f y == x) z >>= children >>= followPath f xs -- | go to the first node next to the cursor that matches findChild :: (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a) findChild f z | f (cursor z) = Just z | otherwise = nextChild z >>= findChild f -- | Check whenther this is a leaf node isLeaf :: TreeZipper a -> Bool isLeaf = null . subForest . tz_current -- | Check whenther this is a leaf node isRoot :: TreeZipper a -> Bool isRoot = null . tz_parents -- | Check whenther this the last child isLast :: TreeZipper a -> Bool isLast = null . tz_after -- | Check whenther this the first child isFirst :: TreeZipper a -> Bool isFirst = null . tz_before xmonad-contrib-0.18.0/XMonad/Util/Types.hs0000644000000000000000000000163407346545000016464 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Types -- Description : Miscellaneous commonly used types. -- Copyright : (c) Daniel Schoepe (2009) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- Miscellaneous commonly used types. -- ----------------------------------------------------------------------------- module XMonad.Util.Types (Direction1D(..) ,Direction2D(..) ) where -- | One-dimensional directions: 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) xmonad-contrib-0.18.0/XMonad/Util/Ungrab.hs0000644000000000000000000000343607346545000016600 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Ungrab -- Description : Release xmonad's keyboard and pointer grabs immediately. -- Copyright : (c) 2016 Brandon S Allbery -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : unportable -- -- Allow releasing xmonad's keyboard grab -- ----------------------------------------------------------------------------- module XMonad.Util.Ungrab {-# DEPRECATED "Use XMonad.Operations.unGrab instead" #-} ( -- * Usage: -- $usage unGrab ) where #if MIN_VERSION_xmonad(0, 17, 9) import XMonad.Operations (unGrab) #else import Graphics.X11.Xlib (sync) import Graphics.X11.Xlib.Extras (currentTime) import Graphics.X11.Xlib.Misc (ungrabKeyboard, ungrabPointer) import XMonad.Core -- $usage -- Start a keyboard action with this if it is going to run something -- that needs to do a keyboard, pointer, or server grab. For example, -- -- > , ((modm .|. controlMask, xK_p), unGrab >> spawn "scrot") -- -- (Other examples are screen lockers and "gksu".) -- This avoids needing to insert a pause/sleep before running the -- command. -- -- xmonad retains the keyboard grab during key actions because if they -- use a Submap, they need the keyboard to be grabbed, and if they had -- to assert their own grab then the asynchronous nature of X11 allows -- race conditions between xmonad, other clients, and the X server that -- would cause keys to sometimes be "leaked" to the focused window. -- | Release xmonad's keyboard grab, so other grabbers can do their thing. unGrab :: X () unGrab = withDisplay $ \d -> io (ungrabKeyboard d currentTime >> ungrabPointer d currentTime >> sync d False) #endif xmonad-contrib-0.18.0/XMonad/Util/WindowProperties.hs0000644000000000000000000000660307346545000020705 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.WindowProperties -- Description : EDSL for specifying window properties. -- Copyright : (c) Roman Cheplyaka -- License : BSD-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- EDSL for specifying window properties; various utilities related to window -- properties. -- ----------------------------------------------------------------------------- module XMonad.Util.WindowProperties ( -- * EDSL for window properties -- $edsl Property(..), hasProperty, focusedHasProperty, allWithProperty, propertyToQuery, -- * Helper functions -- $helpers getProp32, getProp32s) where import Foreign.C.Types (CLong) import XMonad import XMonad.Actions.TagWindows (hasTag) import XMonad.Prelude (filterM) import qualified XMonad.StackSet as W -- $edsl -- Allows to specify window properties, such as title, classname or -- resource, and to check them. -- -- In contrast to ManageHook properties, these are instances of Show and Read, -- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM" -- | Most of the property constructors are quite self-explaining. data Property = Title String | ClassName String | Resource String | Role String -- ^ WM_WINDOW_ROLE property | Machine String -- ^ WM_CLIENT_MACHINE property | And Property Property | Or Property Property | Not Property | Const Bool | Tagged String -- ^ Tagged via "XMonad.Actions.TagWindows" deriving (Read, Show) infixr 9 `And` infixr 8 `Or` -- | Does given window have this property? hasProperty :: Property -> Window -> X Bool hasProperty p = runQuery (propertyToQuery p) -- | Does the focused window have this property? focusedHasProperty :: Property -> X Bool focusedHasProperty p = do ws <- gets windowset let ms = W.stack $ W.workspace $ W.current ws case ms of Just s -> hasProperty p $ W.focus s Nothing -> return False -- | Find all existing windows with specified property allWithProperty :: Property -> X [Window] allWithProperty prop = withDisplay $ \dpy -> do rootw <- asks theRoot (_,_,wins) <- io $ queryTree dpy rootw hasProperty prop `filterM` wins -- | Convert property to 'Query' 'Bool' (see "XMonad.ManageHook") propertyToQuery :: Property -> Query Bool propertyToQuery (Title s) = title =? s propertyToQuery (Resource s) = resource =? s propertyToQuery (ClassName s) = className =? s propertyToQuery (Role s) = stringProperty "WM_WINDOW_ROLE" =? s 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 <$> propertyToQuery p propertyToQuery (Const b) = return b propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w) -- $helpers -- | Get a window property from atom getProp32 :: Atom -> Window -> X (Maybe [CLong]) getProp32 a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w -- | Get a window property from string getProp32s :: String -> Window -> X (Maybe [CLong]) getProp32s str w = do { a <- getAtom str; getProp32 a w } xmonad-contrib-0.18.0/XMonad/Util/WindowState.hs0000644000000000000000000000702107346545000017624 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.WindowState -- Description : Functions for saving per-window data. -- Copyright : (c) Dmitry Bogatov -- License : BSD -- -- Maintainer : Dmitry Bogatov -- Stability : unstable -- Portability : unportable -- -- Functions for saving per-window data. ----------------------------------------------------------------------------- module XMonad.Util.WindowState ( -- * Usage -- $usage get, put, StateQuery(..), runStateQuery, catchQuery ) where import XMonad hiding (get, put, modify) import Control.Monad.Reader(ReaderT(..)) import Control.Monad.State.Class import Data.Typeable (typeOf) -- $usage -- -- This module allow to store state data with some 'Window'. -- It is implemented with XProperties, so resources will be freed when -- 'Window' is destoyed. -- -- This module have advantage over "XMonad.Actions.TagWindows" in that it -- hides from you implementation details and provides simple type-safe -- interface. Main datatype is 'StateQuery', which is simple wrapper around -- 'Query', which is instance of MonadState, with 'put' and 'get' are -- functions to acess data, stored in 'Window'. -- -- To save some data in window you probably want to do following: -- > (runStateQuery (put $ Just value) win) :: X () -- To retrive it, you can use -- > (runStateQuery get win) :: X (Maybe YourValueType) -- 'Query' can be promoted to 'StateQuery' simply by constructor, -- and reverse is 'getQuery'. -- -- For example, I use it to have all X applications @russian@ or @dvorak@ -- layout, but emacs have only @us@, to not screw keybindings. Use your -- imagination! -- | Wrapper around 'Query' with phantom type @s@, representing state, saved in -- window. newtype StateQuery s a = StateQuery { getQuery :: Query a } deriving (Monad, MonadIO, Applicative, Functor) packIntoQuery :: (Window -> X a) -> Query a packIntoQuery = Query . ReaderT -- | Apply 'StateQuery' to 'Window'. runStateQuery :: StateQuery s a -> Window -> X a runStateQuery = runQuery . getQuery -- | Lifted to 'Query' version of 'catchX' catchQuery :: Query a -> Query (Maybe a) catchQuery q = packIntoQuery $ \win -> userCode $ runQuery q win -- | Instance of MonadState for StateQuery. instance (Show s, Read s, Typeable s) => MonadState (Maybe s) (StateQuery s) where get = StateQuery $ read' <$> get' undefined where get' :: Maybe s -> Query String get' x = stringProperty (typePropertyName x) read' :: (Read s) => String -> Maybe s read' "" = Nothing read' s = Just $ read s put = StateQuery . packIntoQuery <$> setWindowProperty' where setWindowProperty' val = setWindowProperty prop strValue where prop = typePropertyName val strValue = maybe "" show val typePropertyName :: (Typeable a) => a -> String typePropertyName x = "_XMONAD_WINSTATE__" ++ show (typeOf x) type PropertyName = String setWindowProperty :: PropertyName -> String -> Window -> X () setWindowProperty prop val win = withDisplay $ \d -> io $ internAtom d prop False >>= setTextProperty d win val xmonad-contrib-0.18.0/XMonad/Util/WorkspaceCompare.hs0000644000000000000000000001160107346545000020620 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.WorkspaceCompare -- Description : Functions for examining, comparing, and sorting workspaces. -- Copyright : (c) Spencer Janssen -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort , filterOutWs , getWsIndex , getWsCompare , getWsCompareByTag , getXineramaPhysicalWsCompare , getXineramaWsCompare , mkWsSort , getSortByIndex , getSortByTag , getSortByXineramaPhysicalRule , getSortByXineramaRule ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Prelude import XMonad.Actions.PhysicalScreens (ScreenComparator(ScreenComparator), getScreenIdAndRectangle, screenComparatorById) 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) getWsIndex = do spaces <- asks (workspaces . config) return $ flip elemIndex spaces -- | Compare Maybe's differently, so Nothing (i.e. workspaces without indexes) -- come last in the order indexCompare :: Maybe Int -> Maybe Int -> Ordering indexCompare Nothing Nothing = EQ indexCompare Nothing (Just _) = GT indexCompare (Just _) Nothing = LT indexCompare a b = compare a b -- | A comparison function for WorkspaceId, based on the index of the -- tags in the user's config. getWsCompare :: X WorkspaceCompare getWsCompare = do wsIndex <- getWsIndex return $ mconcat [indexCompare `on` wsIndex, compare] -- | A simple comparison function that orders workspaces -- lexicographically by tag. getWsCompareByTag :: X WorkspaceCompare getWsCompareByTag = return compare -- | A comparison function for Xinerama based on visibility, workspace -- and screen id. It produces the same ordering as -- 'XMonad.Hooks.StatusBar.PP.pprWindowSetXinerama'. getXineramaWsCompare :: X WorkspaceCompare getXineramaWsCompare = getXineramaPhysicalWsCompare $ screenComparatorById compare -- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens. getXineramaPhysicalWsCompare :: ScreenComparator -> X WorkspaceCompare getXineramaPhysicalWsCompare (ScreenComparator sc) = do w <- gets windowset return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of (True, True) -> compareUsingScreen w a b (False, False) -> compare a b (True, False) -> LT (False, True) -> GT where onScreen w = S.current w : S.visible w isOnScreen a w = a `elem` map (S.tag . S.workspace) (onScreen w) tagToScreen s x = fromJust $ find ((== x) . S.tag . S.workspace) s compareUsingScreen w = sc `on` getScreenIdAndRectangle . tagToScreen (onScreen w) -- | Create a workspace sorting function from a workspace comparison -- function. mkWsSort :: X WorkspaceCompare -> X WorkspaceSort mkWsSort cmpX = do cmp <- cmpX return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) -- | Sort several workspaces according to their tags' indices in the -- user's config. getSortByIndex :: X WorkspaceSort getSortByIndex = mkWsSort getWsCompare -- | Sort workspaces lexicographically by tag. getSortByTag :: X WorkspaceSort getSortByTag = mkWsSort getWsCompareByTag -- | Sort serveral workspaces for xinerama displays, in the same order -- produced by 'XMonad.Hooks.StatusBar.PP.pprWindowSetXinerama': first -- visible workspaces, sorted by screen, then hidden workspaces, -- sorted by tag. getSortByXineramaRule :: X WorkspaceSort getSortByXineramaRule = mkWsSort getXineramaWsCompare -- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens. getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort getSortByXineramaPhysicalRule sc = mkWsSort $ getXineramaPhysicalWsCompare sc xmonad-contrib-0.18.0/XMonad/Util/XSelection.hs0000644000000000000000000001122207346545000017427 0ustar0000000000000000{-# 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 Maintainer : Gwern Branwen Stability : unstable Portability : unportable A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting). 'getSelection' is an adaptation of Hxsel.hs and Hxput.hs from the XMonad-utils, available: > $ darcs get -} module XMonad.Util.XSelection ( -- * Usage -- $usage getSelection, promptSelection, safePromptSelection, transformPromptSelection, transformSafePromptSelection) where import Control.Exception as E (catch,SomeException(..)) import XMonad import XMonad.Util.Run (safeSpawn, unsafeSpawn) import Codec.Binary.UTF8.String (decode) {- $usage Add @import XMonad.Util.XSelection@ to the top of Config.hs Then make use of getSelection or promptSelection as needed; if one wanted to run Firefox with the selection as an argument (perhaps the selection string is an URL you just highlighted), then one could add to the xmonad.hs a line like thus: > , ((modm .|. shiftMask, xK_b), promptSelection "firefox") Future improvements for XSelection: * More elaborate functionality: Emacs' registers are nice; if you don't know what they are, see -} -- | Returns a String corresponding to the current mouse selection in X; -- if there is none, an empty string is returned. -- -- WARNING: this function is fundamentally implemented incorrectly and may, among other possible failure modes, -- deadlock or crash. For details, see . -- (These errors are generally very rare in practice, but still exist.) getSelection :: MonadIO m => m String getSelection = io $ do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 p <- internAtom dpy "PRIMARY" True ty <- E.catch (E.catch (internAtom dpy "UTF8_STRING" False) (\(E.SomeException _) -> internAtom dpy "COMPOUND_TEXT" False)) (\(E.SomeException _) -> internAtom dpy "sTring" False) clp <- internAtom dpy "BLITZ_SEL_STRING" False xConvertSelection dpy p ty clp win currentTime allocaXEvent $ \e -> do nextEvent dpy e ev <- getEvent e result <- if ev_event_type ev == selectionNotify then do res <- getWindowProperty8 dpy clp win return $ decode . maybe [] (map fromIntegral) $ res else destroyWindow dpy win >> return "" closeDisplay dpy return result {- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument. This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to @promptSelection \"firefox\"@; this would allow you to highlight a URL string and then immediately open it up in Firefox. 'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more details on the advantages and disadvantages of using safeSpawn. -} promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () promptSelection = unsafePromptSelection 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. The transformer essentially transforms the selection in X. 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 = (safeSpawn app . return . f) =<< getSelection transformSafePromptSelection f app = unsafeSpawn . (\x -> app ++ " " ++ x) . f =<< getSelection xmonad-contrib-0.18.0/XMonad/Util/XUtils.hs0000644000000000000000000002625607346545000016617 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.XUtils -- Description : A module for painting on the screen. -- Copyright : (c) 2007 Andrea Rossato -- 2010 Alejandro Serrano -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A module for painting on the screen -- ----------------------------------------------------------------------------- module XMonad.Util.XUtils ( -- * Usage: -- $usage withSimpleWindow , showSimpleWindow , WindowConfig(..) , WindowRect(..) , averagePixels , createNewWindow , showWindow , showWindows , hideWindow , hideWindows , deleteWindow , deleteWindows , paintWindow , paintAndWrite , paintTextAndIcons , stringToPixel , pixelToString , fi ) where import XMonad.Prelude import XMonad import XMonad.Util.Font import XMonad.Util.Image import qualified XMonad.StackSet as W import Data.Bits ((.&.)) -- $usage -- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or -- "XMonad.Layout.Decoration" for usage examples -- | Compute the weighted average the colors of two given 'Pixel' values. -- -- This function masks out any alpha channel in the passed pixels, and the -- result has no alpha channel. X11 mishandles @Pixel@ values with alpha -- channels and throws errors while producing black pixels. averagePixels :: Pixel -> Pixel -> Double -> X Pixel averagePixels p1' p2' f = do d <- asks display let cm = defaultColormap d (defaultScreen d) mask p = p .&. 0x00FFFFFF p1 = mask p1' p2 = mask p2' [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0] let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f)) Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0) return p -- | Create a simple window given a rectangle. If Nothing is given -- only the exposureMask will be set, otherwise the Just value. -- Use 'showWindow' to map and hideWindow to unmap. createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window createNewWindow (Rectangle x y w h) m col o = do d <- asks display rw <- asks theRoot c <- stringToPixel d col win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o case m of Just em -> io $ selectInput d win em Nothing -> io $ selectInput d win exposureMask -- @@@ ugly hack to prevent compositing whenX (return $ isJust m) $ flip catchX (return ()) $ do wINDOW_TYPE <- getAtom "_NET_WM_WINDOW_TYPE" dESKTOP <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" io $ changeProperty32 d win wINDOW_TYPE aTOM propModeReplace [fi dESKTOP] return win -- | Map a window showWindow :: Window -> X () showWindow w = do d <- asks display io $ mapWindow d w -- | the list version showWindows :: [Window] -> X () showWindows = mapM_ showWindow -- | unmap a window hideWindow :: Window -> X () hideWindow w = do d <- asks display io $ unmapWindow d w -- | the list version hideWindows :: [Window] -> X () hideWindows = mapM_ hideWindow -- | destroy a window deleteWindow :: Window -> X () deleteWindow w = do d <- asks display io $ destroyWindow d w -- | the list version deleteWindows :: [Window] -> X () deleteWindows = mapM_ deleteWindow -- | Fill a window with a rectangle and a border paintWindow :: Window -- ^ The window where to draw -> Dimension -- ^ Window width -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color -> X () paintWindow w wh ht bw c bc = paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing Nothing -- | Fill a window with a rectangle and a border, and write -- | a number of strings to given positions paintAndWrite :: Window -- ^ The window where to draw -> XMonadFont -- ^ XMonad Font for drawing -> Dimension -- ^ Window width -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color -> String -- ^ String color -> String -- ^ String background color -> [Align] -- ^ String 'Align'ments -> [String] -- ^ Strings to be printed -> X () paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do d <- asks display 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 -- | Fill a window with a rectangle and a border, and write -- | a number of strings and a number of icons to given positions paintTextAndIcons :: Window -- ^ The window where to draw -> XMonadFont -- ^ XMonad Font for drawing -> Dimension -- ^ Window width -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color -> String -- ^ String color -> String -- ^ String background color -> [Align] -- ^ String 'Align'ments -> [String] -- ^ Strings to be printed -> [Placement] -- ^ Icon 'Placements' -> [[[Bool]]] -- ^ Icons to be printed -> 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) $ uncurry (stringPosition d fs (Rectangle 0 0 wh ht)) let iconPositions = zipWith (iconPosition (Rectangle 0 0 wh ht)) i_als icons ms = Just (fs,ffc,fbc, zip strs strPositions) is = Just (ffc, fbc, zip iconPositions icons) paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is -- | The config for a window, as interpreted by 'showSimpleWindow'. -- -- The font @winFont@ can either be specified in the TODO format or as an -- xft font. For example: -- -- > winFont = "xft:monospace-20" -- -- or -- -- > winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*" data WindowConfig = WindowConfig { winFont :: !String -- ^ Font to use. , winBg :: !String -- ^ Background color. , winFg :: !String -- ^ Foreground color. , winRect :: !WindowRect -- ^ Position and size of the rectangle. } instance Default WindowConfig where def = WindowConfig { #ifdef XFT winFont = "xft:monospace-20" #else winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*" #endif , winBg = "black" , winFg = "white" , winRect = CenterWindow } -- | What kind of window we should be. data WindowRect = CenterWindow -- ^ Centered, big enough to fit all the text. | CustomRect Rectangle -- ^ Completely custom dimensions. -- | Create a window, then fill and show it with the given text. If you -- are looking for a version of this function that also takes care of -- destroying the window, refer to 'withSimpleWindow'. showSimpleWindow :: WindowConfig -- ^ Window config. -> [String] -- ^ Lines of text to show. -> X Window showSimpleWindow WindowConfig{..} strs = do let pad = 20 font <- initXMF winFont dpy <- asks display Rectangle sx sy sw sh <- getRectangle winRect -- Text extents for centering all fonts extends <- maximum . map (uncurry (+)) <$> traverse (textExtentsXMF font) strs -- Height and width of entire window height <- pure . fi $ (1 + length strs) * fi extends width <- (+ pad) . fi . maximum <$> traverse (textWidthXMF dpy font) strs let -- x and y coordinates that specify the upper left corner of the window x = sx + (fi sw - width + 2) `div` 2 y = sy + (fi sh - height + 2) `div` 2 -- y position of first string yFirst = (height + 2 * extends) `div` fi (2 + length strs) -- (x starting, y starting) for all strings strPositions = map (pad `div` 2, ) [yFirst, yFirst + extends ..] w <- createNewWindow (Rectangle x y (fi width) (fi height)) Nothing "" True let ms = Just (font, winFg, winBg, zip strs strPositions) showWindow w paintWindow' w (Rectangle 0 0 (fi width) (fi height)) 0 winBg "" ms Nothing releaseXMF font pure w where getRectangle :: WindowRect -> X Rectangle getRectangle = \case CenterWindow -> gets $ screenRect . W.screenDetail . W.current . windowset CustomRect r -> pure r -- | Like 'showSimpleWindow', but fully manage the window; i.e., destroy -- it after the given function finishes its execution. withSimpleWindow :: WindowConfig -> [String] -> X a -> X a withSimpleWindow wc strs doStuff = do w <- showSimpleWindow wc strs doStuff <* withDisplay (io . (`destroyWindow` w)) -- This stuff is not exported -- | Paints a titlebar with some strings and icons -- drawn inside it. -- Not exported. paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X () paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do d <- asks display p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) gc <- io $ createGC d p -- draw io $ setGraphicsExposures d gc False [color',b_color'] <- mapM (stringToPixel d) [color,b_color] -- we start with the border io $ setForeground d gc b_color' io $ fillRectangle d p gc 0 0 wh ht -- and now again io $ setForeground d gc color' io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) -- paint strings when (isJust strStuff) $ do let (xmf,fc,bc,strAndPos) = fromJust strStuff forM_ strAndPos $ \(s, (x, y)) -> printStringXMF d p xmf gc fc bc x y s -- paint icons when (isJust iconStuff) $ do let (fc, bc, iconAndPos) = fromJust iconStuff forM_ iconAndPos $ \((x, y), icon) -> drawIcon d p gc fc bc x y icon -- copy the pixmap over the window io $ copyArea d p win gc 0 0 wh ht 0 0 -- free the pixmap and GC io $ freePixmap d p io $ freeGC d gc -- | Creates a window with the possibility of setting some attributes. -- Not exported. mkWindow :: Display -> Screen -> Window -> Position -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window mkWindow d s rw x y w h p o = do let visual = defaultVisualOfScreen s attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes o set_border_pixel attributes p set_background_pixel attributes p createWindow d rw x y w h 0 (defaultDepthOfScreen s) inputOutput visual attrmask attributes xmonad-contrib-0.18.0/scripts/0000755000000000000000000000000007346545000014404 5ustar0000000000000000xmonad-contrib-0.18.0/scripts/run-xmonad.sh0000644000000000000000000000151107346545000017026 0ustar0000000000000000#!/bin/sh # # launch xmonad, with a couple of dzens to run the status bar # send xmonad state over a named pipe # FG='#a8a3f7' BG='#3f3c6d' FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" PATH=${HOME}/bin:$PATH # simple xmonad use, no interactive status bar. # #clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & #xmonad # # with a pipe talking to an external program # PIPE=$HOME/.xmonad-status rm -f $PIPE PATH=${PATH}:/sbin mkfifo -m 600 $PIPE [ -p $PIPE ] || exit # launch the external 60 second clock, and launch the workspace status bar xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & # and a workspace status bar dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT < $PIPE & # go for it xmonad > $PIPE & # wait for xmonad wait $! pkill -HUP dzen2 pkill -HUP -f xmonad-clock wait xmonad-contrib-0.18.0/scripts/window-properties.sh0000644000000000000000000000105707346545000020444 0ustar0000000000000000#! /bin/sh # Script to print common window properties in ManageHook format, # via xprop. All xprop options may be used, although anything other # than -display, -id, and -name is probably a bad idea. # # Written and placed into the public domain by Brandon S Allbery # KF8NH # exec xprop -notype \ -f WM_NAME 8s ':\n title =\? $0\n' \ -f WM_CLASS 8s ':\n appName =\? $0\n className =\? $1\n' \ -f WM_WINDOW_ROLE 8s ':\n stringProperty "WM_WINDOW_ROLE" =\? $0\n' \ WM_NAME WM_CLASS WM_WINDOW_ROLE \ ${1+"$@"} xmonad-contrib-0.18.0/scripts/xinitrc0000644000000000000000000000176507346545000016020 0ustar0000000000000000# .xinitrc xrandr -s 0 xrdb $HOME/.Xresources xsetroot -cursor_name left_ptr xsetroot -solid '#80a0af' # if we have private ssh key(s), start ssh-agent and add the key(s) id1=$HOME/.ssh/identity id2=$HOME/.ssh/id_dsa id3=$HOME/.ssh/id_rsa if [ -x /usr/bin/ssh-agent ] && [ -f $id1 -o -f $id2 -o -f $id3 ]; then eval `ssh-agent -s` ssh-add < /dev/null fi xset fp+ /usr/local/lib/X11/fonts/terminus xset fp+ /usr/local/lib/X11/fonts/ghostscript xset fp+ /usr/X11R6/lib/X11/fonts/TTF/ # xset fp rehash xset b 100 0 0 xset r rate 140 200 xmodmap -e "keycode 233 = Page_Down" xmodmap -e "keycode 234 = Page_Up" xmodmap -e "remove Lock = Caps_Lock" xmodmap -e "keysym Caps_Lock = Control_L" xmodmap -e "add Control = Control_L" PATH=/home/dons/bin:$PATH # launch the external 60 second clock, and launch the workspace status bar FG='#a8a3f7' BG='#3f3c6d' xmonad-clock | dzen2 -e '' -x 400 -w 1200 -ta r -fg $FG -bg $BG & xmonad & # wait for xmonad wait $! pkill -HUP dzen2 pkill -HUP -f xmonad-clock wait xmonad-contrib-0.18.0/scripts/xmonad-acpi.c0000644000000000000000000000464507346545000016761 0ustar0000000000000000/* dwm/xmonad status bar provider. launch from your .xinitrc, and pipe into dzen2. to compile: gcc -Os -s -o xmonad-acpi xmonad-acpi.c Copyright (c) 2007, Tom Menari Copyright (c) 2007, Don Stewart Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include #include #include #include /* configuration */ #define REFRESH_RATE 2 #define TIME_FORMAT "%a %b %d %H:%M:%S" #define BATTERY_INFO "/proc/acpi/battery/BAT0/info" #define BATTERY_STATE "/proc/acpi/battery/BAT0/state" int main(void) { FILE *acpi; char b[34]; time_t epochtime; struct tm *realtime; int last_full, remaining; double load[3]; signal(SIGPIPE, SIG_IGN); if ((acpi = fopen(BATTERY_INFO, "r")) == NULL) { perror("couldn't open "BATTERY_INFO); exit(-1); } while (fgets(b, sizeof(b), acpi)) if (sscanf(b, "last full capacity: %d", &last_full) == 1) break; fclose(acpi); for(;;) { /* Load */ getloadavg(load, 3); /* Battery */ if ((acpi = fopen(BATTERY_STATE, "r")) == NULL) { perror("couldn't open "BATTERY_STATE); exit(-1); } while (fgets(b, sizeof(b), acpi)) if (sscanf(b, "remaining capacity: %d", &remaining) == 1) break; fclose(acpi); /* Time */ epochtime = time(NULL); realtime = localtime(&epochtime); strftime(b, sizeof(b), TIME_FORMAT, realtime); fprintf(stdout, "%s | %.2f %.2f %.2f | %.1f%% \n", b, load[0], load[1], load[2], (float) (remaining * 100) / last_full); fflush(stdout); sleep(REFRESH_RATE); } return EXIT_SUCCESS; } xmonad-contrib-0.18.0/scripts/xmonad-clock.c0000644000000000000000000000363007346545000017131 0ustar0000000000000000/* dwm/xmonad status bar provider. launch from your .xinitrc, and pipe into dzen2. to compile: gcc -Os -s -o xmonad-clock xmonad-clock.c Copyright (c) 2007, Tom Menari Copyright (c) 2007, Don Stewart Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include #include #include #include /* configuration */ #define REFRESH_RATE 60 #define TIME_FORMAT "%H.%M %a %b %d" #define TIME_FORMAT2 "SYD %H.%M" int main(void) { char b[34]; char c[34]; time_t epochtime; struct tm *realtime; time_t pdttime; struct tm *pdtrealtime; double load[3]; signal(SIGPIPE, SIG_IGN); for(;;) { getloadavg(load, 3); epochtime = time(NULL); realtime = localtime(&epochtime); strftime(b, sizeof(b), TIME_FORMAT, realtime); setenv("TZ","Australia/Sydney", 1); pdttime = time(NULL); pdtrealtime = localtime(&pdttime); strftime(c, sizeof(c), TIME_FORMAT2, pdtrealtime); unsetenv("TZ"); fprintf(stdout, "%s | %s | %.2f %.2f %.2f | xmonad 0.3 \n", b, c, load[0], load[1], load[2]); fflush(stdout); sleep(REFRESH_RATE); } return EXIT_SUCCESS; } xmonad-contrib-0.18.0/scripts/xmonadctl.hs0000644000000000000000000000446707346545000016744 0ustar0000000000000000#!/usr/bin/env runhaskell -- Copyright: (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007 -- License: BSD-style (see xmonad/LICENSE) -- -- Compile with @ghc --make xmonadctl.hs@ -- For usage help, do @xmonadctl -h@ import Control.Monad import Data.Char import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import System.Environment import System.IO main :: IO () main = parse True "XMONAD_COMMAND" =<< getArgs parse :: Bool -> String -> [String] -> IO () parse input addr args = case args of ["--"] | input -> repl addr | otherwise -> return () ("--":xs) -> sendAll addr xs ("-a":a:xs) -> parse input a xs ("-h":_) -> showHelp ("--help":_) -> showHelp ("-?":_) -> showHelp (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a) (x:xs) -> sendCommand addr x >> parse False addr xs [] | input -> repl addr | otherwise -> return () repl :: String -> IO () repl addr = do e <- isEOF unless e $ do l <- getLine sendCommand addr l repl addr sendAll :: String -> [String] -> IO () sendAll addr = foldr (\a b -> sendCommand addr a >> b) (return ()) sendCommand :: String -> String -> IO () sendCommand addr s = do d <- openDisplay "" rw <- rootWindow d $ defaultScreen d a <- internAtom d addr False m <- internAtom d s False allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw a 32 m 0 sendEvent d rw False structureNotifyMask e sync d False showHelp :: IO () showHelp = do pn <- getProgName mapM_ putStrLn [ "Send commands to a running instance of xmonad." , "(xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.)" , "" , "-a atomname can be used at any point in the command line arguments to" , "change which atom it is sending on. The atom defaults to XMONAD_COMMAND." , "" , "If sent with no arguments or only -a atom arguments, it will read commands from stdin." , "" , "Ex:" , pn ++ " cmd1 cmd2" , pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world" , pn ++ " -a XMONAD_PRINT # will read data from stdin." ] xmonad-contrib-0.18.0/scripts/xmonadpropread.hs0000644000000000000000000000255207346545000017767 0ustar0000000000000000#!/usr/bin/env runhaskell {-# LANGUAGE LambdaCase #-} -- Copyright Spencer Janssen -- BSD3 (see LICENSE) -- -- Reads from an X property on the root window and writes to standard output. -- -- May be used together with XMonad.Hooks.StatusBar.xmonadPropLog and a -- status bar that doesn't support reading from properties itself, such as -- dzen. -- -- Usage: -- -- $ xmonadpropread | dzen2 -- -- or -- -- $ xmonadpropread _XMONAD_LOG_CUSTOM | dzen2 import Control.Monad import Graphics.X11 import Graphics.X11.Xlib.Extras import Codec.Binary.UTF8.String as UTF8 import Foreign.C (CChar) import System.Environment import System.IO main :: IO () main = do hSetBuffering stdout LineBuffering atom <- flip fmap getArgs $ \case [a] -> a _ -> "_XMONAD_LOG" d <- openDisplay "" xlog <- internAtom d atom False root <- rootWindow d (defaultScreen d) selectInput d root propertyChangeMask let printProp = do mwp <- getWindowProperty8 d xlog root maybe (return ()) (putStrLn . decodeCChar) mwp printProp allocaXEvent $ \ep -> forever $ do nextEvent d ep e <- getEvent ep case e of PropertyEvent { ev_atom = a } | a == xlog -> printProp _ -> return () decodeCChar :: [CChar] -> String decodeCChar = UTF8.decode . map fromIntegral xmonad-contrib-0.18.0/tests/0000755000000000000000000000000007346545000014057 5ustar0000000000000000xmonad-contrib-0.18.0/tests/CycleRecentWS.hs0000644000000000000000000000111107346545000017057 0ustar0000000000000000{-# 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 xmonad-contrib-0.18.0/tests/EZConfig.hs0000644000000000000000000000675707346545000016076 0ustar0000000000000000{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} module EZConfig (spec) where import Control.Arrow (first, (>>>)) import Data.Coerce import Foreign.C.Types (CUInt(..)) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck import XMonad import XMonad.Prelude import XMonad.Util.EZConfig import XMonad.Util.Parser spec :: Spec spec = do prop "prop_decodePreservation" prop_decodePreservation prop "prop_encodePreservation" prop_encodePreservation context "parseKey" $ do let prepare = unzip . map (first surround) testParseKey (ns, ks) = traverse (runParser parseKey) ns `shouldBe` Just ks it "parses all regular keys" $ testParseKey (unzip regularKeys ) it "parses all function keys" $ testParseKey (prepare functionKeys ) it "parses all special keys" $ testParseKey (prepare specialKeys ) it "parses all multimedia keys" $ testParseKey (prepare multimediaKeys) context "parseModifier" $ do it "parses all combinations of modifiers" $ nub . map sort <$> traverse (runParser (many $ parseModifier def)) modifiers `shouldBe` Just [[ shiftMask, controlMask , mod1Mask, mod1Mask -- def M and M1 , mod2Mask, mod3Mask, mod4Mask, mod5Mask ]] -- Checking for regressions describe "readKeySequence" $ it "Fails on the non-existent key M-10" $ readKeySequence def "M-10" `shouldBe` Nothing -- | Parsing preserves all info that printing does. prop_encodePreservation :: KeyString -> Property prop_encodePreservation (coerce -> s) = parse s === (parse . pp =<< parse s) where parse = runParser (parseKeySequence def) pp = unwords . map keyToString -- | Printing preserves all info that parsing does. prop_decodePreservation :: NonEmptyList (AKeyMask, AKeySym) -> Property prop_decodePreservation (getNonEmpty >>> coerce -> xs) = Just (pp xs) === (fmap pp . parse $ pp xs) where parse = runParser (parseKeySequence def) pp = unwords . map keyToString -- | QuickCheck can handle the 8! combinations just fine. modifiers :: [String] modifiers = map concat $ permutations mods mods :: [String] mods = ["M-", "C-", "S-", "M1-", "M2-", "M3-", "M4-", "M5-"] surround :: String -> String surround s = "<" <> s <> ">" ----------------------------------------------------------------------- -- Newtypes and Arbitrary instances newtype AKeyMask = AKeyMask KeyMask deriving newtype (Show) instance Arbitrary AKeyMask where arbitrary :: Gen AKeyMask arbitrary = fmap (coerce . sum . nub) . listOf . elements $ [noModMask, shiftMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask] newtype AKeySym = AKeySym KeySym deriving newtype (Show) instance Arbitrary AKeySym where arbitrary :: Gen AKeySym arbitrary = elements . coerce . map snd $ regularKeys <> allSpecialKeys newtype KeyString = KeyString String deriving newtype (Show) instance Arbitrary KeyString where arbitrary :: Gen KeyString arbitrary = coerce . unwords <$> listOf keybinding where keybinding :: Gen String keybinding = do let keyStr = map fst $ regularKeys <> allSpecialKeys mks <- nub <$> listOf (elements ("" : mods)) k <- elements keyStr ks <- listOf . elements $ keyStr pure $ concat mks <> k <> " " <> unwords ks xmonad-contrib-0.18.0/tests/ExtensibleConf.hs0000644000000000000000000000304707346545000017327 0ustar0000000000000000{-# 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) } xmonad-contrib-0.18.0/tests/GridSelect.hs0000644000000000000000000000052707346545000016444 0ustar0000000000000000module 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 xmonad-contrib-0.18.0/tests/Instances.hs0000644000000000000000000001313007346545000016340 0ustar0000000000000000{-# 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 xmonad-contrib-0.18.0/tests/Main.hs0000644000000000000000000000474107346545000015305 0ustar0000000000000000module Main where import Test.Hspec import Test.Hspec.QuickCheck import qualified ExtensibleConf import qualified ManageDocks import qualified NoBorders import qualified RotateSome import qualified Selective import qualified SwapWorkspaces import qualified XPrompt import qualified CycleRecentWS import qualified OrgMode import qualified GridSelect import qualified EZConfig main :: IO () main = hspec $ do context "ManageDocks" $ do prop "prop_r2c_c2r" ManageDocks.prop_r2c_c2r prop "prop_c2r_r2c" ManageDocks.prop_c2r_r2c context "Selective" $ do prop "prop_select_length" Selective.prop_select_length prop "prop_update_idem" Selective.prop_update_idem prop "prop_select_master" Selective.prop_select_master prop "prop_select_focus" Selective.prop_select_focus prop "prop_select_increasing" Selective.prop_select_increasing prop "prop_select_two_consec" Selective.prop_select_two_consec prop "prop_update_nm" Selective.prop_update_nm prop "prop_update_start" Selective.prop_update_start prop "prop_update_nr" Selective.prop_update_nr prop "prop_update_focus_up" Selective.prop_update_focus_up prop "prop_update_focus_down" Selective.prop_update_focus_down context "RotateSome" $ do prop "prop_rotate_some_length" RotateSome.prop_rotate_some_length prop "prop_rotate_some_cycle" RotateSome.prop_rotate_some_cycle prop "prop_rotate_some_anchors" RotateSome.prop_rotate_some_anchors prop "prop_rotate_some_rotate" RotateSome.prop_rotate_some_rotate prop "prop_rotate_some_focus" RotateSome.prop_rotate_some_focus context "SwapWorkspaces" $ do prop "prop_double_swap" SwapWorkspaces.prop_double_swap prop "prop_invalid_swap" SwapWorkspaces.prop_invalid_swap prop "prop_swap_only_two" SwapWorkspaces.prop_swap_only_two prop "prop_swap_with_current" SwapWorkspaces.prop_swap_with_current context "XPrompt" $ do prop "prop_split" XPrompt.prop_split prop "prop_spliInSubListsAt" XPrompt.prop_spliInSubListsAt prop "prop_skipGetLastWord" XPrompt.prop_skipGetLastWord context "NoBorders" NoBorders.spec context "ExtensibleConf" ExtensibleConf.spec context "CycleRecentWS" CycleRecentWS.spec context "OrgMode" OrgMode.spec context "GridSelect" GridSelect.spec context "EZConfig" EZConfig.spec xmonad-contrib-0.18.0/tests/ManageDocks.hs0000644000000000000000000000040707346545000016570 0ustar0000000000000000module ManageDocks where import XMonad ( Rectangle ) import XMonad.Hooks.ManageDocks prop_r2c_c2r :: RectC -> Bool prop_r2c_c2r r = r2c (c2r r) == r prop_c2r_r2c :: Rectangle -> Bool prop_c2r_r2c r = c2r (r2c r) == r xmonad-contrib-0.18.0/tests/NoBorders.hs0000644000000000000000000000707207346545000016316 0ustar0000000000000000{-# 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 } xmonad-contrib-0.18.0/tests/OrgMode.hs0000644000000000000000000001705607346545000015760 0ustar0000000000000000{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} module OrgMode where import XMonad.Prelude hiding ((!?)) import XMonad.Prompt.OrgMode import qualified Data.Map.Strict as Map import Data.Map.Strict (Map, (!), (!?)) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck spec :: Spec spec = do prop "prop_encodePreservation" prop_encodePreservation prop "prop_decodePreservation" prop_decodePreservation -- Checking for regressions describe "pInput" $ do it "works with todo +d 22 january 2021" $ do pInput "todo +d 22 ja 2021" `shouldBe` Just ( Deadline "todo" (Time {date = Date (22, Just 1, Just 2021), tod = Nothing}) NoPriority ) it "works with todo +d 22 01 2022" $ do pInput "todo +d 22 01 2022" `shouldBe` Just ( Deadline "todo" (Time {date = Date (22, Just 1, Just 2022), tod = Nothing}) NoPriority ) it "works with todo +d 1 01:01" $ do pInput "todo +d 1 01:01" `shouldBe` Just ( Deadline "todo" (Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1}) NoPriority ) it "works with todo +d 22 jan 2021 01:01 #b" $ do pInput "todo +d 22 jan 2021 01:01 #b" `shouldBe` Just ( Deadline "todo" (Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1}) B ) context "no priority#b" $ do it "parses to the correct thing" $ pInput "no priority#b" `shouldBe` Just (NormalMsg "no priority#b" NoPriority) it "encode" $ prop_encodePreservation (OrgMsg "no priority#b") it "decode" $ prop_decodePreservation (NormalMsg "no priority#b" NoPriority) context "+d +d f" $ do it "encode" $ prop_encodePreservation (OrgMsg "+d +d f") it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}) NoPriority) context "+d f 1 +d f #c" $ do it "encode" $ prop_encodePreservation (OrgMsg "+d +d f") it "decode" $ prop_decodePreservation (Deadline "+d" (Time {date = Next Friday, tod = Nothing}) C) context "+d f 1 +d f" $ do it "encode" $ prop_encodePreservation (OrgMsg "+d f 1 +d f") it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}) NoPriority) context "+d f 1 +d f #b" $ do it "encode" $ prop_encodePreservation (OrgMsg "+d f 1 +d f #b") it "decode" $ prop_decodePreservation (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}) B) -- | Parsing preserves all info that printing does. prop_encodePreservation :: OrgMsg -> Property prop_encodePreservation (OrgMsg s) = pInput s === (pInput . ppNote =<< pInput s) -- | Printing preserves all info that parsing does. prop_decodePreservation :: Note -> Property prop_decodePreservation n = Just (ppNote n) === (fmap ppNote . pInput $ ppNote n) ------------------------------------------------------------------------ -- Pretty Printing ppNote :: Note -> String ppNote = \case Scheduled str t p -> str <> " +s " <> ppTime t <> ppPrio p Deadline str t p -> str <> " +d " <> ppTime t <> ppPrio p NormalMsg str p -> str <> ppPrio p ppPrio :: Priority -> String ppPrio = \case NoPriority -> "" prio -> " #" <> show prio ppTime :: Time -> String ppTime (Time d t) = ppDate d <> 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 -- note <<>> elements [" +s ", " +d ", ""] <<>> dateGen <<>> hourGen -- time and date <<>> elements ("" : map (reverse . (: " #")) "AaBbCc") -- priority where dateGen :: Gen String dateGen = oneof [ pure $ days ! Today , pure $ days ! Tomorrow , elements $ (days !) . Next <$> [Monday .. Sunday] , rNat -- 17 , unwords <$> sequenceA [rNat, monthGen] -- 17 jan , unwords <$> sequenceA [rNat, monthGen, rYear] -- 17 jan 2021 , unwords <$> traverse (fmap show) [rNat, rMonth] -- 17 01 , unwords <$> traverse (fmap show) [rNat, rMonth, rYear] -- 17 01 2021 ] where rNat, rYear, rMonth :: Gen String rNat = show <$> posInt rMonth = show <$> posInt `suchThat` (<= 12) rYear = show <$> posInt `suchThat` (> 25) monthGen :: Gen String monthGen = elements $ Map.elems months hourGen :: Gen String hourGen = oneof [ pure " " <<>> (pad <$> hourInt) <<>> pure ":" <<>> (pad <$> minuteInt) , pure " " <<>> (pad <$> hourInt) <<>> (pad <$> minuteInt) , pure "" ] where pad :: Int -> String pad n = (if n <= 9 then "0" else "") <> show n instance Arbitrary Note where arbitrary :: Gen Note arbitrary = do msg <- randomString t <- arbitrary p <- arbitrary elements [Scheduled msg t p, Deadline msg t p, NormalMsg msg p] instance Arbitrary Priority where arbitrary :: Gen Priority arbitrary = elements [A, B, C, NoPriority] instance Arbitrary Time where arbitrary :: Gen Time arbitrary = Time <$> arbitrary <*> arbitrary instance Arbitrary Date where arbitrary :: Gen Date arbitrary = oneof [ pure Today , pure Tomorrow , Next . toEnum <$> choose (0, 6) , do d <- posInt 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 (<>) xmonad-contrib-0.18.0/tests/RotateSome.hs0000644000000000000000000000320507346545000016475 0ustar0000000000000000{-# 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) xmonad-contrib-0.18.0/tests/Selective.hs0000644000000000000000000000635207346545000016344 0ustar0000000000000000{-# 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 Test.QuickCheck -- 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)) where sel' = update sel stk -- update normalizes selections (is idempotent) prop_update_idem sel (stk :: Stack Int) = sel' == update sel' stk where sel' = update sel stk -- select selects the master pane 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) 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 $ drop 1 res -- selection has the form [0..l] ++ [m..n] -- relies on the Arbitrary instance for Stack Int generating stacks like [0..k] prop_select_two_consec :: Selection l -> Stack Int -> Bool prop_select_two_consec sel (stk :: Stack Int) = let wins = integrate $ select sel stk in (length . filter not . zipWith ((==) . (+1)) wins $ drop 1 wins) <= 1 -- update preserves invariants on selections prop_update_nm :: Selection l -> Stack Int -> Bool prop_update_nm sel (stk :: Stack Int) = nMaster (update sel stk) >= 0 prop_update_start :: Selection l -> Stack Int -> Bool prop_update_start sel (stk :: Stack Int) = nMaster sel' <= start sel' where sel' = update sel stk prop_update_nr :: Selection l -> Stack Int -> Bool prop_update_nr sel (stk :: Stack Int) = nRest (update sel stk) >= 0 -- moving the focus to a window that's already selected doesn't change the selection prop_update_focus_up :: Selection l -> Stack Int -> Int -> Property prop_update_focus_up sel (stk :: Stack Int) x' = (length (up stk) >= x) && ((up stk !! (x-1)) `elem` integrate stk') ==> 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') ==> 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 } xmonad-contrib-0.18.0/tests/SwapWorkspaces.hs0000644000000000000000000000343407346545000017373 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module SwapWorkspaces where import Instances import Test.QuickCheck import XMonad.StackSet import XMonad.Actions.SwapWorkspaces -- Ensures that no "loss of information" can happen from a swap. 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) = 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) (NonNegative t1) (NonNegative t2) = -- t1 `tagMember` ss && not (t2 `tagMember` ss) ==> -- ss == swapWorkspaces t1 t2 ss zipWorkspacesWith :: (Workspace i l a -> Workspace i l a -> n) -> StackSet i l a s sd -> StackSet i l a s sd -> [n] zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) : zipWith f (map workspace $ visible s) (map workspace $ visible t) ++ 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) = 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) = 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 xmonad-contrib-0.18.0/tests/Utils.hs0000644000000000000000000000323607346545000015517 0ustar0000000000000000{-# 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 xmonad-contrib-0.18.0/tests/XPrompt.hs0000644000000000000000000000347307346545000016033 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} ------------------------------------- -- -- Tests for XPrompt and ShellPrompt -- ------------------------------------- module XPrompt where import Test.QuickCheck import XMonad.Prelude (chunksOf) import XMonad.Prompt import qualified XMonad.Prompt.Shell as S -- brute force check for exceptions 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 :: String) = x < length str ==> result == take x str where result = case chunksOf x str of [] -> [] 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 :: 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 [String] let l = case filter (/= []) a of [] -> ["a"] x -> x e <- elements l return (l,e) {- newIndex and newCommand have since been renamed or are no longer used -- newIndex calculates the index of the next completion in the -- completion list, so the index must be within the range of the -- copletions list prop_newIndex_range = forAll elemGen $ \(l,c) -> newIndex c l >= 0 && newIndex c l < length l -} -- this is actually the definition of newCommand... -- just to check something. {- prop_newCommandIndex = forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l))) == newCommand c l -} xmonad-contrib-0.18.0/xmonad-contrib.cabal0000644000000000000000000005354207346545000016636 0ustar0000000000000000name: xmonad-contrib version: 0.18.0 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_* homepage: https://xmonad.org/ synopsis: Community-maintained extensions for xmonad description: 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: . "XMonad.Doc.Configuring", a guide to configuring xmonad . "XMonad.Doc.Extending", using the contributed extensions library . "XMonad.Doc.Developing", introduction to xmonad internals and writing your own extensions. . category: System license: BSD3 license-file: LICENSE author: Spencer Janssen & others maintainer: xmonad@haskell.org extra-source-files: README.md CHANGES.md scripts/run-xmonad.sh scripts/window-properties.sh scripts/xinitrc scripts/xmonad-acpi.c scripts/xmonad-clock.c scripts/xmonadctl.hs scripts/xmonadpropread.hs XMonad/Config/dmwit.xmobarrc XMonad/Config/Example.hs cabal-version: 1.12 build-type: Simple bug-reports: https://github.com/xmonad/xmonad-contrib/issues tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1 source-repository head type: git location: https://github.com/xmonad/xmonad-contrib flag use_xft description: Use Xft to render text flag pedantic description: Be pedantic (-Werror and the like) default: False manual: True library build-depends: base >= 4.11 && < 5, bytestring >= 0.10 && < 0.13, containers >= 0.5 && < 0.8, directory, filepath, time >= 1.8 && < 1.13, process, random, mtl >= 1 && < 3, unix, X11 >= 1.10 && < 1.11, xmonad >= 0.16.99999 && < 0.19, utf8-string, deepseq default-language: Haskell2010 cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0 -DXMONAD_CONTRIB_VERSION_MINOR=18 -DXMONAD_CONTRIB_VERSION_PATCH=0 ghc-options: -Wall -Wno-unused-do-bind if flag(pedantic) ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports -- Keep this in sync with the oldest version in 'tested-with' if impl(ghc > 8.6.5) -- 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 flag(use_xft) build-depends: X11-xft >= 0.2 cpp-options: -DXFT exposed-modules: XMonad.Actions.AfterDrag XMonad.Actions.BluetileCommands XMonad.Actions.Commands XMonad.Actions.ConstrainedResize XMonad.Actions.CopyWindow XMonad.Actions.CycleRecentWS XMonad.Actions.CycleSelectedLayouts XMonad.Actions.CycleWS XMonad.Actions.CycleWindows XMonad.Actions.CycleWorkspaceByScreen XMonad.Actions.DeManage XMonad.Actions.DwmPromote XMonad.Actions.DynamicProjects XMonad.Actions.DynamicWorkspaceGroups XMonad.Actions.DynamicWorkspaceOrder XMonad.Actions.DynamicWorkspaces XMonad.Actions.EasyMotion XMonad.Actions.FindEmptyWorkspace XMonad.Actions.FlexibleManipulate XMonad.Actions.FlexibleResize XMonad.Actions.FloatKeys XMonad.Actions.FloatSnap XMonad.Actions.FocusNth XMonad.Actions.GridSelect XMonad.Actions.GroupNavigation XMonad.Actions.KeyRemap XMonad.Actions.Launcher XMonad.Actions.LinkWorkspaces XMonad.Actions.MessageFeedback XMonad.Actions.Minimize XMonad.Actions.MostRecentlyUsed XMonad.Actions.MouseGestures XMonad.Actions.MouseResize XMonad.Actions.Navigation2D XMonad.Actions.NoBorders XMonad.Actions.OnScreen XMonad.Actions.PerLayoutKeys XMonad.Actions.PerWindowKeys XMonad.Actions.PerWorkspaceKeys XMonad.Actions.PhysicalScreens XMonad.Actions.Plane XMonad.Actions.Prefix XMonad.Actions.Promote XMonad.Actions.RandomBackground XMonad.Actions.RepeatAction XMonad.Actions.Repeatable XMonad.Actions.RotSlaves XMonad.Actions.RotateSome XMonad.Actions.Search XMonad.Actions.ShowText XMonad.Actions.Sift XMonad.Actions.SimpleDate XMonad.Actions.SinkAll XMonad.Actions.SpawnOn XMonad.Actions.Submap XMonad.Actions.SwapPromote XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.TiledWindowDragging XMonad.Actions.ToggleFullFloat XMonad.Actions.TopicSpace XMonad.Actions.TreeSelect XMonad.Actions.UpdateFocus XMonad.Actions.UpdatePointer XMonad.Actions.Warp XMonad.Actions.WindowBringer XMonad.Actions.WindowGo XMonad.Actions.WindowMenu XMonad.Actions.WindowNavigation XMonad.Actions.WithAll XMonad.Actions.Workscreen XMonad.Actions.WorkspaceCursors XMonad.Actions.WorkspaceNames XMonad.Config.Arossato XMonad.Config.Azerty XMonad.Config.Bepo XMonad.Config.Bluetile XMonad.Config.Desktop XMonad.Config.Dmwit XMonad.Config.Droundy XMonad.Config.Gnome XMonad.Config.Kde XMonad.Config.Mate XMonad.Config.Prime XMonad.Config.Sjanssen XMonad.Config.Xfce XMonad.Doc XMonad.Doc.Configuring XMonad.Doc.Developing XMonad.Doc.Extending XMonad.Hooks.BorderPerWindow XMonad.Hooks.CurrentWorkspaceOnTop XMonad.Hooks.DebugEvents XMonad.Hooks.DebugKeyEvents XMonad.Hooks.DebugStack XMonad.Hooks.DynamicBars XMonad.Hooks.DynamicHooks XMonad.Hooks.DynamicIcons XMonad.Hooks.DynamicLog XMonad.Hooks.DynamicProperty XMonad.Hooks.EwmhDesktops XMonad.Hooks.FadeInactive XMonad.Hooks.FadeWindows XMonad.Hooks.FloatNext XMonad.Hooks.Focus XMonad.Hooks.InsertPosition XMonad.Hooks.ManageDebug XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.Minimize XMonad.Hooks.Modal XMonad.Hooks.OnPropertyChange XMonad.Hooks.Place XMonad.Hooks.PositionStoreHooks XMonad.Hooks.RefocusLast XMonad.Hooks.Rescreen XMonad.Hooks.ScreenCorners XMonad.Hooks.Script XMonad.Hooks.ServerMode XMonad.Hooks.SetWMName XMonad.Hooks.ShowWName XMonad.Hooks.StatusBar XMonad.Hooks.StatusBar.PP XMonad.Hooks.StatusBar.WorkspaceScreen XMonad.Hooks.TaffybarPagerHints XMonad.Hooks.ToggleHook XMonad.Hooks.UrgencyHook XMonad.Hooks.WallpaperSetter XMonad.Hooks.WindowSwallowing XMonad.Hooks.WorkspaceByPos XMonad.Hooks.WorkspaceHistory XMonad.Hooks.XPropManage XMonad.Layout.Accordion XMonad.Layout.AutoMaster XMonad.Layout.AvoidFloats XMonad.Layout.BinaryColumn XMonad.Layout.BinarySpacePartition XMonad.Layout.BorderResize XMonad.Layout.BoringWindows XMonad.Layout.ButtonDecoration XMonad.Layout.CenterMainFluid XMonad.Layout.CenteredIfSingle XMonad.Layout.CenteredMaster XMonad.Layout.Circle XMonad.Layout.CircleEx XMonad.Layout.Column XMonad.Layout.Combo XMonad.Layout.ComboP XMonad.Layout.Cross XMonad.Layout.Decoration XMonad.Layout.DecorationEx XMonad.Layout.DecorationEx.Common XMonad.Layout.DecorationEx.Engine XMonad.Layout.DecorationEx.Geometry XMonad.Layout.DecorationEx.Widgets XMonad.Layout.DecorationEx.LayoutModifier XMonad.Layout.DecorationEx.TextEngine XMonad.Layout.DecorationEx.DwmGeometry XMonad.Layout.DecorationEx.TabbedGeometry XMonad.Layout.DecorationAddons XMonad.Layout.DecorationMadness XMonad.Layout.Dishes XMonad.Layout.DragPane XMonad.Layout.DraggingVisualizer XMonad.Layout.Drawer XMonad.Layout.Dwindle XMonad.Layout.DwmStyle XMonad.Layout.FixedAspectRatio XMonad.Layout.FixedColumn XMonad.Layout.FocusTracking XMonad.Layout.Fullscreen XMonad.Layout.Gaps XMonad.Layout.Grid XMonad.Layout.GridVariants XMonad.Layout.Groups XMonad.Layout.Groups.Examples XMonad.Layout.Groups.Helpers XMonad.Layout.Groups.Wmii XMonad.Layout.Hidden XMonad.Layout.HintedGrid XMonad.Layout.HintedTile XMonad.Layout.IM XMonad.Layout.IfMax XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder XMonad.Layout.LayoutCombinators XMonad.Layout.LayoutHints XMonad.Layout.LayoutModifier XMonad.Layout.LayoutScreens XMonad.Layout.LimitWindows XMonad.Layout.MagicFocus XMonad.Layout.Magnifier XMonad.Layout.Master XMonad.Layout.Maximize XMonad.Layout.MessageControl XMonad.Layout.Minimize XMonad.Layout.Monitor XMonad.Layout.Mosaic XMonad.Layout.MosaicAlt XMonad.Layout.MouseResizableTile XMonad.Layout.MultiColumns XMonad.Layout.MultiDishes XMonad.Layout.MultiToggle XMonad.Layout.MultiToggle.Instances XMonad.Layout.MultiToggle.TabBarDecoration XMonad.Layout.Named XMonad.Layout.NoBorders XMonad.Layout.NoFrillsDecoration XMonad.Layout.OnHost XMonad.Layout.OneBig XMonad.Layout.PerScreen XMonad.Layout.PerWorkspace XMonad.Layout.PositionStoreFloat XMonad.Layout.Reflect XMonad.Layout.Renamed XMonad.Layout.ResizableThreeColumns XMonad.Layout.ResizableTile XMonad.Layout.ResizeScreen XMonad.Layout.Roledex XMonad.Layout.ShowWName XMonad.Layout.SideBorderDecoration XMonad.Layout.SimpleDecoration XMonad.Layout.SimpleFloat XMonad.Layout.Simplest XMonad.Layout.SimplestFloat XMonad.Layout.SortedLayout XMonad.Layout.Spacing XMonad.Layout.Spiral XMonad.Layout.Square XMonad.Layout.StackTile XMonad.Layout.StateFull XMonad.Layout.Stoppable 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 XMonad.Prompt.ConfirmPrompt XMonad.Prompt.DirExec XMonad.Prompt.Directory XMonad.Prompt.Email XMonad.Prompt.FuzzyMatch XMonad.Prompt.Input XMonad.Prompt.Layout XMonad.Prompt.Man XMonad.Prompt.OrgMode XMonad.Prompt.Pass XMonad.Prompt.RunOrRaise XMonad.Prompt.Shell XMonad.Prompt.Ssh XMonad.Prompt.Theme XMonad.Prompt.Unicode XMonad.Prompt.Window XMonad.Prompt.Workspace XMonad.Prompt.XMonad XMonad.Prompt.Zsh XMonad.Util.ActionCycle XMonad.Util.ActionQueue XMonad.Util.ClickableWorkspaces XMonad.Util.Cursor XMonad.Util.CustomKeys XMonad.Util.DebugWindow XMonad.Util.Dmenu XMonad.Util.DynamicScratchpads XMonad.Util.Dzen XMonad.Util.EZConfig XMonad.Util.ExclusiveScratchpads XMonad.Util.ExtensibleConf XMonad.Util.ExtensibleState XMonad.Util.Font XMonad.Util.Grab XMonad.Util.Hacks XMonad.Util.History XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.Loggers XMonad.Util.Loggers.NamedScratchpad XMonad.Util.Minimize XMonad.Util.NamedActions XMonad.Util.NamedScratchpad XMonad.Util.NamedWindows XMonad.Util.NoTaskbar XMonad.Util.Parser XMonad.Util.Paste XMonad.Util.PositionStore XMonad.Util.Process XMonad.Util.PureX XMonad.Util.Rectangle XMonad.Util.RemoteWindows XMonad.Util.Replace XMonad.Util.Run XMonad.Util.Scratchpad XMonad.Util.SessionStart XMonad.Util.SpawnNamedPipe XMonad.Util.SpawnOnce XMonad.Util.Stack XMonad.Util.StringProp XMonad.Util.Themes XMonad.Util.Timer XMonad.Util.TreeZipper XMonad.Util.Types XMonad.Util.Ungrab XMonad.Util.WindowProperties XMonad.Util.WindowState XMonad.Util.WorkspaceCompare XMonad.Util.XSelection XMonad.Util.XUtils test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: CycleRecentWS EZConfig ExtensibleConf GridSelect Instances ManageDocks NoBorders OrgMode RotateSome Selective SwapWorkspaces Utils XMonad.Actions.CycleRecentWS XMonad.Actions.CycleWS XMonad.Actions.FocusNth XMonad.Actions.GridSelect XMonad.Actions.PhysicalScreens XMonad.Actions.Repeatable XMonad.Actions.RotateSome XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.WindowBringer XMonad.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.EZConfig XMonad.Util.ExtensibleConf XMonad.Util.ExtensibleState XMonad.Util.Font XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.NamedActions XMonad.Util.NamedWindows XMonad.Util.Parser XMonad.Util.Process XMonad.Util.PureX XMonad.Util.Rectangle XMonad.Util.Run XMonad.Util.Stack XMonad.Util.Timer XMonad.Util.Types XMonad.Util.WindowProperties XMonad.Util.WorkspaceCompare XMonad.Util.XSelection XMonad.Util.XUtils XPrompt hs-source-dirs: tests, . build-depends: base , QuickCheck >= 2 , X11 >= 1.10 && < 1.11 , bytestring >= 0.10 && < 0.13 , containers , directory , time >= 1.8 && < 1.13 , hspec >= 2.4.0 && < 3 , mtl , random , process , unix , utf8-string , deepseq , xmonad >= 0.16.9999 && < 0.19 cpp-options: -DTESTING ghc-options: -Wall -Wno-unused-do-bind default-language: Haskell2010 if flag(pedantic) ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports -- Keep this in sync with the oldest version in 'tested-with' if impl(ghc > 8.6.5) -- don't treat unused-imports warning as errors, they may be necessary -- for compatibility with older versions of base (or other deps) ghc-options: -Wwarn=unused-imports if impl(ghc > 9.8) ghc-options: -Wno-x-partial