xmonad-contrib 0.17.0 → 0.17.1
raw patch · 161 files changed
+4623/−1696 lines, 161 filesdep +deepseq
Dependencies added: deepseq
Files
- CHANGES.md +260/−0
- README.md +12/−27
- XMonad/Actions/ConstrainedResize.hs +2/−2
- XMonad/Actions/CopyWindow.hs +2/−2
- XMonad/Actions/CycleWindows.hs +7/−3
- XMonad/Actions/CycleWorkspaceByScreen.hs +30/−4
- XMonad/Actions/DwmPromote.hs +6/−3
- XMonad/Actions/DynamicProjects.hs +2/−2
- XMonad/Actions/DynamicWorkspaceOrder.hs +2/−1
- XMonad/Actions/DynamicWorkspaces.hs +2/−6
- XMonad/Actions/EasyMotion.hs +15/−12
- XMonad/Actions/FlexibleManipulate.hs +6/−12
- XMonad/Actions/FlexibleResize.hs +6/−3
- XMonad/Actions/FloatKeys.hs +8/−8
- XMonad/Actions/FloatSnap.hs +11/−13
- XMonad/Actions/FocusNth.hs +8/−11
- XMonad/Actions/GridSelect.hs +6/−9
- XMonad/Actions/GroupNavigation.hs +9/−6
- XMonad/Actions/KeyRemap.hs +2/−4
- XMonad/Actions/Launcher.hs +2/−2
- XMonad/Actions/Minimize.hs +4/−0
- XMonad/Actions/MouseGestures.hs +5/−11
- XMonad/Actions/Navigation2D.hs +5/−9
- XMonad/Actions/NoBorders.hs +2/−3
- XMonad/Actions/PerLayoutKeys.hs +49/−0
- XMonad/Actions/RepeatAction.hs +84/−0
- XMonad/Actions/RotSlaves.hs +7/−4
- XMonad/Actions/RotateSome.hs +4/−2
- XMonad/Actions/Search.hs +1/−1
- XMonad/Actions/ShowText.hs +1/−1
- XMonad/Actions/SpawnOn.hs +17/−42
- XMonad/Actions/Submap.hs +65/−18
- XMonad/Actions/TiledWindowDragging.hs +7/−9
- XMonad/Actions/TreeSelect.hs +11/−6
- XMonad/Actions/UpdatePointer.hs +3/−5
- XMonad/Actions/Warp.hs +3/−5
- XMonad/Actions/WindowGo.hs +6/−2
- XMonad/Actions/WindowMenu.hs +5/−7
- XMonad/Actions/WindowNavigation.hs +3/−3
- XMonad/Actions/Workscreen.hs +4/−1
- XMonad/Actions/WorkspaceCursors.hs +1/−1
- XMonad/Config/Arossato.hs +1/−0
- XMonad/Config/Azerty.hs +3/−3
- XMonad/Config/Bepo.hs +1/−1
- XMonad/Config/Bluetile.hs +1/−1
- XMonad/Config/Desktop.hs +6/−6
- XMonad/Config/Dmwit.hs +12/−12
- XMonad/Config/Droundy.hs +1/−1
- XMonad/Config/Example.hs +3/−3
- XMonad/Config/Gnome.hs +1/−1
- XMonad/Config/Kde.hs +2/−2
- XMonad/Config/Mate.hs +1/−1
- XMonad/Config/Prime.hs +3/−3
- XMonad/Config/Sjanssen.hs +3/−3
- XMonad/Config/Xfce.hs +1/−1
- XMonad/Doc/Extending.hs +170/−131
- XMonad/Hooks/BorderPerWindow.hs +77/−0
- XMonad/Hooks/DebugEvents.hs +1/−23
- XMonad/Hooks/DebugKeyEvents.hs +1/−5
- XMonad/Hooks/DynamicHooks.hs +2/−2
- XMonad/Hooks/DynamicLog.hs +1/−1
- XMonad/Hooks/DynamicProperty.hs +2/−2
- XMonad/Hooks/EwmhDesktops.hs +42/−5
- XMonad/Hooks/FadeWindows.hs +4/−5
- XMonad/Hooks/FloatNext.hs +1/−1
- XMonad/Hooks/Focus.hs +16/−18
- XMonad/Hooks/InsertPosition.hs +1/−1
- XMonad/Hooks/ManageDebug.hs +29/−21
- XMonad/Hooks/ManageDocks.hs +37/−24
- XMonad/Hooks/ManageHelpers.hs +14/−8
- XMonad/Hooks/Modal.hs +314/−0
- XMonad/Hooks/Place.hs +2/−2
- XMonad/Hooks/PositionStoreHooks.hs +2/−3
- XMonad/Hooks/RefocusLast.hs +3/−3
- XMonad/Hooks/Rescreen.hs +19/−16
- XMonad/Hooks/SetWMName.hs +1/−1
- XMonad/Hooks/ShowWName.hs +84/−0
- XMonad/Hooks/StatusBar/WorkspaceScreen.hs +105/−0
- XMonad/Hooks/TaffybarPagerHints.hs +1/−1
- XMonad/Hooks/ToggleHook.hs +2/−2
- XMonad/Hooks/UrgencyHook.hs +16/−7
- XMonad/Hooks/WallpaperSetter.hs +5/−7
- XMonad/Hooks/WindowSwallowing.hs +26/−21
- XMonad/Hooks/WorkspaceByPos.hs +6/−5
- XMonad/Hooks/WorkspaceHistory.hs +17/−8
- XMonad/Layout/BinarySpacePartition.hs +17/−9
- XMonad/Layout/BoringWindows.hs +3/−2
- XMonad/Layout/ButtonDecoration.hs +1/−1
- XMonad/Layout/CenteredIfSingle.hs +81/−0
- XMonad/Layout/Combo.hs +1/−1
- XMonad/Layout/ComboP.hs +1/−1
- XMonad/Layout/Decoration.hs +4/−4
- XMonad/Layout/FixedColumn.hs +7/−14
- XMonad/Layout/Fullscreen.hs +3/−3
- XMonad/Layout/Gaps.hs +4/−0
- XMonad/Layout/Groups.hs +13/−13
- XMonad/Layout/Groups/Helpers.hs +2/−2
- XMonad/Layout/ImageButtonDecoration.hs +4/−1
- XMonad/Layout/IndependentScreens.hs +2/−2
- XMonad/Layout/LayoutHints.hs +11/−9
- XMonad/Layout/LayoutModifier.hs +1/−1
- XMonad/Layout/LayoutScreens.hs +14/−11
- XMonad/Layout/LimitWindows.hs +4/−4
- XMonad/Layout/MagicFocus.hs +4/−7
- XMonad/Layout/Monitor.hs +1/−1
- XMonad/Layout/Mosaic.hs +6/−7
- XMonad/Layout/MouseResizableTile.hs +2/−1
- XMonad/Layout/OnHost.hs +1/−1
- XMonad/Layout/PerWorkspace.hs +1/−1
- XMonad/Layout/Renamed.hs +1/−1
- XMonad/Layout/ResizeScreen.hs +1/−1
- XMonad/Layout/ShowWName.hs +1/−1
- XMonad/Layout/SideBorderDecoration.hs +193/−0
- XMonad/Layout/SimpleDecoration.hs +1/−1
- XMonad/Layout/Spacing.hs +5/−2
- XMonad/Layout/SubLayouts.hs +20/−10
- XMonad/Layout/TallMastersCombo.hs +4/−13
- XMonad/Layout/ThreeColumns.hs +3/−3
- XMonad/Layout/VoidBorders.hs +34/−11
- XMonad/Layout/WindowNavigation.hs +17/−5
- XMonad/Layout/WindowSwitcherDecoration.hs +4/−4
- XMonad/Prelude.hs +398/−4
- XMonad/Prompt.hs +36/−26
- XMonad/Prompt/AppendFile.hs +2/−1
- XMonad/Prompt/FuzzyMatch.hs +6/−8
- XMonad/Prompt/Man.hs +4/−16
- XMonad/Prompt/OrgMode.hs +136/−96
- XMonad/Prompt/Pass.hs +47/−6
- XMonad/Prompt/Unicode.hs +11/−10
- XMonad/Prompt/Window.hs +2/−2
- XMonad/Util/ActionQueue.hs +89/−0
- XMonad/Util/DebugWindow.hs +60/−16
- XMonad/Util/DynamicScratchpads.hs +4/−2
- XMonad/Util/EZConfig.hs +42/−267
- XMonad/Util/ExclusiveScratchpads.hs +1/−1
- XMonad/Util/ExtensibleConf.hs +1/−1
- XMonad/Util/ExtensibleState.hs +17/−1
- XMonad/Util/Font.hs +53/−21
- XMonad/Util/Grab.hs +136/−0
- XMonad/Util/Hacks.hs +68/−3
- XMonad/Util/Loggers.hs +53/−15
- XMonad/Util/Loggers/NamedScratchpad.hs +2/−2
- XMonad/Util/NamedActions.hs +2/−19
- XMonad/Util/NamedScratchpad.hs +148/−15
- XMonad/Util/Parser.hs +230/−0
- XMonad/Util/Paste.hs +4/−4
- XMonad/Util/Process.hs +43/−0
- XMonad/Util/PureX.hs +2/−5
- XMonad/Util/Rectangle.hs +4/−3
- XMonad/Util/Run.hs +351/−38
- XMonad/Util/Scratchpad.hs +1/−1
- XMonad/Util/SpawnOnce.hs +16/−3
- XMonad/Util/Stack.hs +4/−4
- XMonad/Util/XUtils.hs +100/−3
- scripts/generate-configs +0/−302
- scripts/xmonadctl.hs +73/−0
- scripts/xmonadpropread.hs +58/−0
- tests/EZConfig.hs +99/−0
- tests/Main.hs +2/−0
- tests/OrgMode.hs +86/−23
- xmonad-contrib.cabal +35/−9
CHANGES.md view
@@ -1,5 +1,257 @@ # Change Log / Release Notes +## 0.17.1 (September 3, 2021)++### 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@@ -549,6 +801,11 @@ 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.@@ -771,6 +1028,9 @@ - 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
README.md view
@@ -1,35 +1,20 @@ <p align="center">- <a href="https://xmonad.org/">- <img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150>- </a>+ <a href="https://xmonad.org/"><img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150></a> </p> <p align="center">- <a href="https://hackage.haskell.org/package/xmonad-contrib">- <img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad-contrib?logo=haskell">- </a>- <a href="https://github.com/xmonad/xmonad-contrib/blob/readme/LICENSE">- <img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad-contrib">- </a>- <a href="https://haskell.org/">- <img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell">- </a>+ <a href="https://hackage.haskell.org/package/xmonad-contrib"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad-contrib?logo=haskell"></a>+ <a href="https://github.com/xmonad/xmonad-contrib/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad-contrib"></a>+ <a href="https://haskell.org/"><img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell"></a> <br>- <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml">- <img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Stack?label=Stack&logo=githubactions&logoColor=white">- </a>- <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml">- <img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white">- </a>- <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml">- <img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Nix?label=Nix&logo=githubactions&logoColor=white">- </a>+ <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Stack?label=Stack&logo=githubactions&logoColor=white"></a>+ <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white"></a>+ <a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Nix?label=Nix&logo=githubactions&logoColor=white"></a> <br>- <a href="https://github.com/sponsors/xmonad">- <img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors">- </a>- <a href="https://opencollective.com/xmonad">- <img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective">- </a>+ <a href="https://github.com/sponsors/xmonad"><img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors"></a>+ <a href="https://opencollective.com/xmonad"><img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective"></a>+ <br>+ <a href="https://web.libera.chat/#xmonad"><img alt="Chat on #xmonad@irc.libera.chat" src="https://img.shields.io/badge/%23%20chat-on%20libera-brightgreen"></a>+ <a href="https://matrix.to/#/#xmonad:matrix.org"><img alt="Chat on #xmonad:matrix.org" src="https://img.shields.io/matrix/xmonad:matrix.org?logo=matrix"></a> </p> # xmonad-contrib
XMonad/Actions/ConstrainedResize.hs view
@@ -44,8 +44,8 @@ -- | Resize (floating) window with optional aspect ratio constraints. mouseResizeWindow :: Window -> Bool -> X ()-mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do sh <- io $ getWMNormalHints d w io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) mouseDrag (\ex ey -> do
XMonad/Actions/CopyWindow.hs view
@@ -114,10 +114,10 @@ where copy' s = if n `W.tagMember` s then W.view (W.currentTag s) $ insertUp' w $ W.view n s else s- insertUp' a s = W.modify (Just $ W.Stack a [] [])+ insertUp' a = W.modify (Just $ W.Stack a [] []) (\(W.Stack t l r) -> if a `elem` t:l++r then Just $ W.Stack t l r- else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s+ else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) -- | runOrCopy will run the provided shell command unless it can
XMonad/Actions/CycleWindows.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ViewPatterns #-}+ -------------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWindows@@ -53,7 +55,9 @@ ) where import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W+import qualified Data.List.NonEmpty as NE import XMonad.Actions.RotSlaves import Control.Arrow (second)@@ -179,7 +183,7 @@ rotOpposite' (W.Stack t l r) = W.Stack t' l' r' where rrvl = r ++ reverse l part = (length rrvl + 1) `div` 2- (l',t':r') = second reverse . splitAt (length l) $+ (l', notEmpty -> t' :| r') = second reverse . splitAt (length l) $ reverse (take part rrvl ++ t : drop part rrvl) @@ -205,7 +209,7 @@ rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotFocused' _ s@(W.Stack _ [] []) = s rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus- where (t':rs') = f (t:rs)+ where (notEmpty -> t' :| rs') = f (t:rs) rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise @@ -223,7 +227,7 @@ rotUnfocused' _ s@(W.Stack _ [] []) = s rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise- where (master:revls) = reverse ls+ where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll) (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) -- $generic
XMonad/Actions/CycleWorkspaceByScreen.hs view
@@ -33,10 +33,25 @@ import qualified XMonad.StackSet as W -- $usage--- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory ----- To use, add something like the following to your keybindings--- , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)+-- 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) repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X () repeatableAction mods pressHandler = do@@ -72,7 +87,16 @@ runFirst matchers eventType key = fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers -cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()+-- | Like 'XMonad.Actions.CycleRecentWS.cycleRecentWS', but only cycle+-- through the most recent workspaces on the given screen.+cycleWorkspaceOnScreen+ :: ScreenId -- ^ The screen to cycle on.+ -> [KeySym] -- ^ A list of modifier keys used when invoking this+ -- action; as soon as one of them is released, the final+ -- switch is made.+ -> KeySym -- ^ Key used to switch to next workspace.+ -> KeySym -- ^ Key used to switch to previous workspace.+ -> X () cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do startingHistory <- workspaceHistoryByScreen currentWSIndex <- io $ newIORef 1@@ -93,6 +117,8 @@ ] return () +-- | Like 'cycleWorkspaceOnScreen', but supply the currently focused+-- screen as the @screenId@. cycleWorkspaceOnCurrentScreen :: [KeySym] -> KeySym -> KeySym -> X () cycleWorkspaceOnCurrentScreen mods n p =
XMonad/Actions/DwmPromote.hs view
@@ -25,7 +25,10 @@ import XMonad import XMonad.StackSet+import XMonad.Prelude +import qualified Data.List.NonEmpty as NE+ -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -45,6 +48,6 @@ dwmpromote :: X () dwmpromote = windows $ modify' $ \c -> case c of- Stack _ [] [] -> c- Stack t [] (x:rs) -> Stack x [] (t:rs)- Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls+ Stack _ [] [] -> c+ Stack t [] (r:rs) -> Stack r [] (t:rs)+ Stack t (l:ls) rs -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls)
XMonad/Actions/DynamicProjects.hs view
@@ -109,8 +109,8 @@ -- -- And finally, configure some optional key bindings: ----- > , ((modm, xK_space), switchProjectPrompt)--- > , ((modm, xK_slash), shiftToProjectPrompt)+-- > , ((modm, xK_space), switchProjectPrompt def)+-- > , ((modm, xK_slash), shiftToProjectPrompt def) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings".
XMonad/Actions/DynamicWorkspaceOrder.hs view
@@ -152,7 +152,8 @@ swapOrder w1 w2 = do io $ print (w1,w2) WSO (Just m) <- XS.get- let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]+ let i1 = fromJust (w1 `M.lookup` m)+ let i2 = fromJust (w2 `M.lookup` m) XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) windows id -- force a status bar update
XMonad/Actions/DynamicWorkspaces.hs view
@@ -38,7 +38,7 @@ import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter, modify, delete) import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )-import XMonad.Prompt ( XPConfig, mkXPrompt )+import XMonad.Prompt ( XPConfig, mkComplFunFromList', mkXPrompt ) import XMonad.Util.WorkspaceCompare ( getSortByIndex ) import qualified Data.Map.Strict as Map import qualified XMonad.Util.ExtensibleState as XS@@ -107,17 +107,13 @@ ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag) ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap --mkCompl :: [String] -> String -> IO [String]-mkCompl l s = return $ filter (\x -> take (length s) x == s) l- 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 (mkCompl ts) job'+ mkXPrompt (Wor "") c (mkComplFunFromList' c ts) job' renameWorkspace :: XPConfig -> X () renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
XMonad/Actions/EasyMotion.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} -----------------------------------------------------------------------------@@ -263,19 +264,19 @@ visibleWindows :: [Window] visibleWindows = toList mappedWins sortedOverlayWindows :: X [OverlayWindow]- sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows dpy th visibleWindows+ 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 (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+ 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 dpy th (visibleWindowsOnScreen sid)+ sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows th (visibleWindowsOnScreen sid) status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime if status == grabSuccess then do@@ -296,10 +297,11 @@ allKeys (PerScreenKeys m) = concat $ M.elems m buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]- buildOverlays ks = appendChords (maxChordLen c) ks+ buildOverlays = appendChords (maxChordLen c) - buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]- buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws+ buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]+ buildOverlayWindows th = fmap (fromMaybe [] . sequenceA)+ . traverse (buildOverlayWin th) sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow] sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)@@ -307,12 +309,13 @@ makeRect :: WindowAttributes -> Rectangle makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa)) - buildOverlayWin :: Display -> Position -> Window -> X OverlayWindow- buildOverlayWin dpy th w = do- wAttrs <- io $ getWindowAttributes dpy w- let r = overlayF c th $ makeRect wAttrs- o <- createNewWindow r Nothing "" True- return OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }+ 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 ()
XMonad/Actions/FlexibleManipulate.hs view
@@ -24,9 +24,9 @@ ) where import XMonad-import XMonad.Prelude ((<&>))+import XMonad.Prelude ((<&>), fi) import qualified Prelude as P-import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.))+import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($)) -- $usage -- First, add this import to your @~\/.xmonad\/xmonad.hs@:@@ -80,8 +80,10 @@ -- | Given an interpolation function, implement an appropriate window -- manipulation action. mouseWindow :: (Double -> Double) -> Window -> X ()-mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do- [wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do+ let wpos = (fi (wa_x wa), fi (wa_y wa))+ wsize = (fi (wa_width wa), fi (wa_height wa)) sh <- io $ getWMNormalHints d w pointer <- io $ queryPointer d w <&> pointerPos @@ -104,17 +106,9 @@ where pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt- winAttrs :: WindowAttributes -> [Pnt]- winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] - -- I'd rather I didn't have to do this, but I hate writing component 2d math type Pnt = (Double, Double)--pairUp :: [a] -> [(a,a)]-pairUp [] = []-pairUp [_] = []-pairUp (x:y:xs) = (x, y) : pairUp xs mapP :: (a -> b) -> (a, a) -> (b, b) mapP f (x, y) = (f x, f y)
XMonad/Actions/FlexibleResize.hs view
@@ -50,12 +50,15 @@ :: Rational -- ^ The size of the area where only one edge is resized. -> Window -- ^ The window to resize. -> X ()-mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do sh <- io $ getWMNormalHints d w (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w let- [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height]+ pos_x = fi $ wa_x wa+ pos_y = fi $ wa_y wa+ width = fi $ wa_width wa+ height = fi $ wa_height wa west = findPos ix width north = findPos iy height (cx, fx, gx) = mkSel west width pos_x
XMonad/Actions/FloatKeys.hs view
@@ -19,7 +19,7 @@ keysMoveWindowTo, keysResizeWindow, keysAbsResizeWindow,- P, G,+ P, G, ChangeDim ) where import XMonad@@ -43,9 +43,9 @@ -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the -- right and @dy@ pixels down.-keysMoveWindow :: D -> Window -> X ()-keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+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@@ -61,8 +61,8 @@ -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen -- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner keysMoveWindowTo :: P -> G -> Window -> X ()-keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+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@@ -113,8 +113,8 @@ ny = round $ fi y + gy * fi h - gy * fi nh keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()-keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do sh <- io $ getWMNormalHints d w let wa_dim = (fi $ wa_width wa, fi $ wa_height wa) wa_pos = (fi $ wa_x wa, fi $ wa_y wa)
XMonad/Actions/FloatSnap.hs view
@@ -92,8 +92,8 @@ -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. -> X ()-snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do (_, _, _, px, py, _, _, _) <- io $ queryPointer d w let x = (fromIntegral px - wx wa)/ww wa y = (fromIntegral py - wy wa)/wh wa@@ -119,9 +119,8 @@ -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. -> X ()-snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w-+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do (xbegin,xend) <- handleAxis True d wa (ybegin,yend) <- handleAxis False d wa @@ -168,9 +167,8 @@ -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move. -> X ()-snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w-+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do nx <- handleAxis True d wa ny <- handleAxis False d wa @@ -208,8 +206,8 @@ snapMove D = doSnapMove False False doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()-doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w let (mb,mf) = if rev then (bl,fl)@@ -247,8 +245,8 @@ snapShrink = snapResize False snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()-snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do- wa <- io $ getWindowAttributes d w+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d ->+ withWindowAttributes d w $ \wa -> do mr <- case dir of L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w return $ case (if grow then mg else ms) of@@ -285,7 +283,7 @@ 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])+ 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)
XMonad/Actions/FocusNth.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FocusNth@@ -18,8 +20,9 @@ focusNth,focusNth', swapNth,swapNth') where -import XMonad.StackSet import XMonad+import XMonad.Prelude+import XMonad.StackSet -- $usage -- Add the import to your @~\/.xmonad\/xmonad.hs@:@@ -40,8 +43,8 @@ focusNth = windows . modify' . focusNth' focusNth' :: Int -> Stack a -> Stack a-focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s- | otherwise = listToStack n (integrate s)+focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs+ | otherwise = s -- | Swap current window with nth. Focus stays in the same position swapNth :: Int -> X ()@@ -50,11 +53,5 @@ swapNth' :: Int -> Stack a -> Stack a swapNth' n s@(Stack c l r) | (n < 0) || (n > length l + length r) || (n == length l) = s- | n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r- | otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)--listToStack :: Int -> [a] -> Stack a-listToStack n l = Stack t ls rs- where- (t:rs) = drop n l- ls = reverse (take n l)+ | n < length l = let (nl, notEmpty -> nc :| nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r+ | otherwise = let (nl, notEmpty -> nc :| nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
XMonad/Actions/GridSelect.hs view
@@ -124,7 +124,7 @@ -- > ... -- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 } ----- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'+-- An example where 'buildDefaultGSConfig' is used instead of 'def' -- in order to specify a custom colorizer is @gsconfig2@ (found in -- "XMonad.Actions.GridSelect#Colorizers"): --@@ -285,11 +285,7 @@ newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }- deriving (Monad,Functor,MonadState (TwoDState a))--instance Applicative (TwoD a) where- (<*>) = ap- pure = return+ deriving (Functor, Applicative, Monad, MonadState (TwoDState a)) liftX :: X a1 -> TwoD a a1 liftX = TwoD . lift@@ -411,10 +407,11 @@ ev <- getEvent e if ev_event_type ev == keyPress then do- (ks,s) <- lookupString $ asKeyEvent e+ (_, s) <- lookupString $ asKeyEvent e+ ks <- keycodeToKeysym d (ev_keycode ev) 0 return $ do- mask <- liftX $ cleanMask (ev_state ev)- keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)+ mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)+ keyhandler (ks, s, mask) else return $ stdHandle ev me
@@ -1,3 +1,4 @@+{-# language DeriveGeneric, DeriveAnyClass #-} ---------------------------------------------------------------------- -- | -- Module : XMonad.Actions.GroupNavigation@@ -34,13 +35,15 @@ import Control.Monad.Reader import Control.Monad.State+import Control.DeepSeq import Data.Map ((!)) import qualified Data.Map as Map import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>)) import qualified Data.Sequence as Seq import qualified Data.Set as Set import Graphics.X11.Types-import Prelude hiding (concatMap, drop, elem, filter, null, reverse)+import GHC.Generics+import Prelude hiding (drop, elem, filter, null, reverse) import XMonad.Core import XMonad.ManageHook import XMonad.Operations (windows, withFocused)@@ -156,7 +159,7 @@ -- The state extension that holds the history information data HistoryDB = HistoryDB (Maybe Window) -- currently focused window (Seq Window) -- previously focused windows- deriving (Read, Show)+ deriving (Read, Show, Generic, NFData) instance ExtensionClass HistoryDB where @@ -166,15 +169,15 @@ -- | Action that needs to be executed as a logHook to maintain the -- focus history of all windows as the WindowSet changes. historyHook :: X ()-historyHook = XS.get >>= updateHistory >>= XS.put+historyHook = (XS.put $!) . force =<< updateHistory =<< XS.get -- Updates the history in response to a WindowSet change updateHistory :: HistoryDB -> X HistoryDB-updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do+updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> let newcur = SS.peek ss wins = Set.fromList $ SS.allWindows ss newhist = Seq.filter (`Set.member` wins) (ins oldcur oldhist)- return $ HistoryDB newcur (del newcur newhist)+ 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@@ -221,7 +224,7 @@ isOnAnyVisibleWS = do w <- ask ws <- liftX $ gets windowset- let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws+ let allVisible = concatMap (maybe [] SS.integrate . SS.stack . SS.workspace) (SS.current ws:SS.visible ws) visibleWs = w `elem` allVisible unfocused = Just w /= SS.peek ws return $ visibleWs && unfocused
XMonad/Actions/KeyRemap.hs view
@@ -148,8 +148,6 @@ layoutDvorakShift = map getShift layoutDvorak layoutDvorakKey = map getKey layoutDvorak- getKey char = let Just index = elemIndex char layoutUs- in layoutUsKey !! index- getShift char = let Just index = elemIndex char layoutUs- in layoutUsShift !! index+ getKey char = fromJust $ (layoutUsKey !?) =<< elemIndex char layoutUs+ getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs charToMask char = if [char] == "0" then 0 else shiftMask
XMonad/Actions/Launcher.hs view
@@ -62,7 +62,7 @@ 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+ 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 @@ -70,7 +70,7 @@ instance XPrompt HoogleMode where showXPrompt _ = "hoogle %s> " commandToComplete _ = id- completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]+ completionFunction (HMode pathToHoogleBin' _) s = completionFunctionWith pathToHoogleBin' ["--count","8",s] -- This action calls hoogle again to find the URL corresponding to the autocompleted item modeAction (HMode pathToHoogleBin'' browser') query result = do completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]
XMonad/Actions/Minimize.hs view
@@ -50,14 +50,18 @@ -- $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)
XMonad/Actions/MouseGestures.hs view
@@ -79,17 +79,11 @@ gauge hook op st nx ny = do let np = (nx, ny) stx <- io $ readIORef st- let- (~(Just od), pivot) = case stx of- Nothing -> (Nothing, op)- Just (d, zp) -> (Just d, zp)- cont = do- guard $ significant np pivot- return $ do- let d' = dir pivot np- when (isNothing stx || od /= d') $ hook d'- io $ writeIORef st (Just (d', np))- fromMaybe (return ()) cont+ let pivot = maybe op snd stx+ when (significant np pivot) $ do+ let d' = dir pivot np+ when ((fst <$> stx) /= Just d') $ hook d'+ io $ writeIORef st (Just (d', np)) where significant a b = delta a b >= 10
@@ -388,7 +388,7 @@ } -- | Shorthand for the tedious screen type-type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail+type Screen = WindowScreen -- | Convenience function for enabling Navigation2D with typical keybindings. -- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from@@ -433,7 +433,7 @@ -- mapping from key prefix to action, and a bool to indicate if wrapping should -- occur, and returns a function from XConfig to XConfig. Example: ----- > additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig+-- > additionalNav2DKeysP ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l additionalNav2DKeysP (u, l, d, r) modifiers wrap =@@ -616,11 +616,8 @@ -- | Determines whether a given window is mapped isMapped :: Window -> X Bool-isMapped win = withDisplay- $ \dpy -> io- $ (waIsUnmapped /=)- . wa_map_state- <$> getWindowAttributes dpy win+isMapped = fmap (maybe False ((waIsUnmapped /=) . wa_map_state))+ . safeGetWindowAttributes ---------------------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------------------@@ -824,8 +821,7 @@ rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r) -- Apply the above function until d becomes synonymous with R (wolog).- rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]- in foldr (const $ (.) rHalfPiCC) id l+ rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC transform = rotateToR dir . translate . toSR
XMonad/Actions/NoBorders.hs view
@@ -27,8 +27,7 @@ toggleBorder :: Window -> X () toggleBorder w = do bw <- asks (borderWidth . config)- withDisplay $ \d -> io $ do- cw <- wa_border_width <$> getWindowAttributes d w- if cw == 0+ withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $+ if wa_border_width wa == 0 then setWindowBorderWidth d w bw else setWindowBorderWidth d w 0
+ XMonad/Actions/PerLayoutKeys.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.PerLayoutKeys+-- Description : Define key-bindings on per-layout basis.+-- Copyright : (c) brandon s allbery kf8nh 2022, Roman Cheplyaka, 2008+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : brandon s allbery kf8ng <allbery.b@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- Define key-bindings on per-layout basis.+--+-----------------------------------------------------------------------------++module XMonad.Actions.PerLayoutKeys (+ -- * Usage+ -- $usage+ chooseActionByLayout,+ bindByLayout+ ) where++import XMonad+import XMonad.StackSet as S++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/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+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Uses supplied function to decide which action to run depending on current layout name.+chooseActionByLayout :: (String->X()) -> X()+chooseActionByLayout f = withWindowSet (f . description . S.layout. S.workspace . S.current)++-- | If current layout is listed, run appropriate action (only the first match counts!)+-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied.+bindByLayout :: [(String, X())] -> X()+bindByLayout bindings = chooseActionByLayout chooser where+ chooser l = case lookup l bindings of+ Just action -> action+ Nothing -> case lookup "" bindings of+ Just action -> action+ Nothing -> return ()
+ XMonad/Actions/RepeatAction.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE LambdaCase #-}+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.RepeatAction+-- Description : Repeat the last performed action.+-- Copyright : (c) 2022 Martin Kozlovsky+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : <kozlovsky.m7@gmail.com>+-- Stability : unstable+-- Portability : not portable+--+-- Ability to repeat the last action.+--+-----------------------------------------------------------------------------++module XMonad.Actions.RepeatAction (+ -- * Usage+ -- $usage+ rememberAction,+ rememberActions,+ repeatLast,+) where++import XMonad++import qualified XMonad.Util.ExtensibleState as XS++-- $usage+--+-- You can use this module with the following in your @xmonad.hs@:+--+-- > import XMonad.Actions.RepeatAction+--+-- Then join a dedicated key to run the last action with the rest of your+-- key bindings using the 'rememberActions':+--+-- > rememberActions (modm, xK_period) [((modm, xK_c), kill), …]+--+-- It can be also used in the same way for "XMonad.Util.EZConfig":+--+-- > rememberActions "M-." [("M-c", kill), …]+--+-- For example, if you use 'XMonad.Util.EZConfig.additionalKeysP',+--+-- > main = xmonad $ … $ def+-- > {+-- > …+-- > }+-- > `additionalKeysP` myKeys+--+-- you would adjust the call to 'XMonad.Util.EZConfig.additionalKeysP'+-- like so:+--+-- > `additionalKeysP` (rememberActions "M-." myKeys)+--+-- For more detailed instructions on editing your key bindings, see+-- <https://xmonad.org/TUTORIAL.html the tutorial>.++newtype LastAction = LastAction { runLastAction :: X () }++instance ExtensionClass LastAction where+ initialValue = LastAction $ pure ()++-- | Transforms an action into an action that can be remembered and repeated.+rememberAction :: X () -> X ()+rememberAction x = userCode x >>= \case+ Nothing -> pure ()+ Just () -> XS.put (LastAction x) -- Only remember action if nothing went wrong.++-- | Maps 'rememberAction' over a list of key bindings.+rememberActions' :: [(a, X ())] -> [(a, X ())]+rememberActions' = map (fmap rememberAction)++infixl 4 `rememberActions`+-- | Maps 'rememberAction' over a list of key bindings and adds a dedicated+-- key to repeat the last action.+rememberActions :: a -> [(a, X ())] -> [(a, X ())]+rememberActions key keyList = (key, repeatLast) : rememberActions' keyList++-- | Runs the last remembered action.+-- / Be careful not to include this action in the remembered actions! /+repeatLast :: X ()+repeatLast = XS.get >>= runLastAction
XMonad/Actions/RotSlaves.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotSlaves@@ -18,8 +20,9 @@ rotAll', rotAllUp, rotAllDown ) where -import XMonad.StackSet import XMonad+import XMonad.StackSet+import XMonad.Prelude -- $usage --@@ -49,8 +52,8 @@ rotSlaves' _ s@(Stack _ [] []) = s rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise- where (master:ws) = integrate s- (revls',t':rs') = splitAt (length ls) (master:f ws)+ where (notEmpty -> master :| ws) = integrate s+ (revls', notEmpty -> t' :| rs') = splitAt (length ls) (master:f ws) -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X ()@@ -60,4 +63,4 @@ -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a rotAll' f s = Stack r (reverse revls) rs- where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))+ where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s))
XMonad/Actions/RotateSome.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotateSome@@ -26,7 +28,7 @@ ) where import Control.Arrow ((***))-import XMonad.Prelude (partition, sortOn, (\\))+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)@@ -148,7 +150,7 @@ -- Append anchored elements, along with their unchanged indices, and sort -- by index. Separate lefts (negative indices) from the rest, and grab the -- new focus from the head of the remaining elements.- (ls', t':rs') =+ (ls', notEmpty -> t' :| rs') = (map snd *** map snd) . span ((< 0) . fst) . sortOn fst
XMonad/Actions/Search.hs view
@@ -298,7 +298,7 @@ dictionary = searchEngine "dict" "https://dictionary.reference.com/browse/" ebay = searchEngine "ebay" "https://www.ebay.com/sch/i.html?_nkw=" github = searchEngine "github" "https://github.com/search?q="-google = searchEngine "google" "https://www.google.com/search?num=100&q="+google = searchEngine "google" "https://www.google.com/search?q=" hackage = searchEngine "hackage" "https://hackage.haskell.org/package/" hoogle = searchEngine "hoogle" "https://hoogle.haskell.org/?hoogle=" images = searchEngine "images" "https://images.google.fr/images?q="
XMonad/Actions/ShowText.hs view
@@ -47,7 +47,7 @@ -- -- Then add the event hook handler: ----- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }+-- > xmonad { handleEventHook = myHandleEventHooks <> handleTimerEvent } -- -- You can then use flashText in your keybindings: --
XMonad/Actions/SpawnOn.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SpawnOn@@ -28,11 +30,7 @@ shellPromptOn ) where -import Control.Exception (tryJust)-import System.IO.Error (isDoesNotExistError)-import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID)-import Text.Printf (printf) import XMonad import XMonad.Prelude@@ -42,6 +40,7 @@ import XMonad.Prompt import XMonad.Prompt.Shell import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Process (getPPIDChain) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -51,7 +50,7 @@ -- > main = do -- > xmonad def { -- > ...--- > manageHook = manageSpawn <+> manageHook def+-- > manageHook = manageSpawn <> manageHook def -- > ... -- > } --@@ -72,29 +71,13 @@ initialValue = Spawner [] -getPPIDOf :: ProcessID -> Maybe ProcessID-getPPIDOf thisPid =- case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger thisPid of- Left _ -> Nothing- Right contents -> case lines contents of- [] -> Nothing- first : _ -> case words first of- _ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int)- _ -> Nothing--getPPIDChain :: ProcessID -> [ProcessID]-getPPIDChain thisPid = ppid_chain thisPid []- where ppid_chain pid' acc =- if pid' == 0- then acc- else case getPPIDOf pid' of- Nothing -> acc- Just ppid -> ppid_chain ppid (ppid : acc)- -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner f = XS.modify (Spawner . f . pidsRef) +modifySpawnerM :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> X ()+modifySpawnerM f = XS.modifyM (fmap Spawner . f . pidsRef)+ -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. manageSpawn :: ManageHook@@ -103,24 +86,16 @@ manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@ -> ManageHook-manageSpawnWithGC garbageCollect = do- Spawner pids <- liftX XS.get- mp <- pid- let ppid_chain = case mp of- Just winpid -> winpid : getPPIDChain winpid- Nothing -> []- known_window_handlers = [ mh- | ppid <- ppid_chain- , let mpid = lookup ppid pids- , isJust mpid- , let (Just mh) = mpid ]- case known_window_handlers of- [] -> idHook- (mh:_) -> do- whenJust mp $ \p -> liftX $ do- ps <- XS.gets pidsRef- XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)- mh+manageSpawnWithGC garbageCollect = pid >>= \case+ Nothing -> mempty+ Just p -> do+ Spawner pids <- liftX XS.get+ ppid_chain <- io $ getPPIDChain p+ case mapMaybe (`lookup` pids) ppid_chain of+ [] -> mempty+ mh : _ -> liftX (gc p) >> mh+ where+ gc p = modifySpawnerM $ garbageCollect . filter ((/= p) . fst) mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt cb c = do
XMonad/Actions/Submap.hs view
@@ -17,13 +17,18 @@ -- * Usage -- $usage submap,+ visualSubmap, submapDefault,- submapDefaultWithKey+ submapDefaultWithKey,++ -- * Utilities+ subName, ) where import Data.Bits-import XMonad.Prelude (fix, fromMaybe)-import XMonad hiding (keys) import qualified Data.Map as M+import XMonad hiding (keys)+import XMonad.Prelude (fix, fromMaybe, keyToString, cleanKeyMask)+import XMonad.Util.XUtils {- $usage @@ -62,6 +67,44 @@ 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@@ -71,28 +114,32 @@ submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> M.Map (KeyMask, KeySym) (X ()) -> X ()-submapDefaultWithKey defAction keys = do- XConf { theRoot = root, display = d } <- ask+submapDefaultWithKey defAction keys = waitForKeyPress >>=+ \(m', s) -> fromMaybe (defAction (m', s)) (M.lookup (m', s) keys) - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime- io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync- none none currentTime+-----------------------------------------------------------------------+-- Internal stuff +waitForKeyPress :: X (KeyMask, KeySym)+waitForKeyPress = do+ XConf{ theRoot = root, display = dpy } <- ask++ io $ do grabKeyboard dpy root False grabModeAsync grabModeAsync currentTime+ grabPointer dpy root False buttonPressMask grabModeAsync grabModeAsync+ none none currentTime+ (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do- maskEvent d (keyPressMask .|. buttonPressMask) p+ maskEvent dpy (keyPressMask .|. buttonPressMask) p ev <- getEvent p case ev of KeyEvent { ev_keycode = code, ev_state = m } -> do- keysym <- keycodeToKeysym d code 0+ keysym <- keycodeToKeysym dpy code 0 if isModifierKey keysym then nextkey else return (m, keysym) _ -> return (0, 0)- -- Remove num lock mask and Xkb group state bits- m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)-- io $ ungrabPointer d currentTime- io $ ungrabKeyboard d currentTime- io $ sync d False-- fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)+ m' <- cleanKeyMask <*> pure m+ io $ do ungrabPointer dpy currentTime+ ungrabKeyboard dpy currentTime+ sync dpy False+ pure (m', s)
XMonad/Actions/TiledWindowDragging.hs view
@@ -48,10 +48,11 @@ -- | Create a mouse binding for this to be able to drag your windows around. -- You need "XMonad.Layout.DraggingVisualizer" for this to look good. dragWindow :: Window -> X ()-dragWindow window = whenX (isClient window) $ do+dragWindow window = whenX (isClient window) $ withDisplay $ \dpy ->+ withWindowAttributes dpy window $ \wa -> do focus window- (offsetX, offsetY) <- getPointerOffset window- (winX, winY, winWidth, winHeight) <- getWindowPlacement window+ (offsetX, offsetY) <- getPointerOffset window+ let (winX, winY, winWidth, winHeight) = getWindowPlacement wa mouseDrag (\posX posY ->@@ -71,11 +72,8 @@ return (fi oX, fi oY) -- | return a tuple of windowX, windowY, windowWidth, windowHeight-getWindowPlacement :: Window -> X (Int, Int, Int, Int)-getWindowPlacement window = do- wa <- withDisplay (\d -> io $ getWindowAttributes d window)- return (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)-+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@@ -85,7 +83,7 @@ let allWindows = W.index ws when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows- let (ls, t : rs) = break (== win) allWindowsSwitched+ (ls, t : rs) <- pure $ break (== win) allWindowsSwitched let newStack = W.Stack t (reverse ls) rs windows $ W.modify' $ const newStack where
XMonad/Actions/TreeSelect.hs view
@@ -79,8 +79,9 @@ import qualified Data.Map as M #ifdef XFT-import Graphics.X11.Xft+import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender+import Graphics.X11.Xft #endif -- $usage@@ -532,11 +533,11 @@ ev <- getEvent e if | ev_event_type ev == keyPress -> do- (ks, _) <- lookupString $ asKeyEvent e+ ks <- keycodeToKeysym d (ev_keycode ev) 0 return $ do- mask <- liftX $ cleanMask (ev_state ev)+ mask <- liftX $ cleanKeyMask <*> pure (ev_state ev) f <- asks ts_navigate- fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f+ fromMaybe navigate $ M.lookup (mask, ks) f | ev_event_type ev == buttonPress -> do -- See XMonad.Prompt Note [Allow ButtonEvents] allowEvents d replayPointer currentTime@@ -648,10 +649,14 @@ setForeground display gc col wcDrawImageString display window fnt gc x y text #ifdef XFT- Xft fnt -> do+ Xft fnts -> do withXftDraw display window visual colormap $ \ft_draw -> withXftColorValue display visual colormap (fromARGB col) $- \ft_color -> xftDrawString ft_draw ft_color fnt x y text+#if MIN_VERSION_X11_xft(0, 3, 4)+ \ft_color -> xftDrawStringFallback ft_draw ft_color (NE.toList fnts) (fi x) (fi y) text+#else+ \ft_color -> xftDrawString ft_draw ft_color (NE.head fnts) x y text+#endif -- | Convert 'Pixel' to 'XRenderColor' --
XMonad/Actions/UpdatePointer.hs view
@@ -28,7 +28,6 @@ import XMonad.Prelude import XMonad.StackSet (member, peek, screenDetail, current) -import Control.Exception (SomeException, try) import Control.Arrow ((&&&), (***)) -- $usage@@ -73,10 +72,9 @@ let defaultRect = screenRect $ screenDetail $ current ws rect <- case peek ws of Nothing -> return defaultRect- Just w -> do tryAttributes <- io $ try $ getWindowAttributes dpy w- return $ case tryAttributes of- Left (_ :: SomeException) -> defaultRect- Right attributes -> windowAttributesToRectangle attributes+ Just w -> maybe defaultRect windowAttributesToRectangle+ <$> safeGetWindowAttributes w+ root <- asks theRoot mouseIsMoving <- asks mouseFocused (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
XMonad/Actions/Warp.hs view
@@ -91,11 +91,9 @@ -- | Warp the pointer to a given position relative to the currently -- focused window. Top left = (0,0), bottom right = (1,1). warpToWindow :: Rational -> Rational -> X ()-warpToWindow h v =- withDisplay $ \d ->- withFocused $ \w -> do- wa <- io $ getWindowAttributes d w- warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))+warpToWindow h v = withDisplay $ \d -> withFocused $ \w ->+ withWindowAttributes d w $ \wa ->+ warp w (fraction h (wa_width wa)) (fraction v (wa_height wa)) -- | Warp the pointer to the given position (top left = (0,0), bottom -- right = (1,1)) on the given screen.
XMonad/Actions/WindowGo.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ViewPatterns #-}+ {- | Module : XMonad.Actions.WindowGo Description : Operations for raising (traveling to) windows.@@ -158,8 +160,10 @@ raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do foc <- withWindowSet $ return . W.peek case foc of- Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match- in windows $ focusFn y+ Just w | w `elem` ws ->+ let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws+ -- cannot fail to match+ in windows $ focusFn y _ -> windows . focusFn . head $ ws -- | Given a function which gets us a String, we try to raise a window with that classname,
XMonad/Actions/WindowMenu.hs view
@@ -51,9 +51,9 @@ else (nBC, fBC) windowMenu :: X ()-windowMenu = withFocused $ \w -> do+windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do tags <- asks (workspaces . config)- Rectangle x y wh ht <- getSize w+ let Rectangle x y wh ht = getSize wa Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset let originFractX = (fi x - fi sx + fi wh / 2) / fi swh originFractY = (fi y - fi sy + fi ht / 2) / fi sht@@ -69,12 +69,10 @@ | tag <- tags ] runSelectedAction gsConfig actions -getSize :: Window -> X Rectangle-getSize w = do- d <- asks display- wa <- io $ getWindowAttributes d w+getSize :: WindowAttributes -> Rectangle+getSize wa = let x = fi $ wa_x wa y = fi $ wa_y wa wh = fi $ wa_width wa ht = fi $ wa_height wa- return (Rectangle x y wh ht)+ in Rectangle x y wh ht
@@ -127,7 +127,7 @@ Just currentWin -> W.focusWindow currentWin $ mapWindows (swapWin currentWin targetWin) winSet Nothing -> winSet- mapWindows f ss = W.mapWorkspace (mapWindows' f) ss+ 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@@ -209,9 +209,9 @@ py < ry + fromIntegral h inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && py > ry-inr R (Point px py) (Rectangle rx ry _ h) = px < rx &&+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 w h) = px > rx + fromIntegral w &&+inr L (Point px py) (Rectangle rx ry _ h) = px > rx && py >= ry && py < ry + fromIntegral h sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
XMonad/Actions/Workscreen.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Workscreen@@ -35,6 +37,7 @@ ) 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@@ -90,7 +93,7 @@ let wscr = if wscrId == c then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId) else a !! wscrId- (x,_:ys) = splitAt wscrId a+ (x, notEmpty -> _ :| ys) = splitAt wscrId a newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys) windows (viewWorkscreen' wscr) XS.put newWorkscreenStorage
XMonad/Actions/WorkspaceCursors.hs view
@@ -212,4 +212,4 @@ return (arrs,WorkspaceCursors <$> focusTo cws cs) handleMess (WorkspaceCursors cs) m =- sequenceA $ fmap WorkspaceCursors . ($ cs) . unWrap <$> fromMessage m+ traverse (fmap WorkspaceCursors . ($ cs) . unWrap) (fromMessage m)
XMonad/Config/Arossato.hs view
@@ -16,6 +16,7 @@ ------------------------------------------------------------------------ module XMonad.Config.Arossato+ {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( -- * Usage -- $usage arossatoConfig
XMonad/Config/Azerty.hs view
@@ -37,11 +37,11 @@ -- If you prefer, an azertyKeys function is provided which you can use as so: -- -- > import qualified Data.Map as M--- > main = xmonad someConfig { keys = \c -> azertyKeys c <+> keys someConfig c }+-- > main = xmonad someConfig { keys = \c -> azertyKeys c <> keys someConfig c } -azertyConfig = def { keys = azertyKeys <+> keys def }+azertyConfig = def { keys = azertyKeys <> keys def } -belgianConfig = def { keys = belgianKeys <+> keys def }+belgianConfig = def { keys = belgianKeys <> keys def } azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
XMonad/Config/Bepo.hs view
@@ -38,7 +38,7 @@ -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c } -bepoConfig = def { keys = bepoKeys <+> keys def }+bepoConfig = def { keys = bepoKeys <> keys def } bepoKeys conf@XConfig { modMask = modm } = M.fromList $ ((modm, xK_semicolon), sendMessage (IncMasterN (-1)))
XMonad/Config/Bluetile.hs view
@@ -194,7 +194,7 @@ fullscreen = tilingDeco $ maximize $ smartBorders Full tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)- floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l+ floatingDeco = buttonDeco shrinkText defaultThemeWithButtons bluetileConfig = docks . ewmhFullscreen . ewmh $
XMonad/Config/Desktop.hs view
@@ -106,7 +106,7 @@ -- > main = -- > xmonad $ desktopConfig { -- > -- add manage hooks while still ignoring panels and using default manageHooks--- > manageHook = myManageHook <+> manageHook desktopConfig+-- > manageHook = myManageHook <> manageHook desktopConfig -- > -- > -- add a fullscreen tabbed layout that does not avoid covering -- > -- up desktop panels before the desktop layouts@@ -129,7 +129,7 @@ -- To add to the logHook while still sending workspace and window information -- to DE apps use something like: ----- > , logHook = myLogHook <+> logHook desktopConfig+-- > , logHook = myLogHook <> logHook desktopConfig -- -- Or for more elaborate logHooks you can use @do@: --@@ -143,7 +143,7 @@ -- To customize xmonad's event handling while still having it respond -- to EWMH events from pagers, task bars: ----- > , handleEventHook = myEventHooks <+> handleEventHook desktopConfig+-- > , handleEventHook = myEventHooks <> handleEventHook desktopConfig -- -- or 'mconcat' if you write a list event of event hooks --@@ -157,7 +157,7 @@ -- $startupHook -- To run the desktop startupHook, plus add further actions to be run each--- time xmonad starts or restarts, use '<+>' to combine actions as in the+-- time xmonad starts or restarts, use '<>' to combine actions as in the -- logHook example, or something like: -- -- > , startupHook = do@@ -169,9 +169,9 @@ desktopConfig :: XConfig (ModifiedLayout AvoidStruts (Choose Tall (Choose (Mirror Tall) Full))) desktopConfig = docks $ ewmh def- { startupHook = setDefaultCursor xC_left_ptr <+> startupHook def+ { startupHook = setDefaultCursor xC_left_ptr <> startupHook def , layoutHook = desktopLayoutModifiers $ layoutHook def- , keys = desktopKeys <+> keys def }+ , keys = desktopKeys <> keys def } desktopKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X ()) desktopKeys XConfig{modMask = modm} = M.fromList
XMonad/Config/Dmwit.hs view
@@ -1,5 +1,5 @@ -- boilerplate {{{-{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}+{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-} ----------------------------------------------------------------------------- -- |@@ -7,7 +7,7 @@ -- Description : Daniel Wagner's xmonad configuration. -- -------------------------------------------------------------------------module XMonad.Config.Dmwit where+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@@ -78,7 +78,7 @@ where sign | n > 0 = "+" | otherwise = "-" ctlKind = map (\c -> if c == ' ' then '-' else c) kind- parseKind = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind+ parseKind = unwords . map (\(notEmpty -> c :| cs) -> toUpper c : cs) . words $ kind setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%" listCommand = "pactl list " ++ ctlKind ++ "s" -- }}}@@ -217,13 +217,13 @@ keys = keyBindings, layoutHook = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full, manageHook = (title =? "CGoban: Main Window" --> doF sinkFocus)- <+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")- <+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")- <+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one- <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)- <+> fullscreenMPlayer- <+> floatAll ["Gimp", "Wine"]- <+> manageSpawn,+ <> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")+ <> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")+ <> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <> compared to) this one+ <> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)+ <> fullscreenMPlayer+ <> floatAll ["Gimp", "Wine"]+ <> manageSpawn, logHook = allPPs nScreens, startupHook = refresh >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]@@ -308,7 +308,7 @@ color c = xmobarColor c "" ppFocus s@(S s_) = whenCurrentOn s def {- ppOrder = \(_:_:windowTitle:_) -> [windowTitle],+ ppOrder = \case{ _:_:windowTitle:_ -> [windowTitle]; _ -> [] }, ppOutput = appendFile (pipeName "focus" s_) . (++ "\n") } @@ -318,7 +318,7 @@ ppHiddenNoWindows = color dark, ppUrgent = color "red", ppSep = "",- ppOrder = \(wss:_layout:_title:_) -> [wss],+ ppOrder = \case{ wss:_layout:_title:_ -> [wss]; _ -> [] }, ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n") } -- }}}
XMonad/Config/Droundy.hs view
@@ -8,7 +8,7 @@ -- License : BSD3-style (see LICENSE) -- -------------------------------------------------------------------------module XMonad.Config.Droundy ( config, mytab ) where+module XMonad.Config.Droundy {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( config, mytab ) where import XMonad hiding (keys, config) import qualified XMonad (keys)
XMonad/Config/Example.hs view
@@ -28,10 +28,10 @@ -- simple overrides: xmonad $ desktopConfig { modMask = mod4Mask -- Use the "Win" key for the mod key- , manageHook = myManageHook <+> manageHook desktopConfig+ , manageHook = myManageHook <> manageHook desktopConfig , layoutHook = desktopLayoutModifiers myLayouts , logHook = (dynamicLogString def >>= xmonadPropLog)- <+> logHook desktopConfig+ <> logHook desktopConfig } `additionalKeysP` -- Add some extra key bindings:@@ -72,7 +72,7 @@ -- Handle floating windows: [ transience -- move transient windows to their parent , isDialog -?> doCenterFloat- ] <+> composeAll+ ] <> composeAll [ className =? "Pidgin" --> doFloat , className =? "XCalc" --> doFloat , className =? "mpv" --> doFloat
XMonad/Config/Gnome.hs view
@@ -43,7 +43,7 @@ gnomeConfig = desktopConfig { terminal = "gnome-terminal"- , keys = gnomeKeys <+> keys desktopConfig+ , keys = gnomeKeys <> keys desktopConfig , startupHook = gnomeRegister >> startupHook desktopConfig } gnomeKeys XConfig{modMask = modm} = M.fromList
XMonad/Config/Kde.hs view
@@ -42,11 +42,11 @@ kdeConfig = desktopConfig { terminal = "konsole"- , keys = kdeKeys <+> keys desktopConfig }+ , keys = kdeKeys <> keys desktopConfig } kde4Config = desktopConfig { terminal = "konsole"- , keys = kde4Keys <+> keys desktopConfig }+ , keys = kde4Keys <> keys desktopConfig } kdeKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand")
XMonad/Config/Mate.hs view
@@ -50,7 +50,7 @@ mateConfig = desktopConfig { terminal = "mate-terminal"- , keys = mateKeys <+> keys desktopConfig+ , keys = mateKeys <> keys desktopConfig , startupHook = mateRegister >> startupHook desktopConfig } mateKeys XConfig{modMask = modm} = M.fromList
XMonad/Config/Prime.hs view
@@ -23,7 +23,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Config.Prime (+module XMonad.Config.Prime {-# DEPRECATED "This module is a perpetual draft and will therefore be removed from xmonad-contrib in the near future." #-} ( -- Note: The identifiers here are listed in the order that makes the most sense -- for a user, while the definitions below are listed in the order that makes -- the most sense for a developer.@@ -280,7 +280,7 @@ -- -- Note that operator precedence mandates the parentheses here. manageHook :: Summable ManageHook ManageHook (XConfig l)-manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<+>)+manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<>) -- | Custom X event handler. Return @All True@ if the default handler should -- also be run afterwards. Default does nothing. To add an event handler:@@ -289,7 +289,7 @@ -- > ... -- > handleEventHook =+ serverModeEventHook handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)-handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<+>)+handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<>) -- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding -- appends to the end:
XMonad/Config/Sjanssen.hs view
@@ -5,7 +5,7 @@ -- Description : Spencer Janssen's xmonad config. -- -------------------------------------------------------------------------module XMonad.Config.Sjanssen (sjanssenConfig) where+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@@ -41,8 +41,8 @@ | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]]- <+> manageHook def <+> manageSpawn- <+> (isFullscreen --> doFullFloat)+ <> manageHook def <> manageSpawn+ <> (isFullscreen --> doFullFloat) , startupHook = mapM_ spawnOnce spawns } where
XMonad/Config/Xfce.hs view
@@ -38,7 +38,7 @@ xfceConfig = desktopConfig { terminal = "xfce4-terminal"- , keys = xfceKeys <+> keys desktopConfig }+ , keys = xfceKeys <> keys desktopConfig } xfceKeys XConfig{modMask = modm} = M.fromList [ ((modm, xK_p), spawn "xfrun4")
XMonad/Doc/Extending.hs view
@@ -21,25 +21,24 @@ -- Stability : unstable -- Portability : portable ----- This module documents the xmonad-contrib library and--- how to use it to extend the capabilities of xmonad.+-- This module documents the xmonad-contrib library and guides you+-- through some more advanced parts of extending the capabilities of+-- xmonad. If you're new to xmonad, you should first check out the+-- <https://xmonad.org/TUTORIAL.html tutorial> and treat this document+-- as supplemental reading. ----- Reading this document should not require a deep knowledge of--- Haskell; the examples are intended to be useful and understandable--- for those users who do not know Haskell and don't want to have to--- learn it just to configure xmonad. You should be able to get by--- just fine by ignoring anything you don't understand and using the--- provided examples as templates. However, relevant Haskell features--- are discussed when appropriate, so this document will hopefully be--- useful for more advanced Haskell users as well.+-- 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 may be found on the Haskell wiki:+-- extensions (it's easier than it sounds, we promise!) should read the+-- documentation in "XMonad.Doc.Developing". ----- <http://haskell.org/haskellwiki/Xmonad/Config_archive>+-- More configuration examples can be found+-- <https://xmonad.org/TUTORIAL.html#closing-thoughts here>. -- ----------------------------------------------------------------------------- @@ -66,12 +65,9 @@ -- * Extending xmonad -- $extending - -- ** Editing key bindings+ -- ** Adding key bindings -- $keys - -- *** Adding key bindings- -- $keyAdding- -- *** Removing key bindings -- $keyDel @@ -99,10 +95,10 @@ {- $library -The xmonad-contrib (xmc) library is a set of extension modules-contributed by xmonad hackers and users, which provide additional-xmonad features. Examples include various layout modes (tabbed,-spiral, three-column...), prompts, program launchers, the ability to+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.@@ -143,9 +139,6 @@ combinations or mouse actions, in order to provide functionality beyond the standard keybindings provided by xmonad. -See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to-edit your key bindings.- -} {- $hooks@@ -154,23 +147,23 @@ hooks. Hooks are actions that xmonad performs when certain events occur. The three most important hooks are: -* 'XMonad.Core.manageHook': this hook is called when a new window+* 'XMonad.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- "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on- customizing 'XMonad.Core.manageHook'.+ "XMonad.Doc.Extending#Editing_the_manage_hook" for more information+ on customizing 'XMonad.Core.manageHook'. * 'XMonad.Core.logHook': this hook is called when the stack of windows- managed by xmonad has been changed, by calling the- 'XMonad.Operations.windows' function. For instance+ managed by xmonad has been changed; for example, this is invoked at+ the end of the 'XMonad.Operations.windows' function. For instance "XMonad.Hooks.DynamicLog" will produce a string (whose format can be configured) to be printed to the standard output. This can be used to display some information about the xmonad state in a status bar.- See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more- information.+ See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for+ more information. * 'XMonad.Core.handleEventHook': this hook is called on all events handled by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras"@@ -181,7 +174,7 @@ {- $layouts In the @XMonad.Layout@ namespace you can find modules exporting-contributed tiling algorithms, such as a tabbed layout, a circle, a spiral,+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@@ -204,8 +197,8 @@ graphical prompts for getting user input and using it to perform various actions. -The "XMonad.Prompt" provides a library for easily writing new prompt-modules.+The "XMonad.Prompt" module provides a library for easily writing new+prompts. -} @@ -237,124 +230,171 @@ -} {- $keys-#Editing_key_bindings# -Editing key bindings means changing the 'XMonad.Core.XConfig.keys'-field of the 'XMonad.Core.XConfig' record used by xmonad. For-example, you could write:+In the+<https://github.com/xmonad/xmonad/blob/master/TUTORIAL.md#customizing-xmonad customization section>+of the tutorial we have seen how to add new keys to xmonad with the help+of the 'XMonad.Util.EZConfig.additionalKeysP' function. But how does+that work? Assuming that library didn't exist yet, could we write it+ourselves? -> import XMonad->-> main = xmonad $ def { keys = myKeys }+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: -and provide an appropriate definition of @myKeys@, such as:+> main :: IO ()+> main = xmonad $ def+> `additionalKeys`+> [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+> , ((mod1Mask, xK_BackSpace), spawn "xterm")+> ] -> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList-> [ ((modm, xK_F12), xmonadPrompt def)-> , ((modm, xK_F3 ), shellPrompt def)-> ]+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. -This particular definition also requires importing "XMonad.Prompt",-"XMonad.Prompt.Shell", "XMonad.Prompt.XMonad", and "Data.Map":+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 qualified Data.Map as M-> import XMonad.Prompt-> import XMonad.Prompt.Shell-> import XMonad.Prompt.XMonad+> 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")+> ] -For a list of the names of particular keys (such as xK_F12, and so-on), see-<http://hackage.haskell.org/packages/archive/X11/latest/doc/html/Graphics-X11-Types.html>+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: -Usually, rather than completely redefining the key bindings, as we did-above, we want to simply add some new bindings and\/or remove existing-ones.+> 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. -{- $keyAdding-#Adding_key_bindings#+This means that, as a first guess, the type signature of our version of+'XMonad.Util.EZConfig.additionalKeys' might look like -Adding key bindings can be done in different ways. See the end of this-section for the easiest ways. The type signature of-'XMonad.Core.XConfig.keys' is:+> 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 -> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())+However, even assuming a correct implementation, using this is not very+ergonomic: -In order to add new key bindings, you need to first create an-appropriate 'Data.Map.Map' from a list of key bindings using-'Data.Map.fromList'. This 'Data.Map.Map' of new key bindings then-needs to be joined to a 'Data.Map.Map' of existing bindings using-'Data.Map.union'.+> main = xmonad $ def+> `myAdditionalKeys`+> (\conf -> Map.fromList+> [ ((mod1Mask , xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+> , ((modMask conf, xK_BackSpace), spawn "xterm")+> ]) -Since we are going to need some of the functions of the "Data.Map"-module, before starting we must first import this modules:+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 -> import qualified Data.Map as M+> 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). -For instance, if you have defined some additional key bindings like-these:+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'. -> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList-> [ ((modm, xK_F12), xmonadPrompt def)-> , ((modm, xK_F3 ), shellPrompt def)-> ]+What's left is essentially playing "type tetris": -then you can create a new key bindings map by joining the default one-with yours:+> myAdditionalKeys baseConf keyList =+> let mergeKeylist conf = Map.fromList keyList `Map.union` (keys baseConf) conf+> in baseConf { keys = mergeKeylist } -> newKeys x = myKeys x `M.union` keys def x+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. -Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field-of the configuration:+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. -> main = xmonad $ def { keys = newKeys }+Our function now works as expected: -Alternatively, the '<+>' operator can be used which in this usage does exactly-the same as the explicit usage of 'M.union' and propagation of the config-argument, thanks to appropriate instances in "Data.Monoid".+> main :: IO ()+> main = xmonad $ def+> `myAdditionalKeys`+> [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+> , ((mod1Mask, xK_BackSpace), spawn "xterm")+> ] -> main = xmonad $ def { keys = myKeys <+> keys def }+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 -All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:+> myConfig = def { modMask = mod4Mask } +and then using that information -> module Main (main) where->-> import XMonad->-> import qualified Data.Map as M-> import Graphics.X11.Xlib-> import XMonad.Prompt-> import XMonad.Prompt.Shell-> import XMonad.Prompt.XMonad->-> main :: IO ()-> main = xmonad $ def { keys = myKeys <+> keys def }->-> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList-> [ ((modm, xK_F12), xmonadPrompt def)-> , ((modm, xK_F3 ), shellPrompt def)-> ]+> 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 -There are much simpler ways to accomplish this, however, if you are-willing to use an extension module to help you configure your keys.-For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both-provide useful functions for editing your key bindings; "XMonad.Util.EZConfig" even lets you use emacs-style keybinding descriptions like \"M-C-<F12>\".+Hopefully you now feel well equipped to write some small functions that+extend xmonad an scratch a particular itch! -} {- $keyDel #Removing_key_bindings# -Removing key bindings requires modifying the 'Data.Map.Map' which-stores the key bindings. This can be done with 'Data.Map.difference'-or with 'Data.Map.delete'.+Removing key bindings requires modifying the 'Data.Map.Strict.Map' which+stores the key bindings. This can be done with 'Data.Map.difference' or+with 'Data.Map.Strict.delete'. For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@-(you just want to leave xmonad running forever). To do this you need-to define @newKeys@ as a 'Data.Map.difference' between the default+(you just want to leave xmonad running forever). To do this 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 x = keys def x `M.difference` keysToRemove x@@ -370,8 +410,8 @@ \"null\" action). It is also possible to simply define a list of keys we want to unbind-and then use 'Data.Map.delete' to remove them. In that case we would-write something like:+and then use 'Data.Map.Strict.delete' to remove them. In that case we+would write something like: > newKeys x = foldr M.delete (keys def x) (keysToRemove x) >@@ -468,9 +508,8 @@ This allows us to very easily write new layouts, combine or modify existing layouts, create layouts with internal state, etc. See "XMonad.Doc.Extending#The_LayoutClass" for more information. This-means that we cannot simply have a list of layouts as we used to have-before the 0.5 release: a list requires every member to belong to the-same type!+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.|||'.@@ -569,7 +608,7 @@ > , resource =? "win" --> doF (W.shift "doc") -- xpdf > , resource =? "firefox-bin" --> doF (W.shift "web") > ]-> newManageHook = myManageHook <+> manageHook def+> newManageHook = myManageHook <> manageHook def Again we use 'XMonad.ManageHook.composeAll' to compose a list of@@ -578,7 +617,7 @@ windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift' functions, and the third one will put all firefox windows on the workspace called "web". Then we use the-'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the+'<>' combinator to compose @myManageHook@ with the default 'XMonad.Config.manageHook' to form @newManageHook@. Each 'XMonad.Config.ManageHook' has the form:@@ -628,10 +667,10 @@ > myManageHook = resource =? "realplay.bin" --> doFloat -We can now use the 'XMonad.ManageHook.<+>' combinator to add our+We can now use the '<>' combinator to add our 'XMonad.Config.manageHook' to the default one: -> newManageHook = myManageHook <+> manageHook def+> newManageHook = myManageHook <> manageHook def (Of course, if we wanted to completely replace the default 'XMonad.Config.manageHook', this step would not be necessary.) Now,@@ -665,11 +704,11 @@ One more thing to note about this system is that if a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ of the corresponding actions will be run (in the order in which they-are defined). This is a change from versions before 0.5, when only-the first rule that matched was run.+are defined). An alternative version where only the first rule that+matches is run is available as 'XMonad.Hooks.ManageHelpers.composeOne'. -Finally, for additional rules and actions you can use in your-manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers".+For additional rules and actions you can use in your manageHook, check+out the contrib module "XMonad.Hooks.ManageHelpers". -}
+ XMonad/Hooks/BorderPerWindow.hs view
@@ -0,0 +1,77 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Hooks.BorderPerWindow+-- Description : Set border width for a window in a ManageHook.+-- Copyright : (c) 2021 Xiaokui Shu+-- License : BSD-style (see LICENSE)+--+-- Maintainer : subbyte@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-- Want to customize border width, for each window on all layouts? Want+-- specific window have no border on all layouts? Try this.+-----------------------------------------------------------------------------++module XMonad.Hooks.BorderPerWindow ( -- * Usage+ -- $usage+ defineBorderWidth+ , actionQueue++ -- * Design Considerations+ -- $design+ ) where+++import XMonad+import XMonad.Util.ActionQueue (enqueue, actionQueue)++-- $usage+--+-- To use this module, first import it+--+-- > import XMonad.Hooks.BorderPerWindow (defineBorderWidth, actionQueue)+--+-- Then specify which window to customize the border of in your+-- @manageHook@:+--+-- > myManageHook :: ManageHook+-- > myManageHook = composeAll+-- > [ className =? "firefox" --> defineBorderWidth 0+-- > , className =? "Chromium" --> defineBorderWidth 0+-- > , isDialog --> defineBorderWidth 8+-- > ]+--+-- Finally, add the 'actionQueue' combinator and @myManageHook@ to your+-- config:+--+-- > main = xmonad $ actionQueue $ def+-- > { ...+-- > , manageHook = myManageHook+-- > , ...+-- > }+--+-- Note that this module is incompatible with other ways of changing+-- borders, like "XMonad.Layout.NoBorders". This is because we are+-- changing the border exactly /once/ (when the window first appears)+-- and not every time some condition is satisfied.++-- $design+--+-- 1. Keep it simple. Since the extension does not aim to change border setting+-- when layout changes, only execute the border setting function once to+-- avoid potential window flashing/jumping/scaling.+--+-- 2. The 'ManageHook' eDSL is a nice language for specifying windows. Let's+-- build on top of it and use it to specify window to define border.++defineBorderWidth :: Dimension -> ManageHook+defineBorderWidth bw = do+ w <- ask+ liftX . enqueue $ updateBorderWidth w bw+ idHook++updateBorderWidth :: Window -> Dimension -> X ()+updateBorderWidth w bw = do+ withDisplay $ \d -> io $ setWindowBorderWidth d w bw+ refresh
XMonad/Hooks/DebugEvents.hs view
@@ -111,7 +111,7 @@ windowEvent "Button" w nl <- gets numberlockMask let msk | s == 0 = ""- | otherwise = "modifiers " ++ vmask nl s+ | otherwise = "modifiers " ++ keymaskToString nl s say " button" $ show b ++ msk debugEventsHook' DestroyWindowEvent {ev_window = w@@ -217,28 +217,6 @@ ,("WM_COMMAND" ,("STRING" , 8,0)) ,("WM_SAVE_YOURSELF" ,("STRING" , 8,0)) ]---- | Convert a modifier mask into a useful string-vmask :: KeyMask -> KeyMask -> String-vmask numLockMask msk = unwords $- reverse $- fst $- foldr vmask' ([],msk) masks- where- masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++- [(numLockMask,"num" )- ,( lockMask,"lock" )- ,(controlMask,"ctrl" )- ,( shiftMask,"shift")- ,( mod5Mask,"mod5" )- ,( mod4Mask,"mod4" )- ,( mod3Mask,"mod3" )- ,( mod2Mask,"mod2" )- ,( mod1Mask,"mod1" )- ]- vmask' _ a@( _,0) = a- vmask' (m,s) (ss,v) | v .&. m == m = (s : ss,v .&. complement m)- vmask' _ r = r -- formatting properties. ick. --
XMonad/Hooks/DebugKeyEvents.hs view
@@ -41,7 +41,7 @@ -- -- If you already have a handleEventHook then you should append it: ----- > , handleEventHook = ... <+> debugKeyEvents+-- > , handleEventHook = ... <> debugKeyEvents -- -- Logged key events look like: --@@ -92,10 +92,6 @@ fst $ foldr vmask' ([],msk) masks where--#if __GLASGOW_HASKELL__ < 707- finiteBitSize x = bitSize x-#endif masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++ [(numLockMask,"num" ) ,( lockMask,"lock" )
XMonad/Hooks/DynamicHooks.hs view
@@ -38,7 +38,7 @@ -- -- To use this module, add 'dynamicMasterHook' to your 'manageHook': ----- > xmonad { manageHook = myManageHook <+> dynamicMasterHook }+-- > xmonad { manageHook = myManageHook <> dynamicMasterHook } -- -- You can then use the supplied functions in your keybindings: --@@ -70,7 +70,7 @@ -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'. addDynamicHook :: ManageHook -> X ()-addDynamicHook m = updateDynamicHook (<+> m)+addDynamicHook m = updateDynamicHook (<> m) -- | Modifies the permanent 'ManageHook' with an arbitrary function. updateDynamicHook :: (ManageHook -> ManageHook) -> X ()
XMonad/Hooks/DynamicLog.hs view
@@ -243,7 +243,7 @@ -- | Run xmonad with a property-based xmobar status bar set to some nice -- defaults. ----- > main = xmonad =<< xmobarProp myConfig+-- > main = xmonad $ xmobarProp myConfig -- > -- > myConfig = def { ... } --
XMonad/Hooks/DynamicProperty.hs view
@@ -65,7 +65,7 @@ -- -- > main = xmonad $ def -- > { ...--- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynamicManageHook <+> handleEventHook baseConfig+-- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynamicManageHook <> handleEventHook baseConfig -- > , ... -- > } --@@ -88,7 +88,7 @@ -- -- > main = xmonad $ def -- > { ...--- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <+> handleEventHook baseConfig+-- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <> handleEventHook baseConfig -- > , ... -- > } -- >
XMonad/Hooks/EwmhDesktops.hs view
@@ -85,9 +85,9 @@ -- | 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 }+ewmh c = c { startupHook = ewmhDesktopsStartup <> startupHook c+ , handleEventHook = ewmhDesktopsEventHook <> handleEventHook c+ , logHook = ewmhDesktopsLogHook <> logHook c } -- $customization@@ -293,6 +293,10 @@ 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 ()@@ -337,6 +341,32 @@ let activeWindow' = fromMaybe none (W.peek s) whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' + -- Set desktop Viewport+ 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}@@ -376,8 +406,8 @@ -- | Add EWMH fullscreen functionality to the given config. ewmhFullscreen :: XConfig a -> XConfig a-ewmhFullscreen c = c { startupHook = startupHook c <+> fullscreenStartup- , handleEventHook = handleEventHook c <+> fullscreenEventHook }+ewmhFullscreen c = c { startupHook = startupHook c <> fullscreenStartup+ , handleEventHook = handleEventHook c <> fullscreenEventHook } -- | Advertises EWMH fullscreen support to the X server. {-# DEPRECATED fullscreenStartup "Use ewmhFullscreen instead." #-}@@ -461,6 +491,12 @@ 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@@ -475,6 +511,7 @@ ,"_NET_ACTIVE_WINDOW" ,"_NET_WM_DESKTOP" ,"_NET_WM_STRUT"+ ,"_NET_DESKTOP_VIEWPORT" ] io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp)
XMonad/Hooks/FadeWindows.hs view
@@ -138,13 +138,12 @@ -- to make it obay the monoid laws data Opacity = Opacity Rational | OEmpty +instance Semigroup Opacity where+ r <> OEmpty = r+ _ <> r = r+ instance Monoid Opacity where mempty = OEmpty- r `mappend` OEmpty = r- _ `mappend` r = r--instance Semigroup Opacity where- (<>) = mappend -- | A FadeHook is similar to a ManageHook, but records window opacity. type FadeHook = Query Opacity
XMonad/Hooks/FloatNext.hs view
@@ -53,7 +53,7 @@ -- -- and adding 'floatNextHook' to your 'ManageHook': ----- > myManageHook = floatNextHook <+> manageHook def+-- > myManageHook = floatNextHook <> manageHook def -- -- The 'floatNext' and 'toggleFloatNext' functions can be used in key -- bindings to float the next spawned window:
XMonad/Hooks/Focus.hs view
@@ -160,7 +160,7 @@ -- > --> keepFocus -- > -- Default behavior for activated windows: switch -- > -- workspace and focus.--- > , return True --> switchWorkspace <+> switchFocus+-- > , return True --> switchWorkspace <> switchFocus -- > ] -- > -- > newFocusHook :: FocusHook@@ -202,7 +202,7 @@ -- > acFh = manageFocus activateFocusHook -- > xcf = setEwmhActivateHook acFh -- > . ewmh $ def--- > { manageHook = newFh <+> manageHook def+-- > { manageHook = newFh <> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]@@ -227,7 +227,7 @@ -- > ] -- > xcf = setEwmhActivateHook (fh True) -- > . ewmh $ def--- > { manageHook = fh False <+> manageHook def+-- > { manageHook = fh False <> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]@@ -250,11 +250,11 @@ -- This can be worked around by splitting 'FocusHook' into several different -- values and evaluating each one separately, like: ----- > (FH2 -- manageFocus --> MH2) <+> (FH1 -- manageFocus --> MH1) <+> ..+-- > (FH2 -- manageFocus --> MH2) <> (FH1 -- manageFocus --> MH1) <> .. -- -- E.g. ----- > manageFocus FH2 <+> manageFocus FH1 <+> ..+-- > manageFocus FH2 <> manageFocus FH1 <> .. -- -- now @FH2@ will see window shift made by @FH1@. --@@ -275,9 +275,9 @@ -- > [ pure activated -?> (newOnCur --> keepFocus) -- > , pure True -?> newFocusHook -- > ]--- > xcf = setEwmhActivateHook (fh True <+> activateOnCurrentWs)+-- > xcf = setEwmhActivateHook (fh True <> activateOnCurrentWs) -- > . ewmh $ def--- > { manageHook = fh False <+> manageHook def+-- > { manageHook = fh False <> manageHook def -- > , modMask = mod4Mask -- > } -- > `additionalKeys` [((mod4Mask, xK_v), toggleLock)]@@ -361,7 +361,6 @@ pure x = FocusQuery (pure x) (FocusQuery f) <*> (FocusQuery mx) = FocusQuery (f <*> mx) instance Monad FocusQuery where- return x = FocusQuery (return x) (FocusQuery mx) >>= f = FocusQuery $ mx >>= \x -> let FocusQuery y = f x in y instance MonadReader Focus FocusQuery where@@ -373,7 +372,6 @@ (<>) = liftM2 (<>) instance Monoid a => Monoid (FocusQuery a) where mempty = return mempty- mappend = (<>) runFocusQuery :: FocusQuery a -> Focus -> Query a runFocusQuery (FocusQuery m) = runReaderT m@@ -446,15 +444,15 @@ -- '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+-- 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+-- prop> keepFocus <> switchWorkspace = switchWorkspace <> keepFocus+-- prop> switchFocus <> switchWorkspace = switchWorkspace <> switchFocus -- -- etc. @@ -542,7 +540,7 @@ -- | 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)+activateSwitchWs = manageFocus (switchWorkspace <> switchFocus) -- | Move activated window to current workspace. Not to be used in a 'manageHook'. activateOnCurrent' :: ManageHook@@ -553,9 +551,9 @@ -- 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'+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'+activateOnCurrentKeepFocus = manageFocus (newOnCur --> keepFocus) <> activateOnCurrent'
XMonad/Hooks/InsertPosition.hs view
@@ -29,7 +29,7 @@ -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.InsertPosition--- > xmonad def { manageHook = insertPosition Master Newer <+> myManageHook }+-- > xmonad def { manageHook = insertPosition Master Newer <> myManageHook } -- -- You should you put the manageHooks that use 'doShift' to take effect -- /before/ 'insertPosition', so that the window order will be consistent.
XMonad/Hooks/ManageDebug.hs view
@@ -28,29 +28,30 @@ ) where import XMonad-import XMonad.Prelude (when) import XMonad.Hooks.DebugStack import XMonad.Util.DebugWindow import XMonad.Util.EZConfig import qualified XMonad.Util.ExtensibleState as XS --- persistent state for manageHook debugging to trigger logHook debugging-newtype ManageStackDebug = MSD (Bool,Bool)+-- state for manageHook debugging to trigger logHook debugging+data MSDFinal = DoLogHook | SkipLogHook deriving Show+data MSDTrigger = MSDActivated | MSDInactive deriving Show+data ManageStackDebug = MSD MSDFinal MSDTrigger deriving Show instance ExtensionClass ManageStackDebug where- initialValue = MSD (False,False)+ initialValue = MSD SkipLogHook MSDInactive -- | A combinator to add full 'ManageHook' debugging in a single operation. debugManageHook :: XConfig l -> XConfig l-debugManageHook cf = cf {logHook = manageDebugLogHook <+> logHook cf- ,manageHook = manageDebug <+> manageHook cf+debugManageHook cf = cf {logHook = manageDebugLogHook <> logHook cf+ ,manageHook = manageDebug <> manageHook cf } -- | A combinator to add triggerable 'ManageHook' debugging in a single operation. -- Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press -- this key before opening the window to get just that logged. debugManageHookOn :: String -> XConfig l -> XConfig l-debugManageHookOn key cf = cf {logHook = manageDebugLogHook <+> logHook cf- ,manageHook = maybeManageDebug <+> manageHook cf+debugManageHookOn key cf = cf {logHook = manageDebugLogHook <> logHook cf+ ,manageHook = maybeManageDebug <> manageHook cf } `additionalKeysP` [(key,debugNextManagedWindow)]@@ -61,7 +62,7 @@ -- final 'StackSet' state. -- -- Note that the initial state shows only the current workspace; the final--- one shows all workspaces, since your 'ManageHook' might use e.g. 'doShift',+-- one shows all workspaces, since your 'manageHook' might use e.g. 'doShift', manageDebug :: ManageHook manageDebug = do w <- ask@@ -69,31 +70,38 @@ trace "== manageHook; current stack ==" debugStackString >>= trace ws <- debugWindow w- trace $ "new:\n " ++ ws- XS.modify $ \(MSD (_,key)) -> MSD (True,key)+ trace $ "new window:\n " ++ ws+ -- technically we don't care about go here, since only maybeManageDebug+ -- uses it+ XS.modify $ \(MSD _ go') -> MSD DoLogHook go' idHook -- | @manageDebug@ only if the user requested it with @debugNextManagedWindow@. maybeManageDebug :: ManageHook maybeManageDebug = do go <- liftX $ do- MSD (log_,go') <- XS.get- XS.put $ MSD (log_,False)+ MSD _ go' <- XS.get+ -- leave it active, as we may manage multiple windows before the logHook+ -- so we now deactivate it in the logHook return go'- if go then manageDebug else idHook+ case go of+ MSDActivated -> manageDebug+ _ -> idHook -- | If @manageDebug@ has set the debug-stack flag, show the stack. manageDebugLogHook :: X () manageDebugLogHook = do- MSD (go,key) <- XS.get- when go $ do- trace "== manageHook; final stack =="- debugStackFullString >>= trace- XS.put $ MSD (False,key)- idHook+ MSD log' _ <- XS.get+ case log' of+ DoLogHook -> do+ trace "== manageHook; final stack =="+ debugStackFullString >>= trace+ -- see comment in maybeManageDebug+ XS.put $ MSD SkipLogHook MSDInactive+ _ -> idHook -- | Request that the next window to be managed be @manageDebug@-ed. This can -- be used anywhere an X action can, such as key bindings, mouse bindings -- (presumably with 'const'), 'startupHook', etc. debugNextManagedWindow :: X ()-debugNextManagedWindow = XS.modify $ \(MSD (log_,_)) -> MSD (log_,True)+debugNextManagedWindow = XS.modify $ \(MSD log' _) -> MSD log' MSDActivated
XMonad/Hooks/ManageDocks.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP, LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageDocks@@ -42,10 +42,11 @@ import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s) import qualified XMonad.Util.ExtensibleState as XS-import XMonad.Prelude (All (..), fi, filterM, foldlM, void, when, (<=<))+import XMonad.Prelude -import qualified Data.Set as S-import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Map as M+import qualified XMonad.StackSet as W -- $usage -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:@@ -87,9 +88,9 @@ -- | Add docks functionality to the given config. See above for an example. docks :: XConfig a -> XConfig a-docks c = c { startupHook = docksStartupHook <+> startupHook c- , handleEventHook = docksEventHook <+> handleEventHook c- , manageHook = manageDocks <+> manageHook c }+docks c = c { startupHook = docksStartupHook <> startupHook c+ , handleEventHook = docksEventHook <> handleEventHook c+ , manageHook = manageDocks <> manageHook c } type WindowStruts = M.Map Window [Strut] @@ -136,7 +137,7 @@ -- | 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)+manageDocks = checkDock --> (doIgnore <> doRequestDockEvents) where doRequestDockEvents = ask >>= liftX . requestDockEvents >> mempty @@ -147,15 +148,20 @@ 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+-- | Checks if a window is a DOCK or DESKTOP window.+-- Ignores xmonad's own windows (usually _NET_WM_WINDOW_TYPE_DESKTOP) to avoid+-- unnecessary refreshes. checkDock :: Query Bool-checkDock = ask >>= \w -> liftX $ do- dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"- desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"- mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w- case mbr of- Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs- _ -> return False+checkDock = isDockOrDesktop <&&> (not <$> isXMonad)+ where+ isDockOrDesktop = ask >>= \w -> liftX $ do+ dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"+ desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"+ mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w+ case mbr of+ Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs+ _ -> return False+ isXMonad = className =? "xmonad" -- | Whenever a new dock appears, refresh the layout immediately to avoid the -- new dock.@@ -200,26 +206,33 @@ -- | Goes through the list of windows and find the gap so that all -- STRUT settings are satisfied. calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)-calcGap ss = withDisplay $ \dpy -> do+calcGap ss = do rootw <- asks theRoot struts <- filter careAbout . concat . M.elems <$> getStrutCache - -- we grab the window attributes of the root window rather than checking- -- the width of the screen because xlib caches this info and it tends to- -- be incorrect after RAndR- wa <- io $ getWindowAttributes dpy rootw- let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)+ -- If possible, we grab the window attributes of the root window rather+ -- than checking the width of the screen because xlib caches this info+ -- and it tends to be incorrect after RAndR+ screen <- safeGetWindowAttributes rootw >>= \case+ Nothing -> gets $ r2c . screenRect . W.screenDetail . W.current . windowset+ Just wa -> pure . r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa) return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts where careAbout (s,_,_,_) = s `S.member` ss -- | Adjust layout automagically: don't cover up any docks, status -- bars, etc.+--+-- Note that this modifier must be applied before any modifier that+-- changes the screen rectangle, or struts will be applied in the wrong+-- place and may affect the other modifier(s) in odd ways. This is+-- most commonly seen with the 'spacing' modifier and friends. avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a avoidStruts = avoidStrutsOn [U,D,L,R] -- | Adjust layout automagically: don't cover up docks, status bars,--- etc. on the indicated sides of the screen. Valid sides are U--- (top), D (bottom), R (right), or L (left).+-- etc. on the indicated sides of the screen. Valid sides are 'U'+-- (top), 'D' (bottom), 'R' (right), or 'L' (left). The warning in+-- 'avoidStruts' applies to this modifier as well. avoidStrutsOn :: LayoutClass l a => [Direction2D] -> l a
XMonad/Hooks/ManageHelpers.hs view
@@ -32,9 +32,9 @@ -- > f :: a -> b -> Bool -- > -- > -- a new helper--- > q ***? x = fmap (\a -> f a x) q+-- > q ***? x = fmap (\a -> f a x) q -- or: (\b -> f x b) -- > -- or--- > q ***? x = fmap (`f` x) q+-- > q ***? x = fmap (`f` x) q -- or: (x `f`) -- -- Any existing operator can be "lifted" in the same way: --@@ -49,6 +49,7 @@ isInProperty, isKDETrayWindow, isFullscreen,+ isMinimized, isDialog, pid, transientTo,@@ -109,17 +110,17 @@ (/=?) :: (Eq a, Functor m) => m a -> a -> m Bool q /=? x = fmap (/= x) q --- | q ^? x. if the result of q 'isPrefixOf' x, return True+-- | q ^? x. if the result of @x `isPrefixOf` q@, return True (^?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool-q ^? x = fmap (`isPrefixOf` x) q+q ^? x = fmap (x `isPrefixOf`) q --- | q ~? x. if the result of q 'isSuffixOf' x, return True+-- | q ~? x. if the result of @x `isInfixOf` q@, return True (~?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool-q ~? x = fmap (`isInfixOf` x) q+q ~? x = fmap (x `isInfixOf`) q --- | q $? x. if the result of q 'isSuffixOf' x, return True+-- | q $? x. if the result of @x `isSuffixOf` q@, return True ($?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool-q $? x = fmap (`isSuffixOf` x) q+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)@@ -182,6 +183,11 @@ -- 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
+ XMonad/Hooks/Modal.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}++--------------------------------------------------------------------------------+-- |+-- Module : XMonad.Hooks.Modal+-- Description : Implements true modality in xmonad key-bindings.+-- Copyright : (c) 2018 L. S. Leary+-- License : BSD3-style (see LICENSE)+--+-- Author : L. S. Leary+-- Maintainer : Yecine Megdiche <yecine.megdiche@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- This module implements modal keybindings for xmonad.+--+--------------------------------------------------------------------------------++-- --< Imports & Exports >-- {{{+module XMonad.Hooks.Modal+ (+ -- * Usage+ -- $Usage+ modal+ , modeWithExit+ , mode+ , Mode+ , mkKeysEz+ , setMode+ , exitMode+ -- * Provided Modes #ProvidedModes#+ -- $ProvidedModes+ , noModModeLabel+ , noModMode+ , floatModeLabel+ , floatMode+ , overlayedFloatModeLabel+ , overlayedFloatMode+ , floatMap+ , overlay+ -- * Logger+ , logMode+ ) where++-- core+import XMonad+-- base+import Data.Bits ( (.&.)+ , complement+ )+import Data.List+import qualified Data.Map.Strict as M+-- contrib+import XMonad.Actions.FloatKeys ( keysMoveWindow+ , keysResizeWindow+ )+import XMonad.Prelude+import XMonad.Util.EZConfig ( parseKeyCombo+ , mkKeymap+ )+import qualified XMonad.Util.ExtensibleConf as XC+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Grab+import XMonad.Util.Loggers+import XMonad.Util.Parser ( runParser )++-- }}}++-- Original Draft By L.S.Leary : https://gist.github.com/LSLeary/6741b0572d62db3f0cea8e6618141b2f++-- --< Usage >-- {{{++-- $Usage+--+-- This module provides modal keybindings in xmonad. If you're not familiar with+-- modal keybindings from Vim, you can think of modes as submaps from+-- "XMonad.Actions.Submap", but after each action you execute, you land back in+-- the submap until you explicitly exit the submap. To use this module you+-- should apply the 'modal' function to the config, which will setup the list of+-- modes (or rather, @XConfig Layout -> Mode@) you provide:+--+-- >+-- > import XMonad+-- > import XMonad.Hooks.Modal+-- > import XMonad.Util.EZConfig+-- > import qualified Data.Map as M+-- >+-- > main :: IO ()+-- > main =+-- > xmonad+-- > . modal [noModMode, floatMode 10, overlayedFloatMode 10, sayHelloMode]+-- > $ def+-- > `additionalKeysP` [ ("M-S-n", setMode noModModeLabel)+-- > , ("M-S-r", setMode floatModeLabel)+-- > , ("M-S-z", setMode overlayedFloatModeLabel)+-- > , ("M-S-h", setMode "Hello")+-- > ]+-- >+-- > sayHelloMode :: Mode+-- > sayHelloMode = mode "Hello" $ mkKeysEz+-- > [ ("h", xmessage "Hello, World!")+-- > , ("M-g", xmessage "Goodbye, World!")+-- > ]+--+-- Alternatively, one could have defined @sayHelloMode@ as+--+-- > sayHelloMode :: Mode+-- > sayHelloMode = mode "Hello" $ \cfg ->+-- > M.fromList [ ((noModMask, xK_h), xmessage "Hello, World!")+-- > , ((modMask cfg, xK_g), xmessage "Goodbye, World!")+-- > ]+--+-- In short, a 'Mode' has a label describing its purpose, as well as+-- attached keybindings. These are of the form+--+-- - @[(String, X ())]@, or+--+-- - @XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())@).+--+-- The former—accessible via 'mkKeysEz'—is how specifying keys work with+-- "XMonad.Util.EZConfig", while the latter is more geared towards how+-- defining keys works by default in xmonad. Note that, by default,+-- modes are exited with the Escape key. If one wishes to customise+-- this, the 'modeWithExit' function should be used instead of 'mode'+-- when defining a new mode.+--+-- The label of the active mode can be logged with 'logMode' to be+-- displayed in a status bar, for example (For more information check+-- "XMonad.Util.Loggers"). Some examples are included in [the provided+-- modes](#g:ProvidedModes).++-- }}}++-- --< Types >-- {{{++-- | Internally, we represent keys as the usual function type:+-- @XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())@.+type Keys = XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())++-- | From a list of 'XMonad.Util.EZConfig'-style bindings, generate a+-- key representation.+--+-- >>> mkKeysEz [("h", xmessage "Hello, world!")]+mkKeysEz :: [(String, X ())] -> Keys+mkKeysEz = flip mkKeymap++-- | The mode type. Use 'mode' or 'modeWithExit' to create modes.+data Mode = Mode+ { label :: !String+ , boundKeys :: !Keys+ }++-- | 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 -> Keys -> 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 -> Keys -> Mode+mode = modeWithExit "<Escape>"++-- | Set the current 'Mode' based on its label.+setMode :: String -> X ()+setMode l = do+ XC.with $ \(MC ls) -> case find ((== l) . label) ls of+ Nothing -> mempty+ Just m -> do+ XS.modify $ \cm -> cm { currentMode = Just m }+ refreshMode++-- | Exits the current mode.+exitMode :: X ()+exitMode = do+ XS.modify $ \m -> m { currentMode = Nothing }+ refreshMode++-- | A 'Logger' to display the current mode.+logMode :: Logger+logMode = fmap label <$> XS.gets currentMode++-- Provided modes+noModModeLabel, floatModeLabel, overlayedFloatModeLabel :: String+noModModeLabel = "NoMod"+floatModeLabel = "Float"+overlayedFloatModeLabel = "Overlayed Float"++-- | In this 'Mode', all keybindings are available without the need for pressing+-- the modifier. Pressing @escape@ exits the mode.+noModMode :: Mode+noModMode =+ mode noModModeLabel $ \cnf -> stripModifier (modMask cnf) (keys cnf cnf)++-- | Generates the keybindings for 'floatMode' and 'overlayedFloatMode'.+floatMap+ :: KeyMask -- ^ Move mask+ -> KeyMask -- ^ Enlarge mask+ -> KeyMask -- ^ Shrink mask+ -> Int -- ^ Step size+ -> M.Map (ButtonMask, KeySym) (X ())+floatMap move enlarge shrink s = M.fromList+ [ -- move+ ((move, xK_h) , withFocused (keysMoveWindow (-s, 0)))+ , ((move, xK_j) , withFocused (keysMoveWindow (0, s)))+ , ((move, xK_k) , withFocused (keysMoveWindow (0, -s)))+ , ((move, xK_l) , withFocused (keysMoveWindow (s, 0)))+ -- enlarge+ , ((enlarge, xK_h), withFocused (keysResizeWindow (s, 0) (1, 0)))+ , ((enlarge, xK_j), withFocused (keysResizeWindow (0, s) (0, 0)))+ , ((enlarge, xK_k), withFocused (keysResizeWindow (0, s) (0, 1)))+ , ((enlarge, xK_l), withFocused (keysResizeWindow (s, 0) (0, 0)))+ -- shrink+ , ((shrink, xK_h), withFocused (keysResizeWindow (-s, 0) (0, 0)))+ , ((shrink, xK_j), withFocused (keysResizeWindow (0, -s) (0, 1)))+ , ((shrink, xK_k), withFocused (keysResizeWindow (0, -s) (0, 0)))+ , ((shrink, xK_l), withFocused (keysResizeWindow (-s, 0) (1, 0)))+ , ((noModMask, xK_Escape), exitMode)+ ]++-- | A mode to control floating windows with @{hijk}@, @M-{hijk}@ and+-- @M-S-{hijk}@ in order to respectively move, enlarge and+-- shrink windows.+floatMode+ :: Int -- ^ Step size+ -> Mode+floatMode i = mode floatModeLabel $ \XConfig { modMask } ->+ floatMap noModMask modMask (modMask .|. shiftMask) i++-- | Similar to 'resizeMode', but keeps the bindings of the original+-- config active.+overlayedFloatMode+ :: Int -- ^ Step size+ -> Mode+overlayedFloatMode = overlay overlayedFloatModeLabel . floatMode++-- | Modifies a mode so that the keybindings are merged with those from+-- the config instead of replacing them.+overlay+ :: String -- ^ Label for the new mode+ -> Mode -- ^ Base mode+ -> Mode+overlay label m = Mode label $ \cnf -> boundKeys m cnf <> keys cnf cnf++-- | Strips the modifier key from the provided keybindings.+stripModifier+ :: ButtonMask -- ^ Modifier to remove+ -> M.Map (ButtonMask, KeySym) (X ()) -- ^ Original keybinding map+ -> M.Map (ButtonMask, KeySym) (X ())+stripModifier mask = M.mapKeys $ \(m, k) -> (m .&. complement mask, k)++-- }}}
XMonad/Hooks/Place.hs view
@@ -57,10 +57,10 @@ -- and adding 'placeHook' to your 'manageHook', for example: -- -- > main = xmonad $ def { manageHook = placeHook simpleSmart--- > <+> manageHook def }+-- > <> manageHook def } -- -- Note that 'placeHook' should be applied after most other hooks, especially hooks--- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from+-- such as 'doFloat' and 'doShift'. Since hooks combined with '<>' are applied from -- right to left, this means that 'placeHook' should be the /first/ hook in your chain. -- -- You can also define a key to manually trigger repositioning with 'placeFocused' by
XMonad/Hooks/PositionStoreHooks.hs view
@@ -56,7 +56,7 @@ -- otherwise use 'Just def' or similar to inform the module about the -- decoration theme used. ----- > myManageHook = positionStoreManageHook Nothing <+> manageHook def+-- > myManageHook = positionStoreManageHook Nothing <> manageHook def -- > myHandleEventHook = positionStoreEventHook -- > -- > main = xmonad def { manageHook = myManageHook@@ -68,10 +68,9 @@ positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook positionStoreInit :: Maybe Theme -> Window -> X ()-positionStoreInit mDecoTheme w = withDisplay $ \d -> do+positionStoreInit mDecoTheme w = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do let decoH = maybe 0 decoHeight mDecoTheme -- take decoration into account, which - in its current -- form - makes windows smaller to make room for it- wa <- io $ getWindowAttributes d w ws <- gets windowset arbitraryOffsetX <- randomIntOffset arbitraryOffsetY <- randomIntOffset
XMonad/Hooks/RefocusLast.hs view
@@ -79,10 +79,10 @@ -- > -- > main :: IO () -- > main = xmonad def--- > { handleEventHook = refocusLastWhen myPred <+> handleEventHook def--- > , logHook = refocusLastLogHook <+> logHook def+-- > { handleEventHook = refocusLastWhen myPred <> handleEventHook def+-- > , logHook = refocusLastLogHook <> logHook def -- > -- , layoutHook = refocusLastLayoutHook $ layoutHook def--- > , keys = refocusLastKeys <+> keys def+-- > , keys = refocusLastKeys <> keys def -- > } where -- > myPred = refocusingIsActive <||> isFloat -- > refocusLastKeys cnf
XMonad/Hooks/Rescreen.hs view
@@ -13,9 +13,9 @@ module XMonad.Hooks.Rescreen ( -- * Usage -- $usage- RescreenConfig(..), addAfterRescreenHook, addRandrChangeHook,+ RescreenConfig(..), rescreenHook, ) where @@ -28,29 +28,32 @@ -- This module provides a replacement for the screen configuration change -- handling in core that enables attaching custom hooks to screen (xrandr) -- configuration change events. These can be used to restart/reposition status--- bars or systrays automatically after xrandr, as well as to actually invoke--- xrandr or autorandr when an output is (dis)connected.+-- 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. ----- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:+-- To use this, include the following in your @~\/.xmonad\/xmonad.hs@: ----- > import XMonad.Hooks.RescreenHook+-- > import XMonad.Hooks.Rescreen ----- defining your custom hooks:+-- define your custom hooks: -- -- > myAfterRescreenHook :: X ()--- > myAfterRescreenHook = …+-- > myAfterRescreenHook = spawn "fbsetroot -solid red" -- -- > myRandrChangeHook :: X ()--- > myRandrChangeHook = …+-- > myRandrChangeHook = spawn "autorandr --change" ----- > rescreenCfg = def{--- > afterRescreenHook = myAfterRescreenHook,--- > randrChangeHook = myRandrChangeHook--- > }+-- and hook them into your 'xmonad' config: ----- and adding 'rescreenHook' to your 'xmonad' config:+-- > main = xmonad $ …+-- > . addAfterRescreenHook myAfterRescreenHook+-- > . addRandrChangeHook myRandrChangeHook+-- > . …+-- > $ def{…} ----- > main = xmonad $ … . rescreenHook rescreenCfg . … $ def{…}+-- See documentation of 'rescreenHook' for details about when these hooks are+-- called. -- | Hook configuration for 'rescreenHook'. data RescreenConfig = RescreenConfig@@ -95,11 +98,11 @@ -- | Shortcut for 'rescreenHook'. addAfterRescreenHook :: X () -> XConfig l -> XConfig l-addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }+addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h } -- | Shortcut for 'rescreenHook'. addRandrChangeHook :: X () -> XConfig l -> XConfig l-addRandrChangeHook h = rescreenHook def{ randrChangeHook = h }+addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h } -- | Startup hook to listen for @RRScreenChangeNotify@ events. rescreenStartupHook :: X ()
XMonad/Hooks/SetWMName.hs view
@@ -69,7 +69,7 @@ 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 str = map (fromIntegral . ord) str+ latin1StringToCCharList = map (fromIntegral . ord) netSupportingWMCheckAtom :: X Atom netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
+ XMonad/Hooks/ShowWName.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE InstanceSigs #-}+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Hooks.ShowWName+-- Description : Like 'XMonad.Layout.ShowWName', but as a logHook+-- Copyright : (c) 2022 Tony Zorman+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org>+--+-- Flash the names of workspaces name when switching to them. This is a+-- reimplementation of 'XMonad.Layout.ShowWName' as a logHook.+-----------------------------------------------------------------------------++module XMonad.Hooks.ShowWName (+ -- * Usage+ -- $usage+ showWNameLogHook,+ SWNConfig(..),+ flashName,+) where++import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS++import XMonad+import XMonad.Layout.ShowWName (SWNConfig (..))+import XMonad.Prelude+import XMonad.Util.XUtils (WindowConfig (..), showSimpleWindow)++import Control.Concurrent (threadDelay)++{- $usage++You can use this module with the following in your+@~\/.xmonad\/xmonad.hs@:++> import XMonad.Hooks.ShowWName+>+> main :: IO ()+> main = xmonad $ def+> { logHook = showWNameLogHook def+> }++Whenever a workspace gains focus, the above logHook will flash its name.+You can customise the duration of the flash, as well as colours by+customising the 'SWNConfig' argument that 'showWNameLogHook' takes.++Alternatively, you can also bind 'flashName' to a key and manually+invoke it when you want to know which workspace you are on.+-}++-- | LogHook for flashing the name of a workspace upon entering it.+showWNameLogHook :: SWNConfig -> X ()+showWNameLogHook cfg = do+ LastShown s <- XS.get+ foc <- withWindowSet (pure . W.currentTag)+ unless (s == foc) $ do+ flashName cfg+ XS.put (LastShown foc)++-- | Flash the name of the currently focused workspace.+flashName :: SWNConfig -> X ()+flashName cfg = do+ n <- withWindowSet (pure . W.currentTag)+ showSimpleWindow cfg' [n] >>= \w -> void . xfork $ do+ dpy <- openDisplay ""+ threadDelay (fromEnum $ swn_fade cfg * 1000000) -- 1_000_000 needs GHC 8.6.x and up+ void $ destroyWindow dpy w+ closeDisplay dpy+ where+ cfg' :: WindowConfig+ cfg' = def{ winFont = swn_font cfg, winBg = swn_bgcolor cfg, winFg = swn_color cfg }++-- | Last shown workspace.+newtype LastShown = LastShown WorkspaceId+ deriving (Show, Read)++instance ExtensionClass LastShown where+ initialValue :: LastShown+ initialValue = LastShown ""++ extensionType :: LastShown -> StateExtension+ extensionType = PersistentExtension
+ XMonad/Hooks/StatusBar/WorkspaceScreen.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}++{- |+ Module : XMonad.Hooks.StatusBar.WorkspaceScreen+ Description : Combine workspace names with screen information+ Copyright : (c) Yecine Megdiche <yecine.megdiche@gmail.com>+ License : BSD3-style (see LICENSE)++ Maintainer : Yecine Megdiche <yecine.megdiche@gmail.com>+ Stability : unstable+ Portability : unportable++ In multi-head setup, it might be useful to have screen information of the+ visible workspaces combined with the workspace name, for example in a status+ bar. This module provides utility functions to do just that.+-}+module XMonad.Hooks.StatusBar.WorkspaceScreen+ (+ -- * Usage+ -- $usage+ combineWithScreen+ , combineWithScreenName+ , combineWithScreenNumber+ , WorkspaceScreenCombiner+ -- * Limitations+ -- $limitations+ ) where++import Graphics.X11.Xrandr+import XMonad+import XMonad.Hooks.StatusBar.PP+import XMonad.Prelude+import qualified XMonad.StackSet as W++{- $usage+ You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:++ > import XMonad+ > import XMonad.Hooks.StatusBar+ > import XMonad.Hooks.StatusBar.PP+ > import XMonad.Hooks.StatusBar.WorkspaceScreen++ For example, to add the screen number in parentheses to each visible+ workspace number, you can use 'combineWithScreenNumber':++ > myWorkspaceScreenCombiner :: WorkspaceId -> String -> String+ > myWorkspaceScreenCombiner w sc = w <> wrap "(" ")" sc+ >+ > mySB = statusBarProp "xmobar" (combineWithScreenNumber myWorkspaceScreenCombiner xmobarPP)+ > main = xmonad $ withEasySB mySB defToggleStrutsKey def++ This will annotate the workspace names as following:++ > [1(0)] 2 3 4 <5(1)> 6 7 8 9++ To use the screen's name instead, checkout 'combineWithScreenName':++ > [1(eDP-1)] 2 3 4 <5(HDMI-1)> 6 7 8 9++ For advanced cases, use 'combineWithScreen'.+-}++{- $limitations+ For simplicity, this module assumes xmonad screen ids match screen/monitor+ numbers as managed by the X server (for example, as given by @xrandr+ --listactivemonitors@). Thus, it may not work well when screens show an+ overlapping range of the framebuffer, e.g. when using a projector. This also+ means that it doesn't work with "XMonad.Layout.LayoutScreens".+ (This isn't difficult to fix, PRs welcome.)+-}++-- | Type synonym for a function that combines a workspace name with a screen.+type WorkspaceScreenCombiner = WorkspaceId -> WindowScreen -> String++-- | A helper function that returns a list of screen names.+screenNames :: X [Maybe String]+screenNames = do+ XConf { display, theRoot } <- ask+ let getName mi = getAtomName display (xrr_moninf_name mi)+ io+ $ maybe (pure []) (traverse getName)+ =<< xrrGetMonitors display theRoot True++-- | Combine a workspace name with the screen name it's visible on.+combineWithScreenName :: (WorkspaceId -> String -> String) -> PP -> X PP+combineWithScreenName c = combineWithScreen $ do+ screens <- screenNames+ return $ \w sc -> maybe w (c w) $ join (screens !? fi (W.screen sc))++-- | Combine a workspace name with the screen number it's visible on.+combineWithScreenNumber :: (WorkspaceId -> String -> String) -> PP -> X PP+combineWithScreenNumber c =+ combineWithScreen . return $ \w sc -> c w (show @Int . fi . W.screen $ sc)++-- | Combine a workspace name with a screen according to the given+-- 'WorkspaceScreenCombiner'.+combineWithScreen :: X WorkspaceScreenCombiner -> PP -> X PP+combineWithScreen xCombiner pp = do+ combiner <- xCombiner+ ss <- withWindowSet (return . W.screens)+ return $ pp+ { ppRename = ppRename pp <=< \s w ->+ maybe s (combiner s) (find ((== W.tag w) . W.tag . W.workspace) ss)+ }
XMonad/Hooks/TaffybarPagerHints.hs view
@@ -38,7 +38,7 @@ -- -- > import XMonad.Hooks.TaffybarPagerHints (pagerHints) -- >--- > main = xmonad $ ewmh $ pagerHints $ defaultConfig+-- > main = xmonad $ ewmh $ pagerHints $ def -- > ... -- | The \"Current Layout\" custom hint.
XMonad/Hooks/ToggleHook.hs view
@@ -84,12 +84,12 @@ -- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the -- name of the hook and @hook@ is the hook to execute based on the state. ----- > myManageHook = toggleHook "float" doFloat <+> manageHook def+-- > myManageHook = toggleHook "float" doFloat <> manageHook def -- -- Additionally, toggleHook' is provided to toggle between two hooks (rather -- than on/off). ----- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def+-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <> manageHook def -- -- The 'hookNext' and 'toggleHookNext' functions can be used in key -- bindings to set whether the hook is applied or not.
XMonad/Hooks/UrgencyHook.hs view
@@ -197,11 +197,11 @@ -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) => h -> XConfig l -> XConfig l-withUrgencyHook hook = withUrgencyHookC hook urgencyConfig+withUrgencyHook hook = withUrgencyHookC hook def -- | This lets you modify the defaults set in 'urgencyConfig'. An example: ----- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused }+-- > withUrgencyHookC dzenUrgencyHook { ... } def { suppressWhen = Focused } -- -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration. withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>@@ -250,12 +250,17 @@ minutes :: Rational -> Rational minutes secs = secs * 60 --- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.--- Use a variation of this in your config just as you use a variation of--- 'def' for your xmonad definition.+-- | The default 'UrgencyConfig': @urgencyConfig = 'def'@. urgencyConfig :: UrgencyConfig-urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }+urgencyConfig = def+{-# DEPRECATED urgencyConfig "Use def insetad." #-} +-- | The default 'UrgencyConfig': @suppressWhen = 'Visible', remindWhen = 'Dont'@.+-- Use a variation of this in your config just as you would use any+-- other instance of 'def'.+instance Default UrgencyConfig where+ def = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }+ -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings. -- Example keybinding: --@@ -510,7 +515,11 @@ -- Defaults to a duration of five seconds, and no extra args to dzen. -- See 'DzenUrgencyHook'. dzenUrgencyHook :: DzenUrgencyHook-dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }+dzenUrgencyHook = def++-- | @'def' = 'dzenUrgencyHook'@.+instance Default DzenUrgencyHook where+ def = DzenUrgencyHook { duration = seconds 5, args = [] } -- | Spawn a commandline thing, appending the window id to the prefix string -- you provide. (Make sure to add a space if you need it.) Do your crazy
XMonad/Hooks/WallpaperSetter.hs view
@@ -74,13 +74,12 @@ newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)] deriving (Show,Read) -instance Monoid WallpaperList where- mempty = WallpaperList []- mappend (WallpaperList w1) (WallpaperList w2) =+instance Semigroup WallpaperList where+ WallpaperList w1 <> WallpaperList w2 = WallpaperList $ M.toList $ M.fromList w2 `M.union` M.fromList w1 -instance Semigroup WallpaperList where- (<>) = mappend+instance Monoid WallpaperList where+ mempty = WallpaperList [] -- | Complete wallpaper configuration passed to the hook data WallpaperConf = WallpaperConf {@@ -184,9 +183,8 @@ visws <- getVisibleWorkspaces let visscr = S.current winset : S.visible winset visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr- hasPicAndIsVisible (n, mp) = n `elem` visws && isJust mp getRect tag = screenRect $ fromJust $ M.lookup tag visrects- foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths+ foundpaths = [ (getRect n, p) | (n, Just p) <- paths, n `elem` visws ] return foundpaths where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y >>= \p -> return (x,p)) wl
XMonad/Hooks/WindowSwallowing.hs view
@@ -19,9 +19,6 @@ -- window, and allows you "swallow" that parent window for the time the new -- window is running. ----- __NOTE__: This module depends on @pstree@ to analyze the process hierarchy, so make--- sure that is on your @$PATH@.--- -- __NOTE__ that this does not always work perfectly: -- -- - Because window swallowing needs to check the process hierarchy, it requires@@ -36,7 +33,9 @@ -- 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.+-- 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@@ -50,8 +49,9 @@ import XMonad.Layout.SubLayouts import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.WindowProperties-import XMonad.Util.Run ( runProcessWithInput )+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/xmonad.hs@:@@ -155,14 +155,19 @@ 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- -- If there actually is a corresponding swallowed parent window for this window,- -- we will try to restore it.- -- because there are some cases where the stack-state is not stored correctly in the ConfigureEvent hook,- -- we have to first check if the stack-state is valid.- -- if it is, we can restore the parent exactly where the child window was before being closed- -- if the stored stack-state is invalid however, we still restore the window- -- by just inserting it as the focused window in the stack. stackStoredCorrectly <- do curStack <- withWindowSet (return . currentStack) let oldLen = length (W.integrate oldStack)@@ -178,13 +183,15 @@ $ ws { W.floating = oldFloating } ) else windows (insertIntoStack parent)- -- after restoring, we remove the information about the swallowing from the state.- XS.modify $ removeSwallowed childWindow- XS.modify $ setStackBeforeWindowClosing Nothing+ deleteState childWindow _ -> return ()- 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@@ -219,12 +226,10 @@ -- | check if a given process is a child of another process. This depends on "pstree" being in the PATH -- NOTE: this does not work if the child process does any kind of process-sharing. isChildOf- :: Int -- ^ child PID- -> Int -- ^ parent PID+ :: ProcessID -- ^ child PID+ -> ProcessID -- ^ parent PID -> IO Bool-isChildOf child parent = do- output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""- return $ any (show child `isInfixOf`) $ lines output+isChildOf child parent = (parent `elem`) <$> getPPIDChain child data SwallowingState = SwallowingState
XMonad/Hooks/WorkspaceByPos.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.WorkspaceByPos@@ -32,7 +33,7 @@ -- -- > import XMonad.Hooks.WorkspaceByPos -- >--- > myManageHook = workspaceByPos <+> manageHook def+-- > myManageHook = workspaceByPos <> manageHook def -- > -- > main = xmonad def { manageHook = myManageHook } @@ -40,10 +41,10 @@ workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask needsMoving :: Window -> X (Maybe WorkspaceId)-needsMoving w = withDisplay $ \d -> do- -- only relocate windows with non-zero position- wa <- io $ getWindowAttributes d w- fmap (const Nothing `either` Just) . runExceptT $ do+needsMoving w = safeGetWindowAttributes w >>= \case+ Nothing -> pure Nothing+ Just wa -> fmap (either (const Nothing) Just) . runExceptT $ do+ -- only relocate windows with non-zero position guard $ wa_x wa /= 0 || wa_y wa /= 0 ws <- gets windowset sc <- lift $ fromMaybe (W.current ws)
XMonad/Hooks/WorkspaceHistory.hs view
@@ -28,9 +28,9 @@ , workspaceHistoryModify ) where -import Control.Applicative-import Prelude-+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)@@ -65,6 +65,13 @@ -- reverse-chronological order. } deriving (Read, Show) +-- @ScreenId@ is not an instance of NFData, but is a newtype on @Int@. @seq@+-- is enough for forcing it. This requires us to provide an instance.+instance NFData WorkspaceHistory where+ rnf (WorkspaceHistory hist) =+ let go = liftRnf2 rwhnf rwhnf+ in liftRnf go hist+ instance ExtensionClass WorkspaceHistory where initialValue = WorkspaceHistory [] extensionType = PersistentExtension@@ -72,13 +79,15 @@ -- | A 'logHook' that keeps track of the order in which workspaces have -- been viewed. workspaceHistoryHook :: X ()-workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen)+workspaceHistoryHook = workspaceHistoryHookExclude [] -- | Like 'workspaceHistoryHook', but with the ability to exclude -- certain workspaces. workspaceHistoryHookExclude :: [WorkspaceId] -> X ()-workspaceHistoryHookExclude ws =- gets windowset >>= XS.modify . updateLastActiveOnEachScreenExclude ws+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@@ -101,7 +110,7 @@ startingHistory <- XS.gets history action new <- flip updateLastActiveOnEachScreen (WorkspaceHistory startingHistory) <$> gets windowset- XS.put new+ 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.@@ -125,4 +134,4 @@ -- | Modify a the workspace history with a given pure function. workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()-workspaceHistoryModify action = XS.modify $ WorkspaceHistory . action . history+workspaceHistoryModify action = XS.modify' $ force . WorkspaceHistory . action . history
XMonad/Layout/BinarySpacePartition.hs view
@@ -38,6 +38,7 @@ 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 @@ -425,13 +426,15 @@ resizeSplit _ _ z@(_, []) = Just z resizeSplit dir (xsc,ysc) z = case goToBorder dir z of Nothing -> Just z- Just (t, crumb) -> Just $ case dir of+ Just (t@Node{}, crumb) -> Just $ case dir of R -> (t{value=sp{ratio=scaleRatio (ratio sp) xsc}}, crumb) D -> (t{value=sp{ratio=scaleRatio (ratio sp) ysc}}, crumb) L -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) xsc}}, crumb) U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb) where sp = value t scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac+ Just (Leaf{}, _) ->+ undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf) -- starting from a leaf, go to node representing a border of the according window goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)@@ -694,20 +697,23 @@ 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] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)-withoutFloating fs = maybe Nothing (unfloat fs)+withoutFloating :: [Window] -> [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)+withoutFloating fs hs = maybe Nothing (unfloat fs hs) -- ignore messages if current focus is on floating window, otherwise return stack without floating-unfloat :: [Window] -> W.Stack Window -> Maybe (W.Stack Window)-unfloat fs s = if W.focus s `elem` fs+unfloat :: [Window] -> [Window] -> W.Stack Window -> Maybe (W.Stack Window)+unfloat fs hs s = if W.focus s `elem` fs then Nothing- else Just $ s{W.up = W.up s \\ fs, W.down = W.down s \\ fs}+ else Just $ s{W.up = W.up s \\ (fs ++ hs), W.down = W.down s \\ (fs ++ hs)} instance LayoutClass BinarySpacePartition Window where doLayout b r s = do@@ -741,9 +747,10 @@ | otherwise = do ws <- getStackSet fs <- getFloating+ hs <- getHidden r <- getScreenRect -- removeBorder $ refWins $ getSelectedNode b- let lws = withoutFloating fs ws -- tiled windows on WS+ let lws = withoutFloating fs hs ws -- tiled windows on WS lfs = maybe [] W.integrate ws \\ maybe [] W.integrate lws -- untiled windows on WS b' = handleMesg r -- transform tree (concerns only tiled windows) ws' = adjustStack ws lws lfs b' -- apply transformation to window stack, reintegrate floating wins@@ -781,6 +788,7 @@ handleResize b (SetGeometry newrect@(Rectangle _ _ w h)) = do ws <- getStackSet fs <- getFloating+ hs <- getHidden case W.focus <$> ws of Nothing -> return Nothing Just win -> do@@ -789,7 +797,7 @@ let (xsc,ysc) = (fi w % fi ow, fi h % fi oh) (xsc',ysc') = (rough xsc, rough ysc) dirs = changedDirs oldrect newrect (fi mx,fi my)- n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs ws+ n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs hs ws -- unless (isNothing dir) $ debug $ -- show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh) -- ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my)@@ -820,7 +828,7 @@ else return b b'' <- if force then return b'{getSelectedNode=noRef} else return b' renderBorders r b''- where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getStackSet)+ where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getHidden <*> getStackSet) -- create border around focused node if necessary renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
XMonad/Layout/BoringWindows.hs view
@@ -37,8 +37,9 @@ LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) import XMonad(LayoutClass, Message, X, fromMessage, broadcastMessage, sendMessage, windows, withFocused, Window)-import XMonad.Prelude (find, fromMaybe, listToMaybe, maybeToList, union, (\\))+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 @@ -168,7 +169,7 @@ -- 'Stack' rather than an entire 'StackSet'. focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c-focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls+focusMaster' (W.Stack t (l:ls) rs) = W.Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls) swapUp' :: W.Stack a -> W.Stack a swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)
XMonad/Layout/ButtonDecoration.hs view
@@ -53,5 +53,5 @@ instance Eq a => DecorationStyle ButtonDecoration a where describeDeco _ = "ButtonDeco"- decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR+ decorationCatchClicksHook _ = titleBarButtonHandler decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()
+ XMonad/Layout/CenteredIfSingle.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.CenteredIfSingle+-- Description : If only a single window is shown, center it on screen+-- Copyright : (c) 2021 Leon Kowarschick+-- License : BSD-style (see xmonad/LICENSE)+--+-- Maintainer : Leon Kowarschick. <TheElkOfWar@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- A layout modifier that, if there is only a single window on screen, places+-- that window in the center of the screen.+-- This is especially useful on wide screen setups, where the window would otherwise+-- be unnecessarily far away from the center of your field of vision.+--+-----------------------------------------------------------------------------++module XMonad.Layout.CenteredIfSingle+ ( -- * Usage+ -- $usage+ centeredIfSingle, CenteredIfSingle+ ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Prelude (fi)++-- $usage+-- You can use this module by including the following in your @~\/.xmonad/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 "XMonad.Doc.Extending".+++-- | Layout Modifier that places a window in the center of the screen,+-- leaving room on the left and right if there is only a single window.+-- The first argument is the horizontal and the second one the vertical+-- ratio of the screen the centered window should take up. Both numbers+-- should be between 0.0 and 1.0.+data CenteredIfSingle a = CenteredIfSingle !Double !Double+ deriving (Show, Read)++instance LayoutModifier CenteredIfSingle Window where+ pureModifier (CenteredIfSingle ratioX ratioY) r _ [(onlyWindow, _)] = ([(onlyWindow, rectangleCenterPiece ratioX ratioY r)], Nothing)+ pureModifier _ _ _ winRects = (winRects, Nothing)++-- | Layout Modifier that places a window in the center of the screen,+-- leaving room on all sides if there is only a single window+centeredIfSingle :: Double -- ^ Horizontal ratio of the screen the centered window should take up; should be a value between 0.0 and 1.0+ -> Double -- ^ Vertical ratio; should also be a value between 0.0 and 1.0+ -> l a -- ^ The layout that will be used if more than one window is open+ -> ModifiedLayout CenteredIfSingle l a+centeredIfSingle ratioX ratioY = ModifiedLayout (CenteredIfSingle ratioX ratioY)++-- | Calculate the center piece of a rectangle given the percentage of the outer rectangle it should occupy.+rectangleCenterPiece :: Double -> Double -> Rectangle -> Rectangle+rectangleCenterPiece ratioX ratioY (Rectangle rx ry rw rh) = Rectangle startX startY width height+ where+ startX = rx + left+ startY = ry + top++ width = newSize rw left+ height = newSize rh top++ left = rw `scaleBy` ratioX+ top = rh `scaleBy` ratioY++newSize :: Dimension -> Position -> Dimension+newSize dim pos = fi $ fi dim - pos * 2++scaleBy :: Dimension -> Double -> Position+scaleBy dim ratio = floor $ fi dim * (1.0 - ratio) / 2
XMonad/Layout/Combo.hs view
@@ -36,7 +36,7 @@ -- -- and add something like ----- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)+-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) -- -- to your layouts. --
XMonad/Layout/ComboP.hs view
@@ -39,7 +39,7 @@ -- -- and add something like ----- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox")+-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText def) (tabbed shrinkText def) (ClassName "Firefox") -- -- to your layouts. This way all windows with class = \"Firefox\" will always go -- to the left pane, all others - to the right.
XMonad/Layout/Decoration.hs view
@@ -152,7 +152,7 @@ -- | The description that the 'Decoration' modifier will display. describeDeco :: ds a -> String- describeDeco ds = show ds+ describeDeco = show -- | Shrink the window's rectangle when applying a decoration. shrink :: ds a -> Rectangle -> Rectangle -> Rectangle@@ -160,7 +160,7 @@ -- | The decoration event hook decorationEventHook :: ds a -> DecorationState -> Event -> X ()- decorationEventHook ds s e = handleMouseFocusDrag ds s e+ decorationEventHook = handleMouseFocusDrag -- | A hook that can be used to catch the cases when the user -- clicks on the decoration. If you return True here, the click event@@ -176,7 +176,7 @@ -- The hook can be overwritten if a different way of handling the dragging -- is required. decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()- decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y+ decorationWhileDraggingHook _ = handleDraggingInProgress -- | This hoook is called after a window has been dragged using the decoration. decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()@@ -317,7 +317,7 @@ , ev_y_root = ey } | et == buttonPress , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do- let Just (Rectangle dx _ dwh _) = decoRectM+ let Rectangle dx _ dwh _ = fromJust decoRectM distFromLeft = ex - fi dx distFromRight = fi dwh - (ex - fi dx) dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)
XMonad/Layout/FixedColumn.hs view
@@ -23,17 +23,9 @@ FixedColumn(..) ) where -import Graphics.X11.Xlib (Window, rect_width)-import Graphics.X11.Xlib.Extras ( getWMNormalHints- , getWindowAttributes- , sh_base_size- , sh_resize_inc- , wa_border_width)--import XMonad.Prelude (fromMaybe, msum, (<&>))-import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)-import XMonad.Layout (Resize(..), IncMasterN(..), tile)-import XMonad.StackSet as W+import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -82,9 +74,10 @@ -- columns wide, using @inc@ as a resize increment for windows that -- don't have one widthCols :: Int -> Int -> Window -> X Int-widthCols inc n w = withDisplay $ \d -> io $ do- sh <- getWMNormalHints d w- bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w+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
XMonad/Layout/Fullscreen.hs view
@@ -78,9 +78,9 @@ 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+ handleEventHook = handleEventHook c <> fullscreenEventHook,+ manageHook = manageHook c <> fullscreenManageHook,+ startupHook = startupHook c <> fullscreenStartup } -- | fullscreenSupport with smartBorders support so the border doesn't
XMonad/Layout/Gaps.hs view
@@ -91,6 +91,10 @@ -- -- To configure gaps differently per-screen, use -- "XMonad.Layout.PerScreen" (coming soon).+--+-- __Warning__: If you also use the 'avoidStruts' layout modifier, it+-- must come /before/ any of these modifiers. See the documentation of+-- 'avoidStruts' for details. -- | A manual gap configuration. Each side of the screen on which a -- gap is enabled is paired with a size in pixels.
XMonad/Layout/Groups.hs view
@@ -197,16 +197,16 @@ modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a -> Groups l l2 a-modifyGroups f g = let (seed', id:_) = gen (seed g)- defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ+modifyGroups f g = let (seed', ids) = gen (seed g)+ defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ in g { groups = fromMaybe defaultGroups . f . Just $ groups g , seed = seed' } modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a))) -> Groups l l2 a -> X (Groups l l2 a) modifyGroupsX f g = do- let (seed', id:_) = gen (seed g)- defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ+ let (seed', ids) = gen (seed g)+ defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ g' <- f . Just $ groups g return g { groups = fromMaybe defaultGroups g', seed = seed' } @@ -218,12 +218,12 @@ -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt z g = let mf = getFocusZ z- (seed', id:_) = gen $ seed g+ (seed', ids) = gen $ seed g g' = g { seed = seed' } in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) >>> filterKeepLast (isJust . gZipper) >>> findNewWindows (W.integrate' z)- >>> addWindows (ID id $ baseLayout g)+ >>> addWindows (ID (head ids) $ baseLayout g) >>> focusGroup mf >>> onFocusedZ (onZipper $ focusWindow mf) where filterKeepLast _ Nothing = Nothing@@ -239,7 +239,7 @@ findNewWindows :: Eq a => [a] -> Zipper (Group l a) -> (Zipper (Group l a), [a]) findNewWindows as gs = (gs, foldrZ_ removePresent as gs)- where removePresent g as' = filter (not . flip elemZ (gZipper g)) as'+ where removePresent g = filter (not . flip elemZ (gZipper g)) -- | Add windows to the focused group. If you need to create one, -- use the given layout and an id from the given list.@@ -379,10 +379,10 @@ -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g =- let (seed', id:ids) = gen $ seed g- g' = flip modifyGroups g $ f (ID id $ baseLayout g)+ let (seed', ids) = gen $ seed g+ g' = flip modifyGroups g $ f (ID (head ids) $ baseLayout g) >>> toTags- >>> foldr (reID g) ((ids, []), [])+ >>> foldr (reID g) ((tail ids, []), []) >>> snd >>> fromTags in if groups g == groups g'@@ -391,10 +391,10 @@ applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window)) applySpecX f g = do- let (seed', id:ids) = gen $ seed g- g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)+ let (seed', ids) = gen $ seed g+ g' <- flip modifyGroupsX g $ f (ID (head ids) $ baseLayout g) >>> fmap toTags- >>> fmap (foldr (reID g) ((ids, []), []))+ >>> fmap (foldr (reID g) ((tail ids, []), [])) >>> fmap snd >>> fmap fromTags return $ if groups g == groups g'
XMonad/Layout/Groups/Helpers.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ViewPatterns #-} ----------------------------------------------------------------------------- -- |@@ -155,7 +155,7 @@ -> X () focusHelper f g = withFocused $ \w -> do ws <- getWindows- let (before, _:after) = span (/=w) ws+ let (before, tail -> after) = span (/=w) ws let toFocus = g $ after ++ before floats <- getFloats case filter (f . flip elem floats) toFocus of
XMonad/Layout/ImageButtonDecoration.hs view
@@ -29,6 +29,9 @@ -- $usage imageButtonDeco , defaultThemeWithImageButtons+ , shrinkText+ , CustomShrink(CustomShrink)+ , Shrinker , imageTitleBarButtonHandler , ImageButtonDecoration ) where@@ -177,5 +180,5 @@ instance Eq a => DecorationStyle ImageButtonDecoration a where describeDeco _ = "ImageButtonDeco"- decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR+ decorationCatchClicksHook _ = imageTitleBarButtonHandler decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()
XMonad/Layout/IndependentScreens.hs view
@@ -78,7 +78,7 @@ -- screen into a physical workspace name. -- -- A complete example abusing many of the functions below is available in the--- "XMonad.Config.Dmwit" module.+-- <https://xmonad.org/configurations.html XMonad.Config.Dmwit> configuration. type VirtualWorkspace = WorkspaceId type PhysicalWorkspace = WorkspaceId@@ -148,7 +148,7 @@ Nothing -> ws -- | Get the workspace that is active on a given screen.-screenOnMonitor :: ScreenId -> WindowSet -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+screenOnMonitor :: ScreenId -> 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.
XMonad/Layout/LayoutHints.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ParallelListComp, PatternGuards #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutHints@@ -32,8 +33,8 @@ Dimension, Position, Rectangle(Rectangle), D, X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS, (<&&>), io, applySizeHints, whenX, isClient, withDisplay,- getWindowAttributes, getWMNormalHints, WindowAttributes(..))-import XMonad.Prelude (All (..), fromJust, join, maximumBy, on, sortBy)+ getWMNormalHints, WindowAttributes(..))+import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Layout.Decoration(isInStack)@@ -72,7 +73,7 @@ -- To make XMonad reflect changes in window hints immediately, add -- 'hintsEventHook' to your 'handleEventHook'. ----- > myHandleEventHook = hintsEventHook <+> ...+-- > myHandleEventHook = hintsEventHook <> ... -- > -- > main = xmonad def { handleEventHook = myHandleEventHook -- > , ... }@@ -164,7 +165,7 @@ $ if isInStack s w then Rectangle a b c' d' else lrect ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d')- growOther' r = growOther ds lrect (freeDirs root lrect) r+ growOther' = growOther ds lrect (freeDirs root lrect) mapSnd f = map (first $ second f) next = applyHints s root $ mapSnd growOther' xs in (w,redr):next@@ -264,8 +265,9 @@ -- | True if the window's current size does not satisfy its size hints. hintsMismatch :: Window -> X Bool-hintsMismatch w = withDisplay $ \d -> io $ do- wa <- getWindowAttributes d w- sh <- getWMNormalHints d w- let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)- return $ dim /= applySizeHints 0 sh dim+hintsMismatch w = safeGetWindowAttributes w >>= \case+ Nothing -> pure False+ Just wa -> do+ sh <- withDisplay $ \d -> io (getWMNormalHints d w)+ let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)+ return $ dim /= applySizeHints 0 sh dim
XMonad/Layout/LayoutModifier.hs view
@@ -107,7 +107,7 @@ -> Workspace WorkspaceId (l a) a -- ^ current workspace -> Rectangle -- ^ screen rectangle -> X ([(a, Rectangle)], Maybe (l a))- modifyLayout _ w r = runLayout w r+ modifyLayout _ = runLayout -- | Similar to 'modifyLayout', but this function also allows you -- update the state of your layout modifier(the second value in the
XMonad/Layout/LayoutScreens.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- |@@ -22,6 +23,7 @@ ) where import XMonad+import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage@@ -60,12 +62,14 @@ -- | Modify all screens. layoutScreens :: LayoutClass l Int => Int -> l Int -> X () layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."-layoutScreens nscr l =- do rtrect <- asks theRoot >>= getWindowRectangle+layoutScreens nscr l = asks theRoot >>= \w -> withDisplay $ \d ->+ withWindowAttributes d w $ \attrs ->+ do let rtrect = windowRectangle attrs (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->- let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs- s:ss = map snd wss+ 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 }@@ -77,18 +81,17 @@ do rect <- gets $ screenRect . W.screenDetail . W.current . windowset (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect windows $ \ws@W.StackSet{ W.current = c, W.visible = vs, W.hidden = hs } ->- let (x:xs, ys) = splitAt nscr $ W.workspace c : hs- s:ss = map snd wss+ 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 } -getWindowRectangle :: Window -> X Rectangle-getWindowRectangle w = withDisplay $ \d ->- do a <- io $ getWindowAttributes d w- return $ Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a)- (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)+windowRectangle :: WindowAttributes -> Rectangle+windowRectangle a = Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a)+ (fromIntegral $ wa_width a) (fromIntegral $ wa_height a) newtype FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)
XMonad/Layout/LimitWindows.hs view
@@ -99,8 +99,8 @@ where pos x = guard (x>=1) >> return x app f x = guard (f x /= x) >> return (f x) - modifyLayout (LimitWindows style n) ws r =- runLayout ws { W.stack = f n <$> W.stack ws } r+ modifyLayout (LimitWindows style n) ws =+ runLayout ws { W.stack = f n <$> W.stack ws } where f = case style of FirstN -> firstN Slice -> slice@@ -123,8 +123,8 @@ deriving (Read, Show, Eq) instance LayoutModifier Selection a where- modifyLayout s w r =- runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r+ modifyLayout s w =+ runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) pureModifier sel _ stk wins = (wins, update sel <$> stk)
XMonad/Layout/MagicFocus.hs view
@@ -57,14 +57,11 @@ data MagicFocus a = MagicFocus deriving (Show, Read) instance LayoutModifier MagicFocus Window where- modifyLayout MagicFocus (W.Workspace i l s) r =- withWindowSet $ \wset ->- runLayout (W.Workspace i l (s >>= \st -> Just $ swap st (W.peek wset))) r+ modifyLayout MagicFocus (W.Workspace i l s) =+ runLayout (W.Workspace i l (s >>= Just . shift)) -swap :: (Eq a) => W.Stack a -> Maybe a -> W.Stack a-swap (W.Stack f u d) focused- | Just f == focused = W.Stack f [] (reverse u ++ d)- | otherwise = W.Stack f u d+shift :: (Eq a) => W.Stack a -> W.Stack a+shift (W.Stack f u d) = W.Stack f [] (reverse u ++ d) -- | An eventHook that overrides the normal focusFollowsMouse. When the mouse -- it moved to another window, that window is replaced as the master, and the
XMonad/Layout/Monitor.hs view
@@ -73,7 +73,7 @@ -- -- Add ManageHook to de-manage monitor windows and apply opacity settings. ----- > manageHook = myManageHook <+> manageMonitor clock+-- > manageHook = myManageHook <> manageMonitor clock -- -- Apply layout modifier. --
XMonad/Layout/Mosaic.hs view
@@ -111,7 +111,7 @@ nextIx (ov,ix,mix) | mix <= 0 || ov = fromIntegral $ nls `div` 2 | otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix- rect = rects !! maybe (nls `div` 2) round (nextIx <$> state)+ rect = rects !! maybe (nls `div` 2) (round . nextIx) state state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state `mplus` Just (True,fromIntegral nls / 2,pred nls) ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt@@ -190,14 +190,13 @@ fmap f (Branch l r) = Branch (fmap f l) (fmap f r) fmap _ Empty = Empty +instance Semigroup (Tree a) where+ Empty <> x = x+ x <> Empty = x+ x <> y = Branch x y+ instance Monoid (Tree a) where mempty = Empty- mappend Empty x = x- mappend x Empty = x- mappend x y = Branch x y--instance Semigroup (Tree a) where- (<>) = mappend makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree _ [] = Empty
XMonad/Layout/MouseResizableTile.hs view
@@ -35,6 +35,7 @@ ) 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@@ -146,7 +147,7 @@ (rightFracs st ++ repeat (slaveFrac st)) sr' num drg rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects mapM_ deleteDragger $ draggers st- (draggerWrs, newDraggers) <- unzip <$> mapM+ (draggerWrs, newDraggers) <- mapAndUnzipM (createDragger sr . adjustForMirror (isMirrored st)) preparedDraggers return (draggerWrs ++ zip wins rects', Just $ st { draggers = newDraggers,
XMonad/Layout/OnHost.hs view
@@ -47,7 +47,7 @@ -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText--- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a+-- def ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. -- -- In another scenario, suppose you wanted to have layouts A, B, and C
XMonad/Layout/PerWorkspace.hs view
@@ -42,7 +42,7 @@ -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText--- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a+-- def ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. (In fact, @m1@ can be any -- function @(LayoutClass l a, LayoutClass l' a) => l a -> l' a@.) --
XMonad/Layout/Renamed.hs view
@@ -71,7 +71,7 @@ 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+apply (Chain rs) s = ($ s) $ foldr (flip (.) . apply) id rs instance LayoutModifier Rename a where modifyDescription r l = apply r (description l)
XMonad/Layout/ResizeScreen.hs view
@@ -71,7 +71,7 @@ | 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 nr = runLayout ws nr+ where resize = runLayout ws pureMess (ResizeScreen d _) m | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t)
XMonad/Layout/ShowWName.hs view
@@ -77,7 +77,7 @@ } instance LayoutModifier ShowWName a where- redoLayout sn r _ wrs = doShow sn r wrs+ redoLayout sn r _ = doShow sn r handleMess (SWN _ c (Just (i,w))) m | Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)
+ XMonad/Layout/SideBorderDecoration.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+--------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.SideBorderDecoration+-- Description : Configure the border position around windows.+-- Copyright : (c) 2018 L. S. Leary+-- 2022 Tony Zorman+-- License : BSD3+-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org>+--+-- This module allows for having a configurable border position around+-- windows; i.e., it can move the border to any cardinal direction.+--+--------------------------------------------------------------------+module XMonad.Layout.SideBorderDecoration (+ -- * Usage+ -- $usage+ sideBorder,++ -- * Border configuration+ SideBorderConfig (..),+ def,++ -- * Re-exports+ Direction2D (..),++ -- * Lower-level hooks+ sideBorderLayout,+) where++import qualified XMonad.StackSet as W++import XMonad+import XMonad.Layout.Decoration+import XMonad.StackSet (Stack)+import XMonad.Util.Types++{- $usage++To use this module, first import it into your configuration file:++> import XMonad.Layout.SideBorderDecoration++You can now add the 'sideBorder' combinator to your configuration:++> main :: IO ()+> main = xmonad+> $ …+> $ sideBorder mySideBorderConfig+> $ def { … }+> where+> mySideBorderConfig :: SideBorderConfig+> mySideBorderConfig = def+> { sbSide = D+> , sbActiveColor = "#ff0000"+> , sbInactiveColor = "#ffaaaa"+> , sbSize = 5+> }++or, alternatively,++> main :: IO ()+> main = xmonad+> $ …+> $ sideBorder def{ sbSide = D, sbActiveColor = "#ff000", … }+> $ def { … }++See 'SideBorderConfig' for the different size and colour options.++The following is a fully-functional, minimal configuration example:++> import XMonad+> import XMonad.Layout.SideBorderDecoration+>+> main :: IO ()+> main = xmonad $ sideBorder def $ def++This would result in the following border being displayed:++<<https://user-images.githubusercontent.com/50166980/184537672-136f85a3-dfe7-42e2-b4c8-356d934d1bff.png>>++-}++-----------------------------------------------------------------------+-- Configuration++-- | Configuring how the border looks like.+data SideBorderConfig = SideBorderConfig+ { sbSide :: !Direction2D -- ^ Which side to have the border on.+ , sbActiveColor :: !String -- ^ Active border colour.+ , sbInactiveColor :: !String -- ^ Inactive border colour.+ , sbSize :: !Dimension+ -- ^ Size of the border. This will be the height if 'sbSide' is 'U'+ -- or 'D' and the width if it is 'L' or 'R'.+ }++instance Default SideBorderConfig where+ def :: SideBorderConfig+ def = SideBorderConfig+ { sbSide = D+ , sbActiveColor = "#ff0000"+ , sbInactiveColor = "#ffaaaa"+ , sbSize = 5+ }++-----------------------------------------------------------------------+-- User-facing++-- | Move the default XMonad border to any of the four cardinal+-- directions.+--+-- Note that this function should only be applied once to your+-- configuration and should /not/ be combined with 'sideBorderLayout'.+sideBorder :: SideBorderConfig -> XConfig l -> XConfig (SideBorder l)+sideBorder sbc cfg =+ cfg{ layoutHook = sideBorderLayout sbc (layoutHook cfg)+ , borderWidth = 0+ }++-- | Layout hook to only enable the side border for some layouts. For+-- example:+--+-- > myLayout = Full ||| sideBorderLayout def tall ||| somethingElse+--+-- Note that, unlike 'sideBorder', this does /not/ disable the normal+-- border in XMonad, you will have to do this yourself. Remove this+-- function from your layout hook and use 'sideBorder' if you want a+-- side border in every layout (do not use the two functions together).+sideBorderLayout :: Eq a => SideBorderConfig -> l a -> SideBorder l a+sideBorderLayout SideBorderConfig{ sbSide, sbActiveColor, sbInactiveColor, sbSize } =+ decoration BorderShrinker theme (SideBorderDecoration sbSide)+ where+ theme :: Theme+ theme = deco+ { activeColor = sbActiveColor+ , inactiveColor = sbInactiveColor+ }+ where+ deco | sbSide `elem` [U, D] = def{ decoHeight = sbSize }+ | otherwise = def{ decoWidth = sbSize }++-----------------------------------------------------------------------+-- Decoration++newtype SideBorderDecoration a = SideBorderDecoration Direction2D+ deriving (Show, Read)++type SideBorder = ModifiedLayout (Decoration SideBorderDecoration BorderShrinker)++instance Eq a => DecorationStyle SideBorderDecoration a where+ shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle+ shrink dec (Rectangle _ _ dw dh) (Rectangle x y w h) = case dec of+ SideBorderDecoration U -> Rectangle x (y + fi dh) w (h - dh)+ SideBorderDecoration R -> Rectangle x y (w - dw) h+ SideBorderDecoration D -> Rectangle x y w (h - dh)+ SideBorderDecoration L -> Rectangle (x + fi dw) y (w - dw) h++ pureDecoration+ :: SideBorderDecoration a+ -> Dimension -> Dimension+ -> Rectangle+ -> Stack a+ -> [(a, Rectangle)]+ -> (a, Rectangle)+ -> Maybe Rectangle+ pureDecoration dec dw dh _ st _ (win, Rectangle x y w h)+ | win `elem` W.integrate st && dw < w && dh < h = Just $ case dec of+ SideBorderDecoration U -> Rectangle x y w dh+ SideBorderDecoration R -> Rectangle (x + fi (w - dw)) y dw h+ SideBorderDecoration D -> Rectangle x (y + fi (h - dh)) w dh+ SideBorderDecoration L -> Rectangle x y dw h+ | otherwise = Nothing++-----------------------------------------------------------------------+-- Shrinker++-- | Kill all text.+data BorderShrinker = BorderShrinker++instance Show BorderShrinker where+ show :: BorderShrinker -> String+ show _ = ""++instance Read BorderShrinker where+ readsPrec :: Int -> ReadS BorderShrinker+ readsPrec _ s = [(BorderShrinker, s)]++instance Shrinker BorderShrinker where+ shrinkIt :: BorderShrinker -> String -> [String]+ shrinkIt _ _ = [""]
XMonad/Layout/SimpleDecoration.hs view
@@ -53,7 +53,7 @@ -- -- and ----- > myL = dwmStyle shrinkText mySDConfig (layoutHook def)+-- > myL = simpleDeco shrinkText mySDConfig (layoutHook def) -- | Add simple decorations to windows of a layout. simpleDeco :: (Eq a, Shrinker s) => s -> Theme
XMonad/Layout/Spacing.hs view
@@ -96,6 +96,10 @@ -- 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@@ -330,8 +334,7 @@ let bl = [t,b,r,l] o = maximum bl o' = max i $ negate o- [t',b',r',l'] = map (+o') bl- in Border t' b' r' l'+ in Border (t + o') (b + o') (r + o') (l + o') -- | Interface to 'XMonad.Util.Rectangle.withBorder'. withBorder' :: Border -> Integer -> Rectangle -> Rectangle
XMonad/Layout/SubLayouts.hs view
@@ -1,4 +1,11 @@-{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ParallelListComp #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SubLayouts@@ -211,7 +218,7 @@ ] where -- should these go into XMonad.StackSet?- focusMaster' st = let (f:fs) = W.integrate st+ focusMaster' st = let (notEmpty -> f :| fs) = W.integrate st in W.Stack f [] fs swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d @@ -298,7 +305,7 @@ toSubl :: (Message a) => a -> X () toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m)) -instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where+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@@ -390,7 +397,7 @@ in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs - | otherwise = join <$> sequenceA (catchLayoutMess <$> fromMessage m)+ | otherwise = join <$> traverse catchLayoutMess (fromMessage m) where gs = toGroups sls fgs gs' = do st <- currentStack@@ -398,10 +405,8 @@ findGroup z = mplus (M.lookup z gs) $ listToMaybe $ M.elems $ M.filter ((z `elem`) . W.integrate) gs- -- catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))- -- This l must be the same as from the instance head,- -- -XScopedTypeVariables should bring it into scope, but we are- -- trying to avoid warnings with ghc-6.8.2 and avoid CPP++ catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window)) catchLayoutMess x = do let m' = x `asTypeOf` (undefined :: LayoutMessages) ms' <- zip (repeat $ SomeMessage m') . W.integrate'@@ -417,7 +422,7 @@ updateGroup Nothing _ = mempty updateGroup (Just st) gs = fromGroupStack (toGroupStack gs st) --- | rearrange the windowset to put the groups of tabs next to eachother, so+-- | rearrange the windowset to put the groups of tabs next to each other, so -- that the stack of tabs stays put. updateWs :: Groups Window -> X () updateWs = windowsMaybe . updateWs'@@ -442,9 +447,14 @@ -- | 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 (let Just f' = lu f in f') (mapMaybe lu ls) (mapMaybe lu 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
XMonad/Layout/TallMastersCombo.hs view
@@ -317,19 +317,10 @@ -- | Swap a given window with the focused window. swapWindow :: (Eq a) => a -> Stack a -> Stack a-swapWindow w s =- let upLst = up s- foc = focus s- downLst = down s- in if w `elem` downLst- then let us = takeWhile (/= w) downLst- d:ds = dropWhile (/= w) downLst- us' = reverse us ++ d : upLst- in Stack foc us' ds- else let ds = takeWhile (/= w) upLst- u:us = dropWhile (/= w) upLst- ds' = reverse ds ++ u : downLst- in Stack foc us ds'+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.
XMonad/Layout/ThreeColumns.hs view
@@ -46,10 +46,10 @@ -- resizing and the third argument specifies the initial size of the columns. -- A positive size designates the fraction of the screen that the main window -- should occupy, but if the size is negative the absolute value designates the--- fraction a slave column should occupy. If both slave columns are visible,+-- fraction a stack column should occupy. If both stack columns are visible, -- they always occupy the same amount of space. ----- The ThreeColMid variant places the main window between the slave columns.+-- The ThreeColMid variant places the main window between the stack columns. -- -- For more detailed instructions on editing the layoutHook see: --@@ -57,7 +57,7 @@ -- $screenshot--- <<http://server.c-otto.de/xmonad/ThreeColumnsMiddle.png>>+-- <<https://user-images.githubusercontent.com/50166980/156938482-ac38fdd7-eb94-4371-801b-e191cdb9a4ba.png>> -- | Arguments are nmaster, delta, fraction data ThreeCol a = ThreeColMid { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational}
XMonad/Layout/VoidBorders.hs view
@@ -13,19 +13,21 @@ -- Portability : unportable -- -- Modifies a layout to set borders to 0 for all windows in the workspace.--- Unlike XMonad.Layout.NoBorders, this modifier will not restore the window--- border if the windows are moved to a different workspace or the layout is--- changed. --+-- 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 `noBorders` modifier. It won't return--- the borders to their original width, however.+-- while switching workspaces with the "XMonad.Layout.NoBorders" modifier. -- ----------------------------------------------------------------------------- module XMonad.Layout.VoidBorders ( -- * Usage -- $usage voidBorders+ , normalBorders ) where import XMonad@@ -39,9 +41,10 @@ -- > import XMonad.Layout.VoidBorders -- -- and modify the layouts to call 'voidBorders' on the layouts you want to--- remove borders from windows:+-- remove borders from windows, and 'normalBorders' on the layouts you want+-- to keep borders for: ----- > layoutHook = ... ||| voidBorders Full ||| ...+-- > layoutHook = ... ||| voidBorders Full ||| normalBorders Tall ... -- -- For more detailed instructions on editing the layoutHook see: --@@ -49,9 +52,6 @@ data VoidBorders a = VoidBorders deriving (Read, Show) -voidBorders :: l Window -> ModifiedLayout VoidBorders l Window-voidBorders = ModifiedLayout VoidBorders- instance LayoutModifier VoidBorders Window where modifierDescription = const "VoidBorders" @@ -60,6 +60,29 @@ 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 = withDisplay $ \d -> io $ setWindowBorderWidth d w 0+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
@@ -20,9 +20,9 @@ -- $usage windowNavigation, configurableNavigation, Navigate(..), Direction2D(..),- MoveWindowToWindow(..),+ MoveWindowToWindow(..), WNConfig, navigateColor, navigateBrightness,- noNavigateBorders, def, WNConfig,+ noNavigateBorders, def, WindowNavigation, ) where @@ -39,13 +39,13 @@ -- -- > import XMonad.Layout.WindowNavigation ----- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier+-- Then edit your 'layoutHook' by adding the WindowNavigation layout modifier -- to some layout: ----- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc..+-- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } ----- For more detailed instructions on editing the layoutHook see:+-- For more detailed instructions on editing the 'layoutHook' see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" --@@ -72,6 +72,14 @@ | 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@@ -80,14 +88,18 @@ , 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 }
XMonad/Layout/WindowSwitcherDecoration.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowSwitcherDecoration@@ -84,7 +84,7 @@ decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons then titleBarButtonHandler mainw dFL dFR else return False- decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+ decorationWhileDraggingHook _ = handleTiledDraggingInProgress decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage DraggingStopped@@ -105,7 +105,7 @@ decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons then imageTitleBarButtonHandler mainw dFL dFR else return False- decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+ decorationWhileDraggingHook _ = handleTiledDraggingInProgress decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage DraggingStopped@@ -129,7 +129,7 @@ -- 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, t:rs) = break (win ==) allWindowsSwitched+ let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched let newStack = S.Stack t (reverse ls) rs windows $ S.modify' $ const newStack where
XMonad/Prelude.hs view
@@ -1,12 +1,14 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Prelude -- Description : Utility functions and re-exports.--- Copyright : slotThe <soliditsallgood@mailbox.org>+-- Copyright : (c) 2021 Tony Zorman -- License : BSD3-style (see LICENSE) ----- Maintainer : slotThe <soliditsallgood@mailbox.org>+-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org> -- -- Utility functions and re-exports for a more ergonomic developing -- experience. Users themselves will not find much use here.@@ -18,8 +20,26 @@ chunksOf, (.:), (!?),+ NonEmpty((:|)),+ notEmpty,+ safeGetWindowAttributes,+ mkAbsolutePath,++ -- * Keys+ keyToString,+ keymaskToString,+ cleanKeyMask,+ regularKeys,+ allSpecialKeys,+ specialKeys,+ multimediaKeys,+ functionKeys,+ WindowScreen, ) where +import Foreign (alloca, peek)+import XMonad+ import Control.Applicative as Exports import Control.Monad as Exports import Data.Bool as Exports@@ -32,6 +52,19 @@ import Data.Monoid as Exports import Data.Traversable as Exports +import qualified Data.Map.Strict as Map++import Control.Arrow ((&&&), first)+import Data.Bifunctor (bimap)+import Data.Bits+import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Tuple (swap)+import GHC.Stack+import System.Directory (getHomeDirectory)+import System.Environment (getEnv)+import Control.Exception (SomeException, handle)+import qualified XMonad.StackSet as W+ -- | Short for 'fromIntegral'. fi :: (Integral a, Num b) => a -> b fi = fromIntegral@@ -50,8 +83,369 @@ (!?) xs n | n < 0 = Nothing | otherwise = listToMaybe $ drop n xs --- | Multivariant composition.+-- | Multivariable composition. -- -- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d) (.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b (.:) = (.) . (.)++-- | '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.Extras.getWindowAttributes'.+safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes)+safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->+ xGetWindowAttributes dpy w p >>= \case+ 0 -> pure Nothing+ _ -> Just <$> peek p++-- | (Naïvely) turn a relative path into an absolute one.+--+-- * If the path starts with @\/@, do nothing.+--+-- * If it starts with @~\/@, replace that with the actual home+-- * directory.+--+-- * If it starts with @$@, read the name of an environment+-- * variable and replace it with the contents of that.+--+-- * Otherwise, prepend the home directory and @\/@ to the path.+mkAbsolutePath :: MonadIO m => FilePath -> m FilePath+mkAbsolutePath ps = do+ home <- io getHomeDirectory+ case ps of+ '/' : _ -> pure ps+ '~' : '/' : _ -> pure (home <> drop 1 ps)+ '$' : _ -> let (v,ps') = span (`elem` ("_"<>['A'..'Z']<>['a'..'z']<>['0'..'9'])) (drop 1 ps)+ in io ((\(_ :: SomeException) -> pure "") `handle` getEnv v) Exports.<&> (<> ps')+ _ -> pure (home <> ('/' : ps))+{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}+{-# SPECIALISE mkAbsolutePath :: FilePath -> X FilePath #-}++-----------------------------------------------------------------------+-- Keys++-- | Convert a modifier mask into a useful string.+keymaskToString :: KeyMask -- ^ Num lock mask+ -> KeyMask -- ^ Modifier mask+ -> String+keymaskToString numLockMask msk =+ concat . reverse . fst . foldr go ([], msk) $ masks+ where+ masks :: [(KeyMask, String)]+ masks = map (\m -> (m, show m))+ [0 .. toEnum (finiteBitSize msk - 1)]+ ++ [ (numLockMask, "num-" )+ , (lockMask, "lock-")+ , (controlMask, "C-" )+ , (shiftMask, "S-" )+ , (mod5Mask, "M5-" )+ , (mod4Mask, "M4-" )+ , (mod3Mask, "M3-" )+ , (mod2Mask, "M2-" )+ , (mod1Mask, "M1-" )+ ]++ go :: (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)+ go (m, s) a@(ss, v)+ | v == 0 = a+ | v .&. m == m = (s : ss, v .&. complement m)+ | otherwise = a++-- | Convert a full key combination; i.e., a 'KeyMask' and 'KeySym'+-- pair, into a string.+keyToString :: (KeyMask, KeySym) -> String+keyToString = uncurry (++) . bimap (keymaskToString 0) ppKeysym+ where+ ppKeysym :: KeySym -> String+ ppKeysym x = case specialMap Map.!? x of+ Just s -> "<" <> s <> ">"+ Nothing -> case regularMap Map.!? x of+ Nothing -> keysymToString x+ Just s -> s++ regularMap = Map.fromList (map swap regularKeys)+ specialMap = Map.fromList (map swap allSpecialKeys)++-- | Strip numlock, capslock, mouse buttons and XKB group from a 'KeyMask',+-- leaving only modifier keys like Shift, Control, Super, Hyper in the mask+-- (hence the \"Key\" in \"cleanKeyMask\").+--+-- Core's 'cleanMask' only strips the first two because key events from+-- passive grabs (key bindings) are stripped of mouse buttons and XKB group by+-- the X server already for compatibility reasons. For more info, see:+-- <https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.html#Delivering_a_Key_or_Button_Event_to_a_Client>+cleanKeyMask :: X (KeyMask -> KeyMask)+cleanKeyMask = cleanKeyMask' <$> gets numberlockMask++cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask+cleanKeyMask' numLockMask mask =+ mask .&. complement (numLockMask .|. lockMask) .&. (button1Mask - 1)++-- | A list of "regular" (extended ASCII) keys.+regularKeys :: [(String, KeySym)]+regularKeys = map (first (:[]))+ $ zip ['!' .. '~' ] -- ASCII+ [xK_exclam .. xK_asciitilde]+ <> zip ['\xa0' .. '\xff' ] -- Latin1+ [xK_nobreakspace .. xK_ydiaeresis]++-- | A list of all special key names and their associated KeySyms.+allSpecialKeys :: [(String, KeySym)]+allSpecialKeys = functionKeys <> specialKeys <> multimediaKeys++-- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@)+-- with the associated KeySyms.+functionKeys :: [(String, KeySym)]+functionKeys = [ ('F' : show n, k)+ | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..]+ ]++-- | A list of special key names and their corresponding KeySyms.+specialKeys :: [(String, KeySym)]+specialKeys =+ [ ("Backspace" , xK_BackSpace)+ , ("Tab" , xK_Tab)+ , ("Return" , xK_Return)+ , ("Pause" , xK_Pause)+ , ("Num_Lock" , xK_Num_Lock)+ , ("Caps_Lock" , xK_Caps_Lock)+ , ("Scroll_lock", xK_Scroll_Lock)+ , ("Sys_Req" , xK_Sys_Req)+ , ("Print" , xK_Print)+ , ("Escape" , xK_Escape)+ , ("Esc" , xK_Escape)+ , ("Delete" , xK_Delete)+ , ("Home" , xK_Home)+ , ("Left" , xK_Left)+ , ("Up" , xK_Up)+ , ("Right" , xK_Right)+ , ("Down" , xK_Down)+ , ("L" , xK_Left)+ , ("U" , xK_Up)+ , ("R" , xK_Right)+ , ("D" , xK_Down)+ , ("Page_Up" , xK_Page_Up)+ , ("Page_Down" , xK_Page_Down)+ , ("End" , xK_End)+ , ("Insert" , xK_Insert)+ , ("Break" , xK_Break)+ , ("Space" , xK_space)+ , ("Control_L" , xK_Control_L)+ , ("Control_R" , xK_Control_R)+ , ("Shift_L" , xK_Shift_L)+ , ("Shift_R" , xK_Shift_R)+ , ("Alt_L" , xK_Alt_L)+ , ("Alt_R" , xK_Alt_R)+ , ("Meta_L" , xK_Meta_L)+ , ("Meta_R" , xK_Meta_R)+ , ("Super_L" , xK_Super_L)+ , ("Super_R" , xK_Super_R)+ , ("Hyper_L" , xK_Hyper_L)+ , ("Hyper_R" , xK_Hyper_R)+ , ("KP_Space" , xK_KP_Space)+ , ("KP_Tab" , xK_KP_Tab)+ , ("KP_Enter" , xK_KP_Enter)+ , ("KP_F1" , xK_KP_F1)+ , ("KP_F2" , xK_KP_F2)+ , ("KP_F3" , xK_KP_F3)+ , ("KP_F4" , xK_KP_F4)+ , ("KP_Home" , xK_KP_Home)+ , ("KP_Left" , xK_KP_Left)+ , ("KP_Up" , xK_KP_Up)+ , ("KP_Right" , xK_KP_Right)+ , ("KP_Down" , xK_KP_Down)+ , ("KP_Prior" , xK_KP_Prior)+ , ("KP_Page_Up" , xK_KP_Page_Up)+ , ("KP_Next" , xK_KP_Next)+ , ("KP_Page_Down", xK_KP_Page_Down)+ , ("KP_End" , xK_KP_End)+ , ("KP_Begin" , xK_KP_Begin)+ , ("KP_Insert" , xK_KP_Insert)+ , ("KP_Delete" , xK_KP_Delete)+ , ("KP_Equal" , xK_KP_Equal)+ , ("KP_Multiply", xK_KP_Multiply)+ , ("KP_Add" , xK_KP_Add)+ , ("KP_Separator", xK_KP_Separator)+ , ("KP_Subtract", xK_KP_Subtract)+ , ("KP_Decimal" , xK_KP_Decimal)+ , ("KP_Divide" , xK_KP_Divide)+ , ("KP_0" , xK_KP_0)+ , ("KP_1" , xK_KP_1)+ , ("KP_2" , xK_KP_2)+ , ("KP_3" , xK_KP_3)+ , ("KP_4" , xK_KP_4)+ , ("KP_5" , xK_KP_5)+ , ("KP_6" , xK_KP_6)+ , ("KP_7" , xK_KP_7)+ , ("KP_8" , xK_KP_8)+ , ("KP_9" , xK_KP_9)+ ]++-- | 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
XMonad/Prompt.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt@@ -98,7 +99,6 @@ import XMonad hiding (cleanMask, config) import XMonad.Prelude hiding (toList)-import qualified XMonad as X (numberlockMask) import qualified XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.Types@@ -149,7 +149,7 @@ , offset :: !Int , config :: XPConfig , successful :: Bool- , numlockMask :: KeyMask+ , cleanMask :: KeyMask -> KeyMask , done :: Bool , modeDone :: Bool , color :: XPColor@@ -270,7 +270,7 @@ -- The argument passed to this function is given by `commandToComplete` -- The default implementation shows an error message. completionFunction :: t -> ComplFunction- completionFunction t = \_ -> return ["Completions for " ++ showXPrompt t ++ " could not be loaded"]+ completionFunction t = 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.@@ -356,9 +356,9 @@ } initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode- -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> Dimension- -> XPState-initState d rw w s opMode gc fonts h c nm width =+ -> 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@@ -381,7 +381,7 @@ , successful = False , done = False , modeDone = False- , numlockMask = nm+ , cleanMask = cm , prompter = defaultPrompter c , color = defaultColor c , eventBuffer = []@@ -554,7 +554,7 @@ mkXPromptImplementation historyKey conf om = do XConf { display = d, theRoot = rw } <- ask s <- gets $ screenRect . W.screenDetail . W.current . windowset- numlock <- gets X.numberlockMask+ cleanMask <- cleanKeyMask cachedir <- asks (cacheDir . directories) hist <- io $ readHistory cachedir fs <- initXMF (font conf)@@ -571,7 +571,7 @@ selectInput d w $ exposureMask .|. keyPressMask setGraphicsExposures d gc False let hs = fromMaybe [] $ M.lookup historyKey hist- st = initState d rw w s om gc fs hs conf numlock width+ st = initState d rw w s om gc fs hs conf cleanMask width runXP st)) releaseXMF fs when (successful st') $ do@@ -594,15 +594,6 @@ CenteredAt{ xpWidth } -> floor $ fi (rect_width scr) * xpWidth _ -> rect_width scr --- | Removes numlock and capslock from a keymask.--- Duplicate of cleanMask from core, but in the--- XP monad instead of X.-cleanMask :: KeyMask -> XP KeyMask-cleanMask msk = do- numlock <- gets numlockMask- let highMasks = 1 `shiftL` 12 - 1- return (complement (numlock .|. lockMask) .&. msk .&. highMasks)- -- | 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.@@ -646,10 +637,11 @@ -- Also capture @buttonPressMask@, see Note [Allow ButtonEvents] maskEvent d (exposureMask .|. keyPressMask .|. buttonPressMask) e ev <- getEvent e- (ks,s) <- if ev_event_type ev == keyPress- then lookupString $ asKeyEvent e- else return (Nothing, "")- return (fromMaybe xK_VoidSymbol ks,s,ev)+ 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 -> do modify $ \s -> s { eventBuffer = tail l } return $ head l@@ -698,7 +690,7 @@ handleMain :: KeyStroke -> Event -> XP () handleMain stroke@(keysym,_) KeyEvent{ev_event_type = t, ev_state = m} = do (compKey,modeKey) <- gets $ (completionKey &&& changeModeKey) . config- keymask <- cleanMask m+ keymask <- gets cleanMask <*> pure m -- haven't subscribed to keyRelease, so just in case when (t == keyPress) $ if (keymask,keysym) == compKey@@ -747,7 +739,7 @@ alwaysHlight <- gets $ alwaysHighlight . config st <- get - let updateWins l = redrawWindows (pure ()) l+ let updateWins = redrawWindows (pure ()) updateState l = if alwaysHlight then hlComplete (getLastWord $ command st) l st else simpleComplete l st@@ -830,7 +822,7 @@ -> Event -> XP () handleSubmap defaultAction keymap stroke KeyEvent{ev_event_type = t, ev_state = m} = do- keymask <- cleanMask m+ keymask <- gets cleanMask <*> pure m when (t == keyPress) $ handleInputSubmap defaultAction keymap keymask stroke handleSubmap _ _ stroke event = handleOther stroke event @@ -887,7 +879,7 @@ -> Event -> XP () handleBuffer f stroke event@KeyEvent{ev_event_type = t, ev_state = m} = do- keymask <- cleanMask m+ keymask <- gets cleanMask <*> pure m when (t == keyPress) $ handleInputBuffer f keymask stroke event handleBuffer _ stroke event = handleOther stroke event @@ -1016,6 +1008,7 @@ , (xK_y, pasteString) , (xK_g, quit) , (xK_bracketleft, quit)+ , (xK_t, transposeChars) ] ++ map (first $ (,) mod1Mask) -- meta key + <key> [ (xK_BackSpace, killWord' p Prev)@@ -1226,6 +1219,23 @@ 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 ()
XMonad/Prompt/AppendFile.hs view
@@ -30,6 +30,7 @@ import XMonad.Core import XMonad.Prompt+import XMonad.Prelude (mkAbsolutePath) import System.IO @@ -91,4 +92,4 @@ -- | Append a string to a file. doAppend :: (String -> String) -> FilePath -> String -> X ()-doAppend trans fn = io . withFile fn AppendMode . flip hPutStrLn . trans+doAppend trans fn s = mkAbsolutePath fn >>= \f -> (io . withFile f AppendMode . flip hPutStrLn . trans) s
XMonad/Prompt/FuzzyMatch.hs view
@@ -20,6 +20,7 @@ ) where import XMonad.Prelude+import qualified Data.List.NonEmpty as NE -- $usage --@@ -67,10 +68,7 @@ -- | Returns True if the first argument is a subsequence of the second argument, -- that is, it can be obtained from the second sequence by deleting elements. fuzzyMatch :: String -> String -> Bool-fuzzyMatch [] _ = True-fuzzyMatch _ [] = False-fuzzyMatch xxs@(x:xs) (y:ys) | toLower x == toLower y = fuzzyMatch xs ys- | otherwise = fuzzyMatch xxs ys+fuzzyMatch a b = isSubsequenceOf (map toLower a) (map toLower b) -- | Sort the given set of strings by how well they match. Match quality is -- measured first by the length of the substring containing the match and second@@ -84,12 +82,12 @@ rankMatches :: String -> String -> [(Int, Int)] rankMatches [] _ = [(0, 0)]-rankMatches q s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s+rankMatches (q:qs) s = map (\(l, r) -> (r - l, l)) $ findShortestMatches (q :| qs) s -findShortestMatches :: String -> String -> [(Int, Int)]+findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)] findShortestMatches q s = foldl' extendMatches spans oss- where (os:oss) = map (findOccurrences s) q- spans = [(o, o) | o <- os]+ where (os :| oss) = NE.map (findOccurrences s) q+ spans = [(o, o) | o <- os] findOccurrences :: String -> Char -> [Int] findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]
XMonad/Prompt/Man.hs view
@@ -32,8 +32,9 @@ import XMonad.Prompt.Shell (split) import System.Directory-import System.Process+import System.FilePath (dropExtensions, (</>)) import System.IO+import System.Process import qualified Control.Exception as E @@ -70,12 +71,11 @@ p2 <- getout "manpath 2>/dev/null" return $ intercalate ":" $ lines $ p1 ++ p2 let sects = ["man" ++ show n | n <- [1..9 :: Int]]- dirs = [d ++ "/" ++ s | d <- split ':' paths, s <- sects]+ dirs = [d </> s | d <- split ':' paths, s <- sects] mans <- forM (nub dirs) $ \d -> do exists <- doesDirectoryExist d if exists- then map (stripExt . stripSuffixes [".gz", ".bz2"]) <$>- getDirectoryContents d+ then map dropExtensions <$> getDirectoryContents d else return [] return $ uniqSort $ concat mans @@ -101,15 +101,3 @@ E.evaluate (length output) hClose perr return output--stripExt :: String -> String-stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse--stripSuffixes :: Eq a => [[a]] -> [a] -> [a]-stripSuffixes sufs fn =- head . catMaybes $ map (`rstrip` fn) sufs ++ [Just fn]--rstrip :: Eq a => [a] -> [a] -> Maybe [a]-rstrip suf lst- | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst- | otherwise = Nothing
XMonad/Prompt/OrgMode.hs view
@@ -2,16 +2,17 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE StrictData #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.OrgMode -- Description : A prompt for interacting with org-mode.--- Copyright : (c) 2021 slotThe <soliditsallgood@mailbox.org>+-- Copyright : (c) 2021 Tony Zorman -- License : BSD3-style (see LICENSE) ----- Maintainer : slotThe <soliditsallgood@mailbox.org>+-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org> -- Stability : experimental -- Portability : unknown --@@ -20,11 +21,14 @@ -- "XMonad.Prompt.AppendFile", allowing for more interesting -- interactions with that particular file type. ----- It can be used to quickly save TODOs, NOTEs, and the like with--- the additional capability to schedule/deadline a task, or use--- the system's clipboard (really: the primary selection) as the+-- It can be used to quickly save TODOs, NOTEs, and the like with the+-- additional capability to schedule/deadline a task, add a priority,+-- and use the system's clipboard (really: the primary selection) as the -- contents of the note. --+-- A blog post highlighting some features of this module can be found+-- <https://tony-zorman.com/posts/orgmode-prompt/2022-08-27-xmonad-and-org-mode.html here>.+-- -------------------------------------------------------------------- module XMonad.Prompt.OrgMode ( -- * Usage@@ -41,6 +45,7 @@ #ifdef TESTING pInput, Note (..),+ Priority (..), Date (..), Time (..), TimeOfDay (..),@@ -53,12 +58,11 @@ import XMonad (X, io) import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt)+import XMonad.Util.Parser import XMonad.Util.XSelection (getSelection) import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian)-import System.Directory (getHomeDirectory) import System.IO (IOMode (AppendMode), hPutStrLn, withFile)-import Text.ParserCombinators.ReadP (ReadP, munch, munch1, readP_to_S, skipSpaces, string, (<++)) {- $usage @@ -133,6 +137,14 @@ 13@ resolve to—the 11th of january at 13:00 or the 11th of january in the year 13? +There is basic support for alphabetic org-mode+<https:\/\/orgmode.org\/manual\/Priorities.html priorities>.+Simply append either @#A@, @#B@, or @#C@ (capitalisation is optional) to+the end of the note. For example, one could write @"hello +s 11 jan+2013 #A"@ or @"hello #C"@. Note that there has to be at least one+whitespace character between the end of the note and the chosen+priority.+ There's also the possibility to take what's currently in the primary selection and paste that as the content of the created note. This is especially useful when you want to quickly save a URL for later and@@ -217,10 +229,7 @@ else Body $ "\n " <> sel -- Expand path if applicable- fp <- case orgFile of- '/' : _ -> pure orgFile- '~' : '/' : _ -> getHomeDirectory <&> (<> drop 1 orgFile)- _ -> getHomeDirectory <&> (<> ('/' : orgFile))+ fp <- mkAbsolutePath orgFile withFile fp AppendMode . flip hPutStrLn <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput@@ -331,122 +340,153 @@ -- | An @org-mode@ style note. data Note- = Scheduled String Time- | Deadline String Time- | NormalMsg String+ = 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 -> mkLine str "SCHEDULED: " (Just time)- Deadline str time -> mkLine str "DEADLINE: " (Just time)- NormalMsg str -> mkLine str "" Nothing+ 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 -> IO String- mkLine str sched time = do+ 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 $ case clp of- Body c -> mconcat ["* ", todo, " ", str, t, c]- Header c -> mconcat ["* ", todo, " [[", c, "][", str,"]]", t]+ 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 <> "] " ------------------------------------------------------------------------ -- Parsing -- | Parse the given string into a 'Note'. pInput :: String -> Maybe Note-pInput inp = fmap fst . listToMaybe . (`readP_to_S` inp) . lchoice $- [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay)- , Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay)- , NormalMsg <$> munch1 (const True)+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- getLast :: String -> ReadP String- getLast ptn = reverse- . dropWhile (== ' ') -- trim whitespace at the end- . drop (length ptn) -- drop only the last pattern- . reverse+ 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 -> ReadP String+ go :: String -> Parser String go consumed = do str <- munch (/= head ptn) word <- munch1 (/= ' ') bool go pure (word == ptn) $ consumed <> str <> word +-- | Parse a 'Priority'.+pPriority :: Parser Priority+pPriority = pLast (pure NoPriority) $+ " " *> skipSpaces *> choice+ [ "#" *> ("A" <|> "a") $> A+ , "#" *> ("B" <|> "b") $> B+ , "#" *> ("C" <|> "c") $> C+ ]+ -- | Try to parse a 'Time'.-pTimeOfDay :: ReadP (Maybe TimeOfDay)-pTimeOfDay = lchoice- [ Just <$> (TimeOfDay <$> pInt <* string ":" <*> pInt ) -- HH:MM- , Just <$> (TimeOfDay <$> pInt <*> pure 0) -- HH- , pure Nothing- ]+pTimeOfDay :: Parser (Maybe TimeOfDay)+pTimeOfDay = pLast (pure Nothing) $+ skipSpaces *> choice+ [ Just <$> (TimeOfDay <$> pHour <* string ":" <*> pMinute) -- HH:MM+ , Just <$> (TimeOfDay <$> pHour <*> pure 0 ) -- HH+ ]+ where+ pMinute :: Parser Int = pNumBetween 1 60+ pHour :: Parser Int = pNumBetween 1 24 -- | Parse a 'Date'.-pDate :: ReadP Date-pDate = skipSpaces *> lchoice- [ pString "tod" "ay" Today- , pString "tom" "orrow" Tomorrow- , Next <$> pNext- , Date <$> pDate1 <++ pDate2 <++ pDate3- ] <* skipSpaces -- cleanup+pDate :: Parser Date+pDate = skipSpaces *> choice+ [ pPrefix "tod" "ay" Today+ , pPrefix "tom" "orrow" Tomorrow+ , Next <$> pNext+ , Date <$> pDate'+ ] where- pNext :: ReadP DayOfWeek = lchoice- [ pString "m" "onday" Monday , pString "tu" "esday" Tuesday- , pString "w" "ednesday" Wednesday, pString "th" "ursday" Thursday- , pString "f" "riday" Friday , pString "sa" "turday" Saturday- , pString "su" "nday" Sunday+ 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 ] - -- XXX: This is really horrible, but I can't see a way to not have- -- exponential blowup with ReadP otherwise.- pDate1, pDate2, pDate3 :: ReadP (Int, Maybe Int, Maybe Integer)- pDate1 = pDate' (fmap Just) (fmap Just)- pDate2 = pDate' (fmap Just) (const (pure Nothing))- pDate3 = pDate' (const (pure Nothing)) (const (pure Nothing))- pDate'- :: (ReadP Int -> ReadP (f Int ))- -> (ReadP Integer -> ReadP (f Integer))- -> ReadP (Int, f Int, f Integer)- pDate' p p' =- (,,) <$> pInt- <*> p (skipSpaces *> lchoice- [ pString "ja" "nuary" 1 , pString "f" "ebruary" 2- , pString "mar" "ch" 3 , pString "ap" "ril" 4- , pString "may" "" 5 , pString "jun" "e" 6- , pString "jul" "y" 7 , pString "au" "gust" 8- , pString "s" "eptember" 9 , pString "o" "ctober" 10- , pString "n" "ovember" 11, pString "d" "ecember" 12- ])- <*> p' (skipSpaces *> pInt >>= \i -> guard (i >= 25) $> i)+ numWithoutColon :: Parser Int+ numWithoutColon = do+ str <- pNumBetween 1 12 -- month+ c <- get+ if c == ':'+ then pfail+ else pure str --- | Parse a @start@ and see whether the rest of the word (separated by--- spaces) fits the @leftover@.-pString :: String -> String -> a -> ReadP a-pString start leftover ret = do- void $ string start- l <- munch (/= ' ')- guard (l `isPrefixOf` leftover)- pure ret+ 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 number.-pInt :: (Read a, Integral a) => ReadP a-pInt = read <$> munch1 isDigit+ -- | Parse a prefix and drop a potential suffix up to the next (space+ -- separated) word. If successful, return @ret@.+ pPrefix :: Parser String -> String -> a -> Parser a+ pPrefix start leftover ret = do+ void start+ l <- munch (/= ' ')+ guard (l `isPrefixOf` leftover)+ pure ret --- | Like 'choice', but with '(<++)' instead of '(+++)', stopping--- parsing when the left-most parser succeeds.-lchoice :: [ReadP a] -> ReadP a-lchoice = foldl' (<++) empty+-- | 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) --- | Like 'Text.ParserCombinators.ReadP.endBy1', but only return the--- parse where @parser@ had the highest number of applications.-endBy1 :: ReadP a -> ReadP sep -> ReadP [a]-endBy1 parser sep = many1 (parser <* sep)- where- -- | Like 'Text.ParserCombinators.ReadP.many1', but use '(<++)'- -- instead of '(+++)'.- many1 :: ReadP a -> ReadP [a]- many1 p = (:) <$> p <*> (many1 p <++ pure [])+-- | A flipped version of '(<|>)'. Useful when @p'@ is some complicated+-- expression that, for example, consumes spaces and @p@ does not want+-- to do that.+pLast :: Parser a -> Parser a -> Parser a+pLast p p' = p' <|> p
XMonad/Prompt/Pass.hs view
@@ -51,13 +51,18 @@ -- * Retrieving passwords passPrompt+ , passPrompt' , passTypePrompt -- * Editing passwords , passEditPrompt+ , passEditPrompt' , passRemovePrompt+ , passRemovePrompt' , passGeneratePrompt+ , passGeneratePrompt' , passGenerateAndCopyPrompt+ , passGenerateAndCopyPrompt' -- * Misc , passOTPPrompt@@ -90,6 +95,22 @@ -- > , ((modMask .|. shiftMask, xK_p) , passEditPrompt def) -- > , ((modMask .|. controlMask .|. shiftMask, xK_p), passRemovePrompt def) --+-- You can also use the versions that let you specify a custom prompt:+--+-- > , ((modMask , xK_p) , passPrompt' "Ask 'pass' for" def)+--+-- Note that, by default, we do not use fuzzy matching in this module.+-- To enable this feature, import the "XMonad.Prompt.FuzzyMatch" module+-- and add the relevant functions to your prompt configuration:+--+-- > myXPConfig :: XPConfig+-- > myXPConfig = def+-- > { searchPredicate = fuzzyMatch+-- > , sorter = fuzzySort+-- > }+-- >+-- > , ((modMask , xK_p), passPrompt myXPConfig)+-- -- For detailed instructions on: -- -- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".@@ -137,8 +158,12 @@ -- | A prompt to retrieve a password from a given entry. -- passPrompt :: XPConfig -> X ()-passPrompt = mkPassPrompt "Select password" selectPassword+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 <https://github.com/tadfisher/pass-otp pass-otp> -- extension for this to work.@@ -151,21 +176,33 @@ -- (Beware that no confirmation is asked) -- passGeneratePrompt :: XPConfig -> X ()-passGeneratePrompt = mkPassPrompt "Generate password" generatePassword+passGeneratePrompt = passGeneratePrompt' "Generate password" +-- | The same as 'passGeneratePrompt' but with a user-specified prompt.+passGeneratePrompt' :: String -> XPConfig -> X ()+passGeneratePrompt' s = mkPassPrompt s generatePassword+ -- | A prompt to generate a password for a given entry and immediately copy it -- to the clipboard. This can be used to override an already stored entry. -- (Beware that no confirmation is asked) -- passGenerateAndCopyPrompt :: XPConfig -> X ()-passGenerateAndCopyPrompt = mkPassPrompt "Generate and copy password" generateAndCopyPassword+passGenerateAndCopyPrompt = passGenerateAndCopyPrompt' "Generate and copy password" +-- | The same as 'passGenerateAndCopyPrompt' but with a user-specified prompt.+passGenerateAndCopyPrompt' :: String -> XPConfig -> X ()+passGenerateAndCopyPrompt' s = mkPassPrompt s generateAndCopyPassword+ -- | A prompt to remove a password for a given entry. -- (Beware that no confirmation is asked) -- passRemovePrompt :: XPConfig -> X ()-passRemovePrompt = mkPassPrompt "Remove password" removePassword+passRemovePrompt = passRemovePrompt' "Remove password" +-- | The same as 'passRemovePrompt' but with a user-specified prompt.+passRemovePrompt' :: String -> XPConfig -> X ()+passRemovePrompt' s = mkPassPrompt s removePassword+ -- | A prompt to type in a password for a given entry. -- This doesn't touch the clipboard. --@@ -176,8 +213,12 @@ -- This doesn't touch the clipboard. -- passEditPrompt :: XPConfig -> X ()-passEditPrompt = mkPassPrompt "Edit password" editPassword+passEditPrompt = passEditPrompt' "Edit password" +-- | The same as 'passEditPrompt' but with a user-specified prompt.+passEditPrompt' :: String -> XPConfig -> X ()+passEditPrompt' s = mkPassPrompt s editPassword+ -- | Select a password. -- selectPassword :: String -> X ()@@ -223,7 +264,7 @@ escape '"' = "\\\"" escape x = [x] --- | Retrieve the list of passwords from the password store 'passwordStoreDir+-- | Retrieve the list of passwords from the password store 'passwordStoreDir' -- getPasswords :: FilePath -> IO [String] getPasswords passwordStoreDir = do
XMonad/Prompt/Unicode.hs view
@@ -23,12 +23,12 @@ 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 Control.Arrow (second) import XMonad import XMonad.Prelude@@ -42,7 +42,7 @@ commandToComplete Unicode s = s nextCompletion Unicode = getNextCompletion -newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, BS.ByteString)] }+newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, String)] } deriving (Read, Show) instance ExtensionClass UnicodeData where@@ -79,23 +79,24 @@ hPutStrLn stderr "Do you have unicode-data installed?" return False Right dat -> do- XS.put . UnicodeData . sortOn (BS.length . snd) $ parseUnicodeData dat+ XS.put . UnicodeData . sortOn (length . snd) $ parseUnicodeData dat return True else return True -parseUnicodeData :: BS.ByteString -> [(Char, BS.ByteString)]+parseUnicodeData :: BS.ByteString -> [(Char, String)] parseUnicodeData = mapMaybe parseLine . BS.lines where parseLine l = do field1 : field2 : _ <- return $ BS.split ';' l [(c,"")] <- return . readHex $ BS.unpack field1- return (chr c, field2)+ desc <- return . decodeString $ BS.unpack field2+ return (chr c, desc) type Predicate = String -> String -> Bool -searchUnicode :: [(Char, BS.ByteString)] -> Predicate -> String -> [(Char, String)]-searchUnicode entries p s = map (second BS.unpack) $ filter go entries- where w = filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s- go (_, d) = all (`p` BS.unpack d) w+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 =@@ -107,7 +108,7 @@ (unicodeCompl entries $ searchPredicate xpCfg) paste where- unicodeCompl :: [(Char, BS.ByteString)] -> Predicate -> String -> IO [String]+ unicodeCompl :: [(Char, String)] -> Predicate -> String -> IO [String] unicodeCompl _ _ "" = return [] unicodeCompl entries p s = do let m = searchUnicode entries p s
XMonad/Prompt/Window.hs view
@@ -92,8 +92,8 @@ showXPrompt (WindowModePrompt action _ _) = showXPrompt action - completionFunction (WindowModePrompt _ winmap predicate) =- \s -> return . filter (predicate s) . map fst . M.toList $ winmap+ completionFunction (WindowModePrompt _ winmap predicate) s =+ return . filter (predicate s) . map fst . M.toList $ winmap modeAction (WindowModePrompt action winmap _) buf auto = do let name = if null auto then buf else auto
+ XMonad/Util/ActionQueue.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Util.ActionQueue+-- Description : Queue of XMonad actions+-- Copyright : (c) 2021 Xiaokui Shu+-- License : BSD-style (see LICENSE)+--+-- Maintainer : subbyte@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-- Put XMonad actions in the queue to be executed in either the+-- @logHook@ or another hook of your choice.+-----------------------------------------------------------------------------++module XMonad.Util.ActionQueue ( -- * Usage+ -- $usage+ ActionQueue+ , actionQueue+ , enqueue+ , exequeue+ ) where++import XMonad+import qualified XMonad.Util.ExtensibleConf as XC+import qualified XMonad.Util.ExtensibleState as XS++import Data.Sequence (Seq (..), ViewL (..), viewl, (|>))++-- $usage+--+-- This module provides a queue that, by default, gets executed every+-- time the @logHook@ runs. To use this module+--+-- 1. Enqueue `X ()` actions at the place you need; e.g.:+--+-- > enqueue myAction+--+-- 2. Add the 'actionQueue' combinator to your configuration:+--+-- > main = xmonad $ actionQueue $ def+-- > { ... }+--+-- This will execute all of the actions in the queue (if any) every time+-- the @logHook@ runs. Developers of other extensions using this module+-- should re-export 'actionQueue'.+--+-- Alternatively, you can directly add 'exequeue' to a hook of your choice.+-- This is discouraged when writing user-facing modules, as (accidentally)+-- adding 'exequeue' to two different hooks might lead to undesirable+-- behaviour. 'actionQueue' uses the "XMonad.Util.ExtensibleConf" interface to+-- circumvent this.+--++newtype ActionQueue = ActionQueue (Seq (X ()))++instance ExtensionClass ActionQueue where+ initialValue = ActionQueue mempty++newtype ActionQueueHooked = ActionQueueHooked ()+ deriving newtype (Semigroup)++-- | Every time the @logHook@ runs, execute all actions in the queue.+actionQueue :: XConfig l -> XConfig l+actionQueue = XC.once (\cfg -> cfg{ logHook = logHook cfg <> exequeue })+ ActionQueueHooked++-- | Enqueue an action.+enqueue :: X () -> X ()+enqueue = XS.modify . go+ where+ go :: X () -> ActionQueue -> ActionQueue+ go a (ActionQueue as) = ActionQueue $ as |> a++-- | Execute every action in the queue.+exequeue :: X ()+exequeue = do+ -- Note that we are executing all actions one by one. Otherwise, we may+ -- not execute the actions in the right order. Any of them may call+ -- 'refresh' or 'windows', which triggers the logHook, which may trigger+ -- 'exequeue' again if it is used in the logHook.+ ActionQueue aas <- XS.get+ case viewl aas of+ EmptyL -> pure ()+ a :< as -> do XS.put (ActionQueue as)+ a `catchX` pure ()+ exequeue
XMonad/Util/DebugWindow.hs view
@@ -23,19 +23,20 @@ import Codec.Binary.UTF8.String (decodeString) import Control.Exception as E-import Foreign import Foreign.C.String import Numeric (showHex) import System.Exit -- | Output a window by ID in hex, decimal, its ICCCM resource name and class,--- and its title if available. Also indicate override_redirect with an--- exclamation mark, and wrap in brackets if it is unmapped or withdrawn.+-- its title if available, and EWMH type and state if available. Also+-- indicate override_redirect with an exclamation mark, and wrap in brackets+-- if it is unmapped or withdrawn. debugWindow :: Window -> X String debugWindow 0 = return "-no window-" debugWindow w = do+ d <- asks display let wx = pad 8 '0' $ showHex w ""- w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)+ w' <- safeGetWindowAttributes w case w' of Nothing -> return $ "(deleted window " ++ wx ++ ")"@@ -48,8 +49,7 @@ , wa_map_state = m , wa_override_redirect = o } -> do- c' <- withDisplay $ \d ->- io (getWindowProperty8 d wM_CLASS w)+ c' <- io (getWindowProperty8 d wM_CLASS w) let c = case c' of Nothing -> "" Just c'' -> intercalate "/" $@@ -70,10 +70,10 @@ -- if it has WM_COMMAND use it, else use the appName -- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some -- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them.- p' <- withDisplay $ \d -> safeGetCommand d w+ p' <- safeGetCommand d w let p = if null p' then "" else wrap $ unwords p' nWP <- getAtom "_NET_WM_PID"- pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w+ pid' <- io $ getWindowProperty32 d nWP w let pid = case pid' of Just [pid''] -> '(':show pid'' ++ ")" _ -> ""@@ -82,6 +82,11 @@ () | m == waIsViewable -> ("","") | otherwise -> ("[","]") o' = if o then "!" else ""+ wT <- getAtom "_NET_WM_WINDOW_TYPE"+ wt' <- io $ getWindowProperty32 d wT w+ ewmh <- case wt' of+ Just wt'' -> windowType d w (fmap fi wt'')+ _ -> return "" return $ concat [lb ,o' ,wx@@ -95,6 +100,7 @@ ,',':show y ,if null c then "" else ' ':c ,if null cmd then "" else ' ':cmd+ ,ewmh ,rb ] @@ -153,14 +159,6 @@ | otherwise = s' : wrap' ss wrap' "" = "" --- Graphics.X11.Extras.getWindowAttributes is bugggggggy-safeGetWindowAttributes :: Display -> Window -> IO (Maybe WindowAttributes)-safeGetWindowAttributes d w = alloca $ \p -> do- s <- xGetWindowAttributes d w p- case s of- 0 -> return Nothing- _ -> Just <$> peek p- -- and so is getCommand safeGetCommand :: Display -> Window -> X [String] safeGetCommand d w = do@@ -178,3 +176,49 @@ getMachine :: Window -> X String getMachine w = catchX' (getAtom "WM_CLIENT_MACHINE" >>= getDecodedStringProp w) (return "")++-- if it's one EWMH atom then we strip prefix and lowercase, otherwise we+-- return the whole thing. we also get the state here, with similar rules+-- (all EWMH = all prefixes removed and lowercased)+windowType :: Display -> Window -> [Atom] -> X String+windowType d w ts = do+ tstr <- decodeType ts+ wS <- getAtom "_NET_WM_STATE"+ ss' <- io $ getWindowProperty32 d wS w+ sstr <- case ss' of+ Just ss -> windowState (fmap fi ss)+ _ -> return ""+ return $ " (" ++ tstr ++ sstr ++ ")"+ where+ decodeType :: [Atom] -> X String+ decodeType [] = return ""+ decodeType [t] = simplify "_NET_WM_WINDOW_TYPE_" t+ decodeType tys = unAtoms tys " (" False++ unAtoms :: [Atom] -> String -> Bool -> X String+ unAtoms [] t i = return $ if i then t else t ++ ")"+ unAtoms (a:as) t i = do+ s' <- io $ getAtomName d a+ let s = case s' of+ Just s'' -> s''+ _ -> '<':show a ++ ">"+ unAtoms as (t ++ (if i then ' ':s else s)) True+ + simplify :: String -> Atom -> X String+ simplify pfx a = do+ s' <- io $ getAtomName d a+ case s' of+ Nothing -> return $ '<':show a ++ ">"+ Just s -> if pfx `isPrefixOf` s then+ return $ map toLower (drop (length pfx) s)+ else+ return s++ -- note that above it says this checks all of them before simplifying.+ -- I'll do that after I'm confident this works as intended. + windowState :: [Atom] -> X String+ windowState [] = return ""+ windowState as' = go as' ";"+ where+ go [] t = return t+ go (a:as) t = simplify "_NET_WM_STATE_" a >>= \t' -> go as (t ++ ' ':t')
XMonad/Util/DynamicScratchpads.hs view
@@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.DynamicScratchpads (+module XMonad.Util.DynamicScratchpads {-# DEPRECATED "Use the dynamic scratchpad facility of XMonad.Util.NamedScratchpad instead." #-} ( -- * Usage -- $usage makeDynamicSP,@@ -36,7 +36,7 @@ -- Like with XMonad.Util.NamedScratchpad, you have to have a workspace called -- NSP, where hidden scratchpads will be moved to. ----- You can declare dynamic scrachpads in your xmonad.hs like so:+-- You can declare dynamic scratchpads in your xmonad.hs like so: -- -- import XMonad.Util.DynamicScratchpads --@@ -65,6 +65,7 @@ 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@@ -72,6 +73,7 @@ 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
XMonad/Util/EZConfig.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.EZConfig@@ -34,21 +35,23 @@ parseKey, -- used by XMonad.Util.Paste parseKeyCombo,- parseKeySequence, readKeySequence+ parseKeySequence, readKeySequence,+#ifdef TESTING+ parseModifier,+#endif ) where import XMonad import XMonad.Actions.Submap-import XMonad.Prelude hiding (many)+import XMonad.Prelude import XMonad.Util.NamedActions+import XMonad.Util.Parser import Control.Arrow (first, (&&&)) import qualified Data.Map as M import Data.Ord (comparing) -import Text.ParserCombinators.ReadP- -- $usage -- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@: --@@ -181,6 +184,8 @@ -- > <Tab> -- > <Return> -- > <Pause>+-- > <Num_Lock>+-- > <Caps_Lock> -- > <Scroll_lock> -- > <Sys_Req> -- > <Print>@@ -197,6 +202,18 @@ -- > <Insert> -- > <Break> -- > <Space>+-- > <Control_L>+-- > <Control_R>+-- > <Shift_L>+-- > <Shift_R>+-- > <Alt_L>+-- > <Alt_R>+-- > <Meta_L>+-- > <Meta_R>+-- > <Super_L>+-- > <Super_R>+-- > <Hyper_L>+-- > <Hyper_R> -- > <F1>-<F24> -- > <KP_Space> -- > <KP_Tab>@@ -394,16 +411,15 @@ -- | Parse a sequence of keys, returning Nothing if there is -- a parse failure (no parse, or ambiguous parse). readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]-readKeySequence c = listToMaybe . parses- where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c)+readKeySequence c = runParser (parseKeySequence c <* eof) -- | Parse a sequence of key combinations separated by spaces, e.g. -- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2).-parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)]-parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ')+parseKeySequence :: XConfig l -> Parser [(KeyMask, KeySym)]+parseKeySequence c = parseKeyCombo c `sepBy1` many1 (char ' ') -- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s).-parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym)+parseKeyCombo :: XConfig l -> Parser (KeyMask, KeySym) parseKeyCombo c = do mods <- many (parseModifier c) k <- parseKey return (foldl' (.|.) 0 mods, k)@@ -411,271 +427,30 @@ -- | Parse a modifier: either M- (user-defined mod-key), -- C- (control), S- (shift), or M#- where # is an integer -- from 1 to 5 (mod1Mask through mod5Mask).-parseModifier :: XConfig l -> ReadP KeyMask-parseModifier c = (string "M-" >> return (modMask c))- +++ (string "C-" >> return controlMask)- +++ (string "S-" >> return shiftMask)- +++ do _ <- char 'M'- n <- satisfy (`elem` ['1'..'5'])- _ <- char '-'- return $ indexMod (read [n] - 1)+parseModifier :: XConfig l -> Parser KeyMask+parseModifier c = (string "M-" $> modMask c)+ <> (string "C-" $> controlMask)+ <> (string "S-" $> shiftMask)+ <> do _ <- char 'M'+ n <- satisfy (`elem` ['1'..'5'])+ _ <- char '-'+ return $ indexMod (read [n] - 1) where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] -- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.-parseKey :: ReadP KeySym-parseKey = parseRegular +++ parseSpecial+parseKey :: Parser KeySym+parseKey = parseSpecial <> parseRegular -- | Parse a regular key name (represented by itself).-parseRegular :: ReadP KeySym-parseRegular = choice [ char s >> return k- | (s,k) <- zip ['!' .. '~' ] -- ASCII- [xK_exclam .. xK_asciitilde]-- ++ zip ['\xa0' .. '\xff' ] -- Latin1- [xK_nobreakspace .. xK_ydiaeresis]- ]+parseRegular :: Parser KeySym+parseRegular = choice [ string s $> k | (s, k) <- regularKeys ] -- | Parse a special key name (one enclosed in angle brackets).-parseSpecial :: ReadP KeySym-parseSpecial = do _ <- char '<'- key <- choice [ string name >> return k- | (name,k) <- keyNames- ]- _ <- char '>'- return key---- | A list of all special key names and their associated KeySyms.-keyNames :: [(String, KeySym)]-keyNames = functionKeys ++ specialKeys ++ multimediaKeys---- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@) with--- the associated KeySyms.-functionKeys :: [(String, KeySym)]-functionKeys = [ ('F' : show n, k)- | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ]---- | A list of special key names and their corresponding KeySyms.-specialKeys :: [(String, KeySym)]-specialKeys = [ ("Backspace" , xK_BackSpace)- , ("Tab" , xK_Tab)- , ("Return" , xK_Return)- , ("Pause" , xK_Pause)- , ("Scroll_lock", xK_Scroll_Lock)- , ("Sys_Req" , xK_Sys_Req)- , ("Print" , xK_Print)- , ("Escape" , xK_Escape)- , ("Esc" , xK_Escape)- , ("Delete" , xK_Delete)- , ("Home" , xK_Home)- , ("Left" , xK_Left)- , ("Up" , xK_Up)- , ("Right" , xK_Right)- , ("Down" , xK_Down)- , ("L" , xK_Left)- , ("U" , xK_Up)- , ("R" , xK_Right)- , ("D" , xK_Down)- , ("Page_Up" , xK_Page_Up)- , ("Page_Down" , xK_Page_Down)- , ("End" , xK_End)- , ("Insert" , xK_Insert)- , ("Break" , xK_Break)- , ("Space" , xK_space)- , ("KP_Space" , xK_KP_Space)- , ("KP_Tab" , xK_KP_Tab)- , ("KP_Enter" , xK_KP_Enter)- , ("KP_F1" , xK_KP_F1)- , ("KP_F2" , xK_KP_F2)- , ("KP_F3" , xK_KP_F3)- , ("KP_F4" , xK_KP_F4)- , ("KP_Home" , xK_KP_Home)- , ("KP_Left" , xK_KP_Left)- , ("KP_Up" , xK_KP_Up)- , ("KP_Right" , xK_KP_Right)- , ("KP_Down" , xK_KP_Down)- , ("KP_Prior" , xK_KP_Prior)- , ("KP_Page_Up" , xK_KP_Page_Up)- , ("KP_Next" , xK_KP_Next)- , ("KP_Page_Down", xK_KP_Page_Down)- , ("KP_End" , xK_KP_End)- , ("KP_Begin" , xK_KP_Begin)- , ("KP_Insert" , xK_KP_Insert)- , ("KP_Delete" , xK_KP_Delete)- , ("KP_Equal" , xK_KP_Equal)- , ("KP_Multiply", xK_KP_Multiply)- , ("KP_Add" , xK_KP_Add)- , ("KP_Separator", xK_KP_Separator)- , ("KP_Subtract", xK_KP_Subtract)- , ("KP_Decimal" , xK_KP_Decimal)- , ("KP_Divide" , xK_KP_Divide)- , ("KP_0" , xK_KP_0)- , ("KP_1" , xK_KP_1)- , ("KP_2" , xK_KP_2)- , ("KP_3" , xK_KP_3)- , ("KP_4" , xK_KP_4)- , ("KP_5" , xK_KP_5)- , ("KP_6" , xK_KP_6)- , ("KP_7" , xK_KP_7)- , ("KP_8" , xK_KP_8)- , ("KP_9" , xK_KP_9)- ]---- | List of multimedia keys. If X server does not know about some--- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case)-multimediaKeys :: [(String, KeySym)]-multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $- [ "XF86ModeLock"- , "XF86MonBrightnessUp"- , "XF86MonBrightnessDown"- , "XF86KbdLightOnOff"- , "XF86KbdBrightnessUp"- , "XF86KbdBrightnessDown"- , "XF86Standby"- , "XF86AudioLowerVolume"- , "XF86AudioMute"- , "XF86AudioRaiseVolume"- , "XF86AudioPlay"- , "XF86AudioStop"- , "XF86AudioPrev"- , "XF86AudioNext"- , "XF86HomePage"- , "XF86Mail"- , "XF86Start"- , "XF86Search"- , "XF86AudioRecord"- , "XF86Calculator"- , "XF86Memo"- , "XF86ToDoList"- , "XF86Calendar"- , "XF86PowerDown"- , "XF86ContrastAdjust"- , "XF86RockerUp"- , "XF86RockerDown"- , "XF86RockerEnter"- , "XF86Back"- , "XF86Forward"- , "XF86Stop"- , "XF86Refresh"- , "XF86PowerOff"- , "XF86WakeUp"- , "XF86Eject"- , "XF86ScreenSaver"- , "XF86WWW"- , "XF86Sleep"- , "XF86Favorites"- , "XF86AudioPause"- , "XF86AudioMedia"- , "XF86MyComputer"- , "XF86VendorHome"- , "XF86LightBulb"- , "XF86Shop"- , "XF86History"- , "XF86OpenURL"- , "XF86AddFavorite"- , "XF86HotLinks"- , "XF86BrightnessAdjust"- , "XF86Finance"- , "XF86Community"- , "XF86AudioRewind"- , "XF86BackForward"- , "XF86Launch0"- , "XF86Launch1"- , "XF86Launch2"- , "XF86Launch3"- , "XF86Launch4"- , "XF86Launch5"- , "XF86Launch6"- , "XF86Launch7"- , "XF86Launch8"- , "XF86Launch9"- , "XF86LaunchA"- , "XF86LaunchB"- , "XF86LaunchC"- , "XF86LaunchD"- , "XF86LaunchE"- , "XF86LaunchF"- , "XF86ApplicationLeft"- , "XF86ApplicationRight"- , "XF86Book"- , "XF86CD"- , "XF86Calculater"- , "XF86Clear"- , "XF86Close"- , "XF86Copy"- , "XF86Cut"- , "XF86Display"- , "XF86DOS"- , "XF86Documents"- , "XF86Excel"- , "XF86Explorer"- , "XF86Game"- , "XF86Go"- , "XF86iTouch"- , "XF86LogOff"- , "XF86Market"- , "XF86Meeting"- , "XF86MenuKB"- , "XF86MenuPB"- , "XF86MySites"- , "XF86New"- , "XF86News"- , "XF86OfficeHome"- , "XF86Open"- , "XF86Option"- , "XF86Paste"- , "XF86Phone"- , "XF86Q"- , "XF86Reply"- , "XF86Reload"- , "XF86RotateWindows"- , "XF86RotationPB"- , "XF86RotationKB"- , "XF86Save"- , "XF86ScrollUp"- , "XF86ScrollDown"- , "XF86ScrollClick"- , "XF86Send"- , "XF86Spell"- , "XF86SplitScreen"- , "XF86Support"- , "XF86TaskPane"- , "XF86Terminal"- , "XF86Tools"- , "XF86Travel"- , "XF86UserPB"- , "XF86User1KB"- , "XF86User2KB"- , "XF86Video"- , "XF86WheelButton"- , "XF86Word"- , "XF86Xfer"- , "XF86ZoomIn"- , "XF86ZoomOut"- , "XF86Away"- , "XF86Messenger"- , "XF86WebCam"- , "XF86MailForward"- , "XF86Pictures"- , "XF86Music"- , "XF86TouchpadToggle"- , "XF86AudioMicMute"- , "XF86_Switch_VT_1"- , "XF86_Switch_VT_2"- , "XF86_Switch_VT_3"- , "XF86_Switch_VT_4"- , "XF86_Switch_VT_5"- , "XF86_Switch_VT_6"- , "XF86_Switch_VT_7"- , "XF86_Switch_VT_8"- , "XF86_Switch_VT_9"- , "XF86_Switch_VT_10"- , "XF86_Switch_VT_11"- , "XF86_Switch_VT_12"- , "XF86_Ungrab"- , "XF86_ClearGrab"- , "XF86_Next_VMode"- , "XF86_Prev_VMode"- , "XF86Bluetooth" ]+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
XMonad/Util/ExclusiveScratchpads.hs view
@@ -73,7 +73,7 @@ -- -- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook"), eg.: ----- > manageHook = myManageHook <+> xScratchpadsManageHook scratchpads+-- > manageHook = myManageHook <> xScratchpadsManageHook scratchpads -- -- And finally add some keybindings (see "XMonad.Doc.Extending#Editing_key_bindings"): --
XMonad/Util/ExtensibleConf.hs view
@@ -62,7 +62,7 @@ -- > newtype MyConf = MyConf{ fromMyConf :: [Int] } deriving Semigroup -- > -- > customLogger :: Int -> XConfig l -> XConfig l--- > customLogger i = XC.once (MyConf [i]) $ \c -> c{ logHook = logHook c <> lh }+-- > customLogger i = XC.once (\c -> c{ logHook = logHook c <> lh }) (MyConf [i]) -- > where -- > lh :: X () -- > lh = XC.with $ io . print . fromMyConf
XMonad/Util/ExtensibleState.hs view
@@ -20,6 +20,9 @@ -- $usage put , modify+ , modify'+ , modifyM+ , modifyM' , remove , get , gets@@ -88,7 +91,20 @@ -- | Apply a function to a stored value of the matching type or the initial value if there -- is none. modify :: (ExtensionClass a, XLike m) => (a -> a) -> m ()-modify f = put . f =<< get+modify = modifyM . (pure .)++-- | Apply an action to a stored value of the matching type or the initial value if there+-- is none.+modifyM :: (ExtensionClass a, XLike m) => (a -> m a) -> m ()+modifyM f = put =<< f =<< get++-- | Like 'modify' but the result value is forced to WHNF before being stored.+modify' :: (ExtensionClass a, XLike m) => (a -> a) -> m ()+modify' = modifyM' . (pure .)++-- | Like 'modifyM' but the result value is forced to WHNF before being stored.+modifyM' :: (ExtensionClass a, XLike m) => (a -> m a) -> m ()+modifyM' f = (put $!) =<< f =<< get -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type
XMonad/Util/Font.hs view
@@ -41,15 +41,16 @@ import Text.Printf (printf) #ifdef XFT-import Graphics.X11.Xft+import qualified Data.List.NonEmpty as NE import Graphics.X11.Xrender+import Graphics.X11.Xft #endif -- Hide the Core Font/Xft switching here data XMonadFont = Core FontStruct | Utf8 FontSet #ifdef XFT- | Xft XftFont+ | Xft (NE.NonEmpty XftFont) #endif -- $usage@@ -63,16 +64,23 @@ fallBack = blackPixel d (defaultScreen d) -- | Convert a @Pixel@ into a @String@.+--+-- This function removes any alpha channel from the @Pixel@, because X11+-- mishandles alpha channels and produces black. pixelToString :: (MonadIO m) => Display -> Pixel -> m String pixelToString d p = do let cm = defaultColormap d (defaultScreen d)- (Color _ r g b _) <- io (queryColor d cm $ Color p 0 0 0 0)+ (Color _ r g b _) <- io (queryColor d cm $ Color (p .&. 0x00FFFFFF) 0 0 0 0) return ("#" ++ hex r ++ hex g ++ hex b) where -- NOTE: The @Color@ type has 16-bit values for red, green, and -- blue, even though the actual type in X is only 8 bits wide. It -- seems that the upper and lower 8-bit sections of the @Word16@ -- values are the same. So, we just discard the lower 8 bits.+ --+ -- (Strictly, X11 supports 16-bit values but no visual supported+ -- by XOrg does. It is still correct to discard the lower bits, as+ -- they are not guaranteed to be meaningful in such visuals.) hex = printf "%02x" . (`shiftR` 8) econst :: a -> IOException -> a@@ -109,34 +117,44 @@ -- Example: 'xft: Sans-10' initXMF :: String -> X XMonadFont initXMF s =-#ifdef XFT+#ifndef XFT+ Utf8 <$> initUtf8Font s+#else if xftPrefix `isPrefixOf` s then do dpy <- asks display- xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)- return (Xft xftdraw)- else-#endif- Utf8 <$> initUtf8Font s-#ifdef XFT- where xftPrefix = "xft:"+ let fonts = case wordsBy (== ',') (drop (length xftPrefix) s) of+ [] -> "xft:monospace" :| [] -- NE.singleton only in base 4.15+ (x : xs) -> x :| xs+ Xft <$> io (traverse (openFont dpy) fonts)+ else Utf8 <$> initUtf8Font s+ where+ xftPrefix = "xft:"+ openFont dpy str = xftFontOpen dpy (defaultScreenOfDisplay dpy) str+ wordsBy p str = case dropWhile p str of+ "" -> []+ str' -> w : wordsBy p str''+ where (w, str'') = break p str' #endif releaseXMF :: XMonadFont -> X () #ifdef XFT-releaseXMF (Xft xftfont) = do+releaseXMF (Xft xftfonts) = do dpy <- asks display- io $ xftFontClose dpy xftfont+ io $ mapM_ (xftFontClose dpy) xftfonts #endif releaseXMF (Utf8 fs) = releaseUtf8Font fs releaseXMF (Core fs) = releaseCoreFont fs - textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int textWidthXMF _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s #ifdef XFT textWidthXMF dpy (Xft xftdraw) s = liftIO $ do- gi <- xftTextExtents dpy xftdraw s+#if MIN_VERSION_X11_xft(0, 3, 4)+ gi <- xftTextAccumExtents dpy (toList xftdraw) s+#else+ gi <- xftTextExtents dpy (NE.head xftdraw) s+#endif return $ xglyphinfo_xOff gi #endif @@ -150,9 +168,15 @@ let (_,a,d,_) = textExtents fs s return (a,d) #ifdef XFT-textExtentsXMF (Xft xftfont) _ = io $ do- ascent <- fi <$> xftfont_ascent xftfont- descent <- fi <$> xftfont_descent xftfont+#if MIN_VERSION_X11_xft(0, 3, 4)+textExtentsXMF (Xft xftfonts) _ = io $ do+ ascent <- fi <$> xftfont_max_ascent xftfonts+ descent <- fi <$> xftfont_max_descent xftfonts+#else+textExtentsXMF (Xft xftfonts) _ = io $ do+ ascent <- fi <$> xftfont_ascent (NE.head xftfonts)+ descent <- fi <$> xftfont_descent (NE.head xftfonts)+#endif return (ascent, descent) #endif @@ -188,13 +212,17 @@ setBackground d gc bc' io $ wcDrawImageString d p fs gc x y s #ifdef XFT-printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do+printStringXMF dpy drw fs@(Xft fonts) gc fc bc x y s = do let screen = defaultScreenOfDisplay dpy colormap = defaultColormapOfScreen screen visual = defaultVisualOfScreen screen bcolor <- stringToPixel dpy bc (a,d) <- textExtentsXMF fs s- gi <- io $ xftTextExtents dpy font s+#if MIN_VERSION_X11_xft(0, 3, 4)+ gi <- io $ xftTextAccumExtents dpy (toList fonts) s+#else+ gi <- io $ xftTextExtents dpy (NE.head fonts) s+#endif io $ setForeground dpy gc bcolor io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi)) (y - fi a)@@ -202,5 +230,9 @@ (fi $ a + d) io $ withXftDraw dpy drw visual colormap $ \draw -> withXftColorName dpy visual colormap fc $- \color -> xftDrawString draw color font x y s+#if MIN_VERSION_X11_xft(0, 3, 4)+ \color -> xftDrawStringFallback draw color (toList fonts) (fi x) (fi y) s+#else+ \color -> xftDrawString draw color (NE.head fonts) x y s+#endif #endif
+ XMonad/Util/Grab.hs view
@@ -0,0 +1,136 @@+{-# 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/Util/Hacks.hs view
@@ -34,11 +34,18 @@ -- $raiseTrayer trayerAboveXmobarEventHook, trayAbovePanelEventHook,++ -- * Inform xmobar when trays (e.g. trayer) change width+ -- $padTrayer+ trayerPaddingXmobarEventHook,+ trayPaddingXmobarEventHook,+ trayPaddingEventHook, ) where import XMonad-import XMonad.Prelude (All (All), filterM, when)+import XMonad.Hooks.StatusBar (xmonadPropLog')+import XMonad.Prelude (All (All), fi, filterM, when) import System.Posix.Env (putEnv) @@ -66,7 +73,7 @@ -- Usage: -- add to handleEventHook as follows: ----- > handleEventHook = handleEventHook def <+> Hacks.windowedFullscreenFixEventHook+-- > handleEventHook = handleEventHook def <> Hacks.windowedFullscreenFixEventHook -- -- | Fixes fullscreen behaviour of chromium based apps by quickly applying and undoing a resize.@@ -126,7 +133,7 @@ -- -- > handleEventHook = … <> Hacks.trayerAboveXmobarEventHook --- | 'trayAbovePanelEventHook' for trayer/xmobar+-- | Like 'trayAbovePanelEventHook', but specialised for trayer/xmobar. trayerAboveXmobarEventHook :: Event -> X All trayerAboveXmobarEventHook = trayAbovePanelEventHook (className =? "trayer") (appName =? "xmobar") @@ -145,3 +152,61 @@ mapM_ (io . lowerWindow dpy) panelWs mempty trayAbovePanelEventHook _ _ _ = mempty++-- $padTrayer+-- Communicating tray (e.g., trayer) resize events to xmobar so that+-- padding space may be reserved on xmobar for the tray.+--+-- Basic Usage with trayer:+--+-- First, add the padding hook to your @handleEventHook@ as follows:+--+-- > main = xmonad $ def+-- > { ...+-- > , handleEventHook = handleEventHook def+-- > <> Hacks.trayerPaddingXmobarEventHook+-- > }+--+-- Then, assuming the tray is placed on the right, update your+-- @xmobarrc@ as follows:+--+-- > Config { ...+-- > , commands = [ ...+-- > , Run XPropertyLog "_XMONAD_TRAYPAD", ... ]+-- > , template = " ... %_XMONAD_TRAYPAD%"+-- > }+--+-- As an example of what happens in this basic usage, consider the+-- case where trayer updates to a width of 53 pixels.+-- The following property will appear on the root window:+--+-- > _XMONAD_TRAYPAD(UTF8_STRING) = "<hspace=53/>"++-- | A simple trayer/xmobar-specific event hook that watches for trayer window+-- resize changes and updates the _XMONAD_TRAYPAD property with xmobar markup+-- that leaves a gap for the trayer.+trayerPaddingXmobarEventHook :: Event -> X All -- ^ event hook+trayerPaddingXmobarEventHook = trayPaddingXmobarEventHook (className =? "trayer") "_XMONAD_TRAYPAD"++-- | A generic version of 'trayerPaddingXmobarEventHook' that+-- allows the user to specify how to identify a tray window and the property+-- to use with 'xmonadPropLog''. This is useful for other trays like+-- stalonetray and also when space for more than one tray-like window needs to+-- be reserved.+trayPaddingXmobarEventHook+ :: Query Bool -- ^ query to identify the tray window+ -> String -- ^ 'xmonadPropLog'' property to use+ -> Event -> X All -- ^ resulting event hook+trayPaddingXmobarEventHook trayQ prop = trayPaddingEventHook trayQ hspaceLog+ where hspaceLog width = xmonadPropLog' prop ("<hspace=" ++ show width ++ "/>")++-- | A fully generic tray resize hook that invokes a callback whenever a+-- tray-like window changes width.+trayPaddingEventHook+ :: Query Bool -- ^ query to identify the tray window+ -> (Int -> X ()) -- ^ action to perform when tray width changes+ -> Event -> X All -- ^ resulting event hook+trayPaddingEventHook trayQ widthChanged ConfigureEvent{ ev_window = w, ev_width = wa } = do+ whenX (runQuery trayQ w) $ widthChanged (fi wa)+ mempty+trayPaddingEventHook _ _ _ = mempty
XMonad/Util/Loggers.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Loggers@@ -32,12 +33,15 @@ -- * XMonad Loggers -- $xmonad- , logCurrent, logLayout, logTitle, logTitles+ , logCurrent, logLayout+ , logTitle, logTitles, logTitles' , logConst, logDefault, (.|) -- * XMonad: Screen-specific Loggers -- $xmonad-screen , logCurrentOnScreen, logLayoutOnScreen- , logTitleOnScreen, logWhenActive, logTitlesOnScreen+ , logTitleOnScreen, logWhenActive+ , logTitlesOnScreen, logTitlesOnScreen'+ , TitlesFormat(..) -- * Formatting Utilities -- $format , onLogger@@ -48,15 +52,16 @@ ) where -import XMonad (liftIO, Window, gets)+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) import Control.Exception as E-import XMonad.Prelude (find, fromMaybe, isPrefixOf, isSuffixOf)+import XMonad.Prelude (find, fromMaybe, isPrefixOf, isSuffixOf, WindowScreen) import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) import System.Directory (getDirectoryContents) import System.IO (hGetLine)@@ -193,15 +198,30 @@ -> (String -> String) -- ^ Formatting for the focused window -> (String -> String) -- ^ Formatting for the unfocused window -> Logger-logTitlesOnScreen sid formatFoc formatUnfoc = (`withScreen` sid) $ \screen -> do- let focWin = fmap W.focus . W.stack . W.workspace $ screen- wins = maybe [] W.integrate . W.stack . W.workspace $ screen+logTitlesOnScreen sid formatFoc formatUnfoc =+ logTitlesOnScreen' sid TitlesFormat{ focusedFormat = formatFoc+ , unfocusedFormat = formatUnfoc+ , urgentFormat = 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) =+ (`withScreen` sid) $ \screen -> do+ let focWin = fmap W.focus . W.stack . W.workspace $ screen+ urgWins <- readUrgents+ logTitlesOnScreenWorker screen $ \win name ->+ if | Just win == focWin -> formatFoc name+ | win `elem` urgWins -> formatUrg name+ | otherwise -> formatUnfoc name++-- | Internal function for 'logTitlesOnScreen' and 'logTitlesOnScreen''.+logTitlesOnScreenWorker :: WindowScreen -> (Window -> String -> String) -> Logger+logTitlesOnScreenWorker screen logger = do+ let wins = maybe [] W.integrate . W.stack . W.workspace $ screen winNames <- traverse (fmap show . getName) wins- pure . Just- . unwords- $ zipWith (\w n -> if Just w == focWin then formatFoc n else formatUnfoc n)- wins- winNames+ pure . Just . unwords $ zipWith logger wins winNames -- | Like 'logTitlesOnScreen', but directly use the "focused" screen -- (the one with the currently focused workspace).@@ -210,6 +230,27 @@ sid <- gets $ W.screen . W.current . windowset logTitlesOnScreen sid formatFoc formatUnfoc +-- | Variant of 'logTitles', but with support for urgent windows.+logTitles' :: TitlesFormat -> Logger+logTitles' formatter =+ gets (W.screen . W.current . windowset) >>= (`logTitlesOnScreen'` formatter)++-- | 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 = wrap "[" "]" . xmobarRaw . shorten 30 . xmobarStrip+ , unfocusedFormat = xmobarRaw . shorten 30 . xmobarStrip+ , urgentFormat = wrap "!" "!" . xmobarRaw . shorten 30 . xmobarStrip+ }+ -- | Get the name of the current layout. logLayout :: Logger logLayout = withWindowSet $ return . Just . ld@@ -271,9 +312,6 @@ logLayoutOnScreen :: ScreenId -> Logger logLayoutOnScreen = withScreen $ logConst . description . W.layout . W.workspace---- | A shortcut to a screen-type WindowScreen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -- | A helper function to create screen-specific loggers. withScreen :: (WindowScreen -> Logger) -> ScreenId -> Logger
XMonad/Util/Loggers/NamedScratchpad.hs view
@@ -59,7 +59,7 @@ -- | 'startupHook' to initialize scratchpad activation tracking ----- > , startupHook = ... <+> nspTrackStartup scratchpads+-- > , startupHook = ... <> nspTrackStartup scratchpads -- -- If you kickstart the 'logHook', do it /after/ 'nspTrackStartup'! nspTrackStartup :: [NamedScratchpad] -> X ()@@ -83,7 +83,7 @@ -- | 'handleEventHook' to track scratchpad activation/deactivation ----- > , handleEventHook = ... <+> nspTrackHook scratchpads+-- > , 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
XMonad/Util/NamedActions.hs view
@@ -47,10 +47,9 @@ import XMonad.Actions.Submap(submap)-import XMonad.Prelude (groupBy)+import XMonad.Prelude (groupBy, keyToString) import XMonad-import Control.Arrow(Arrow((&&&), second, (***)))-import Data.Bits(Bits((.&.), complement))+import Control.Arrow(Arrow((&&&), second)) import System.Exit(exitSuccess) import qualified Data.Map as M@@ -165,22 +164,6 @@ (^++^) :: (HasName b, HasName b1) => [(d, b)] -> [(d, b1)] -> [(d, NamedAction)] a ^++^ b = map (second NamedAction) a ++ map (second NamedAction) b---- | Or allow another lookup table?-modToString :: KeyMask -> String-modToString mask = concatMap (++"-") $ filter (not . null)- $ map (uncurry pick)- [(mod1Mask, "M1")- ,(mod2Mask, "M2")- ,(mod3Mask, "M3")- ,(mod4Mask, "M4")- ,(mod5Mask, "M5")- ,(controlMask, "C")- ,(shiftMask,"Shift")]- where pick m str = if m .&. complement mask == 0 then str else ""--keyToString :: (KeyMask, KeySym) -> [Char]-keyToString = uncurry (++) . (modToString *** keysymToString) showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] showKmSimple = concatMap (\(k,e) -> if snd k == 0 then "":showName e else map ((keyToString k ++) . smartSpace) $ showName e)
XMonad/Util/NamedScratchpad.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedScratchpad@@ -27,23 +29,34 @@ customRunNamedScratchpadAction, allNamedScratchpadAction, namedScratchpadManageHook,+ nsHideOnFocusLoss,++ -- * Dynamic Scratchpads+ -- $dynamic-scratchpads+ dynamicNSPAction,+ toggleDynamicNSP,++ -- * Deprecations namedScratchpadFilterOutWorkspace, namedScratchpadFilterOutWorkspacePP,- nsHideOnFocusLoss,+ ) where +import Data.Coerce (coerce)+import Data.Map.Strict (Map, (!?)) import XMonad import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) import XMonad.Actions.SpawnOn (spawnHere)-import XMonad.Hooks.StatusBar.PP (PP, ppSort) import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Hooks.RefocusLast (withRecentsIn)-import XMonad.Prelude (filterM, find, unless, when)+import XMonad.Hooks.StatusBar.PP (PP, ppSort)+import XMonad.Prelude (filterM, unless, when) +import qualified Data.Map.Strict as Map import qualified Data.List.NonEmpty as NE -import qualified XMonad.StackSet as W-+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS -- $usage -- Allows to have several floating scratchpads running different applications.@@ -111,6 +124,24 @@ , hook :: ManageHook -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@ } +-- | The NSP state associates a name to an entire scratchpad.+newtype NSPState = NSPState (Map String NamedScratchpad)++instance ExtensionClass NSPState where+ initialValue :: NSPState+ initialValue = NSPState mempty++-- | Try to fill the 'NSPState' with the given list of scratchpads. In+-- case the state is already non-empty, don't do anything and return+-- that state. Otherwise, fill the state with the given scratchpads.+fillNSPState :: NamedScratchpads -> X NSPState+fillNSPState nsps = do+ nsp@(NSPState xs) <- XS.get+ let nspState = NSPState . Map.fromList $ zip (map name nsps) nsps+ if null xs+ then nspState <$ XS.put nspState+ else pure nsp+ -- | Manage hook that makes the window non-floating nonFloating :: ManageHook nonFloating = idHook@@ -126,10 +157,6 @@ -- | Named scratchpads configuration type NamedScratchpads = [NamedScratchpad] --- | Finds named scratchpad configuration by name-findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad-findByName c s = find ((s ==) . name) c- -- | Runs application which should appear in specified scratchpad runApplication :: NamedScratchpad -> X () runApplication = spawn . cmd@@ -139,24 +166,41 @@ 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 ()@@ -187,14 +231,18 @@ isNS :: Window -> X Bool isNS w = or <$> traverse ((`runQuery` w) . query) scratches --- | execute some action on a named scratchpad+-- | 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 scratchpadConfig scratchpadName =- case findByName scratchpadConfig scratchpadName of+someNamedScratchpadAction f runApp _ns scratchpadName = do+ NSPState scratchpadConfig <- fillNSPState _ns -- See Note [Filling NSPState]+ case scratchpadConfig !? scratchpadName of Just conf -> withWindowSet $ \winSet -> do let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ winSet) allWindows = W.allWindows winSet@@ -211,6 +259,23 @@ 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"@@ -218,7 +283,9 @@ -- | Manage hook to use with named scratchpads namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration -> ManageHook-namedScratchpadManageHook = composeAll . fmap (\c -> query c --> hook c)+namedScratchpadManageHook nsps = do+ ns <- Map.elems . coerce <$> 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.@@ -228,6 +295,74 @@ 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 . coerce $ Map.insert s (mkDynamicNSP s w)++-- | Make a window stop being a dynamic scratchpad+removeDynamicNSP :: String -> X ()+removeDynamicNSP s = XS.modify @NSPState . coerce $ Map.delete @_ @NamedScratchpad s++-- | 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 nsps <- XS.get+ case nsps !? s of+ Nothing -> addDynamicNSP s w+ Just nsp -> ifM (runQuery (query nsp) w)+ (removeDynamicNSP s)+ (addDynamicNSP s w)++------------------------------------------------------------------------+-- Deprecations+ -- | Transforms a workspace list containing the NSP workspace into one that -- doesn't contain it. Intended for use with logHooks. namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]@@ -250,5 +385,3 @@ ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp) } {-# DEPRECATED namedScratchpadFilterOutWorkspacePP "Use XMonad.Hooks.StatusBar.PP.filterOutWsPP [scratchpadWorkspaceTag] instead" #-}---- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
+ XMonad/Util/Parser.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+--------------------------------------------------------------------+-- |+-- Module : XMonad.Util.Parser+-- Description : A parser combinator library for xmonad+-- Copyright : (c) 2021 Tony Zorman+-- License : BSD3+-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org>+-- Stability : experimental+-- Portability : non-portable+--+-- A small wrapper around the 'ReadP' parser combinator in @base@,+-- providing a more intuitive behaviour. While it's theoretically nice+-- that 'ReadP' is actually commutative, this makes a lot of parsing+-- operations rather awkward—more often than not, one only wants the+-- argument that's parsed "first".+--+-- Due to the left-biased nature of the chosen semigroup implementation,+-- using functions like 'many' or 'optional' from "Control.Applicative"+-- now yields more consistent behaviour with other parser combinator+-- libraries.+--+--------------------------------------------------------------------+module XMonad.Util.Parser (+ -- * Usage+ -- $usage++ -- * Running+ Parser,+ runParser,++ -- * Primitive Parsers+ eof,+ num,+ char,+ string,+ skipSpaces,+ get,+ look,++ -- * Combining Parsers+ satisfy,+ choice,+ many1,+ sepBy,+ sepBy1,+ endBy,+ endBy1,+ munch,+ munch1,+ pfail+) where++import XMonad.Prelude++import qualified Text.ParserCombinators.ReadP as ReadP++import Data.Coerce (coerce)+import Data.String (IsString (fromString))+import Text.ParserCombinators.ReadP (ReadP, (<++))++{- $usage++NOTE: This module is mostly intended for developing of other modules.+If you are a users, you probably won't find much use here—you have been+warned.++The high-level API tries to stay as close to 'ReadP' as possible. If+you are familiar with that then no functions here should surprise you.++One notable usability difference when forcing left-biasedness is /when/+one wants to disambiguate a parse. For normal 'ReadP' usage this+happens after the actual parsing stage by going through the list of+successful parses. For 'Parser' it does when constructing the relevant+combinators, leading to only one successful parse. As an example,+consider the 'ReadP'-based parser++> pLangle = ReadP.string "<"+> pLongerSequence = ReadP.char '<' *> ReadP.string "f" <* ReadP.char '>'+> pCombination = pLangle ReadP.+++ pLongerSequence++Parsing the string @"<f>"@ will return++>>> ReadP.readP_to_S pCombination "<f>"+[("<","f>"),("f","")]++One would now need to, for example, filter for the second (leftover)+string being empty and take the head of the resulting list (which may+still have more than one element).++With 'Parser', the same situation would look like the following++> pLangle' = string "<"+> pLongerSequence' = char '<' *> string "f" <* char '>'+> pCombination' = pLongerSequence' <> pLangle'++Notice how @pLangle'@ and @pLongerSequence'@ have traded places—since we+are not forcing @pLangle'@ to consume the entire string and @(<>)@ is+left-biased, @pLongerSequence'@ parses a superset of @pLangle'@!+Running @runParser pCombination'@ now yields the expected result:++>>> runParser pCombination' "<f>"+Just "f"++One might also define @pLangle'@ as @string "<" <* eof@, which would+enable a definition of @pCombination' = pLangle' <> pLongerSequence'@.++For example uses, see "XMonad.Util.EZConfig" or "XMonad.Prompt.OrgMode".+-}++-- Parser :: Type -> Type+newtype Parser a = Parser (ReadP a)+ deriving newtype (Functor, Applicative, Monad)++instance Semigroup (Parser a) where+ -- | Local, exclusive, left-biased choice: If left parser locally+ -- produces any result at all, then right parser is not used.+ (<>) :: Parser a -> Parser a -> Parser a+ (<>) = coerce ((<++) @a)++instance Monoid (Parser a) where+ -- | A parser that always fails.+ mempty :: Parser a+ mempty = Parser empty++instance Alternative Parser where+ empty :: Parser a+ empty = mempty++ (<|>) :: Parser a -> Parser a -> Parser a+ (<|>) = (<>)++-- | 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++-- | Run a parser on a given string.+runParser :: Parser a -> String -> Maybe a+runParser (Parser p) = fmap fst . listToMaybe . ReadP.readP_to_S p++-- | Always fails+pfail :: Parser a+pfail = empty++-- | Consume and return the next character. Fails if there is no input+-- left.+get :: Parser Char+get = coerce ReadP.get++-- | Look-ahead: return the part of the input that is left, without+-- consuming it.+look :: Parser String+look = coerce ReadP.look++-- | Succeeds if and only if we are at the end of input.+eof :: Parser ()+eof = coerce ReadP.eof++-- | Parse an integral number number.+num :: (Read a, Integral a) => Parser a+num = read <$> munch1 isDigit+{-# SPECIALISE num :: Parser Word #-}+{-# SPECIALISE num :: Parser Int #-}+{-# SPECIALISE num :: Parser Integer #-}++-- | Parse and return the specified character.+char :: Char -> Parser Char+char = coerce ReadP.char++-- | Parse and return the specified string.+string :: String -> Parser String+string = coerce ReadP.string++-- | Skip all whitespace.+skipSpaces :: Parser ()+skipSpaces = coerce ReadP.skipSpaces++-- | Consume and return the next character if it satisfies the specified+-- predicate.+satisfy :: (Char -> Bool) -> Parser Char+satisfy = coerce ReadP.satisfy++-- | Combine all parsers in the given list in a left-biased way.+choice :: [Parser a] -> Parser a+choice = foldl' (<>) mempty++-- | 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++-- | 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++-- | @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)++-- | @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)++-- | Parse one or more occurrences of the given parser.+many1 :: Parser a -> Parser [a]+many1 p = liftA2 (:) p (many p)++-- | @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 []++-- | @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))
XMonad/Util/Paste.hs view
@@ -28,10 +28,10 @@ import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent) import Control.Monad.Reader (asks) import XMonad.Operations (withFocused)-import XMonad.Prelude (isUpper, listToMaybe)+import XMonad.Prelude (isUpper, fromMaybe) import XMonad.Util.XSelection (getSelection) import XMonad.Util.EZConfig (parseKey)-import Text.ParserCombinators.ReadP (readP_to_S)+import XMonad.Util.Parser (runParser) {- $usage @@ -72,8 +72,8 @@ outside ASCII. -} pasteChar :: KeyMask -> Char -> X ()-pasteChar m c = sendKey m $ maybe (unicodeToKeysym c) fst- $ listToMaybe $ readP_to_S parseKey [c]+pasteChar m c = sendKey m $ fromMaybe (unicodeToKeysym c)+ $ runParser parseKey [c] -- | Send a key with a modifier to the currently focused window. sendKey :: KeyMask -> KeySym -> X ()
+ XMonad/Util/Process.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : XMonad.Util.Process+-- Description : Utilities for unix processes.+-- Copyright : (c) 2022 Tomáš Janoušek <tomi@nomi.cz>+-- License : BSD3+-- Maintainer : Tomáš Janoušek <tomi@nomi.cz>+--+-- This module should not be directly used by users, it's just common code for+-- other modules.+--+module XMonad.Util.Process (+ getPPIDOf,+ getPPIDChain,+ ) where++import Control.Exception (SomeException, handle)+import System.Posix.Types (ProcessID)+import qualified Data.ByteString.Char8 as B++import XMonad.Prelude (fi)++-- | Get the parent process id (PPID) of a given process.+getPPIDOf :: ProcessID -> IO (Maybe ProcessID)+getPPIDOf pid =+ handle+ (\(_ :: SomeException) -> pure Nothing)+ (parse <$> B.readFile ("/proc/" <> show pid <> "/stat"))+ where+ -- Parse PPID out of /proc/*/stat, being careful not to trip over+ -- processes with names like ":-) 1 2 3 4 5 6".+ -- Inspired by https://gitlab.com/procps-ng/procps/-/blob/bcce3e440a1e1ee130c7371251a39c031519336a/proc/readproc.c#L561+ parse stat = case B.words $ snd $ B.spanEnd (/= ')') stat of+ _ : (B.readInt -> Just (ppid, "")) : _ -> Just (fi ppid)+ _ -> Nothing++-- | Get the chain of parent processes of a given pid. Starts with the given+-- pid and continues up until the parent of all.+getPPIDChain :: ProcessID -> IO [ProcessID]+getPPIDChain pid = (pid :) <$> (maybe (pure []) getPPIDChain =<< getPPIDOf pid)
XMonad/Util/PureX.hs view
@@ -53,7 +53,7 @@ -- xmonad import XMonad-import XMonad.Prelude (Any (..), liftA2)+import XMonad.Prelude (Any (..), liftA2, WindowScreen) import qualified XMonad.StackSet as W import qualified XMonad.Actions.FocusNth @@ -115,7 +115,6 @@ (<>) = liftA2 (<>) instance Monoid a => Monoid (PureX a) where- mappend = liftA2 mappend mempty = return mempty -- | The @XLike@ typeclass over monads reading @XConf@ values and tracking@@ -221,9 +220,7 @@ peek = withWindowSet' (return . W.peek) -- | Get the current screen.-curScreen- :: XLike m- => m (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+curScreen :: XLike m => m WindowScreen curScreen = withWindowSet' (return . W.current) -- | Get the current workspace.
XMonad/Util/Rectangle.hs view
@@ -30,6 +30,7 @@ ) where import XMonad+import XMonad.Prelude (fi) import qualified XMonad.StackSet as W import Data.Ratio@@ -202,6 +203,6 @@ -- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5) toRatio :: Rectangle -> Rectangle -> W.RationalRect toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) =- let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2]- [w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]- in W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)+ W.RationalRect ((fi x1 - fi x2) / fi w2)+ ((fi y1 - fi y2) / fi h2)+ (fi w1 / fi w2) (fi h1 / fi h2)
XMonad/Util/Run.hs view
@@ -1,59 +1,120 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Run--- Description : This modules provides several commands to run an external process.--- Copyright : (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu+-- Description : Several commands, as well as an EDSL, to run external processes.+-- Copyright : (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu+-- 2022 Tony Zorman -- License : BSD-style (see LICENSE) ----- Maintainer : Christian Thiemann <mail@christian-thiemann.de>+-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org> -- Stability : unstable -- Portability : unportable ----- This modules provides several commands to run an external process.--- It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by--- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and--- XMonad.Util.RunInXTerm (by Andrea Rossato).+-- This module provides several commands to run an external process.+-- Additionally, it provides an abstraction—particularly geared towards+-- programs like terminals or Emacs—to specify these processes from+-- XMonad in a compositional way. --+-- Originally, this module was composed of functions formerly defined in+-- "XMonad.Util.Dmenu" (by Spencer Janssen), "XMonad.Util.Dzen" (by+-- glasser\@mit.edu) and @XMonad.Util.RunInXTerm@ (by Andrea Rossato). ----------------------------------------------------------------------------- module XMonad.Util.Run (- -- * Usage- -- $usage- runProcessWithInput,- runProcessWithInputAndWait,- safeSpawn,- safeSpawnProg,- unsafeSpawn,- runInTerm,- safeRunInTerm,- seconds,- spawnPipe,- spawnPipeWithLocaleEncoding,- spawnPipeWithUtf8Encoding,- spawnPipeWithNoEncoding,- hPutStr, hPutStrLn -- re-export for convenience- ) where+ -- * Usage+ -- $usage+ runProcessWithInput,+ runProcessWithInputAndWait,+ safeSpawn,+ safeSpawnProg,+ unsafeSpawn,+ runInTerm,+ safeRunInTerm,+ seconds,+ spawnPipe,+ spawnPipeWithLocaleEncoding,+ spawnPipeWithUtf8Encoding,+ spawnPipeWithNoEncoding, -import Codec.Binary.UTF8.String-import System.Posix.IO-import System.Posix.Process (createSession, executeFile, forkProcess)+ -- * Compositionally Spawning Processes #EDSL#+ -- $EDSL++ -- ** Configuration and Running+ ProcessConfig (..),+ Input,+ spawnExternalProcess,+ proc,+ getInput,++ -- ** Programs+ inEditor,+ inTerm,+ termInDir,+ inProgram,++ -- ** General Combinators+ (>->),+ (>-$),+ inWorkingDir,+ execute,+ eval,+ setXClass,+ asString,++ -- ** Emacs Integration+ EmacsLib (..),+ setFrameName,+ withEmacsLibs,+ inEmacs,+ elispFun,+ asBatch,+ require,+ progn,+ quote,++ -- * Re-exports+ hPutStr,+ hPutStrLn,+) where++import XMonad+import XMonad.Prelude+import qualified XMonad.Util.ExtensibleConf as XC++import Codec.Binary.UTF8.String (encodeString) import Control.Concurrent (threadDelay)+import System.Directory (getDirectoryContents) import System.IO+import System.Posix.IO+import System.Posix.Process (createSession, executeFile, forkProcess) import System.Process (runInteractiveProcess)-import XMonad-import XMonad.Prelude --- $usage--- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh"------ For an example usage of 'runProcessWithInput' see--- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu",--- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions",--- "XMonad.Prompt.WorkspaceDir"------ For an example usage of 'runProcessWithInputAndWait' see--- "XMonad.Util.Dzen"+{- $usage +You can use this module by importing it in your @xmonad.hs@++> import XMonad.Util.Run++It then all depends on what you want to do:++ - If you want to compositionally spawn programs, see [the relevant+ extended documentation](#g:EDSL).++ - For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh".++ - For an example usage of 'runProcessWithInput' see+ "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu",+ "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions", or+ "XMonad.Prompt.WorkspaceDir".++ - 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@@ -180,3 +241,255 @@ executeFile "/bin/sh" False ["-c", encodeString x] Nothing closeFd rd return h++{- $EDSL++To use the provided EDSL, you must first add the 'spawnExternalProcess'+combinator to your xmonad configuration, like so:++> main = xmonad $ … $ spawnExternalProcess def $ … $ def++See 'ProcessConfig' for a list of all default configuration options, in+case you'd like to change them—especially if you want to make use of the+Emacs integration.++After that, the real fun begins! The format for spawning these+processes is always the same: a call to 'proc', its argument being a+bunch of function calls, separated by the pipe operator '(>->)'. You+can just bind the resulting function to a key; no additional plumbing+required. For example, using "XMonad.Util.EZConfig" syntax and with+@terminal = "alacritty"@ in you XMonad configuration, spawning a @ghci@+session with a special class name, "calculator", would look like++> ("M-y", proc $ inTerm >-> setXClass "calculator" >-> execute "ghci")++which would translate, more or less, to @\/usr\/bin\/sh -c "alacritty+--class calculator -e ghci"@. The usefulness of this notation becomes+apparent with more complicated examples:++> proc $ inEmacs+> >-> withEmacsLibs [OwnFile "mailboxes"]+> >-> execute (elispFun "notmuch")+> >-> setFrameName "mail"++This is equivalent to spawning++> emacs -l /home/slot/.config/emacs/lisp/mailboxes.el+> -e '(notmuch)'+> -F '(quote (name . "mail"))'++Notice how we did not have to specify the whole path to @mailboxes.el@,+since we had set the correct 'emacsLispDir' upon starting xmonad. This+becomes especially relevant when running Emacs in batch mode, where one+has to include [M,Non-GNU]ELPA packages in the call, whose exact names+may change at any time. Then the following++> do url <- getSelection -- from XMonad.Util.XSelection+> proc $ inEmacs+> >-> withEmacsLibs [ElpaLib "dash", ElpaLib "s", OwnFile "arXiv-citation"]+> >-> asBatch+> >-> execute (elispFun $ "arXiv-citation" <> asString url)++becomes++> emacs -L /home/slot/.config/emacs/elpa/dash-20220417.2250+> -L /home/slot/.config/emacs/elpa/s-20210616.619+> -l /home/slot/.config/emacs/lisp/arXiv-citation.el+> --batch+> -e '(arXiv-citation "<url-in-the-primary-selection>")'++which would be quite bothersome to type indeed!++-}++-----------------------------------------------------------------------+-- 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 >-$++-- | Spawn a completed input.+proc :: X Input -> X ()+proc xi = spawn =<< getInput xi++-- | 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.+execute :: String -> X Input+execute this = pure ((" -e " <> this) <>)++-- | Eval(uate) the argument. Current /thing/ must support a @--eval@+-- option.+eval :: String -> X Input+eval this = pure ((" --eval " <> this) <>)++-- | Use 'emacs'.+inEmacs :: X Input+inEmacs = XC.withDef $ \ProcessConfig{emacs} -> pure $ mkDList emacs++-- | Use the given program.+inProgram :: String -> X Input+inProgram = pure . mkDList++-- | Spawn /thing/ in the current working directory. /thing/ must+-- support a @--working-directory@ option.+inWorkingDir :: X Input+inWorkingDir = pure (" --working-directory " <>)++-- | Set a frame name for the @emacsclient@.+--+-- Note that this uses the @-F@ option to set the+-- <https://www.gnu.org/software/emacs/manual/html_node/emacs/Frame-Parameters.html frame parameters>+-- alist, which the @emacs@ executable does not support.+setFrameName :: String -> X Input+setFrameName n = pure ((" -F '(quote (name . \"" <> n <> "\"))' ") <>)++-- | Set the appropriate X class for a window. This will more often+-- than not actually be the+-- <https://tronche.com/gui/x/icccm/sec-4.html#WM_CLASS instance name>.+setXClass :: String -> X Input+setXClass = pure . mkDList . (" --class " <>)++-- | Spawn the 'XMonad.Core.XConfig.terminal' in some directory; it must+-- support the @--working-directory@ option.+termInDir :: X Input+termInDir = inTerm >-> inWorkingDir++-- | 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@ and also escape it by wrapping+-- it inside single quotes. The given commands need not be wrapped in+-- parentheses, 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 cmds = elispFun $ "progn " <> unwords (map inParens cmds)++-- | 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 " <>)++-----------------------------------------------------------------------+-- 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 <> ")"
XMonad/Util/Scratchpad.hs view
@@ -110,7 +110,7 @@ scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating rect)] --- | Transforms a workspace list containing the SP workspace into one that+-- | 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').
XMonad/Util/SpawnOnce.hs view
@@ -10,11 +10,19 @@ -- Portability : not portable -- -- A module for spawning a command once, and only once. Useful to start--- status bars and make session settings inside startupHook.+-- status bars and make session settings inside startupHook. See also+-- 'XMonad.Util.SessionStart' for a different and more flexible way to+-- run commands only on first startup. -- ----------------------------------------------------------------------------- -module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where+module XMonad.Util.SpawnOnce (spawnOnce,+ -- * 'SpawnOn' helpers+ -- $spawnon+ manageSpawn,+ spawnOnOnce,+ spawnNOnOnce,+ spawnAndDoOnce) where import XMonad import XMonad.Actions.SpawnOn@@ -43,7 +51,12 @@ spawnOnce :: String -> X () spawnOnce = doOnce spawn --- | Like spawnOnce but launches the application on the given workspace.+-- $spawnon+-- These functions combine 'spawnOnce' with their relatives in+-- 'XMonad.Actions.SpawnOn'. You must add 'manageSpawn' to your+-- @manageHook@ for them to work, as with @SpawnOn@.++-- | Like 'spawnOnce' but launches the application on the given workspace. spawnOnOnce :: WorkspaceId -> String -> X () spawnOnOnce ws = doOnce (spawnOn ws)
XMonad/Util/Stack.hs view
@@ -162,20 +162,20 @@ focusUpZ Nothing = Nothing focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s) focusUpZ (Just s) | null $ W.down s = Just s-focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (reverse (init down) ++ [f]) []+focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (tail (reverse down) ++ [f]) [] -- | Move the focus to the next element focusDownZ :: Zipper a -> Zipper a focusDownZ Nothing = Nothing focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down focusDownZ (Just s) | null $ W.up s = Just s-focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (reverse (init up) ++ [f])+focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (tail (reverse up) ++ [f]) -- | Move the focus to the first element focusMasterZ :: Zipper a -> Zipper a focusMasterZ Nothing = Nothing focusMasterZ (Just (W.Stack f up down)) | not $ null up- = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)+ = Just $ W.Stack (last up) [] (tail (reverse up) ++ [f] ++ down) focusMasterZ (Just s) = Just s -- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to@@ -284,7 +284,7 @@ -- | Delete the ith element deleteIndexZ :: Int -> Zipper a -> Zipper a deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z- number j ea = mapE (\_ a -> (j,a)) ea+ number j = mapE (\_ a -> (j,a)) in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered -- ** Folds
XMonad/Util/XUtils.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.XUtils@@ -17,7 +21,11 @@ module XMonad.Util.XUtils ( -- * Usage: -- $usage- averagePixels+ withSimpleWindow+ , showSimpleWindow+ , WindowConfig(..)+ , WindowRect(..)+ , averagePixels , createNewWindow , showWindow , showWindows@@ -37,16 +45,25 @@ 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.+-- | Compute the weighted average the colors of two given 'Pixel' values.+--+-- This function masks out any alpha channel in the passed pixels, and the+-- result has no alpha channel. X11 mishandles @Pixel@ values with alpha+-- channels and throws errors while producing black pixels. averagePixels :: Pixel -> Pixel -> Double -> X Pixel-averagePixels p1 p2 f =+averagePixels p1' p2' f = do d <- asks display let cm = defaultColormap d (defaultScreen d)+ mask p = p .&. 0x00FFFFFF+ p1 = mask p1'+ p2 = mask p2' [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0] let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f)) Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)@@ -156,6 +173,86 @@ ms = Just (fs,ffc,fbc, zip strs strPositions) is = Just (ffc, fbc, zip iconPositions icons) paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is++-- | The config for a window, as interpreted by 'showSimpleWindow'.+--+-- The font @winFont@ can either be specified in the TODO format or as an+-- xft font. For example:+--+-- > winFont = "xft:monospace-20"+--+-- or+--+-- > winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+data WindowConfig = WindowConfig+ { winFont :: !String -- ^ Font to use.+ , winBg :: !String -- ^ Background color.+ , winFg :: !String -- ^ Foreground color.+ , winRect :: !WindowRect -- ^ Position and size of the rectangle.+ }++instance Default WindowConfig where+ def = WindowConfig+ {+#ifdef XFT+ winFont = "xft:monospace-20"+#else+ winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+#endif+ , winBg = "black"+ , winFg = "white"+ , winRect = CenterWindow+ }++-- | What kind of window we should be.+data WindowRect+ = CenterWindow -- ^ Centered, big enough to fit all the text.+ | CustomRect Rectangle -- ^ Completely custom dimensions.++-- | Create a window, then fill and show it with the given text. If you+-- are looking for a version of this function that also takes care of+-- destroying the window, refer to 'withSimpleWindow'.+showSimpleWindow :: WindowConfig -- ^ Window config.+ -> [String] -- ^ Lines of text to show.+ -> X Window+showSimpleWindow WindowConfig{..} strs = do+ let pad = 20+ font <- initXMF winFont+ dpy <- asks display+ Rectangle sx sy sw sh <- getRectangle winRect++ -- Text extents for centering all fonts+ extends <- maximum . map (uncurry (+)) <$> traverse (textExtentsXMF font) strs+ -- Height and width of entire window+ height <- pure . fi $ (1 + length strs) * fi extends+ width <- (+ pad) . fi . maximum <$> traverse (textWidthXMF dpy font) strs++ let -- x and y coordinates that specify the upper left corner of the window+ x = sx + (fi sw - width + 2) `div` 2+ y = sy + (fi sh - height + 2) `div` 2+ -- y position of first string+ yFirst = (height + 2 * extends) `div` fi (2 + length strs)+ -- (x starting, y starting) for all strings+ strPositions = map (pad `div` 2, ) [yFirst, yFirst + extends ..]++ w <- createNewWindow (Rectangle x y (fi width) (fi height)) Nothing "" True+ let ms = Just (font, winFg, winBg, zip strs strPositions)+ showWindow w+ paintWindow' w (Rectangle 0 0 (fi width) (fi height)) 0 winBg "" ms Nothing+ releaseXMF font+ pure w+ where+ getRectangle :: WindowRect -> X Rectangle+ getRectangle = \case+ CenterWindow -> gets $ screenRect . W.screenDetail . W.current . windowset+ CustomRect r -> pure r++-- | Like 'showSimpleWindow', but fully manage the window; i.e., destroy+-- it after the given function finishes its execution.+withSimpleWindow :: WindowConfig -> [String] -> X a -> X a+withSimpleWindow wc strs doStuff = do+ w <- showSimpleWindow wc strs+ doStuff <* withDisplay (io . (`destroyWindow` w)) -- This stuff is not exported
− scripts/generate-configs
@@ -1,302 +0,0 @@-#!/bin/bash--# generate-configs - Docstring parser for generating xmonad build configs with-# default settings for extensions-# Author: Alex Tarkovsky <alextarkovsky@gmail.com>-# Released into the public domain--# This script parses custom docstrings specifying build-time configuration data-# from xmonad extension source files, then inserts the data into copies of-# xmonad's Config.hs and xmonad.cabal files accordingly.-#-# Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR-#-# OPTIONS:-# --active, -a Insert data in active mode (default: passive)-# --contrib, -c CONTRIB_DIR Path to contrib repository base directory-# --help, -h Show help-# --main, -m MAIN_DIR Path to main repository base directory-# --output, -o OUTPUT_DIR Output directory (default: CONTRIB_DIR)-#-# Data parsed from the extension source files is inserted into Config.hs in-# either active or passive mode. The default is passive mode, in which the-# inserted data is commented out. The --active option inserts the data-# uncommented. Data inserted into xmonad.cabal is always inserted in active-# mode regardless of specified options.-#-# The docstring markup can be extended as needed. Currently the following tags-# are defined, shown with some examples:-#-# ~~~~~-#-# %cabalbuilddep-#-# Cabal build dependency. Value is appended to the "build-depends" line in-# xmonad.cabal and automatically prefixed with ", ". NB: Don't embed-# comments in this tag!-#-# -- %cabalbuilddep readline>=1.0-#-# %def-#-# General definition. Value is appended to the end of Config.sh.-#-# -- %def commands :: [(String, X ())]-# -- %def commands = defaultCommands-#-# %import-#-# Module needed by Config.sh to build the extension. Value is appended to-# the end of the default import list in Config.sh and automatically-# prefixed with "import ".-#-# -- %import XMonad.Layout.Accordion-# -- %import qualified XMonad.Actions.FlexibleManipulate as Flex-#-# %keybind-#-# Tuple defining a key binding. Must be prefixed with ", ". Value is-# inserted at the end of the "keys" list in Config.sh.-#-# -- %keybind , ((modMask, xK_d), date)-#-# %keybindlist-#-# Same as %keybind, but instead of a key binding tuple the definition is a-# list of key binding tuples (or a list comprehension producing them). This-# list is concatenated to the "keys" list must begin with the "++" operator-# rather than ", ".-#-# -- %keybindlist ++-# -- %keybindlist -- mod-[1..9] @@ Switch to workspace N-# -- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N-# -- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N-# -- %keybindlist [((m .|. modMask, k), f i)-# -- %keybindlist | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..]-# -- %keybindlist , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]]-#-# %layout-#-# A layout. Must be prefixed with ", ". Value is inserted at the end of the-# "defaultLayouts" list in Config.sh.-#-# -- %layout , accordion-#-# %mousebind-#-# Tuple defining a mouse binding. Must be prefixed with ", ". Value is-# inserted at the end of the "mouseBindings" list in Config.sh.-#-# -- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w))-#-# ~~~~~-#-# NB: '/' and '\' characters must be escaped with a '\' character!-#-# Tags may also contain comments, as illustrated in the %keybindlist examples-# above. Comments are a good place for special user instructions:-#-# -- %def -- comment out default logHook definition above if you uncomment this:-# -- %def logHook = dynamicLog--# Markup tag to search for in source files.-TAG_CABALBUILDDEP="%cabalbuilddep"-TAG_DEF="%def"-TAG_IMPORT="%import"-TAG_KEYBIND="%keybind"-TAG_KEYBINDLIST="%keybindlist"-TAG_LAYOUT="%layout"-TAG_MOUSEBIND="%mousebind"--# Insert markers to search for in Config.sh and xmonad.cabal. Values are-# extended sed regular expressions.-INS_MARKER_CABALBUILDDEP='^build-depends:.*'-INS_MARKER_IMPORT='-- % Extension-provided imports$'-INS_MARKER_LAYOUT='-- % Extension-provided layouts$'-INS_MARKER_KEYBIND='-- % Extension-provided key bindings$'-INS_MARKER_KEYBINDLIST='-- % Extension-provided key bindings lists$'-INS_MARKER_MOUSEBIND='-- % Extension-provided mouse bindings$'-INS_MARKER_DEF='-- % Extension-provided definitions$'--# Literal indentation strings. Values may contain escaped chars such as \t.-INS_INDENT_CABALBUILDDEP=""-INS_INDENT_DEF=""-INS_INDENT_IMPORT=""-INS_INDENT_KEYBIND=" "-INS_INDENT_KEYBINDLIST=" "-INS_INDENT_LAYOUT=" "-INS_INDENT_MOUSEBIND=" "--# Prefix applied to inserted passive data after indent strings have been applied.-INS_PREFIX_DEF="-- "-INS_PREFIX_IMPORT="--import "-INS_PREFIX_KEYBIND="-- "-INS_PREFIX_KEYBINDLIST="-- "-INS_PREFIX_LAYOUT="-- "-INS_PREFIX_MOUSEBIND="-- "--# Prefix applied to inserted active data after indent strings have been applied.-ACTIVE_INS_PREFIX_CABALBUILDDEP=", "-ACTIVE_INS_PREFIX_DEF=""-ACTIVE_INS_PREFIX_IMPORT="import "-ACTIVE_INS_PREFIX_KEYBIND=""-ACTIVE_INS_PREFIX_KEYBINDLIST=""-ACTIVE_INS_PREFIX_LAYOUT=""-ACTIVE_INS_PREFIX_MOUSEBIND=""--# Don't touch these-opt_active=0-opt_contrib=""-opt_main=""-opt_output=""--generate_configs() {- for extension_srcfile in $(ls --color=never -1 "${opt_contrib}"/*.hs | head -n -1 | sort -r) ; do- for tag in $TAG_CABALBUILDDEP \- $TAG_DEF \- $TAG_IMPORT \- $TAG_KEYBIND \- $TAG_KEYBINDLIST \- $TAG_LAYOUT \- $TAG_MOUSEBIND ; do-- ifs="$IFS"- IFS=$'\n'- tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") )- IFS="${ifs}"-- case $tag in- $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP- ins_marker=$INS_MARKER_CABALBUILDDEP- ins_prefix=$ACTIVE_INS_PREFIX_CABALBUILDDEP- ;;- $TAG_DEF) ins_indent=$INS_INDENT_DEF- ins_marker=$INS_MARKER_DEF- ins_prefix=$INS_PREFIX_DEF- ;;- $TAG_IMPORT) ins_indent=$INS_INDENT_IMPORT- ins_marker=$INS_MARKER_IMPORT- ins_prefix=$INS_PREFIX_IMPORT- ;;- $TAG_KEYBIND) ins_indent=$INS_INDENT_KEYBIND- ins_marker=$INS_MARKER_KEYBIND- ins_prefix=$INS_PREFIX_KEYBIND- ;;- $TAG_KEYBINDLIST) ins_indent=$INS_INDENT_KEYBINDLIST- ins_marker=$INS_MARKER_KEYBINDLIST- ins_prefix=$INS_PREFIX_KEYBINDLIST- ;;- $TAG_LAYOUT) ins_indent=$INS_INDENT_LAYOUT- ins_marker=$INS_MARKER_LAYOUT- ins_prefix=$INS_PREFIX_LAYOUT- ;;- $TAG_MOUSEBIND) ins_indent=$INS_INDENT_MOUSEBIND- ins_marker=$INS_MARKER_MOUSEBIND- ins_prefix=$INS_PREFIX_MOUSEBIND- ;;- esac-- # Insert in reverse so values will ultimately appear in correct order.- for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do- [ -z "${tags[i]}" ] && continue- if [[ $tag == $TAG_CABALBUILDDEP ]] ; then- sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE}"- else- sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE}"- fi- done-- if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then- ins_group_comment="${ins_indent}-- For extension $(basename $extension_srcfile .hs):"- sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE}"- fi- done- done-}--parse_opts() {- [[ -z "$1" ]] && show_usage 1-- while [[ $# > 0 ]] ; do- case "$1" in- --active|-a) opt_active=1- shift ;;-- --contrib|-c) shift- if [[ -z "$1" || ! -d "$1" ]] ; then- echo "Error: Option --contrib requires a directory as argument. See: generate-configs -h"- exit 1- fi- opt_contrib="$1"- shift ;;-- --help|-h) show_usage ;;-- --main|-m) shift- if [[ -z "$1" || ! -d "$1" ]] ; then- echo "Error: Option --main requires a directory as argument. See: generate-configs -h"- exit 1- fi- opt_main="$1"- shift ;;-- --output|-o) shift- if [[ -z "$1" || ! -d "$1" ]] ; then- echo "Error: Option --output requires a directory as argument. See: generate-configs -h"- exit 1- fi- opt_output="$1"- shift ;;-- -*) echo "Error: Unknown option ${1}. See: generate-configs -h"- exit 1 ;;-- *) show_usage 1 ;;- esac- done-- if [[ -z "$opt_main" ]] ; then- echo "Error: Missing required option --main. See: generate-configs -h"- exit 1- fi-- if [[ -z "$opt_contrib" ]] ; then- echo "Error: Missing required option --contrib. See: generate-configs -h"- exit 1- fi-}--show_usage() {-cat << EOF-Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR--OPTIONS:- --active, -a Insert data in active mode (default: passive)- --contrib, -c CONTRIB_DIR Path to contrib repository base directory- --help, -h Show help- --main, -m MAIN_DIR Path to main repository base directory- --output, -o OUTPUT_DIR Output directory (default: CONTRIB_DIR)-EOF- exit ${1:-0}-}--parse_opts $*--[[ -z "$opt_output" ]] && opt_output="$opt_contrib"--CABAL_FILE="${opt_output}/xmonad.cabal"-CONFIG_FILE="${opt_output}/Config.hs"--cp -f "${opt_main}/xmonad.cabal" "${CABAL_FILE}"-cp -f "${opt_main}/Config.hs" "${CONFIG_FILE}"--if [[ $opt_active == 1 ]] ; then- INS_PREFIX_DEF=$ACTIVE_INS_PREFIX_DEF- INS_PREFIX_IMPORT=$ACTIVE_INS_PREFIX_IMPORT- INS_PREFIX_KEYBIND=$ACTIVE_INS_PREFIX_KEYBIND- INS_PREFIX_KEYBINDLIST=$ACTIVE_INS_PREFIX_KEYBINDLIST- INS_PREFIX_LAYOUT=$ACTIVE_INS_PREFIX_LAYOUT- INS_PREFIX_MOUSEBIND=$ACTIVE_INS_PREFIX_MOUSEBIND-fi--generate_configs
+ scripts/xmonadctl.hs view
@@ -0,0 +1,73 @@+#!/usr/bin/env runhaskell++-- Copyright: (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007+-- License: BSD-style (see xmonad/LICENSE)+--+-- Compile with @ghc --make xmonadctl.hs@+-- For usage help, do @xmonadctl -h@++import Control.Monad+import Data.Char+import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras+import System.Environment+import System.IO++main :: IO ()+main = parse True "XMONAD_COMMAND" =<< getArgs++parse :: Bool -> String -> [String] -> IO ()+parse input addr args = case args of+ ["--"] | input -> repl addr+ | otherwise -> return ()+ ("--":xs) -> sendAll addr xs+ ("-a":a:xs) -> parse input a xs+ ("-h":_) -> showHelp+ ("--help":_) -> showHelp+ ("-?":_) -> showHelp+ (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a)++ (x:xs) -> sendCommand addr x >> parse False addr xs+ [] | input -> repl addr+ | otherwise -> return ()+++repl :: String -> IO ()+repl addr = do e <- isEOF+ unless e $ do+ l <- getLine+ sendCommand addr l+ repl addr++sendAll :: String -> [String] -> IO ()+sendAll addr = foldr (\a b -> sendCommand addr a >> b) (return ())++sendCommand :: String -> String -> IO ()+sendCommand addr s = do+ d <- openDisplay ""+ rw <- rootWindow d $ defaultScreen d+ a <- internAtom d addr False+ m <- internAtom d s False+ allocaXEvent $ \e -> do+ setEventType e clientMessage+ setClientMessageEvent e rw a 32 m 0+ sendEvent d rw False structureNotifyMask e+ sync d False++showHelp :: IO ()+showHelp = do+ pn <- getProgName+ mapM_ putStrLn+ [ "Send commands to a running instance of xmonad."+ , "(xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.)"+ , ""+ , "-a atomname can be used at any point in the command line arguments to"+ , "change which atom it is sending on. The atom defaults to XMONAD_COMMAND."+ , ""+ , "If sent with no arguments or only -a atom arguments, it will read commands from stdin."+ , ""+ , "Ex:"+ , pn ++ " cmd1 cmd2"+ , pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world"+ , pn ++ " -a XMONAD_PRINT # will read data from stdin."+ ]
+ scripts/xmonadpropread.hs view
@@ -0,0 +1,58 @@+#!/usr/bin/env runhaskell++{-# LANGUAGE LambdaCase #-}++-- Copyright Spencer Janssen <spencerjanssen@gmail.com>+-- BSD3 (see LICENSE)+--+-- Reads from an X property on the root window and writes to standard output.+--+-- May be used together with XMonad.Hooks.StatusBar.xmonadPropLog and a+-- status bar that doesn't support reading from properties itself, such as+-- dzen.+--+-- Usage:+--+-- $ xmonadpropread | dzen2+--+-- or+--+-- $ xmonadpropread _XMONAD_LOG_CUSTOM | dzen2++import Control.Monad+import Graphics.X11+import Graphics.X11.Xlib.Extras+import Codec.Binary.UTF8.String as UTF8+import Foreign.C (CChar)+import System.Environment+import System.IO++main :: IO ()+main = do+ hSetBuffering stdout LineBuffering++ atom <- flip fmap getArgs $ \case+ [a] -> a+ _ -> "_XMONAD_LOG"++ d <- openDisplay ""+ xlog <- internAtom d atom False++ root <- rootWindow d (defaultScreen d)+ selectInput d root propertyChangeMask++ let printProp = do+ mwp <- getWindowProperty8 d xlog root+ maybe (return ()) (putStrLn . decodeCChar) mwp++ printProp++ allocaXEvent $ \ep -> forever $ do+ nextEvent d ep+ e <- getEvent ep+ case e of+ PropertyEvent { ev_atom = a } | a == xlog -> printProp+ _ -> return ()++decodeCChar :: [CChar] -> String+decodeCChar = UTF8.decode . map fromIntegral
+ tests/EZConfig.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns #-}+module EZConfig (spec) where++import Control.Arrow (first, (>>>))+import Data.Coerce+import Foreign.C.Types (CUInt(..))+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import XMonad+import XMonad.Prelude+import XMonad.Util.EZConfig+import XMonad.Util.Parser++spec :: Spec+spec = do+ prop "prop_decodePreservation" prop_decodePreservation+ prop "prop_encodePreservation" prop_encodePreservation++ context "parseKey" $ do+ let prepare = unzip . map (first surround)+ testParseKey (ns, ks) = traverse (runParser parseKey) ns `shouldBe` Just ks+ it "parses all regular keys" $ testParseKey (unzip regularKeys )+ it "parses all function keys" $ testParseKey (prepare functionKeys )+ it "parses all special keys" $ testParseKey (prepare specialKeys )+ it "parses all multimedia keys" $ testParseKey (prepare multimediaKeys)+ context "parseModifier" $ do+ it "parses all combinations of modifiers" $+ nub . map sort <$> traverse (runParser (many $ parseModifier def))+ modifiers+ `shouldBe` Just [[ shiftMask, controlMask+ , mod1Mask, mod1Mask -- def M and M1+ , mod2Mask, mod3Mask, mod4Mask, mod5Mask+ ]]++ -- Checking for regressions+ describe "readKeySequence" $+ it "Fails on the non-existent key M-10" $+ readKeySequence def "M-10" `shouldBe` Nothing++-- | Parsing preserves all info that printing does.+prop_encodePreservation :: KeyString -> Property+prop_encodePreservation (coerce -> s) = parse s === (parse . pp =<< parse s)+ where parse = runParser (parseKeySequence def)+ pp = unwords . map keyToString++-- | Printing preserves all info that parsing does.+prop_decodePreservation :: NonEmptyList (AKeyMask, AKeySym) -> Property+prop_decodePreservation (getNonEmpty >>> coerce -> xs) =+ Just (pp xs) === (fmap pp . parse $ pp xs)+ where parse = runParser (parseKeySequence def)+ pp = unwords . map keyToString++-- | QuickCheck can handle the 8! combinations just fine.+modifiers :: [String]+modifiers = map concat $ permutations mods++mods :: [String]+mods = ["M-", "C-", "S-", "M1-", "M2-", "M3-", "M4-", "M5-"]++surround :: String -> String+surround s = "<" <> s <> ">"++-----------------------------------------------------------------------+-- Newtypes and Arbitrary instances++newtype AKeyMask = AKeyMask KeyMask+ deriving newtype (Show)++instance Arbitrary AKeyMask where+ arbitrary :: Gen AKeyMask+ arbitrary = fmap (coerce . sum . nub) . listOf . elements $+ [noModMask, shiftMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask]++newtype AKeySym = AKeySym KeySym+ deriving newtype (Show)++instance Arbitrary AKeySym where+ arbitrary :: Gen AKeySym+ arbitrary = elements . coerce . map snd $ regularKeys <> allSpecialKeys++newtype KeyString = KeyString String+ deriving newtype (Show)++instance Arbitrary KeyString where+ arbitrary :: Gen KeyString+ arbitrary = coerce . unwords <$> listOf keybinding+ where+ keybinding :: Gen String+ keybinding = do+ let keyStr = map fst $ regularKeys <> allSpecialKeys+ mks <- nub <$> listOf (elements ("" : mods))+ k <- elements keyStr+ ks <- listOf . elements $ keyStr+ pure $ concat mks <> k <> " " <> unwords ks
tests/Main.hs view
@@ -13,6 +13,7 @@ import qualified CycleRecentWS import qualified OrgMode import qualified GridSelect+import qualified EZConfig main :: IO () main = hspec $ do@@ -51,3 +52,4 @@ context "CycleRecentWS" CycleRecentWS.spec context "OrgMode" OrgMode.spec context "GridSelect" GridSelect.spec+ context "EZConfig" EZConfig.spec
tests/OrgMode.hs view
@@ -19,34 +19,86 @@ spec :: Spec spec = do- prop "prop_encodeLinearity" prop_encodeLinearity- prop "prop_decodeLinearity" prop_decodeLinearity+ 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_encodeLinearity (OrgMsg "+d +d f")- it "decode" $ prop_decodeLinearity (Deadline "+d" (Time {date = Next Friday, tod = Nothing}))+ 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_encodeLinearity (OrgMsg "+d f 1 +d f")- it "decode" $ prop_decodeLinearity (Deadline "+d f 1" (Time {date = Next Friday, tod = Nothing}))+ 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) --- | Printing omits no information from output.-prop_encodeLinearity :: OrgMsg -> Property-prop_encodeLinearity (OrgMsg s) = Just s === (ppNote <$> pInput s)+-- | Parsing preserves all info that printing does.+prop_encodePreservation :: OrgMsg -> Property+prop_encodePreservation (OrgMsg s) = pInput s === (pInput . ppNote =<< pInput s) --- | Parsing discards no information from input.-prop_decodeLinearity :: Note -> Property-prop_decodeLinearity n = Just n === pInput (ppNote n)+-- | 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 -> str <> " +s " <> ppTime t- Deadline str t -> str <> " +d " <> ppTime t- NormalMsg str -> str+ 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@@ -70,21 +122,27 @@ instance Arbitrary OrgMsg where arbitrary :: Gen OrgMsg- arbitrary = OrgMsg <$>- randomString <<>> elements [" +s ", " +d ", ""] <<>> dateGen <<>> hourGen+ 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- , unwords <$> sequenceA [rNat, monthGen]- , unwords <$> sequenceA [rNat, monthGen, show <$> posInt `suchThat` (> 25)]+ , 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 :: Gen String- rNat = show <$> posInt+ 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@@ -103,7 +161,12 @@ arbitrary = do msg <- randomString t <- arbitrary- elements [Scheduled msg t, Deadline msg t, NormalMsg msg]+ 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
xmonad-contrib.cabal view
@@ -1,9 +1,9 @@ name: xmonad-contrib-version: 0.17.0+version: 0.17.1 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_* homepage: https://xmonad.org/-synopsis: Community-maintained extensions extensions for xmonad+synopsis: Community-maintained extensions for xmonad description: Community-maintained tiling algorithms and extension modules for xmonad, an X11 tiling window manager.@@ -23,17 +23,22 @@ license-file: LICENSE author: Spencer Janssen & others maintainer: xmonad@haskell.org-extra-source-files: README.md CHANGES.md scripts/generate-configs scripts/run-xmonad.sh+extra-source-files: README.md+ CHANGES.md+ scripts/run-xmonad.sh scripts/window-properties.sh- scripts/xinitrc scripts/xmonad-acpi.c+ scripts/xinitrc+ scripts/xmonad-acpi.c scripts/xmonad-clock.c+ 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.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1+tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.2 source-repository head type: git@@ -61,16 +66,17 @@ unix, X11 >= 1.10 && < 1.11, xmonad >= 0.16.99999 && < 0.18,- utf8-string+ utf8-string,+ deepseq default-language: Haskell2010 cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0 -DXMONAD_CONTRIB_VERSION_MINOR=17- -DXMONAD_CONTRIB_VERSION_PATCH=0+ -DXMONAD_CONTRIB_VERSION_PATCH=1 ghc-options: -Wall -Wno-unused-do-bind if flag(pedantic)- ghc-options: -Werror -Wwarn=deprecations+ ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports -- Keep this in sync with the oldest version in 'tested-with' if impl(ghc > 8.4.4)@@ -117,6 +123,7 @@ XMonad.Actions.Navigation2D XMonad.Actions.NoBorders XMonad.Actions.OnScreen+ XMonad.Actions.PerLayoutKeys XMonad.Actions.PerWindowKeys XMonad.Actions.PerWorkspaceKeys XMonad.Actions.PhysicalScreens@@ -124,6 +131,7 @@ XMonad.Actions.Prefix XMonad.Actions.Promote XMonad.Actions.RandomBackground+ XMonad.Actions.RepeatAction XMonad.Actions.RotSlaves XMonad.Actions.RotateSome XMonad.Actions.Search@@ -167,6 +175,7 @@ XMonad.Doc.Configuring XMonad.Doc.Developing XMonad.Doc.Extending+ XMonad.Hooks.BorderPerWindow XMonad.Hooks.CurrentWorkspaceOnTop XMonad.Hooks.DebugEvents XMonad.Hooks.DebugKeyEvents@@ -187,6 +196,7 @@ XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.Minimize+ XMonad.Hooks.Modal XMonad.Hooks.Place XMonad.Hooks.PositionStoreHooks XMonad.Hooks.RefocusLast@@ -196,8 +206,10 @@ 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@@ -214,6 +226,7 @@ XMonad.Layout.BorderResize XMonad.Layout.BoringWindows XMonad.Layout.ButtonDecoration+ XMonad.Layout.CenteredIfSingle XMonad.Layout.CenteredMaster XMonad.Layout.Circle XMonad.Layout.Column@@ -283,6 +296,7 @@ XMonad.Layout.ResizeScreen XMonad.Layout.Roledex XMonad.Layout.ShowWName+ XMonad.Layout.SideBorderDecoration XMonad.Layout.SimpleDecoration XMonad.Layout.SimpleFloat XMonad.Layout.Simplest@@ -333,6 +347,7 @@ XMonad.Prompt.XMonad XMonad.Prompt.Zsh XMonad.Util.ActionCycle+ XMonad.Util.ActionQueue XMonad.Util.ClickableWorkspaces XMonad.Util.Cursor XMonad.Util.CustomKeys@@ -345,6 +360,7 @@ XMonad.Util.ExtensibleConf XMonad.Util.ExtensibleState XMonad.Util.Font+ XMonad.Util.Grab XMonad.Util.Hacks XMonad.Util.Image XMonad.Util.Invisible@@ -355,8 +371,10 @@ 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@@ -383,6 +401,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs other-modules: CycleRecentWS+ EZConfig ExtensibleConf GridSelect Instances@@ -399,6 +418,7 @@ XMonad.Actions.GridSelect XMonad.Actions.PhysicalScreens XMonad.Actions.RotateSome+ XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.WindowBringer@@ -417,12 +437,16 @@ 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@@ -438,6 +462,7 @@ build-depends: base , QuickCheck >= 2 , X11 >= 1.10 && < 1.11+ , bytestring >= 0.10 && < 0.12 , containers , directory , time >= 1.8 && < 1.13@@ -447,13 +472,14 @@ , process , unix , utf8-string+ , deepseq , xmonad >= 0.16.9999 && < 0.18 cpp-options: -DTESTING ghc-options: -Wall -Wno-unused-do-bind default-language: Haskell2010 if flag(pedantic)- ghc-options: -Werror -Wwarn=deprecations+ ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports -- Keep this in sync with the oldest version in 'tested-with' if impl(ghc > 8.4.4)