diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,11 +1,320 @@ # Change Log / Release Notes -## 0.17.1 (September 3, 2021) +## 0.18.0 (February 3, 2024) ### Breaking Changes + * Deprecated `XMonad.Layout.Cross` due to bitrot; refer to + `XMonad.Layout.Circle` and `XMonad.Layout.ThreeColumns` for + alternatives. + + * Deprecated the `XMonad.Layout.StateFull` module and + `XMonad.Layout.TrackFloating.(t|T)rackFloating` in favour of + `XMonad.Layout.FocusTracking`. + + * Dropped support for GHC 8.4. + + * `XMonad.Util.ExclusiveScratchpads` + + - Deprecated the module in favour of the (new) exclusive scratchpad + functionality of `XMonad.Util.NamedScratchpad`. + + * `XMonad.Actions.CycleWorkspaceByScreen` + + - The type of `repeatableAction` has changed, and it's deprecated in + favour of `X.A.Repeatable.repeatable`. + + * `XMonad.Hooks.DynamicProperty` + + - Deprecated the module in favour of the more aptly named + `XMonad.Hooks.OnPropertyChange`. + + * `XMonad.Util.Scratchpad`: + + - Deprecated the module; use `XMonad.Util.NamedScratchpad` instead. + + * `XMonad.Actions.Navigation2D` + + - Removed deprecated function `hybridNavigation`. + + * `XMonad.Layout.Spacing` + + - Removed deprecated functions `SpacingWithEdge`, `SmartSpacing`, + `SmartSpacingWithEdge`, `ModifySpacing`, `setSpacing`, and + `incSpacing`. + + * `XMonad.Actions.MessageFeedback` + + - Removed deprecated functions `send`, `sendSM`, `sendSM_`, + `tryInOrder`, `tryInOrder_`, `tryMessage`, and `tryMessage_`. + + * `XMonad.Prompt.Window` + + - Removed deprecated functions `windowPromptGoto`, + `windowPromptBring`, and `windowPromptBringCopy`. + + * `XMonad.Hooks.ICCCMFocus` + + - Removed deprecated module. This was merged into xmonad. + + * `XMonad.Layout.LayoutBuilderP` + + - Removed deprecated module; use `XMonad.Layout.LayoutBuilder` + instead. + + * `XMonad.Hooks.RestoreMinimized` + + - Removed deprecated module; use `XMonad.Hooks.Minimize` instead. + + * `XMonad.Layout.Named` + + - Deprecated the entire module, use `XMonad.Layout.Renamed` (which newly + provides `named` for convenience) instead. + + * `XMonad.Actions.SinkAll` + + - Deprecated the entire module, use `XMonad.Actions.WithAll` + instead. + + * `XMonad.Layout.Circle`: + + - Deprecated the entire module, use the `circle` function from + `XMonad.Layout.CircleEx` instead. + + * `XMonad.Hooks.EwmhDesktops` + + - `_NET_CLIENT_LIST_STACKING` puts windows in the current workspace at the + top in bottom-to-top order, followed by visible workspaces, followed by + invisible workspaces. Within visible and invisible groups, workspaces are + ordered lexicographically, as before. Currently focused window will + always be the topmost, meaning the last in the list. + + * `XMonad.Util.NamedScratchpad` + + - Added `nsSingleScratchpadPerWorkspace`—a logHook to allow only one + active scratchpad per workspace. + * `XMonad.Util.EZConfig` + - The function `readKeySequence` now returns a non-empty list if it + succeeded. + + * Deprecate `XMonad.Util.Ungrab`; it was moved to `XMonad.Operations` + in core. + +### New Modules + + * `XMonad.Layout.CenterMainFluid` + - A three column layout with main column in the center and two stack + column surrounding it. Master window will be on center column and + spaces on the sides are reserved. + + * `XMonad.Layout.FocusTracking`. + + - Replaces `X.L.StateFull` and half of `X.L.TrackFloating`. + + * `XMonad.Actions.MostRecentlyUsed` + + - Tab through windows by recency of use. Based on the Alt+Tab behaviour + common outside of xmonad. + + * `XMonad.Util.History` + + - Track history in *O(log n)* time. Provides `History`, a variation on a + LIFO stack with a uniqueness property. In order to achieve the desired + asymptotics, the data type is implemented as an ordered Map. + + * `XMonad.Actions.Repeatable` + + - Actions you'd like to repeat. Factors out the shared logic of + `X.A.CycleRecentWS`, `X.A.CycleWorkspaceByScreen` and `X.A.CycleWindows`. + + * `XMonad.Hooks.OnPropertyChange`: + + - A new module replicating the functionality of + `XMonad.Hooks.DynamicProperty`, but with more discoverable names. + + * `XMonad.Actions.ToggleFullFloat`: + + - Fullscreen (float) a window while remembering its original state. + There's both an action to be bound to a key, and hooks that plug into + `XMonad.Hooks.EwmhDesktops`. + + * `XMonad.Layout.CircleEx`: + + - A new window layout, similar to X.L.Circle, but with more + possibilities for customisation. + + * `XMonad.Layout.DecorationEx`: + + - A new, more extensible, mechanism for window decorations, and some + standard types of decorations, including usual bar on top of window, + tabbed decorations and dwm-like decorations. + +### Bug Fixes and Minor Changes + + * `XMonad.Layout.Magnifier` + + - Added `magnifyxy` to allow for different magnification in the + horizontal and vertical directions. Added `magnifierxy`, + `magnifierxy'`, `magnifierxyOff`, and `magnifierxyOff'` as + particular combinators. + + * `XMonad.Util.Loggers` + + - Added `logClassname`, `logClassnames`, `logClassnames'`, + `logClassnameOnScreen`, `logClassnamesOnScreen`, `logClassnamesOnScreen'`, + and `ClassnamesFormat`. These are all equivalents of their `Title` + counterparts, allowing logging the window classname instead. + + * `XMonad.Hooks.StatusBar.PP` + + - `dynamicLogString` now forces its result and produces an error string if + it throws an exception. Use `dynamicLogString'` if for some reason you + need the old behavior. + + * `XMonad.Util.EZConfig` + + - Added `remapKeysP`, which remaps keybindings from one binding to + another. + + - Made `additionalKeys{,P}`, `removeKeys{,P}`, `remapKeysP`, and + `{additional,remove}MouseBindings` `infixl 4` so they can more easily + be concatenated with `(++)`. + + * `XMonad.Util.NamedScratchpad` + + - Added `addExclusives`, `resetFocusedNSP`, `setNoexclusive`, + `resizeNoexclusive`, and `floatMoveNoexclusive` in order to augment + named scratchpads with the exclusive scratchpad functionality of + `XMonad.Util.ExclusiveScratchpads`. + + * `XMonad.Layout.BorderResize` + + - Added `borderResizeNear` as a variant of `borderResize` that can + control how many pixels near a border resizing still works. + + * `XMonad.Util.Run` + + - It is now ensured that all arguments of `execute` and `eval` are + quoted. Likewise, `executeNoQuote` is added as a version of + `execute` that does not do that. + + - Added `findFile` as a shorthand to call `find-file`. + + - Added `list` and `saveExcursion` to the list of Emacs commands. + + - Added `toList` to easily lift a `String` to an `X Input`. + + - Added `>&&>` and `>||>` to glue together different inputs. + + * `XMonad.Util.Parser` + + - Added the `gather`, `count`, `between`, `option`, `optionally`, + `skipMany`, `skipMany1`, `chainr`, `chainr1`, `chainl`, `chainl1`, + and `manyTill` functions, in order to achieve feature parity with + `Text.ParserCombinators.ReadP`. + + * `XMonad.Actions.FloatKeys` + + - Added `directionMoveWindow` and `directionMoveWindow` as more + alternatives to the existing functions. + + * `XMonad.Hooks.InsertPosition` + + - Added `setupInsertPosition` as a combinator alternative to + `insertPosition`. + + * `XMonad.Actions.Navigation2D` + + - Added `sideNavigation` as a fallback to the default tiling strategy, + in case `lineNavigation` can't find a window. This benefits + especially users who use `XMonad.Layout.Spacing`. + + * `XMonad.Prompt.OrgMode` + + - Added `orgPromptRefile` and `orgPromptRefileTo` for interactive + and targeted refiling of the entered note into some existing tree + of headings, respectively. + + - Allowed the time specification in `HHMM` format. + + * `XMonad.Actions.Search` + + - Added `aur`, `flora`, `ncatlab`, `protondb`, `rosettacode`, `sourcehut`, + `steam`, `voidpgks_x86_64`, `voidpgks_x86_64_musl`, `arXiv`, + `clojureDocs`, `cratesIo`, `rustStd`, `noogle`, `nixos`, `homeManager`, + and `zbmath` search engines. + + * `XMonad.Layout.ResizableThreeColumns` + + - Fixed an issue where the bottom right window would not respond to + `MirrorShrink` and `MirrorExpand` messages. + + * `XMonad.Hooks.EwmhDesktops` + + - Added `disableEwmhManageDesktopViewport` to avoid setting the + `_NET_DESKTOP_VIEWPORT` property, as it can lead to issues with + some status bars (see this + [polybar issue](https://github.com/polybar/polybar/issues/2603)). + + - Added `setEwmhFullscreenHooks` to override the default fullfloat/sink + behaviour of `_NET_WM_STATE_FULLSCREEN` requests. See also + `XMonad.Actions.ToggleFullFloat` for a float-restoring implementation of + fullscreening. + + - Added `ewmhDesktops(Maybe)ManageHook` that places windows in their + preferred workspaces. This is useful when restoring a browser session + after a restart. + + * `XMonad.Hooks.StatusBar` + + - Added `startAllStatusBars` to start the configured status bars. + + * `XMonad.Util.NamedActions` + + - Changed `addDescrKeys` and `addDescrKeys'` to not discard the + keybindings in the current config. + + * `XMonad.Prompt` + + - The `emacsLikeXPKeymap` and `vimLikeXPKeymap` keymaps now treat + `C-m` the same as `Return`. + + - Added `prevCompletionKey` to `XPConfig`, facilitating the ability + to cycle through the completions backwards. This is bound to + `S-` by default. + + - The `vimLikeXPKeymap` now accepts the prompt upon pressing enter + in normal mode. + + * `XMonad.Actions.Prefix` + + - Added `orIfPrefixed`, a combinator to decide upon an action based + on whether any prefix argument was given. + + * `XMonad.Actions.WorkspaceNames` + + - Enabled prompt completion (from history) in `renameWorkspace`. + + * `XMonad.Prompt.Pass` + + - Added `passOTPTypePrompt` to type out one-time-passwords via + `xdotool`. + + * `XMonad.Util.Stack` + + - Added `zipperFocusedAtFirstOf` to differentiate two lists into a + zipper. + +### Other changes + +## 0.17.1 (September 3, 2022) + +### Breaking Changes + + * `XMonad.Util.EZConfig` + - The functions `parseKey`, `parseKeyCombo`, and `parseKeySequence` now return a `Parser` (from `XMonad.Util.Parser`) instead of a `ReadP`. @@ -15,7 +324,7 @@ - Deprecated all of these modules. The user-specific configuration modules may still be found [on the website]. - * `XMonad.Util.NamedScratchpad` + * `XMonad.Util.NamedScratchpad` - Scratchpads are now only based on the argument given to `namedScratchpadManageHook`; all other scratchpad arguments are, @@ -79,7 +388,7 @@ A module for adding a keybinding to repeat the last action, similar to Vim's `.` or Emacs's `dot-mode`. - * `XMonad.Util.Grab` + * `XMonad.Util.Grab` Utilities for making grabbing and ungrabbing keys more convenient. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,9 +6,9 @@ License Made in Haskell
- Stack - Cabal - Nix + Stack + Cabal + Nix
GitHub Sponsors Open Collective diff --git a/XMonad/Actions/AfterDrag.hs b/XMonad/Actions/AfterDrag.hs --- a/XMonad/Actions/AfterDrag.hs +++ b/XMonad/Actions/AfterDrag.hs @@ -24,7 +24,7 @@ import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.AfterDrag -- diff --git a/XMonad/Actions/BluetileCommands.hs b/XMonad/Actions/BluetileCommands.hs --- a/XMonad/Actions/BluetileCommands.hs +++ b/XMonad/Actions/BluetileCommands.hs @@ -29,7 +29,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode -- > import XMonad.Actions.BluetileCommands diff --git a/XMonad/Actions/Commands.hs b/XMonad/Actions/Commands.hs --- a/XMonad/Actions/Commands.hs +++ b/XMonad/Actions/Commands.hs @@ -37,7 +37,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Commands -- @@ -57,7 +57,7 @@ -- bindings!) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a -- list of pairs. diff --git a/XMonad/Actions/ConstrainedResize.hs b/XMonad/Actions/ConstrainedResize.hs --- a/XMonad/Actions/ConstrainedResize.hs +++ b/XMonad/Actions/ConstrainedResize.hs @@ -26,7 +26,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import qualified XMonad.Actions.ConstrainedResize as Sqr -- diff --git a/XMonad/Actions/CopyWindow.hs b/XMonad/Actions/CopyWindow.hs --- a/XMonad/Actions/CopyWindow.hs +++ b/XMonad/Actions/CopyWindow.hs @@ -37,7 +37,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CopyWindow -- @@ -77,7 +77,7 @@ -- > , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- $logHook -- diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs --- a/XMonad/Actions/CycleRecentWS.hs +++ b/XMonad/Actions/CycleRecentWS.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS @@ -35,21 +36,25 @@ #endif ) where +import XMonad.Actions.Repeatable (repeatableSt) + import XMonad hiding (workspaces) -import XMonad.StackSet hiding (filter) +import XMonad.Prelude (void, when) +import XMonad.StackSet hiding (filter, modify) import Control.Arrow ((&&&)) import Data.Function (on) +import Control.Monad.State (lift) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleRecentWS -- > -- > , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Cycle through most recent workspaces with repeated presses of a key, while -- a modifier key is held down. The recency of workspaces previewed while browsing @@ -111,25 +116,15 @@ -> X () cycleWindowSets genOptions mods keyNext keyPrev = do (options, unView') <- gets $ (genOptions &&& unView) . windowset - XConf {theRoot = root, display = d} <- ask - let event = allocaXEvent $ \p -> do - maskEvent d (keyPressMask .|. keyReleaseMask) p - KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p - s <- keycodeToKeysym d c 0 - return (t, s) - let setOption n = do windows $ view (options `cycref` n) . unView' - (t, s) <- io event - case () of - () | t == keyPress && s == keyNext -> setOption (n+1) - | t == keyPress && s == keyPrev -> setOption (n-1) - | t == keyRelease && s `elem` mods -> return () - | otherwise -> setOption n - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - setOption 0 - io $ ungrabKeyboard d currentTime - where - cycref :: [a] -> Int -> a - cycref l i = l !! (i `mod` length l) + let + preview = do + i <- get + lift $ windows (view (options !! (i `mod` n)) . unView') + where n = length options + void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if + | s == keyNext -> modify succ >> preview + | s == keyPrev -> modify pred >> preview + | otherwise -> pure () -- | Given an old and a new 'WindowSet', which is __exactly__ one -- 'view' away from the old one, restore the workspace order of the diff --git a/XMonad/Actions/CycleSelectedLayouts.hs b/XMonad/Actions/CycleSelectedLayouts.hs --- a/XMonad/Actions/CycleSelectedLayouts.hs +++ b/XMonad/Actions/CycleSelectedLayouts.hs @@ -23,7 +23,7 @@ import qualified XMonad.StackSet as S -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.CycleSelectedLayouts @@ -39,8 +39,9 @@ -- | If the current layout is in the list, cycle to the next layout. Otherwise, -- apply the first layout from list. cycleThroughLayouts :: [String] -> X () -cycleThroughLayouts lst = do +cycleThroughLayouts [] = pure () +cycleThroughLayouts lst@(x: _) = do winset <- gets windowset let ld = description . S.layout . S.workspace . S.current $ winset - let newld = fromMaybe (head lst) (cycleToNext lst ld) + let newld = fromMaybe x (cycleToNext lst ld) sendMessage $ JumpToLayout newld diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs --- a/XMonad/Actions/CycleWS.hs +++ b/XMonad/Actions/CycleWS.hs @@ -92,7 +92,7 @@ import XMonad.Util.WorkspaceCompare -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWS -- > @@ -122,7 +122,7 @@ -- > windows . view $ t ) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- When using the toggle functions, in order to ensure that the workspace -- to which you switch is the previously viewed workspace, use the diff --git a/XMonad/Actions/CycleWindows.hs b/XMonad/Actions/CycleWindows.hs --- a/XMonad/Actions/CycleWindows.hs +++ b/XMonad/Actions/CycleWindows.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns, MultiWayIf #-} -------------------------------------------------------------------------------- -- | @@ -50,7 +50,6 @@ -- $pointer -- * Generic list rotations - -- $generic rotUp, rotDown ) where @@ -59,11 +58,13 @@ import qualified XMonad.StackSet as W import qualified Data.List.NonEmpty as NE import XMonad.Actions.RotSlaves +import XMonad.Actions.Repeatable (repeatableSt) import Control.Arrow (second) +import Control.Monad.Trans (lift) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWindows -- > -- config @@ -79,7 +80,7 @@ -- -- Also, if you use focus follows mouse, you will want to read the section -- on updating the mouse pointer below. For detailed instructions on --- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". +-- editing your key bindings, see . {- $pointer With FocusFollowsMouse == True, the focus is updated after binding actions, possibly focusing a window you didn't intend to focus. Most @@ -139,27 +140,19 @@ -> KeySym -- ^ Key used to select a \"previous\" stack. -> X () cycleStacks' filteredPerms mods keyNext keyPrev = do - XConf {theRoot = root, display = d} <- ask - stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset - - let evt = allocaXEvent $ - \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p - KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p - s <- keycodeToKeysym d c 0 - return (t, s) - choose n (t, s) - | t == keyPress && s == keyNext = io evt >>= choose (n+1) - | t == keyPress && s == keyPrev = io evt >>= choose (n-1) - | t == keyPress && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s) - | t == keyRelease && s `elem` mods = return () - | otherwise = doStack n >> io evt >>= choose n - doStack n = windows . W.modify' . const $ stacks `cycref` n - - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - io evt >>= choose 1 - io $ ungrabKeyboard d currentTime - where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite - numKeyToN = subtract 48 . read . show + stacks <- gets $ maybe [] filteredPerms + . W.stack . W.workspace . W.current . windowset + let + preview = do + i <- get + lift . windows . W.modify' . const $ stacks !! (i `mod` n) + where n = length stacks + void $ repeatableSt 0 mods keyNext $ \t s -> if + | t == keyPress && s == keyNext -> modify succ + | t == keyPress && s == keyPrev -> modify pred + | t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s) + | otherwise -> preview + where numKeyToN = subtract 48 . read . show -- | Given a stack element and a stack, shift or insert the element (window) -- at the currently focused position. @@ -229,12 +222,3 @@ rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll) (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) - --- $generic --- Generic list rotations such that @rotUp [1..4]@ is equivalent to --- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are --- @id@ for null or singleton lists. -rotUp :: [a] -> [a] -rotUp l = drop 1 l ++ take 1 l -rotDown :: [a] -> [a] -rotDown = reverse . rotUp . reverse diff --git a/XMonad/Actions/CycleWorkspaceByScreen.hs b/XMonad/Actions/CycleWorkspaceByScreen.hs --- a/XMonad/Actions/CycleWorkspaceByScreen.hs +++ b/XMonad/Actions/CycleWorkspaceByScreen.hs @@ -25,11 +25,10 @@ import Data.IORef -import Graphics.X11.Xlib.Extras - import XMonad import XMonad.Prelude import XMonad.Hooks.WorkspaceHistory +import XMonad.Actions.Repeatable (repeatable) import qualified XMonad.StackSet as W -- $usage @@ -53,22 +52,9 @@ -- -- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p) -repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X () -repeatableAction mods pressHandler = do - XConf {theRoot = root, display = d} <- ask - let getNextEvent = io $ allocaXEvent $ \p -> - do - maskEvent d (keyPressMask .|. keyReleaseMask) p - KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p - s <- io $ keycodeToKeysym d c 0 - return (t, s) - handleEvent (t, s) - | t == keyRelease && s `elem` mods = return () - | otherwise = pressHandler t s >> getNextEvent >>= handleEvent - - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - getNextEvent >>= handleEvent - io $ ungrabKeyboard d currentTime +{-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-} +repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X () +repeatableAction = repeatable handleKeyEvent :: EventType -> KeySym @@ -109,8 +95,7 @@ return $ cycleWorkspaces !! current focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView) - focusIncrement 1 -- Do the first workspace cycle - repeatableAction mods $ + repeatable mods nextKey $ runFirst [ handleKeyEvent keyPress nextKey $ focusIncrement 1 , handleKeyEvent keyPress prevKey $ focusIncrement (-1) diff --git a/XMonad/Actions/DeManage.hs b/XMonad/Actions/DeManage.hs --- a/XMonad/Actions/DeManage.hs +++ b/XMonad/Actions/DeManage.hs @@ -39,7 +39,7 @@ import XMonad -- $usage --- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@: +-- To use demanage, add this import to your @xmonad.hs@: -- -- > import XMonad.Actions.DeManage -- @@ -48,7 +48,7 @@ -- > , ((modm, xK_d ), withFocused demanage) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Stop managing the currently focused window. demanage :: Window -> X () diff --git a/XMonad/Actions/DwmPromote.hs b/XMonad/Actions/DwmPromote.hs --- a/XMonad/Actions/DwmPromote.hs +++ b/XMonad/Actions/DwmPromote.hs @@ -31,7 +31,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.DwmPromote -- @@ -40,7 +40,7 @@ -- > , ((modm, xK_Return), dwmpromote) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Swap the focused window with the master window. If focus is in -- the master, swap it with the next window in the stack. Focus diff --git a/XMonad/Actions/DynamicProjects.hs b/XMonad/Actions/DynamicProjects.hs --- a/XMonad/Actions/DynamicProjects.hs +++ b/XMonad/Actions/DynamicProjects.hs @@ -113,7 +113,7 @@ -- > , ((modm, xK_slash), shiftToProjectPrompt def) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -------------------------------------------------------------------------------- type ProjectName = String diff --git a/XMonad/Actions/DynamicWorkspaceGroups.hs b/XMonad/Actions/DynamicWorkspaceGroups.hs --- a/XMonad/Actions/DynamicWorkspaceGroups.hs +++ b/XMonad/Actions/DynamicWorkspaceGroups.hs @@ -51,7 +51,7 @@ import XMonad.Actions.TopicSpace -- $usage --- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaceGroups -- diff --git a/XMonad/Actions/DynamicWorkspaceOrder.hs b/XMonad/Actions/DynamicWorkspaceOrder.hs --- a/XMonad/Actions/DynamicWorkspaceOrder.hs +++ b/XMonad/Actions/DynamicWorkspaceOrder.hs @@ -49,7 +49,7 @@ import Data.Ord (comparing) -- $usage --- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs --- a/XMonad/Actions/DynamicWorkspaces.hs +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -44,7 +44,7 @@ import qualified XMonad.Util.ExtensibleState as XS -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaces -- > import XMonad.Actions.CopyWindow(copy) @@ -75,7 +75,7 @@ -- > zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..]) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for +-- . See also the documentation for -- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'. type WorkspaceTag = String diff --git a/XMonad/Actions/EasyMotion.hs b/XMonad/Actions/EasyMotion.hs --- a/XMonad/Actions/EasyMotion.hs +++ b/XMonad/Actions/EasyMotion.hs @@ -51,7 +51,7 @@ -- $usage -- -- You can use this module's basic functionality with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Actions.EasyMotion (selectWindow) -- @@ -387,5 +387,5 @@ _ -> handleKeyboard dpy drawFn cancel (trim fg) (clear bg) >>= retryBackspace where (fg, bg) = partition ((== Just keySym) . listToMaybe . chord) selected - trim = map (\o -> o { chord = tail $ chord o }) + trim = map (\o -> o { chord = drop 1 $ chord o }) clear = map (\o -> o { chord = [] }) diff --git a/XMonad/Actions/FindEmptyWorkspace.hs b/XMonad/Actions/FindEmptyWorkspace.hs --- a/XMonad/Actions/FindEmptyWorkspace.hs +++ b/XMonad/Actions/FindEmptyWorkspace.hs @@ -25,7 +25,7 @@ -- $usage -- --- To use, import this module into your @~\/.xmonad\/xmonad.hs@: +-- To use, import this module into your @xmonad.hs@: -- -- > import XMonad.Actions.FindEmptyWorkspace -- @@ -38,7 +38,7 @@ -- will tag the current window to an empty workspace and view it. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Find the first hidden empty workspace in a StackSet. Returns -- Nothing if all workspaces are in use. Function searches currently diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs --- a/XMonad/Actions/FlexibleManipulate.hs +++ b/XMonad/Actions/FlexibleManipulate.hs @@ -29,7 +29,7 @@ import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($)) -- $usage --- First, add this import to your @~\/.xmonad\/xmonad.hs@: +-- First, add this import to your @xmonad.hs@: -- -- > import qualified XMonad.Actions.FlexibleManipulate as Flex -- diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs --- a/XMonad/Actions/FlexibleResize.hs +++ b/XMonad/Actions/FlexibleResize.hs @@ -25,7 +25,7 @@ import Foreign.C.Types -- $usage --- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file: +-- To use, first import this module into your @xmonad.hs@ file: -- -- > import qualified XMonad.Actions.FlexibleResize as Flex -- diff --git a/XMonad/Actions/FloatKeys.hs b/XMonad/Actions/FloatKeys.hs --- a/XMonad/Actions/FloatKeys.hs +++ b/XMonad/Actions/FloatKeys.hs @@ -19,14 +19,18 @@ keysMoveWindowTo, keysResizeWindow, keysAbsResizeWindow, + directionMoveWindow, + directionResizeWindow, + Direction2D(..), P, G, ChangeDim ) where import XMonad import XMonad.Prelude (fi) +import XMonad.Util.Types -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.FloatKeys -- @@ -38,8 +42,36 @@ -- > , ((modm .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) -- > , ((modm, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) -- +-- Using "XMonad.Util.EZConfig" syntax, we can easily build keybindings +-- where @M-\@ moves the currently focused window and +-- @M-S-\@ resizes it using 'directionMoveWindow' and +-- 'directionResizeWindow': +-- +-- > [ ("M-" <> m <> k, withFocused $ f i) +-- > | (i, k) <- zip [U, D, R, L] ["", "", "", ""] +-- > , (f, m) <- [(directionMoveWindow 10, ""), (directionResizeWindow 10, "S-")] +-- > ] +-- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . + +-- | @directionMoveWindow delta dir win@ moves the window @win@ by +-- @delta@ pixels in direction @dir@. +directionMoveWindow :: Int -> Direction2D -> Window -> X () +directionMoveWindow delta dir win = case dir of + U -> keysMoveWindow (0, -delta) win + D -> keysMoveWindow (0, delta) win + R -> keysMoveWindow (delta, 0) win + L -> keysMoveWindow (-delta, 0) win + +-- | @directionResizeWindow delta dir win@ resizes the window @win@ by +-- @delta@ pixels in direction @dir@. +directionResizeWindow :: Int -> Direction2D -> Window -> X () +directionResizeWindow delta dir win = case dir of + U -> keysResizeWindow (0, -delta) (0, 0) win + D -> keysResizeWindow (0, delta) (0, 0) win + R -> keysResizeWindow (delta, 0) (0, 0) win + L -> keysResizeWindow (-delta, 0) (0, 0) win -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the -- right and @dy@ pixels down. diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -37,7 +37,7 @@ import XMonad.Actions.AfterDrag -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.FloatSnap -- @@ -53,7 +53,7 @@ -- > , ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- And possibly add appropriate mouse bindings, for example: -- diff --git a/XMonad/Actions/FocusNth.hs b/XMonad/Actions/FocusNth.hs --- a/XMonad/Actions/FocusNth.hs +++ b/XMonad/Actions/FocusNth.hs @@ -25,7 +25,7 @@ import XMonad.StackSet -- $usage --- Add the import to your @~\/.xmonad\/xmonad.hs@: +-- Add the import to your @xmonad.hs@: -- -- > import XMonad.Actions.FocusNth -- @@ -36,7 +36,7 @@ -- > | (i, k) <- zip [0 .. 8] [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Give focus to the nth window of the current workspace. focusNth :: Int -> X () diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -97,10 +97,11 @@ import Text.Printf import System.Random (mkStdGen, randomR) import Data.Word (Word8) +import qualified Data.List.NonEmpty as NE -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.GridSelect -- @@ -142,8 +143,8 @@ -- -- Then you can bind to: -- --- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer) --- > ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer) +-- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer) +-- > ,((modm, xK_p), spawnSelected (gsconfig2 defaultColorizer) ["xterm","gvim"]) -- $keybindings -- @@ -302,14 +303,14 @@ r = tr ++ map (\(x,y) -> (y,-x)) tr in r ++ map (negate *** negate) r -diamond :: (Enum a, Num a, Eq a) => [(a, a)] -diamond = concatMap diamondLayer [0..] +diamond :: (Enum a, Num a, Eq a) => Stream (a, a) +diamond = fromList $ concatMap diamondLayer [0..] diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)] diamondRestrict x y originX originY = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) . - take 1000 $ diamond + takeS 1000 $ diamond findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) @@ -658,7 +659,7 @@ originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY coords = diamondRestrict restrictX restrictY originPosX originPosY - s = TwoDState { td_curpos = head coords, + s = TwoDState { td_curpos = NE.head (notEmpty coords), td_availSlots = coords, td_elements = elements, td_gsconfig = gsconfig, diff --git a/XMonad/Actions/GroupNavigation.hs b/XMonad/Actions/GroupNavigation.hs --- a/XMonad/Actions/GroupNavigation.hs +++ b/XMonad/Actions/GroupNavigation.hs @@ -33,8 +33,8 @@ , isOnAnyVisibleWS ) where -import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.Reader (ask, asks) +import Control.Monad.State (gets) import Control.DeepSeq import Data.Map ((!)) import qualified Data.Map as Map @@ -47,13 +47,13 @@ import XMonad.Core import XMonad.ManageHook import XMonad.Operations (windows, withFocused) -import XMonad.Prelude (elem, foldl') +import XMonad.Prelude (elem, foldl', (>=>)) import qualified XMonad.StackSet as SS import qualified XMonad.Util.ExtensibleState as XS {- $usage -Import the module into your @~\/.xmonad\/xmonad.hs@: +Import the module into your @xmonad.hs@: > import XMonad.Actions.GroupNavigation @@ -129,7 +129,7 @@ >=> maybe act (windows . SS.focusWindow) -- Returns the list of windows ordered by workspace as specified in --- ~/.xmonad/xmonad.hs +-- @xmonad.hs@. orderedWindowList :: Direction -> X (Seq Window) orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get orderedWindowList dir = withWindowSet $ \ss -> do @@ -145,7 +145,7 @@ dirfun _ = id rotfun wins x = rotate $ rotateTo (== x) wins --- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs +-- Returns the ordered workspace list as specified in @xmonad.hs@. orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs' where diff --git a/XMonad/Actions/LinkWorkspaces.hs b/XMonad/Actions/LinkWorkspaces.hs --- a/XMonad/Actions/LinkWorkspaces.hs +++ b/XMonad/Actions/LinkWorkspaces.hs @@ -36,7 +36,7 @@ ( insert, delete, Map, lookup, empty, filter ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.LinkWorkspaces -- @@ -58,7 +58,7 @@ -- > , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X() , foreground :: [Char] diff --git a/XMonad/Actions/MessageFeedback.hs b/XMonad/Actions/MessageFeedback.hs --- a/XMonad/Actions/MessageFeedback.hs +++ b/XMonad/Actions/MessageFeedback.hs @@ -42,24 +42,18 @@ -- ** Aliases , sm - - -- * Backwards Compatibility - -- $backwardsCompatibility - , send, sendSM, sendSM_ - , tryInOrder, tryInOrder_ - , tryMessage, tryMessage_ ) where import XMonad ( Window ) import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust ) import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet ) -import XMonad.Prelude ( isJust, liftA2, void ) +import XMonad.Prelude import XMonad.StackSet ( Workspace, current, workspace, layout, tag ) import Control.Monad.State ( gets ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.MessageFeedback -- @@ -230,46 +224,3 @@ -- | Convenience shorthand for 'SomeMessage'. sm :: Message a => a -> SomeMessage sm = SomeMessage - --------------------------------------------------------------------------------- --- Backwards Compatibility: --------------------------------------------------------------------------------- -{-# DEPRECATED send "Use sendMessageB instead." #-} -{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-} -{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-} -{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-} -{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-} -{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-} -{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-} - --- $backwardsCompatibility --- The following functions exist solely for compatibility with pre-0.14 --- releases. - --- | See 'sendMessageWithNoRefreshToCurrentB'. -send :: Message a => a -> X Bool -send = sendMessageWithNoRefreshToCurrentB - --- | See 'sendSomeMessageWithNoRefreshToCurrentB'. -sendSM :: SomeMessage -> X Bool -sendSM = sendSomeMessageWithNoRefreshToCurrentB - --- | See 'sendSomeMessageWithNoRefreshToCurrent'. -sendSM_ :: SomeMessage -> X () -sendSM_ = sendSomeMessageWithNoRefreshToCurrent - --- | See 'tryInOrderWithNoRefreshToCurrentB'. -tryInOrder :: [SomeMessage] -> X Bool -tryInOrder = tryInOrderWithNoRefreshToCurrentB - --- | See 'tryInOrderWithNoRefreshToCurrent'. -tryInOrder_ :: [SomeMessage] -> X () -tryInOrder_ = tryInOrderWithNoRefreshToCurrent - --- | See 'tryMessageWithNoRefreshToCurrentB'. -tryMessage :: (Message a, Message b) => a -> b -> X Bool -tryMessage = tryMessageWithNoRefreshToCurrentB - --- | See 'tryMessageWithNoRefreshToCurrent'. -tryMessage_ :: (Message a, Message b) => a -> b -> X () -tryMessage_ = tryMessageWithNoRefreshToCurrent diff --git a/XMonad/Actions/Minimize.hs b/XMonad/Actions/Minimize.hs --- a/XMonad/Actions/Minimize.hs +++ b/XMonad/Actions/Minimize.hs @@ -12,7 +12,7 @@ -- Adds actions for minimizing and maximizing windows -- -- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your --- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from +-- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from -- this module -- -- Possible keybindings: diff --git a/XMonad/Actions/MostRecentlyUsed.hs b/XMonad/Actions/MostRecentlyUsed.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/MostRecentlyUsed.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.MostRecentlyUsed +-- Description : Tab through windows by recency of use. +-- Copyright : (c) 2022 L. S. Leary +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : @LSLeary (on github) +-- Stability : unstable +-- Portability : unportable +-- +-- Based on the Alt+Tab behaviour common outside of xmonad. +-- +----------------------------------------------------------------------------- + +-- --< Imports & Exports >-- {{{ + +module XMonad.Actions.MostRecentlyUsed ( + + -- * Usage + -- $usage + + -- * Interface + configureMRU, + mostRecentlyUsed, + withMostRecentlyUsed, + Location(..), + + ) where + +-- base +import Data.List.NonEmpty (nonEmpty) +import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef) +import Control.Monad.IO.Class (MonadIO) + +-- mtl +import Control.Monad.Trans (lift) +import Control.Monad.State (get, put, gets) + +-- containers +import qualified Data.Map.Strict as M + +-- xmonad +import XMonad + ( Window, KeySym, keyPress, io + , Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window) + ) +import XMonad.Core + ( X, XConfig(..), windowset, WorkspaceId, ScreenId + , ExtensionClass(..), StateExtension(..) + , waitingUnmap + ) +import XMonad.Operations (screenWorkspace) +import qualified XMonad.StackSet as W + +-- xmonad-contrib +import qualified XMonad.Util.ExtensibleConf as XC +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.PureX + (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow) +import XMonad.Util.History (History, origin, event, erase, ledger) +import XMonad.Actions.Repeatable (repeatableSt) +import XMonad.Prelude + +-- }}} + +-- --< Core Data Types: WindowHistory & Location >-- {{{ + +data WindowHistory = WinHist + { busy :: !Bool + , hist :: !(History Window Location) + } deriving (Show, Read) + +instance ExtensionClass WindowHistory where + initialValue = WinHist + { busy = False + , hist = origin + } + extensionType = PersistentExtension + +data Location = Location + { workspace :: !WorkspaceId + , screen :: !ScreenId + } deriving (Show, Read, Eq, Ord) + +-- }}} + +-- --< Interface >-- {{{ + +-- $usage +-- +-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed' +-- to work. +-- +-- > main :: IO () +-- > main = xmonad . configureMRU . ... $ def +-- > { ... +-- > } +-- +-- Once that's done, it can be used normally in keybinds: +-- +-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab) +-- +-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not +-- always the case, depending on how your system is configured. + +-- | Configure xmonad to support 'mostRecentlyUsed'. +configureMRU :: XConfig l -> XConfig l +configureMRU = XC.once f (MRU ()) where + f cnf = cnf + { logHook = logHook cnf <> logWinHist + , handleEventHook = handleEventHook cnf <> winHistEH + } +newtype MRU = MRU () deriving Semigroup + +-- | An action to browse through the history of focused windows, taking +-- another step back with each tap of the key. +mostRecentlyUsed + :: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the + -- action is bound. + -> KeySym -- ^ The 'KeySym' corresponding to the key to which the action + -- is bound. + -> X () +mostRecentlyUsed mods key = do + (toUndo, undo) <- undoer + let undoably curThing withThing thing = curThing >>= \cur -> + when (cur /= thing) $ withThing thing >> toUndo (withThing cur) + withMostRecentlyUsed mods key $ \win Location{workspace,screen} -> + handlingRefresh $ do + undo + undoably curScreenId viewScreen screen + undoably curTag greedyView workspace + mi <- gets (W.findTag win . windowset) + for_ mi $ \i -> do + undoably curTag greedyView i + mfw <- peek + for_ mfw $ \fw -> do + undoably (pure fw) focusWindow win + where + undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a) + undoer = do + ref <- io . newIORef $ pure mempty + let toUndo = io . modifyIORef ref . liftA2 (<>) + undo = join (io $ readIORef ref) + <* io (writeIORef ref $ pure mempty) + pure (toUndo, undo) + viewScreen :: ScreenId -> X Any + viewScreen scr = screenWorkspace scr >>= foldMap view + +-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what +-- is done with each window you tab through (the default being to visit its +-- previous 'Location' and give it focus). +withMostRecentlyUsed + :: [KeySym] -- ^ The 'KeySym's corresponding to the + -- modifier to which the action is bound. + -> KeySym -- ^ The 'KeySym' corresponding to the key to + -- which the action is bound. + -> (Window -> Location -> X ()) -- ^ The function applied to each window. + -> X () +withMostRecentlyUsed mods tab preview = do + wh@WinHist{busy,hist} <- XS.get + unless busy $ do + XS.put wh{ busy = True } + + for_ (nonEmpty $ ledger hist) $ \ne -> do + mfw <- gets (W.peek . windowset) + let iSt = case cycleS ne of + (w, _) :~ s | mfw == Just w -> s + s -> s + repeatableSt iSt mods tab $ \t s -> + when (t == keyPress && s == tab) (pop >>= lift . uncurry preview) + + XS.modify $ \ws@WinHist{} -> ws{ busy = False } + logWinHist + where + pop = do + h :~ t <- get + put t $> h + +-- }}} + +-- --< Raw Config >-- {{{ + +logWinHist :: X () +logWinHist = do + wh@WinHist{busy,hist} <- XS.get + unless busy $ do + cs <- gets (W.current . windowset) + let cws = W.workspace cs + for_ (W.stack cws) $ \st -> do + let location = Location{ workspace = W.tag cws, screen = W.screen cs } + XS.put wh{ hist = event (W.focus st) location hist } + +winHistEH :: Event -> X All +winHistEH ev = All True <$ case ev of + UnmapEvent{ ev_send_event = synth, ev_window = w } -> do + e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) + when (synth || e == 0) (collect w) + DestroyWindowEvent{ ev_window = w } -> collect w + _ -> pure () + where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist } + +-- }}} diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs --- a/XMonad/Actions/MouseGestures.hs +++ b/XMonad/Actions/MouseGestures.hs @@ -32,7 +32,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.MouseGestures -- > import qualified XMonad.StackSet as W diff --git a/XMonad/Actions/MouseResize.hs b/XMonad/Actions/MouseResize.hs --- a/XMonad/Actions/MouseResize.hs +++ b/XMonad/Actions/MouseResize.hs @@ -37,7 +37,7 @@ -- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness". -- -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Actions.MouseResize -- > import XMonad.Layout.WindowArranger @@ -50,9 +50,9 @@ -- -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". mouseResize :: l a -> ModifiedLayout MouseResize l a mouseResize = ModifiedLayout (MR []) diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -46,7 +46,6 @@ , sideNavigation , sideNavigationWithBias , hybridOf - , hybridNavigation , fullScreenRect , singleWindowRect , switchLayer @@ -67,6 +66,7 @@ import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.EZConfig (additionalKeys, additionalKeysP) import XMonad.Util.Types +import qualified Data.List.NonEmpty as NE -- $usage -- #Usage# @@ -85,7 +85,7 @@ -- layers and allows customization of the navigation strategy for the tiled -- layer based on the layout currently in effect. -- --- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with (a subset of) the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Navigation2D -- @@ -98,8 +98,16 @@ -- > False -- > $ def -- --- Alternatively, you can use navigation2DP: +-- /NOTE/: the @def@ argument to 'navigation2D' contains the strategy +-- that decides which windows actually get selected. While the default +-- behaviour tries to keep them into account, if you use modules that +-- influence tiling in some way, like "XMonad.Layout.Spacing" or +-- "XMonad.Layout.Gaps", you should think about using a different +-- strategy, if you find the default behaviour to be unnatural. Check +-- out the [finer points](#g:Finer_Points) below for more information. -- +-- Alternatively to 'navigation2D', you can use 'navigation2DP': +-- -- > main = xmonad $ navigation2DP def -- > ("", "", "", "") -- > [("M-", windowGo ), @@ -108,7 +116,7 @@ -- > $ def -- -- That's it. If instead you'd like more control, you can combine --- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP: +-- 'withNavigation2DConfig' and 'additionalNav2DKeys' or 'additionalNav2DKeysP': -- -- > main = xmonad $ withNavigation2DConfig def -- > $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right) @@ -162,7 +170,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- $finer_points -- #Finer_Points# @@ -179,9 +187,19 @@ -- values in the above example to 'True'. You could also decide you want -- wrapping only for a subset of the operations and no wrapping for others. -- --- By default, all layouts use the 'defaultTiledNavigation' strategy specified --- in the 'Navigation2DConfig' (by default, line navigation is used). To --- override this behaviour for some layouts, add a pair (\"layout name\", +-- By default, all layouts use the 'defaultTiledNavigation' strategy +-- specified in the 'Navigation2DConfig' (by default, line navigation is +-- used). Many more navigation strategies are available; some may feel +-- more natural, depending on the layout and user: +-- +-- * 'lineNavigation' +-- * 'centerNavigation' +-- * 'sideNavigation' +-- * 'sideNavigationWithBias' +-- +-- There is also the ability to combine two strategies with 'hybridOf'. +-- +-- To override the default behaviour for some layouts, add a pair (\"layout name\", -- navigation strategy) to the 'layoutNavigation' list in the -- 'Navigation2DConfig', where \"layout name\" is the string reported by the -- layout's description method (normally what is shown as the layout name in @@ -327,7 +345,7 @@ -- and push it to the right until it intersects with at least one other window. -- Of those windows, one with a point that is the closest to the centre of the -- line (+1) is selected. This is probably the most intuitive strategy for the --- tiled layer when using XMonad.Layout.Spacing. +-- tiled layer when using "XMonad.Layout.Spacing". sideNavigation :: Navigation2D sideNavigation = N 1 (doSideNavigationWithBias 1) @@ -359,10 +377,6 @@ where applyToBoth f g a b c = f a b c <|> g a b c -{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-} -hybridNavigation :: Navigation2D -hybridNavigation = hybridOf lineNavigation centerNavigation - -- | Stores the configuration of directional navigation. The 'Default' instance -- uses line navigation for the tiled layer and for navigation between screens, -- and center navigation for the float layer. No custom navigation strategies @@ -451,7 +465,7 @@ } instance Default Navigation2DConfig where - def = Navigation2DConfig { defaultTiledNavigation = lineNavigation + def = Navigation2DConfig { defaultTiledNavigation = hybridOf lineNavigation sideNavigation , floatNavigation = centerNavigation , screenNavigation = lineNavigation , layoutNavigation = [] @@ -770,8 +784,7 @@ -- All the points that coincide with the current center and succeed it -- in the (appropriately ordered) window stack. - onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr - -- tail should be safe here because cur should be in onCtr + onCtr' = L.drop 1 $ L.dropWhile ((cur /=) . fst) onCtr -- All the points that do not coincide with the current center and which -- lie in the (rotated) right cone. @@ -871,8 +884,8 @@ -- Reconstruct the workspaces' window stacks to reflect the swap. newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws - newwinset = winset { W.current = head newscrs - , W.visible = tail newscrs + newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen. + , W.visible = drop 1 newscrs } -- | Calculates the center of a rectangle diff --git a/XMonad/Actions/OnScreen.hs b/XMonad/Actions/OnScreen.hs --- a/XMonad/Actions/OnScreen.hs +++ b/XMonad/Actions/OnScreen.hs @@ -27,7 +27,7 @@ ) where import XMonad -import XMonad.Prelude (fromMaybe, guard) +import XMonad.Prelude (fromMaybe, guard, empty) import XMonad.StackSet hiding (new) @@ -140,16 +140,15 @@ let st' = hidden st -- make sure we actually have to do something guard $ i == (tag . workspace $ current st) - guard $ not (null st') - -- finally, toggle! - return $ f (tag . head $ st') st - + case st' of + [] -> empty + (h : _) -> return $ f (tag h) st -- finally, toggle! -- $usage -- -- This module provides an easy way to control, what you see on other screens in -- xinerama mode without having to focus them. Put this into your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Actions.OnScreen -- @@ -183,4 +182,4 @@ -- where 0 is the first screen and \"1\" the workspace with the tag \"1\". -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . diff --git a/XMonad/Actions/PerLayoutKeys.hs b/XMonad/Actions/PerLayoutKeys.hs --- a/XMonad/Actions/PerLayoutKeys.hs +++ b/XMonad/Actions/PerLayoutKeys.hs @@ -25,14 +25,14 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.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() diff --git a/XMonad/Actions/PerWindowKeys.hs b/XMonad/Actions/PerWindowKeys.hs --- a/XMonad/Actions/PerWindowKeys.hs +++ b/XMonad/Actions/PerWindowKeys.hs @@ -24,7 +24,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.PerWindowKeys -- @@ -41,7 +41,7 @@ -- doThisIfTheOthersFail)]@. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Run an action if a Query holds true. Doesn't stop at the first one that -- does, however, and could potentially run all actions. diff --git a/XMonad/Actions/PerWorkspaceKeys.hs b/XMonad/Actions/PerWorkspaceKeys.hs --- a/XMonad/Actions/PerWorkspaceKeys.hs +++ b/XMonad/Actions/PerWorkspaceKeys.hs @@ -25,14 +25,14 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.PerWorkspaceKeys -- -- > ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")]) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Uses supplied function to decide which action to run depending on current workspace name. chooseAction :: (String->X()) -> X() diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs --- a/XMonad/Actions/PhysicalScreens.hs +++ b/XMonad/Actions/PhysicalScreens.hs @@ -46,7 +46,7 @@ The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom and then left-to-right. -Example usage in your @~\/.xmonad\/xmonad.hs@ file: +Example usage in your @xmonad.hs@ file: > import XMonad.Actions.PhysicalScreens > import Data.Default @@ -65,7 +65,7 @@ > , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]] For detailed instructions on editing your key bindings, see -"XMonad.Doc.Extending#Editing_key_bindings". +. -} -- | The type of the index of a screen by location @@ -75,7 +75,7 @@ getScreenIdAndRectangle screen = (W.screen screen, rect) where rect = screenRect $ W.screenDetail screen --- | Translate a physical screen index to a "ScreenId" +-- | Translate a physical screen index to a 'ScreenId' getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId) getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset let screens = W.current w : W.visible w diff --git a/XMonad/Actions/Plane.hs b/XMonad/Actions/Plane.hs --- a/XMonad/Actions/Plane.hs +++ b/XMonad/Actions/Plane.hs @@ -41,13 +41,13 @@ import Data.Map (Map, fromList) -import XMonad.Prelude +import XMonad.Prelude hiding (fromList) import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Run -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.Plane -- > import Data.Map (union) @@ -59,7 +59,7 @@ -- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Direction to go in the plane. data Direction = ToLeft | ToUp | ToRight | ToDown deriving Enum diff --git a/XMonad/Actions/Prefix.hs b/XMonad/Actions/Prefix.hs --- a/XMonad/Actions/Prefix.hs +++ b/XMonad/Actions/Prefix.hs @@ -29,6 +29,7 @@ , withPrefixArgument , isPrefixRaw , isPrefixNumeric + , orIfPrefixed , ppFormatPrefix ) where @@ -40,11 +41,13 @@ import XMonad.Util.Paste (sendKey) import XMonad.Actions.Submap (submapDefaultWithKey) import XMonad.Util.EZConfig (readKeySequence) +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty ((<|)) {- $usage This module implements Emacs-style prefix argument. The argument -comes in two flavours, "Raw" and "Numeric". +comes in two flavours, 'Raw' and 'Numeric'. To initiate the "prefix mode" you hit the prefix keybinding (default C-u). This sets the Raw argument value to 1. Repeatedly hitting this @@ -72,7 +75,7 @@ > ((modm, xK_a), withPrefixArgument addMaybeClean) -Hitting MOD-a will add the to the playlist while C-u MOD-a will +Hitting MOD-a will add the @\@ to the playlist while C-u MOD-a will clear the playlist and then add the file. You can of course use an anonymous action, like so: @@ -128,11 +131,11 @@ -> XConfig l -> XConfig l usePrefixArgument prefix conf = - conf{ keys = M.insert binding (handlePrefixArg [binding]) . keys conf } + conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf } where binding = case readKeySequence conf prefix of - Just [key] -> key - _ -> (controlMask, xK_u) + Just (key :| []) -> key + _ -> (controlMask, xK_u) -- | Set Prefix up with default prefix key (C-u). useDefaultPrefixArgument :: LayoutClass l Window @@ -140,7 +143,7 @@ -> XConfig l useDefaultPrefixArgument = usePrefixArgument "C-u" -handlePrefixArg :: [(KeyMask, KeySym)] -> X () +handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X () handlePrefixArg events = do ks <- asks keyActions logger <- asks (logHook . config) @@ -161,19 +164,19 @@ Raw _ -> XS.put $ Numeric x Numeric a -> XS.put $ Numeric $ a * 10 + x None -> return () -- should never happen - handlePrefixArg (key:events) + handlePrefixArg (key <| events) else do prefix <- XS.get mapM_ (uncurry sendKey) $ case prefix of - Raw a -> replicate a (head events) ++ [key] - _ -> reverse (key:events) + Raw a -> replicate a (NE.head events) ++ [key] + _ -> reverse (key : toList events) keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9] -- | Turn a prefix-aware X action into an X-action. -- -- First, fetch the current prefix, then pass it as argument to the -- original function. You should use this to "run" your commands. -withPrefixArgument :: (PrefixArgument -> X ()) -> X () +withPrefixArgument :: (PrefixArgument -> X a) -> X a withPrefixArgument = (>>=) XS.get -- | Test if 'PrefixArgument' is 'Raw' or not. @@ -185,6 +188,13 @@ isPrefixNumeric :: PrefixArgument -> Bool isPrefixNumeric (Numeric _) = True isPrefixNumeric _ = False + +-- | Execute the first action, unless any prefix argument is given, +-- in which case the second action is chosen instead. +-- +-- > action1 `orIfPrefixed` action2 +orIfPrefixed :: X a -> X a -> X a +orIfPrefixed xa xb = withPrefixArgument $ bool xa xb . isPrefixRaw -- | Format the prefix using the Emacs convetion for use in a -- statusbar, like xmobar. diff --git a/XMonad/Actions/Promote.hs b/XMonad/Actions/Promote.hs --- a/XMonad/Actions/Promote.hs +++ b/XMonad/Actions/Promote.hs @@ -28,7 +28,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Promote -- @@ -37,7 +37,7 @@ -- > , ((modm, xK_Return), promote) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Move the focused window to the master pane. All other windows -- retain their order. If focus is in the master, swap it with the diff --git a/XMonad/Actions/Repeatable.hs b/XMonad/Actions/Repeatable.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/Repeatable.hs @@ -0,0 +1,89 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Repeatable +-- Description : Actions you'd like to repeat. +-- Copyright : (c) 2022 L. S. Leary +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : @LSLeary (on github) +-- Stability : unstable +-- Portability : unportable +-- +-- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS", +-- "XMonad.Actions.CycleWorkspaceByScreen", "XMonad.Actions.CycleWindows" and +-- "XMonad.Actions.MostRecentlyUsed". +-- +-- See the source of these modules for usage examples. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Repeatable + ( repeatable + , repeatableSt + , repeatableM + ) where + +-- mtl +import Control.Monad.State (StateT(..)) + +-- X11 +import Graphics.X11.Xlib.Extras + +-- xmonad +import XMonad + + +-- | An action that temporarily usurps and responds to key press/release events, +-- concluding when one of the modifier keys is released. +repeatable + :: [KeySym] -- ^ The list of 'KeySym's under the + -- modifiers used to invoke the action. + -> KeySym -- ^ The keypress that invokes the action. + -> (EventType -> KeySym -> X ()) -- ^ The keypress handler. + -> X () +repeatable = repeatableM id + +-- | A more general variant of 'repeatable' with a stateful handler, +-- accumulating a monoidal return value throughout the events. +repeatableSt + :: Monoid a + => s -- ^ Initial state. + -> [KeySym] -- ^ The list of 'KeySym's under the + -- modifiers used to invoke the + -- action. + -> KeySym -- ^ The keypress that invokes the + -- action. + -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler. + -> X (a, s) +repeatableSt iSt = repeatableM $ \m -> runStateT m iSt + +-- | A more general variant of 'repeatable' with an arbitrary monadic handler, +-- accumulating a monoidal return value throughout the events. +repeatableM + :: (MonadIO m, Monoid a) + => (m a -> X b) -- ^ How to run the monad in 'X'. + -> [KeySym] -- ^ The list of 'KeySym's under the + -- modifiers used to invoke the action. + -> KeySym -- ^ The keypress that invokes the action. + -> (EventType -> KeySym -> m a) -- ^ The keypress handler. + -> X b +repeatableM run mods key pressHandler = do + XConf{ theRoot = root, display = d } <- ask + run (repeatableRaw d root mods key pressHandler) + +repeatableRaw + :: (MonadIO m, Monoid a) + => Display -> Window + -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a +repeatableRaw d root mods key pressHandler = do + io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime) + handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime) + where + getNextEvent = io $ allocaXEvent $ \p -> do + maskEvent d (keyPressMask .|. keyReleaseMask) p + KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p + s <- keycodeToKeysym d c 0 + return (t, s) + handleEvent (t, s) + | t == keyRelease && s `elem` mods = pure mempty + | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent) diff --git a/XMonad/Actions/RotSlaves.hs b/XMonad/Actions/RotSlaves.hs --- a/XMonad/Actions/RotSlaves.hs +++ b/XMonad/Actions/RotSlaves.hs @@ -17,7 +17,11 @@ module XMonad.Actions.RotSlaves ( -- $usage rotSlaves', rotSlavesUp, rotSlavesDown, - rotAll', rotAllUp, rotAllDown + rotAll', rotAllUp, rotAllDown, + + -- * Generic list rotations + -- $generic + rotUp, rotDown ) where import XMonad @@ -39,13 +43,13 @@ -- TwoPane layout (see "XMonad.Layout.TwoPane"). -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Rotate the windows in the current stack, excluding the first one -- (master). rotSlavesUp,rotSlavesDown :: X () -rotSlavesUp = windows $ modify' (rotSlaves' (\l -> tail l++[head l])) -rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l)) +rotSlavesUp = windows $ modify' (rotSlaves' rotUp) +rotSlavesDown = windows $ modify' (rotSlaves' rotDown) -- | The actual rotation, as a pure function on the window stack. rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a @@ -57,10 +61,19 @@ -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X () -rotAllUp = windows $ modify' (rotAll' (\l -> tail l++[head l])) -rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l)) +rotAllUp = windows $ modify' (rotAll' rotUp) +rotAllDown = windows $ modify' (rotAll' rotDown) -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a rotAll' f s = Stack r (reverse revls) rs where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s)) + +-- $generic +-- Generic list rotations such that @rotUp [1..4]@ is equivalent to +-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are +-- @id@ for null or singleton lists. +rotUp :: [a] -> [a] +rotUp l = drop 1 l ++ take 1 l +rotDown :: [a] -> [a] +rotDown = reverse . rotUp . reverse diff --git a/XMonad/Actions/RotateSome.hs b/XMonad/Actions/RotateSome.hs --- a/XMonad/Actions/RotateSome.hs +++ b/XMonad/Actions/RotateSome.hs @@ -35,7 +35,7 @@ import XMonad.Util.Stack (reverseS) {- $usage -You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +You can use this module with the following in your @xmonad.hs@: > import XMonad.Actions.RotateSome diff --git a/XMonad/Actions/Search.hs b/XMonad/Actions/Search.hs --- a/XMonad/Actions/Search.hs +++ b/XMonad/Actions/Search.hs @@ -31,33 +31,50 @@ prefixAware, namedEngine, - amazon, alpha, + amazon, + arXiv, + aur, + clojureDocs, codesearch, + cratesIo, deb, debbts, debpts, dictionary, + duckduckgo, ebay, + flora, github, google, hackage, + homeManager, hoogle, images, imdb, lucky, maps, mathworld, + ncatlab, + nixos, + noogle, openstreetmap, + protondb, + rosettacode, + rustStd, scholar, + sourcehut, stackage, + steam, thesaurus, + vocabulary, + voidpgks_x86_64, + voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, - vocabulary, - duckduckgo, + zbmath, multi, -- * Use case: searching with a submap -- $tip @@ -102,12 +119,20 @@ The currently available search engines are: +* 'alpha' -- Wolfram|Alpha query. + * 'amazon' -- Amazon keyword search. -* 'alpha' -- Wolfram|Alpha query. +* 'arXiv' -- Open-access preprint archive. +* 'aur' -- Arch User Repository. + +* 'clojureDocs' -- Documentation and examples repository for Clojure. + * 'codesearch' -- Google Labs Code Search search. +* 'cratesIo' -- Rust crate registry. + * 'deb' -- Debian package search. * 'debbts' -- Debian Bug Tracking System. @@ -116,17 +141,21 @@ * 'dictionary' -- dictionary.reference.com search. +* 'duckduckgo' -- DuckDuckGo search engine. + * 'ebay' -- Ebay keyword search. +* 'flora' -- Prettier Haskell package database. + * 'github' -- GitHub keyword search. * 'google' -- basic Google search. * 'hackage' -- Hackage, the Haskell package database. -* 'hoogle' -- Hoogle, the Haskell libraries API search engine. +* 'homeManager' -- Search Nix's home-manager's options. -* 'stackage' -- Stackage, An alternative Haskell libraries API search engine. +* 'hoogle' -- Hoogle, the Haskell libraries API search engine. * 'images' -- Google images. @@ -138,21 +167,45 @@ * 'mathworld' -- Wolfram MathWorld search. +* 'ncatlab' -- Higer Algebra, Homotopy and Category Theory Wiki. + +* 'nixos' -- Search NixOS packages and options. + +* 'noogle' -- 'hoogle'-like Nix API search engine. + * 'openstreetmap' -- OpenStreetMap free wiki world map. +* 'protondb' -- Steam Proton Game Database. + +* 'rosettacode' -- Programming chrestomathy wiki. + +* 'rustStd' -- Rust standard library documentation. + * 'scholar' -- Google scholar academic search. +* 'sourcehut' -- Sourcehut projects search. + +* 'stackage' -- Stackage, An alternative Haskell libraries API search engine. + +* 'steam' -- Steam games search. + * 'thesaurus' -- thesaurus.com search. +* 'vocabulary' -- Dictionary search. + +* 'voidpgks_x86_64' -- Void Linux packages search for @x86_64@. + +* 'voidpgks_x86_64_musl' -- Void Linux packages search for @x86_64-musl@. + * 'wayback' -- the Wayback Machine. * 'wikipedia' -- basic Wikipedia search. -* 'youtube' -- Youtube video search. +* 'wiktionary' -- Wiktionary search. -* 'vocabulary' -- Dictionary search +* 'youtube' -- Youtube video search. -* 'duckduckgo' -- DuckDuckGo search engine. +* 'zbmath' -- Open alternative to MathSciNet. * 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google. @@ -269,7 +322,7 @@ inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function. > searchFunc :: String -> String -> searchFunc s | "wiki:" `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s) +> searchFunc s | "wiki:" `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ drop 1 $ snd $ break (==':') s) > | "https://" `isPrefixOf` s = s > | otherwise = (use google) s > myNewEngine = searchEngineF "mymulti" searchFunc @@ -286,39 +339,57 @@ searchEngineF = SearchEngine -- The engines. -amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle, - images, imdb, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary, - youtube, duckduckgo :: SearchEngine -amazon = searchEngine "amazon" "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords=" +alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, + github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb, + rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, + wikipedia, wiktionary, youtube, zbmath :: SearchEngine alpha = searchEngine "alpha" "https://www.wolframalpha.com/input/?i=" +amazon = searchEngine "amazon" "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords=" +arXiv = searchEngineF "arXiv" (\s -> "https://arxiv.org/search/?query=" <> s <> "&searchtype=all") +aur = searchEngine "aur" "https://aur.archlinux.org/packages?&K=" +clojureDocs = searchEngine "clojureDocs" "https://clojuredocs.org/search?q=" codesearch = searchEngine "codesearch" "https://developers.google.com/s/results/code-search?q=" +cratesIo = searchEngine "cratesIo" "https://crates.io/search?q=" deb = searchEngine "deb" "https://packages.debian.org/" debbts = searchEngine "debbts" "https://bugs.debian.org/" debpts = searchEngine "debpts" "https://packages.qa.debian.org/" dictionary = searchEngine "dict" "https://dictionary.reference.com/browse/" +duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" ebay = searchEngine "ebay" "https://www.ebay.com/sch/i.html?_nkw=" +flora = searchEngine "flora" "https://flora.pm/search?q=" github = searchEngine "github" "https://github.com/search?q=" google = searchEngine "google" "https://www.google.com/search?q=" hackage = searchEngine "hackage" "https://hackage.haskell.org/package/" +homeManager = searchEngine "homeManager" "https://mipmip.github.io/home-manager-option-search/?query=" hoogle = searchEngine "hoogle" "https://hoogle.haskell.org/?hoogle=" images = searchEngine "images" "https://images.google.fr/images?q=" imdb = searchEngine "imdb" "https://www.imdb.com/find?s=all&q=" lucky = searchEngine "lucky" "https://www.google.com/search?btnI&q=" maps = searchEngine "maps" "https://maps.google.com/maps?q=" mathworld = searchEngine "mathworld" "https://mathworld.wolfram.com/search/?query=" +ncatlab = searchEngine "ncatlab" "https://ncatlab.org/nlab/search?query=" +nixos = searchEngine "nixos" "https://search.nixos.org/packages?channel=unstable&from=0&size=200&sort=relevance&type=packages&query=" +noogle = searchEngineF "noogle" (\s -> "https://noogle.dev/?search=" <> s <> "&page=1&to=any&from=any") openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query=" +protondb = searchEngine "protondb" "https://www.protondb.com/search?q=" +rosettacode = searchEngine "rosettacode" "https://rosettacode.org/w/index.php?search=" +rustStd = searchEngine "rustStd" "https://doc.rust-lang.org/std/index.html?search=" scholar = searchEngine "scholar" "https://scholar.google.com/scholar?q=" +sourcehut = searchEngine "sourcehut" "https://sr.ht/projects?search=" stackage = searchEngine "stackage" "https://www.stackage.org/lts/hoogle?q=" +steam = searchEngine "steam" "https://store.steampowered.com/search/?term=" thesaurus = searchEngine "thesaurus" "https://thesaurus.com/browse/" +vocabulary = searchEngine "vocabulary" "https://www.vocabulary.com/search?q=" +voidpgks_x86_64 = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64&q=" +voidpgks_x86_64_musl = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64-musl&q=" +wayback = searchEngineF "wayback" ("https://web.archive.org/web/*/"++) wikipedia = searchEngine "wiki" "https://en.wikipedia.org/wiki/Special:Search?go=Go&search=" wiktionary = searchEngine "wikt" "https://en.wiktionary.org/wiki/Special:Search?go=Go&search=" youtube = searchEngine "youtube" "https://www.youtube.com/results?search_type=search_videos&search_query=" -wayback = searchEngineF "wayback" ("https://web.archive.org/web/*/"++) -vocabulary = searchEngine "vocabulary" "https://www.vocabulary.com/search?q=" -duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" +zbmath = searchEngine "zbmath" "https://zbmath.org/?q=" multi :: SearchEngine -multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle, images, imdb, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google] +multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google] {- | This function wraps up a search engine and creates a new one, which works like the argument, but goes directly to a URL if one is given rather than diff --git a/XMonad/Actions/ShowText.hs b/XMonad/Actions/ShowText.hs --- a/XMonad/Actions/ShowText.hs +++ b/XMonad/Actions/ShowText.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.ShowText @@ -26,7 +27,7 @@ import Data.Map (Map,empty,insert,lookup) import Prelude hiding (lookup) import XMonad -import XMonad.Prelude (All, fi, when) +import XMonad.Prelude (All, fi, listToMaybe) import XMonad.StackSet (current,screen) import XMonad.Util.Font (Align(AlignCenter) , initXMF @@ -41,7 +42,7 @@ import qualified XMonad.Util.ExtensibleState as ES -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.ShowText -- @@ -87,8 +88,9 @@ handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do (ShowText m) <- ES.get :: X ShowText a <- io $ internAtom dis "XMONAD_TIMER" False - when (mtyp == a && not (null d)) - (whenJust (lookup (fromIntegral $ head d) m) deleteWindow) + if | mtyp == a, Just dh <- listToMaybe d -> + whenJust (lookup (fromIntegral dh) m) deleteWindow + | otherwise -> pure () mempty handleTimerEvent _ = mempty diff --git a/XMonad/Actions/Sift.hs b/XMonad/Actions/Sift.hs --- a/XMonad/Actions/Sift.hs +++ b/XMonad/Actions/Sift.hs @@ -28,7 +28,7 @@ import XMonad.Util.Stack (reverseS) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Sift -- diff --git a/XMonad/Actions/SimpleDate.hs b/XMonad/Actions/SimpleDate.hs --- a/XMonad/Actions/SimpleDate.hs +++ b/XMonad/Actions/SimpleDate.hs @@ -24,7 +24,7 @@ import XMonad.Util.Run -- $usage --- To use, import this module into @~\/.xmonad\/xmonad.hs@: +-- To use, import this module into @xmonad.hs@: -- -- > import XMonad.Actions.SimpleDate -- @@ -35,7 +35,7 @@ -- In this example, a popup date menu will now be bound to @mod-d@. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . date :: X () date = unsafeSpawn "(date; sleep 10) | dzen2" diff --git a/XMonad/Actions/SinkAll.hs b/XMonad/Actions/SinkAll.hs --- a/XMonad/Actions/SinkAll.hs +++ b/XMonad/Actions/SinkAll.hs @@ -13,7 +13,7 @@ -- 'sinkAll' function for backwards compatibility. ----------------------------------------------------------------------------- -module XMonad.Actions.SinkAll ( +module XMonad.Actions.SinkAll {-# DEPRECATED "Use XMonad.Actions.WithAll instead" #-} ( -- * Usage -- $usage @@ -23,7 +23,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.SinkAll -- @@ -32,4 +32,4 @@ -- > , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -43,7 +43,7 @@ import XMonad.Util.Process (getPPIDChain) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.SpawnOn -- @@ -63,7 +63,7 @@ -- the spawned application(e.g. float or resize it). -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs --- a/XMonad/Actions/Submap.hs +++ b/XMonad/Actions/Submap.hs @@ -32,10 +32,7 @@ {- $usage - - - -First, import this module into your @~\/.xmonad\/xmonad.hs@: +First, import this module into your @xmonad.hs@: > import XMonad.Actions.Submap @@ -56,7 +53,7 @@ modifier. For detailed instructions on editing your key bindings, see -"XMonad.Doc.Extending#Editing_key_bindings". +. -} @@ -76,17 +73,17 @@ -- > -- > 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" --- > ]] +-- > [("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") --- > ]] +-- > 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)@. diff --git a/XMonad/Actions/SwapPromote.hs b/XMonad/Actions/SwapPromote.hs --- a/XMonad/Actions/SwapPromote.hs +++ b/XMonad/Actions/SwapPromote.hs @@ -63,6 +63,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Control.Arrow +import qualified Data.List.NonEmpty as NE -- $usage @@ -99,7 +100,7 @@ -- So far floating windows have been treated no differently than tiled windows -- even though their positions are independent of the stack. Often, yanking -- floating windows in and out of the workspace will obliterate the stack --- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is +-- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is -- toggled so frequenty and always replaces the master window. That's why the -- swap functions accept a boolean argument; when @True@ non-focused floating -- windows will be ignored. @@ -240,8 +241,8 @@ (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window) (b,s3) = swapFunction pm s2 s4 = stackMerge s3 r - mh = let w = head . W.integrate $ s3 - in const $ w : delete w ch + mh = let w = NE.head . notEmpty . W.integrate $ s3 + in const $ w : delete w ch in (b,Just s4,mh) (x,y,z) = maybe (False,Nothing,id) swapApply' st -- Any floating master windows will be added to the history when 'windows' diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs --- a/XMonad/Actions/SwapWorkspaces.hs +++ b/XMonad/Actions/SwapWorkspaces.hs @@ -30,7 +30,7 @@ -- $usage --- Add this import to your @~\/.xmonad\/xmonad.hs@: +-- Add this import to your @xmonad.hs@: -- -- > import XMonad.Actions.SwapWorkspaces -- @@ -44,7 +44,7 @@ -- will swap workspaces 1 and 5. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Swaps the currently focused workspace with the given workspace tag, via -- @swapWorkspaces@. diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs --- a/XMonad/Actions/TagWindows.hs +++ b/XMonad/Actions/TagWindows.hs @@ -39,7 +39,7 @@ -- $usage -- --- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@: +-- To use window tags, import this module into your @xmonad.hs@: -- -- > import XMonad.Actions.TagWindows -- > import XMonad.Prompt -- to use tagPrompt @@ -64,7 +64,7 @@ -- the tags \"a\" and \"b\" but not \"a b\". -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | set multiple tags for a window at once (overriding any previous tags) setTags :: [String] -> Window -> X () @@ -133,11 +133,6 @@ focusTagged' :: (WindowSet -> [Window]) -> String -> X () focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>= maybe (return ()) (windows . focusWindow) - -findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a) -findM _ [] = return Nothing -findM p (x:xs) = do b <- p x - if b then return (Just x) else findM p xs -- | apply a pure function to windows with a tag withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X () diff --git a/XMonad/Actions/TiledWindowDragging.hs b/XMonad/Actions/TiledWindowDragging.hs --- a/XMonad/Actions/TiledWindowDragging.hs +++ b/XMonad/Actions/TiledWindowDragging.hs @@ -27,7 +27,7 @@ import XMonad.Layout.DraggingVisualizer -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.TiledWindowDragging -- > import XMonad.Layout.DraggingVisualizer diff --git a/XMonad/Actions/ToggleFullFloat.hs b/XMonad/Actions/ToggleFullFloat.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/ToggleFullFloat.hs @@ -0,0 +1,122 @@ +-- | +-- Module : XMonad.Actions.ToggleFullFloat +-- Description : Fullscreen (float) a window while remembering its original state. +-- Copyright : (c) 2022 Tomáš Janoušek +-- License : BSD3 +-- Maintainer : Tomáš Janoušek +-- +module XMonad.Actions.ToggleFullFloat ( + -- * Usage + -- $usage + toggleFullFloatEwmhFullscreen, + toggleFullFloat, + fullFloat, + unFullFloat, + gcToggleFullFloat, + ) where + +import qualified Data.Map.Strict as M + +import XMonad +import XMonad.Prelude +import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks) +import XMonad.Hooks.ManageHelpers +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +-- --------------------------------------------------------------------- +-- $usage +-- +-- The main use-case is to make 'ewmhFullscreen' (re)store the size and +-- position of floating windows instead of just unconditionally sinking them +-- into the floating layer. To enable this, you'll need this in your +-- @xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Actions.ToggleFullFloat +-- > import XMonad.Hooks.EwmhDesktops +-- > +-- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…} +-- +-- Additionally, this "smart" fullscreening can be bound to a key and invoked +-- manually whenever one needs a larger window temporarily: +-- +-- > , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat) + +newtype ToggleFullFloat = ToggleFullFloat{ fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) } + deriving (Show, Read) + +instance ExtensionClass ToggleFullFloat where + extensionType = PersistentExtension + initialValue = ToggleFullFloat mempty + +-- | Full-float a window, remembering its state (tiled/floating and +-- position/size). +fullFloat :: Window -> X () +fullFloat = windows . appEndo <=< runQuery doFullFloatSave + +-- | Restore window to its remembered state. +unFullFloat :: Window -> X () +unFullFloat = windows . appEndo <=< runQuery doFullFloatRestore + +-- | Full-float a window, if it's not already full-floating. Otherwise, +-- restore its original state. +toggleFullFloat :: Window -> X () +toggleFullFloat w = ifM (isFullFloat w) (unFullFloat w) (fullFloat w) + +isFullFloat :: Window -> X Bool +isFullFloat w = gets $ (Just fullRect ==) . M.lookup w . W.floating . windowset + where + fullRect = W.RationalRect 0 0 1 1 + +doFullFloatSave :: ManageHook +doFullFloatSave = do + w <- ask + liftX $ do + f <- gets $ M.lookup w . W.floating . windowset + -- @M.insertWith const@ = don't overwrite stored original state + XS.modify' $ ToggleFullFloat . M.insertWith const w f . fromToggleFullFloat + doFullFloat + +doFullFloatRestore :: ManageHook +doFullFloatRestore = do + w <- ask + mf <- liftX $ do + mf <- XS.gets $ M.lookup w . fromToggleFullFloat + XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat + pure mf + doF $ case mf of + Just (Just f) -> W.float w f -- was floating before + Just Nothing -> W.sink w -- was tiled before + Nothing -> W.sink w -- fallback when not found in ToggleFullFloat + +-- | Install ToggleFullFloat garbage collection hooks. +-- +-- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if +-- using the 'toggleFullFloat' separately from the EWMH hook. +gcToggleFullFloat :: XConfig a -> XConfig a +gcToggleFullFloat c = c { startupHook = startupHook c <> gcToggleFullFloatStartupHook + , handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook } + +-- | ToggleFullFloat garbage collection: drop windows when they're destroyed. +gcToggleFullFloatEventHook :: Event -> X All +gcToggleFullFloatEventHook DestroyWindowEvent{ev_window = w} = do + XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat + mempty +gcToggleFullFloatEventHook _ = mempty + +-- | ToggleFullFloat garbage collection: restrict to existing windows at +-- startup. +gcToggleFullFloatStartupHook :: X () +gcToggleFullFloatStartupHook = withWindowSet $ \ws -> + XS.modify' $ ToggleFullFloat . M.filterWithKey (\w _ -> w `W.member` ws) . fromToggleFullFloat + +-- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This +-- makes windows restore their original state (size and position if floating) +-- instead of unconditionally sinking into the tiling layer. +-- +-- ('gcToggleFullFloat' is included here.) +toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a +toggleFullFloatEwmhFullscreen = + setEwmhFullscreenHooks doFullFloatSave doFullFloatRestore . + gcToggleFullFloat diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs --- a/XMonad/Actions/TopicSpace.hs +++ b/XMonad/Actions/TopicSpace.hs @@ -103,9 +103,12 @@ -- display your topics in an historical way using a custom `pprWindowSet' -- function. You can also easily switch to recent topics using this history -- of last focused topics. +-- +-- A blog post highlighting some features of this module can be found +-- . -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import qualified Data.Map.Strict as M -- > import qualified XMonad.StackSet as W diff --git a/XMonad/Actions/UpdateFocus.hs b/XMonad/Actions/UpdateFocus.hs --- a/XMonad/Actions/UpdateFocus.hs +++ b/XMonad/Actions/UpdateFocus.hs @@ -27,7 +27,7 @@ -- $usage -- To make the focus update on mouse movement within an unfocused window, add the --- following to your @~\/.xmonad\/xmonad.hs@: +-- following to your @xmonad.hs@: -- -- > import XMonad.Actions.UpdateFocus -- > xmonad $ def { diff --git a/XMonad/Actions/UpdatePointer.hs b/XMonad/Actions/UpdatePointer.hs --- a/XMonad/Actions/UpdatePointer.hs +++ b/XMonad/Actions/UpdatePointer.hs @@ -31,7 +31,7 @@ import Control.Arrow ((&&&), (***)) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.UpdatePointer diff --git a/XMonad/Actions/Warp.hs b/XMonad/Actions/Warp.hs --- a/XMonad/Actions/Warp.hs +++ b/XMonad/Actions/Warp.hs @@ -28,7 +28,7 @@ import XMonad.StackSet as W {- $usage -You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +You can use this module with the following in your @xmonad.hs@: > import XMonad.Actions.Warp @@ -45,7 +45,7 @@ -} -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight diff --git a/XMonad/Actions/WindowBringer.hs b/XMonad/Actions/WindowBringer.hs --- a/XMonad/Actions/WindowBringer.hs +++ b/XMonad/Actions/WindowBringer.hs @@ -36,7 +36,7 @@ -- $usage -- --- Import the module into your @~\/.xmonad\/xmonad.hs@: +-- Import the module into your @xmonad.hs@: -- -- > import XMonad.Actions.WindowBringer -- @@ -46,7 +46,7 @@ -- > , ((modm .|. shiftMask, xK_b ), bringMenu) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data WindowBringerConfig = WindowBringerConfig { menuCommand :: String -- ^ The shell command that will handle window selection diff --git a/XMonad/Actions/WindowGo.hs b/XMonad/Actions/WindowGo.hs --- a/XMonad/Actions/WindowGo.hs +++ b/XMonad/Actions/WindowGo.hs @@ -48,9 +48,11 @@ import XMonad.Prompt.Shell (getBrowser, getEditor) import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack) import XMonad.Util.Run (safeSpawnProg) +import qualified Data.List.NonEmpty as NE + {- $usage -Import the module into your @~\/.xmonad\/xmonad.hs@: +Import the module into your @xmonad.hs@: > import XMonad.Actions.WindowGo @@ -66,7 +68,8 @@ > (className =? "Firefox" <||> className =? "Firefox-bin") For detailed instructions on editing your key bindings, see -"XMonad.Doc.Extending#Editing_key_bindings". -} +. +-} -- | Get the list of workspaces sorted by their tag workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a] @@ -89,7 +92,10 @@ -- | The same as ifWindows, but applies a ManageHook to the first match -- instead and discards the other matches ifWindow :: Query Bool -> ManageHook -> X () -> X () -ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head) +ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty) +-- ifWindows guarantees that the list given to the function is +-- non-empty. This should really use Data.List.NonEmpty, but, alas, +-- that would be a breaking change. {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found. Presumably this executable is the same one that you were looking for. @@ -164,7 +170,8 @@ let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws -- cannot fail to match in windows $ focusFn y - _ -> windows . focusFn . head $ ws + _ -> windows . focusFn . NE.head . notEmpty $ ws + -- ws is non-empty by ifWindows's definition. -- | Given a function which gets us a String, we try to raise a window with that classname, -- or we then interpret that String as a executable name. diff --git a/XMonad/Actions/WindowMenu.hs b/XMonad/Actions/WindowMenu.hs --- a/XMonad/Actions/WindowMenu.hs +++ b/XMonad/Actions/WindowMenu.hs @@ -34,7 +34,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.WindowMenu -- diff --git a/XMonad/Actions/WithAll.hs b/XMonad/Actions/WithAll.hs --- a/XMonad/Actions/WithAll.hs +++ b/XMonad/Actions/WithAll.hs @@ -24,7 +24,7 @@ -- $usage -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.WithAll -- @@ -33,7 +33,7 @@ -- , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Un-float all floating windows on the current workspace. sinkAll :: X () diff --git a/XMonad/Actions/Workscreen.hs b/XMonad/Actions/Workscreen.hs --- a/XMonad/Actions/Workscreen.hs +++ b/XMonad/Actions/Workscreen.hs @@ -43,7 +43,7 @@ import XMonad.Actions.OnScreen -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.Workscreen -- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"] @@ -58,7 +58,7 @@ -- > , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]] -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show) @@ -109,5 +109,6 @@ -- @WorkscreenId@. shiftToWorkscreen :: WorkscreenId -> X () shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get - let ws = head . workspaces $ a !! wscrId - windows $ W.shift ws + case workspaces (a !! wscrId) of + [] -> pure () + (w : _) -> windows $ W.shift w diff --git a/XMonad/Actions/WorkspaceCursors.hs b/XMonad/Actions/WorkspaceCursors.hs --- a/XMonad/Actions/WorkspaceCursors.hs +++ b/XMonad/Actions/WorkspaceCursors.hs @@ -50,7 +50,7 @@ import XMonad(Message, WorkspaceId, X, XState(windowset), fromMessage, sendMessage, windows, gets) import XMonad.Util.Stack (reverseS) -import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<)) +import XMonad.Prelude -- $usage -- @@ -95,10 +95,10 @@ -- | makeCursors requires a nonempty string, and each sublist must be nonempty makeCursors :: [[String]] -> Cursors String -makeCursors [] = error "Workspace Cursors cannot be empty" -makeCursors a = concat . reverse <$> foldl addDim x xs - where x = end $ map return $ head a - xs = map (map return) $ tail a +makeCursors [] = error "Workspace Cursors cannot be empty" +makeCursors (a : as) = concat . reverse <$> foldl addDim x xs + where x = end $ map return a + xs = map (map return) as -- this could probably be simplified, but this true: -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[])) -- the strange order is used because it makes the regular M-1..9 diff --git a/XMonad/Actions/WorkspaceNames.hs b/XMonad/Actions/WorkspaceNames.hs --- a/XMonad/Actions/WorkspaceNames.hs +++ b/XMonad/Actions/WorkspaceNames.hs @@ -51,14 +51,14 @@ import qualified XMonad.Actions.SwapWorkspaces as Swap import XMonad.Hooks.StatusBar.PP (PP(..)) import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename) -import XMonad.Prompt (mkXPrompt, XPConfig) +import XMonad.Prompt (mkXPrompt, XPConfig, historyCompletionP) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex) import qualified Data.Map as M -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Actions.WorkspaceNames -- @@ -88,7 +88,7 @@ -- > | (i, k) <- zip workspaces [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . @@ -137,9 +137,11 @@ -- | Prompt for a new name for the current workspace and set it. renameWorkspace :: XPConfig -> X () -renameWorkspace conf = - mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName - where pr = Wor "Workspace name: " +renameWorkspace conf = do + completion <- historyCompletionP (prompt ==) + mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName + where + prompt = "Workspace name: " -- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. swapTo :: Direction1D -> X () diff --git a/XMonad/Config/Arossato.hs b/XMonad/Config/Arossato.hs --- a/XMonad/Config/Arossato.hs +++ b/XMonad/Config/Arossato.hs @@ -47,7 +47,7 @@ -- $usage -- The simplest way to use this configuration module is to use an --- @~\/.xmonad\/xmonad.hs@ like this: +-- @xmonad.hs@ like this: -- -- > module Main (main) where -- > @@ -64,7 +64,7 @@ -- -- You can use this module also as a starting point for writing your -- own configuration module from scratch. Save it as your --- @~\/.xmonad\/xmonad.hs@ and: +-- @xmonad.hs@ and: -- -- 1. Change the module name from -- diff --git a/XMonad/Config/Azerty.hs b/XMonad/Config/Azerty.hs --- a/XMonad/Config/Azerty.hs +++ b/XMonad/Config/Azerty.hs @@ -27,7 +27,7 @@ import qualified Data.Map as M -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Azerty diff --git a/XMonad/Config/Bepo.hs b/XMonad/Config/Bepo.hs --- a/XMonad/Config/Bepo.hs +++ b/XMonad/Config/Bepo.hs @@ -26,7 +26,7 @@ import qualified Data.Map as M -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bepo diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -29,7 +29,7 @@ import XMonad import XMonad.Layout.BorderResize -import XMonad.Layout.BoringWindows +import XMonad.Layout.BoringWindows hiding (Replace) import XMonad.Layout.ButtonDecoration import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons @@ -37,7 +37,7 @@ import XMonad.Layout.Maximize import XMonad.Layout.Minimize import XMonad.Layout.MouseResizableTile -import XMonad.Layout.Named +import XMonad.Layout.Renamed import XMonad.Layout.NoBorders import XMonad.Layout.PositionStoreFloat import XMonad.Layout.WindowSwitcherDecoration @@ -65,7 +65,7 @@ import XMonad.Prelude(when) -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bluetile @@ -183,10 +183,10 @@ , isFullscreen --> doFullFloat] bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ - named "Floating" floating ||| - named "Tiled1" tiled1 ||| - named "Tiled2" tiled2 ||| - named "Fullscreen" fullscreen + renamed [Replace "Floating"] floating ||| + renamed [Replace "Tiled1"] tiled1 ||| + renamed [Replace "Tiled2"] tiled2 ||| + renamed [Replace "Fullscreen"] fullscreen where floating = floatingDeco $ maximize $ borderResize positionStoreFloat tiled1 = tilingDeco $ maximize mouseResizableTileMirrored diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs --- a/XMonad/Config/Desktop.hs +++ b/XMonad/Config/Desktop.hs @@ -24,7 +24,7 @@ -- specification. Extra xmonad settings unique to specific DE's are -- added by overriding or modifying @desktopConfig@ fields in the -- same way that the default configuration is customized in - -- @~\/.xmonad/xmonad.hs@. + -- @xmonad.hs@. -- -- For more information about EWMH see: -- @@ -72,7 +72,7 @@ -- -- -- To configure xmonad for use with a DE or with DE tools like panels --- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@, +-- and pagers, in place of @def@ in your @xmonad.hs@, -- use @desktopConfig@ or one of the other desktop configs from the -- @XMonad.Config@ namespace. The following setup and customization examples -- work the same way for the other desktop configs as for @desktopConfig@. @@ -91,7 +91,7 @@ -- $customizing -- To customize a desktop config, modify its fields as is illustrated with --- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad". +-- the default configuration @def@ in . -- $layouts -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings. diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs --- a/XMonad/Config/Dmwit.hs +++ b/XMonad/Config/Dmwit.hs @@ -34,7 +34,7 @@ import XMonad.Layout.IndependentScreens hiding (withScreen) import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders -import XMonad.Prelude +import XMonad.Prelude hiding (fromList) import XMonad.Util.Dzen hiding (x, y) import XMonad.Util.SpawnOnce -- }}} diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | @@ -20,7 +21,7 @@ import XMonad.Layout.Tabbed ( tabbed, shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) import XMonad.Layout.Combo ( combineTwo ) -import XMonad.Layout.Named ( named ) +import XMonad.Layout.Renamed ( Rename(Replace), renamed ) import XMonad.Layout.LayoutCombinators import XMonad.Layout.Square ( Square(Square) ) import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L), @@ -114,9 +115,9 @@ ] ++ - zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) + zip (map (modMask x,) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) ++ - zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) + zip (map (modMask x .|. shiftMask,) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) config = docks $ ewmh def { borderWidth = 1 -- Width of the window border in pixels. @@ -124,10 +125,10 @@ , layoutHook = showWName $ workspaceDir "~" $ boringWindows $ smartBorders $ windowNavigation $ maximizeVertical $ toggleLayouts Full $ avoidStruts $ - named "tabbed" mytab ||| - named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| - named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| - named "widescreen" ((mytab *||* mytab) + renamed [Replace "tabbed"] mytab ||| + renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) ||| + renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| + renamed [Replace "widescreen"] ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5 , terminal = "xterm" -- The preferred terminal program. diff --git a/XMonad/Config/Gnome.hs b/XMonad/Config/Gnome.hs --- a/XMonad/Config/Gnome.hs +++ b/XMonad/Config/Gnome.hs @@ -32,7 +32,7 @@ import System.Environment (getEnvironment) -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Gnome diff --git a/XMonad/Config/Kde.hs b/XMonad/Config/Kde.hs --- a/XMonad/Config/Kde.hs +++ b/XMonad/Config/Kde.hs @@ -28,7 +28,7 @@ import qualified Data.Map as M -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Kde diff --git a/XMonad/Config/Mate.hs b/XMonad/Config/Mate.hs --- a/XMonad/Config/Mate.hs +++ b/XMonad/Config/Mate.hs @@ -1,5 +1,7 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} - +-- TODO: Remove when we depend on a version of xmonad that has unGrab. +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-dodgy-imports #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Mate @@ -28,18 +30,17 @@ desktopLayoutModifiers ) where -import XMonad -import XMonad.Config.Desktop -import XMonad.Util.Run (safeSpawn) -import XMonad.Util.Ungrab -import XMonad.Prelude (toUpper) - +import System.Environment (getEnvironment) import qualified Data.Map as M -import System.Environment (getEnvironment) +import XMonad hiding (unGrab) +import XMonad.Config.Desktop +import XMonad.Prelude (toUpper) +import XMonad.Util.Run (safeSpawn) +import XMonad.Util.Ungrab (unGrab) -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Mate diff --git a/XMonad/Config/Prime.hs b/XMonad/Config/Prime.hs --- a/XMonad/Config/Prime.hs +++ b/XMonad/Config/Prime.hs @@ -126,7 +126,7 @@ import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings) -- $start_here --- To start with, create a @~\/.xmonad\/xmonad.hs@ that looks like this: +-- To start with, create a @xmonad.hs@ that looks like this: -- -- > {-# LANGUAGE RebindableSyntax #-} -- > import XMonad.Config.Prime @@ -388,7 +388,7 @@ MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings -- | Mouse button bindings to an 'X' actions on a window. Default: see @`man --- xmonad`@. To make mod- switch workspaces: +-- xmonad`@. To make @mod-\@ switch workspaces: -- -- > import XMonad.Actions.CycleWS (nextWS, prevWS) -- > ... diff --git a/XMonad/Config/Xfce.hs b/XMonad/Config/Xfce.hs --- a/XMonad/Config/Xfce.hs +++ b/XMonad/Config/Xfce.hs @@ -27,7 +27,7 @@ import qualified Data.Map as M -- $usage --- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- To use this module, start with the following @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Xfce diff --git a/XMonad/Doc/Configuring.hs b/XMonad/Doc/Configuring.hs --- a/XMonad/Doc/Configuring.hs +++ b/XMonad/Doc/Configuring.hs @@ -14,7 +14,9 @@ -- . -- -- For more detailed instructions on extending xmonad with the --- xmonad-contrib library, see "XMonad.Doc.Extending". +-- xmonad-contrib library, see +-- +-- and "XMonad.Doc.Extending". -- ----------------------------------------------------------------------------- diff --git a/XMonad/Doc/Developing.hs b/XMonad/Doc/Developing.hs --- a/XMonad/Doc/Developing.hs +++ b/XMonad/Doc/Developing.hs @@ -86,7 +86,7 @@ Basically, xmonad and the xmonad-contrib libraries let users write their own window manager in just a few lines of code. While -@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration +@xmonad.hs@ at first seems to be simply a configuration file, it is actually a complete Haskell program which uses the xmonad and xmonad-contrib libraries to create a custom window manager. @@ -106,13 +106,13 @@ xmonad installs a binary, @xmonad@, which must be executed by the Xsession starting script. This binary, whose code can be read in @Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile' -to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@. +to run @ghc@ in order to build a binary from @xmonad.hs@. If this compilation process fails, for any reason, a default @main@ entry point will be used, which calls the 'XMonad.Main.xmonad' function with a default configuration. Thus, the real @main@ entry point, the one that even the users' custom -window manager application in @~\/.xmonad\/xmonad.hs@ must call, is +window manager application in @xmonad.hs@ must call, is the 'XMonad.Main.xmonad' function. This function takes a configuration as its only argument, whose type ('XMonad.Core.XConfig') is defined in "XMonad.Core". diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -71,20 +71,15 @@ -- *** Removing key bindings -- $keyDel - -- *** Adding and removing key bindings - -- $keyAddDel - -- ** Editing mouse bindings -- $mouse - -- ** Editing the layout hook + -- ** Editing the layout hook #LayoutHook# -- $layoutHook - -- ** Editing the manage hook + -- ** Editing the manage hook #ManageHook# -- $manageHook - -- ** The log hook and external status bars - -- $logHook ) where -------------------------------------------------------------------------------- @@ -108,8 +103,8 @@ the documentation and just click on its name to view its Haddock documentation; each module should come with extensive documentation. If you find a module that could be better documented, or has incorrect -documentation, please report it as a bug -()! +documentation, please +! First and foremost, xmonad defines its own prelude for commonly used functions, as well as re-exports from @base@. @@ -137,33 +132,31 @@ In the @XMonad.Actions@ namespace you can find modules exporting various functions that are usually intended to be bound to key combinations or mouse actions, in order to provide functionality -beyond the standard keybindings provided by xmonad. +beyond the standard keybindings offered by xmonad. -} {- $hooks In the @XMonad.Hooks@ namespace you can find modules exporting -hooks. Hooks are actions that xmonad performs when certain events -occur. The three most important hooks are: +hooks—actions that xmonad performs when certain events occur. +The three most important hooks are: * 'XMonad.Core.manageHook': this hook is called when a new window that xmonad must take care of is created. This is a very powerful hook, since it lets us examine the new window's properties and act accordingly. For instance, we can configure xmonad to put windows belonging to a given application in the float layer, not to manage - dock applications, or open them in a given workspace. See - "XMonad.Doc.Extending#Editing_the_manage_hook" for more information - on customizing 'XMonad.Core.manageHook'. + dock applications, or open them in a given workspace. See [Editing the + manage hook](#g:Editing_the_manage_hook) for more information on + customizing 'XMonad.Core.manageHook'. * 'XMonad.Core.logHook': this hook is called when the stack of windows - managed by xmonad 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. + managed by xmonad changes; for example, this is invoked at the end of + the 'XMonad.Operations.windows' function. A big application for this + is to display some information about xmonad in a status bar. The aptly + named "XMonad.Hooks.StatusBar" will produce a string (whose format can + be configured) to be written, for example, to an X11 property. * 'XMonad.Core.handleEventHook': this hook is called on all events handled by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras" @@ -187,13 +180,13 @@ "XMonad.Layout.LayoutModifier". For more information on using those modules for customizing your -'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook". +'XMonad.Core.layoutHook' see [Editing the layout hook](#g:LayoutHook). -} {- $prompts -In the @XMonad.Prompt@ name space you can find modules providing +In the @XMonad.Prompt@ namespace you can find modules providing graphical prompts for getting user input and using it to perform various actions. @@ -206,7 +199,7 @@ In the @XMonad.Util@ namespace you can find modules exporting various utility functions that are used by the other modules of the -xmonad-contrib library. +@xmonad-contrib@ library. There are also utilities for helping in configuring xmonad or using external utilities. @@ -222,7 +215,7 @@ {- $extending #Extending_xmonad# -Since the @xmonad.hs@ file is just another Haskell module, you may +Since the @xmonad.hs@ file is just another Haskell program, you may import and use any Haskell code or libraries you wish, such as extensions from the xmonad-contrib library, or other code you write yourself. @@ -388,83 +381,74 @@ {- $keyDel #Removing_key_bindings# -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'. +As we've learned, XMonad stores keybindings inside of a +'Data.Map.Strict.Map', which means that removing keybindings requires +modifying it. This can be done with 'Data.Map.difference' or with +'Data.Map.Strict.delete'. -For example, suppose you want to 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.Strict.difference' between the default -map and the map of the key bindings you want to remove. Like so: +For example, suppose you want to entirely rid yourself of @"M-q"@ and +@"M-s-q"@ (you just want to leave xmonad running forever). To do this +with bare @xmonad@, you need to define @newKeys@ as a +'Data.Map.Strict.difference' between the default map and the map of the +key bindings you want to remove. Like so: -> newKeys x = keys def x `M.difference` keysToRemove x +> newKeys :: XConfig l -> Map (KeyMask, KeySym) (X ()) +> newKeys x = keys def x `M.difference` keysToRemove x > -> keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -> keysToRemove x = M.fromList -> [ ((modm , xK_q ), return ()) -> , ((modm .|. shiftMask, xK_q ), return ()) -> ] +> keysToRemove :: XConfig l -> Map (KeyMask, KeySym) (X ()) +> keysToRemove x = M.fromList +> [ ((modm , xK_q ), return ()) +> , ((modm .|. shiftMask, xK_q ), return ()) +> ] As you can see, it doesn't matter what actions we associate with the -keys listed in @keysToRemove@, so we just use @return ()@ (the -\"null\" action). +keys listed in @keysToRemove@, so we just use @return ()@ (the \"null\" +action). Since @newKeys@ contains all of the default keys, you can +simply pass it to 'XMonad.Core.XConfig' as your map of keybindings: -It is also possible to simply define a list of keys we want to unbind -and then use 'Data.Map.Strict.delete' to remove them. In that case we -would write something like: +> main :: IO () +> main = xmonad $ def { keys = newKeys } -> newKeys x = foldr M.delete (keys def x) (keysToRemove x) -> -> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] -> keysToRemove x = -> [ (modm , xK_q ) -> , (modm .|. shiftMask, xK_q ) -> ] +However, having to manually type @return ()@ every time seems like a +drag, doesn't it? And this approach isn't at all compatible with adding +custom keybindings via 'XMonad.Util.EZConfig.additionalKeysP'! Well, +good thing "XMonad.Util.EZConfig" also sports +'XMonad.Util.EZConfig.removeKeysP'. You can use it as you would expect. -Another even simpler possibility is the use of some of the utilities -provided by the xmonad-contrib library. Look, for instance, at -'XMonad.Util.EZConfig.removeKeys'. +> main :: IO () +> main = xmonad $ def +> { … } +> `removeKeysP` ["M-q", "M-S-q"] --} +Can you guess how 'XMonad.Util.EZConfig.removeKeysP' works? It's almost +the same code we wrote above, just accepting a list of keybindings. Try +to see if you can come up with an implementation of -{- $keyAddDel -#Adding_and_removing_key_bindings# +> removeKeysP :: XConfig l -> [String] -> XConfig l -Adding and removing key bindings requires simply combining the steps -for removing and adding. Here is an example from -"XMonad.Config.Arossato": +If you're done, just click on @# Source@ when viewing the +'XMonad.Util.EZConfig.removeKeysP' documentation (did you know that +Haddock lets you do that for every function?) and compare. -> defKeys = keys def -> delKeys x = foldr M.delete (defKeys x) (toRemove x) -> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) -> -- remove some of the default key bindings -> toRemove XConfig{modMask = modm} = -> [ (modm , xK_j ) -> , (modm , xK_k ) -> , (modm , xK_p ) -> , (modm .|. shiftMask, xK_p ) -> , (modm .|. shiftMask, xK_q ) -> , (modm , xK_q ) -> ] ++ -> -- I want modm .|. shiftMask 1-9 to be free! -> [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]] -> -- These are my personal key bindings -> toAdd XConfig{modMask = modm} = -> [ ((modm , xK_F12 ), xmonadPrompt def ) -> , ((modm , xK_F3 ), shellPrompt def ) -> ] ++ -> -- Use modm .|. shiftMask .|. controlMask 1-9 instead -> [( (m .|. modm, k), windows $ f i) -> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] -> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] -> ] +By the way, one can conveniently combine +'XMonad.Util.EZConfig.additionalKeysP' and +'XMonad.Util.EZConfig.removeKeysP' by just intuitively chaining them: -You can achieve the same result using the "XMonad.Util.CustomKeys" -module; take a look at the 'XMonad.Util.CustomKeys.customKeys' -function in particular. +> main :: IO () +> main = xmonad $ def +> { … } +> `additionalKeysP myKeys +> `removeKeysP` ["M-q", "M-S-q"] -NOTE: modm is defined as the modMask you defined (or left as the default) in -your config. +If you don't use the @P@ alternatives of EZConfig, there is also an +aptly named 'XMonad.Util.EZConfig.removeKeys'. Again, can you try to +come up with an implementation yourself that has the correct signature? + +> removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a + +In addition to 'Data.Map.Strict.delete', you will probably need to use +'foldr'. + -} {- $mouse @@ -506,8 +490,7 @@ The problem is that the layout subsystem is implemented with an advanced feature of the Haskell programming language: type classes. This allows us to very easily write new layouts, combine or modify -existing layouts, create layouts with internal state, etc. See -"XMonad.Doc.Extending#The_LayoutClass" for more information. This +existing layouts, create layouts with internal state, etc. This means that we cannot simply have a list of layouts: a list requires every member to belong to the same type! @@ -517,7 +500,7 @@ Suppose we want a list with the 'XMonad.Layout.Full', 'XMonad.Layout.Tabbed.tabbed' and 'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our -@~\/.xmonad\/xmonad.hs@, all the needed modules: +@xmonad.hs@, all the needed modules: > import XMonad > @@ -546,7 +529,7 @@ > mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion -Our @~\/.xmonad\/xmonad.hs@ will now look like this: +Our @xmonad.hs@ will now look like this: > import XMonad > @@ -709,44 +692,5 @@ For additional rules and actions you can use in your manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers". - --} - -{- $logHook -#The_log_hook_and_external_status_bars# - -When the stack of the windows managed by xmonad changes for any -reason, xmonad will call 'XMonad.Core.logHook', which can be used to -output some information about the internal state of xmonad, such as the -layout that is presently in use, the workspace we are in, the focused -window's title, and so on. - -Extracting information about the internal xmonad state can be somewhat -difficult if you are not familiar with the source code. Therefore, -it's usually easiest to use a module that has been designed -specifically for logging some of the most interesting information -about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This -module can be used with an external status bar to print the produced -logs in a convenient way; the most commonly used status bars are dzen -and xmobar. The module "XMonad.Hooks.StatusBar" offers another interface -to interact with status bars, that might be more convenient to use. - -By default the 'XMonad.Core.logHook' doesn't produce anything. To -enable it you need first to import "XMonad.Hooks.DynamicLog": - -> import XMonad.Hooks.DynamicLog - -Then you just need to update the 'XMonad.Core.logHook' field of the -'XMonad.Core.XConfig' record with one of the provided functions. For -example: - -> main = xmonad def { logHook = dynamicLog } - -More interesting configurations are also possible; see the -"XMonad.Hooks.DynamicLog" module for more possibilities. - -You may now enjoy your extended xmonad experience. - -Have fun! -} diff --git a/XMonad/Hooks/CurrentWorkspaceOnTop.hs b/XMonad/Hooks/CurrentWorkspaceOnTop.hs --- a/XMonad/Hooks/CurrentWorkspaceOnTop.hs +++ b/XMonad/Hooks/CurrentWorkspaceOnTop.hs @@ -22,14 +22,15 @@ currentWorkspaceOnTop ) where +import qualified Data.List.NonEmpty as NE (nonEmpty) +import qualified Data.Map as M import XMonad +import XMonad.Prelude (NonEmpty ((:|)), when) import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS -import XMonad.Prelude (unless, when) -import qualified Data.Map as M -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.CurrentWorkspaceOnTop -- > @@ -63,7 +64,9 @@ wins = fltWins ++ map fst rs -- order: first all floating windows, then the order the layout returned -- end of reimplementation - unless (null wins) $ do - io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top, - io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow + case NE.nonEmpty wins of + Nothing -> pure () + Just (w :| ws') -> do + io $ raiseWindow d w -- raise first window of current workspace to the very top, + io $ restackWindows d (w : ws') -- then use restackWindows to let all other windows from the workspace follow XS.put(CWOTS curTag) diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs --- a/XMonad/Hooks/DebugEvents.hs +++ b/XMonad/Hooks/DebugEvents.hs @@ -37,12 +37,13 @@ import Control.Monad.State import Control.Monad.Reader import Codec.Binary.UTF8.String -import Foreign +import Foreign hiding (void) import Foreign.C.Types import Numeric (showHex) import System.Exit import System.IO import System.Process +import GHC.Stack (HasCallStack, prettyCallStack, callStack) -- | Event hook to dump all received events. You should probably not use this -- unconditionally; it will produce massive amounts of output. @@ -203,7 +204,7 @@ -- | Helper to emit tagged event information. say :: String -> String -> X () -say l s = trace $ l ++ ' ':s +say l s = XMonad.trace $ l ++ ' ':s -- | Deconstuct a list of 'CInt's into raw bytes splitCInt :: [CInt] -> IO Raw @@ -240,7 +241,7 @@ } newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a) -#ifndef __HADDOCK__ + deriving (Functor ,Applicative ,Monad @@ -249,12 +250,12 @@ ,MonadState DecodeState ,MonadReader Decode ) -#endif + -- | Retrive, parse, and dump a window property. As all the high-level property -- interfaces lose information necessary to decode properties correctly, we -- work at the lowest level available. -dumpProperty :: Atom -> String -> Window -> Int -> X String +dumpProperty :: HasCallStack => Atom -> String -> Window -> Int -> X String dumpProperty a n w i = do prop <- withDisplay $ \d -> io $ @@ -279,7 +280,7 @@ case rc of 0 -> do fmt <- fromIntegral <$> peek fmtp - vs' <- peek vsp + vs' <- peek vsp sz <- fromIntegral <$> peek szp case () of () | fmt == none -> xFree vs' >> return (Left "(property deleted)" ) @@ -303,7 +304,8 @@ -- @@@ am I better off passing in the Decode and DecodeState? -- | Parse and dump a property (or a 'ClientMessage'). -dumpProperty' :: Window -- source window +dumpProperty' :: HasCallStack + => Window -- source window -> Atom -- property id -> String -- property name -> Atom -- property type @@ -334,11 +336,11 @@ (_,ds') <- runDecode dec ds $ dumpProp a n let fin = length (value ds') len = length vs - lost = if ack == 0 then "" else "and " ++ show ack ++ " lost bytes" + lost = if ack == 0 then "" else " and " ++ show ack ++ " lost bytes" unk = case () of () | fin == len -> "undecodeable " | fin == 0 -> "." - | otherwise -> "and remainder (" ++ show (len - fin) ++ '/':show len ++ ")" + | otherwise -> " and remainder (" ++ show (len - fin) ++ '/':show len ++ ")" (_,ds'') <- if fin == 0 then return (True,ds') else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8 @@ -349,7 +351,7 @@ -- | A simplified version of 'dumpProperty\'', to format random values from -- events. -quickFormat :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String +quickFormat :: (HasCallStack, Storable i, Integral i) => [i] -> Decoder Bool -> X String quickFormat v f = do let vl = length v vs <- io $ @@ -382,7 +384,7 @@ -- | The top level property decoder, for a wide variety of standard ICCCM and -- EWMH window properties. We pass part of the 'ReaderT' as arguments for -- pattern matching. -dumpProp :: Atom -> String -> Decoder Bool +dumpProp :: HasCallStack => Atom -> String -> Decoder Bool dumpProp _ "CLIPBOARD" = dumpSelection dumpProp _ "_NET_SUPPORTED" = dumpArray dumpAtom @@ -426,10 +428,13 @@ dumpProp _ "_NET_WM_VISIBLE_NAME" = dumpUTF dumpProp _ "_NET_WM_ICON_NAME" = dumpUTF dumpProp _ "_NET_WM_VISIBLE_ICON_NAME" = dumpUTF -dumpProp _ "_NET_WM_DESKTOP" = dumpExcept [(0xFFFFFFFF,"all")] - dump32 +-- @@@ the property is CARDINAL; the message is _NET_WM_DESKTOP of 5 dump32s +-- [desktop/all, source indication, 3 zeroes] +-- dumpProp _ "_NET_WM_DESKTOP" = dumpExcept [(0xFFFFFFFF,"all")] +-- dump32 +dumpProp _ "_NET_WM_DESKTOP" = dumpSetDesktop dumpProp _ "_NET_WM_WINDOW_TYPE" = dumpArray dumpAtom -dumpProp _ "_NET_WM_STATE" = dumpArray dumpAtom +dumpProp _ "_NET_WM_STATE" = dumpNWState dumpProp _ "_NET_WM_ALLOWED_ACTIONS" = dumpArray dumpAtom dumpProp _ "_NET_WM_STRUT" = dumpList [("left gap" ,dump32) ,("right gap" ,dump32) @@ -467,6 +472,12 @@ ] dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER" = dumpExcept [(0,"illegal value 0")] dump64 +dumpProp _ "_NET_WM_OPAQUE_REGION" = dumpArray $ dumpList [("x",dump32) + ,("y",dump32) + ,("w",dump32) + ,("h",dump32) + ] +dumpProp _ "_NET_WM_BYPASS_COMPOSITOR" = dumpEnum cpState dumpProp _ "_NET_STARTUP_ID" = dumpUTF dumpProp _ "WM_PROTOCOLS" = dumpArray dumpAtom dumpProp _ "WM_COLORMAP_WINDOWS" = dumpArray dumpWindow @@ -521,8 +532,8 @@ ] ) ] - | a == wM_NORMAL_HINTS = (...) - | a == wM_ZOOM_HINTS = (...) -- same as previous + | a == wM_NORMAL_HINTS = dumpSizeHints + | a == wM_ZOOM_HINTS = dumpSizeHints | a == rGB_DEFAULT_MAP = (...) -- XStandardColormap | a == rGB_BEST_MAP = (...) -- " | a == rGB_RED_MAP = (...) -- " @@ -567,12 +578,12 @@ withIndent w = local (\r -> r {indent = indent r + w}) -- dump an array of items. this dumps the entire property -dumpArray :: Decoder Bool -> Decoder Bool +dumpArray :: HasCallStack => Decoder Bool -> Decoder Bool dumpArray item = do withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "") -- step through values as an array, ending on parse error or end of list -dumpArray' :: Decoder Bool -> String -> Decoder Bool +dumpArray' :: HasCallStack => Decoder Bool -> String -> Decoder Bool dumpArray' item pfx = do vs <- gets value if null vs @@ -582,12 +593,12 @@ -- keep parsing until a parse step fails -- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when', -- which suggests that 'whenX' is *also* the same function... yep. ISAGN -whenD :: Monad m => m Bool -> m Bool -> m Bool +whenD :: (HasCallStack, Monad m) => m Bool -> m Bool -> m Bool whenD p f = p >>= \b -> if b then f else return False -- verify a decoder parameter, else call error reporter -- once again, it's more general than I originally wrote -guardR :: (MonadReader r m, Eq v) +guardR :: (HasCallStack, MonadReader r m, Eq v) => (r -> v) -- value selector -> v -- expected value -> (v -> v -> m a) -- error reporter @@ -598,43 +609,47 @@ if v == val then good else err v val -- this is kinda dumb -fi :: Bool -> a -> a -> a +fi :: HasCallStack => Bool -> a -> a -> a fi p n y = if p then y else n -- flip (if' p), if that existed -- verify we have the expected word size -guardSize :: Int -> Decoder Bool -> Decoder Bool +guardSize :: HasCallStack => Int -> Decoder Bool -> Decoder Bool -- see XSync documentation for this insanity -guardSize 64 = guardR width 32 propSizeErr . guardSize' 8 propShortErr -guardSize w = guardR width w propSizeErr . guardSize' (bytes w) propShortErr +guardSize 64 = guardR width 32 propSizeErr . guardSize' 8 (propShortErr' 1) +guardSize w = guardR width w propSizeErr . guardSize' (bytes w) (propShortErr' 2) -guardSize' :: Int -> Decoder a -> Decoder a -> Decoder a -guardSize' l n y = gets value >>= \vs -> fi (length vs >= l) n y +guardSize' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a +guardSize' l n y = gets value >>= \vs -> fi (length vs >= bytes l) n y +-- @guardSize@ doesn't work with empty arrays +guardSize'' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a +guardSize'' l n y = gets value >>= \vs -> fi (null vs || length vs >= bytes l) n y + -- verify we have the expected property type -guardType :: Atom -> Decoder Bool -> Decoder Bool +guardType :: HasCallStack => Atom -> Decoder Bool -> Decoder Bool guardType t = guardR pType t propTypeErr -- dump a structure as a named tuple -dumpList :: [(String,Decoder Bool)] -> Decoder Bool +dumpList :: HasCallStack => [(String,Decoder Bool)] -> Decoder Bool dumpList proto = do a <- asks pType dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "(" -- same but elements have their own distinct types -dumpList' :: [(String,Decoder Bool,Atom)] -> Decoder Bool +dumpList' :: HasCallStack => [(String,Decoder Bool,Atom)] -> Decoder Bool dumpList' proto = dumpList'' (maxBound :: CULong) proto "(" -- same but only dump elements identified by provided mask -dumpListByMask :: CULong -> [(String,Decoder Bool)] -> Decoder Bool +dumpListByMask :: HasCallStack => CULong -> [(String,Decoder Bool)] -> Decoder Bool dumpListByMask m p = do a <- asks pType dumpList'' m (map (\(s,d) -> (s,d,a)) p) "(" -- and the previous two combined -dumpListByMask' :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool +dumpListByMask' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool dumpListByMask' m p = dumpList'' m p "(" -dumpList'' :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool +dumpList'' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool dumpList'' _ [] _ = append ")" >> return True dumpList'' 0 _ _ = append ")" >> return True dumpList'' m ((l,p,t):ps) sep = do @@ -659,22 +674,20 @@ -- do the getTextProperty dance, the hard way. -- @@@ @COMPOUND_TEXT@ not supported yet. -dumpString :: Decoder Bool +dumpString :: HasCallStack => Decoder Bool dumpString = do fmt <- asks pType [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"] case () of - () | fmt == cOMPOUND_TEXT -> guardSize 16 (...) - | fmt == sTRING -> guardSize 8 $ do + () | fmt == cOMPOUND_TEXT -> guardSize'' 16 (propShortErr' 3) ( ... ) + | fmt == sTRING -> guardSize'' 8 (propShortErr' 4) $ do vs <- gets value modify (\r -> r {value = []}) let ss = flip unfoldr (map twiddle vs) $ \s -> if null s then Nothing else let (w,s'') = break (== '\NUL') s - s' = if null s'' - then s'' - else tail s'' + s' = drop 1 s'' in Just (w,s') case ss of [s] -> append $ show s @@ -688,7 +701,7 @@ failure . ("unrecognized string type " ++) -- show who owns a selection -dumpSelection :: Decoder Bool +dumpSelection :: HasCallStack => Decoder Bool dumpSelection = do -- system selections contain a window ID; others are random -- note that the window ID will be the same as the owner, so @@ -702,14 +715,14 @@ append $ "owned by " ++ w -- for now, not querying Xkb -dumpXKlInds :: Decoder Bool +dumpXKlInds :: HasCallStack => Decoder Bool dumpXKlInds = guardType iNTEGER $ do n <- fmap fromIntegral <$> getInt' 32 case n of - Nothing -> propShortErr + Nothing -> propShortErr' 5 Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 []) where - dumpInds :: Word32 -> Word32 -> Int -> [String] -> [String] + dumpInds :: HasCallStack => Word32 -> Word32 -> Int -> [String] -> [String] dumpInds n bt c bs | n == 0 && c == 1 = ["none"] | n == 0 = bs | n .&. bt /= 0 = dumpInds (n .&. complement bt) @@ -722,9 +735,20 @@ bs -- decode an Atom -dumpAtom :: Decoder Bool -dumpAtom = - guardType aTOM $ do + +dumpAtom :: HasCallStack => Decoder Bool +dumpAtom = dumpAtom'' aTOM + +{- +dumpAtom' :: HasCallStack => String -> Decoder Bool +dumpAtom' t' = do + t <- inX $ getAtom t' + dumpAtom'' t +-} + +dumpAtom'' :: HasCallStack => Atom -> Decoder Bool +dumpAtom'' t = + guardType t $ do a <- getInt' 32 case a of Nothing -> return False @@ -732,15 +756,16 @@ an <- inX $ atomName $ fromIntegral a' append an -dumpWindow :: Decoder Bool +dumpWindow :: HasCallStack => Decoder Bool dumpWindow = guardSize 32 $ guardType wINDOW $ do w <- getInt' 32 case w of Nothing -> return False + Just 0 -> append "none" Just w' -> inX (debugWindow (fromIntegral w')) >>= append -- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list -dumpActiveWindow :: Decoder Bool +dumpActiveWindow :: HasCallStack => Decoder Bool dumpActiveWindow = guardSize 32 $ do t <- asks pType nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW" @@ -754,49 +779,87 @@ t' <- inX $ atomName t failure $ concat ["(bad type " ,t' - ,"; expected WINDOW or _NET_ACTIVE_WINDOW" + ,"; expected WINDOW or _NET_ACTIVE_WINDOW)" ] + +-- likewise but for _NET_WM_DESKTOP +dumpSetDesktop :: HasCallStack => Decoder Bool +dumpSetDesktop = guardSize 32 $ do + t <- asks pType + nWD <- inX $ getAtom "_NET_WM_DESKTOP" + case () of + () | t == cARDINAL -> dumpExcept [(0xFFFFFFFF,"all")] + dump32 + | t == nWD -> dumpList' [("desktop",dumpExcept [(0xFFFFFFFF,"all")] + dump32 ,cARDINAL) + ,("source" ,dumpEnum awSource ,cARDINAL) + ] + _ -> do + t' <- inX $ atomName t + failure $ concat ["(bad type " + ,t' + ,"; expected CARDINAL or _NET_WM_DESKTOP)" + ] + +-- and again for _NET_WM_STATE +dumpNWState :: HasCallStack => Decoder Bool +dumpNWState = guardSize'' 32 propShortErr $ do + t <- asks pType + nWS <- inX $ getAtom "_NET_WM_STATE" + case () of + () | t == aTOM -> dumpArray dumpAtom + | t == nWS -> dumpList' [("action",dumpEnum nwAction,cARDINAL) + ,("atom1" ,dumpAtom ,aTOM) + ,("atom2" ,dumpAtom ,aTOM) + ] + _ -> do + t' <- inX $ atomName t + failure $ concat ["(bad type " + ,t' + ,"; expected ATOM or _NET_WM_STATE)" + ] + -- dump a generic CARDINAL value -dumpInt :: Int -> Decoder Bool +dumpInt :: HasCallStack => Int -> Decoder Bool dumpInt w = guardSize w $ guardType cARDINAL $ getInt w show -- INTEGER is the signed version of CARDINAL -dumpInteger :: Int -> Decoder Bool +dumpInteger :: HasCallStack => Int -> Decoder Bool dumpInteger w = guardSize w $ guardType iNTEGER $ getInt w (show . signed w) -- reinterpret an unsigned as a signed -signed :: Int -> Integer -> Integer +signed :: HasCallStack => Int -> Integer -> Integer signed w i = bit (w + 1) - i -- and wrappers to keep the parse list in bounds -dump64 :: Decoder Bool +dump64 :: HasCallStack => Decoder Bool dump64 = dumpInt 64 -dump32 :: Decoder Bool +dump32 :: HasCallStack => Decoder Bool dump32 = dumpInt 32 {- not used in standard properties -dump16 :: Decoder Bool +dump16 :: HasCallStack => Decoder Bool dump16 = dumpInt 16 -} -dump8 :: Decoder Bool +dump8 :: HasCallStack => Decoder Bool dump8 = dumpInt 8 -- I am assuming for the moment that this is a single string. -- This might be false; consider the way the STRING properties -- handle lists. -dumpUTF :: Decoder Bool +dumpUTF :: HasCallStack => Decoder Bool dumpUTF = do uTF8_STRING <- inX $ getAtom "UTF8_STRING" - guardType uTF8_STRING $ guardSize 8 $ do + guardType uTF8_STRING $ guardSize'' 8 propShortErr $ do s <- gets value modify (\r -> r {value = []}) append . show . decode . map fromIntegral $ s return True -- dump an enumerated value using a translation table -dumpEnum' :: [String] -> Atom -> Decoder Bool +dumpEnum' :: HasCallStack => [String] -> Atom -> Decoder Bool dumpEnum' ss fmt = guardType fmt $ getInt 32 $ \r -> case () of @@ -805,11 +868,12 @@ | otherwise -> genericIndex ss r -- we do not, unlike @xev@, try to ascii-art pixmaps. -dumpPixmap :: Decoder Bool +dumpPixmap :: HasCallStack => Decoder Bool dumpPixmap = guardType pIXMAP $ do p' <- getInt' 32 case p' of Nothing -> return False + Just 0 -> append "none" Just p -> do append $ "pixmap " ++ showHex p "" g' <- inX $ withDisplay $ \d -> io $ @@ -833,46 +897,80 @@ ,")" ] -dumpOLAttrs :: Decoder Bool +dumpOLAttrs :: HasCallStack => Decoder Bool dumpOLAttrs = do pt <- inX $ getAtom "_OL_WIN_ATTR" guardType pt $ do msk <- getInt' 32 case msk of - Nothing -> propShortErr + Nothing -> propShortErr' 7 Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom ) ,("menu" ,dump32 ) -- @@@ unk ,("pushpin" ,dumpEnum bool) ,("limited menu",dump32 ) -- @@@ unk ] -dumpMwmHints :: Decoder Bool +dumpMwmHints :: HasCallStack => Decoder Bool dumpMwmHints = do ta <- asks property guardType ta $ do msk <- getInt' 32 case msk of - Nothing -> propShortErr - Just msk' -> dumpListByMask (fromIntegral msk') [("functions" ,dumpBits mwmFuncs ) - ,("decorations",dumpBits mwmDecos ) - ,("input mode" ,dumpEnum mwmInputMode) - ,("status" ,dumpBits mwmState ) - ] + Nothing -> propShortErr' 8 + Just msk' -> dumpListByMask' (fromIntegral msk') [("functions" ,dumpBits mwmFuncs ,cARDINAL) + ,("decorations",dumpBits mwmDecos ,cARDINAL) + ,("input mode" ,dumpEnum mwmInputMode,cARDINAL) -- @@@ s/b iNTEGER? + ,("status" ,dumpBits mwmState ,cARDINAL) + ] -dumpMwmInfo :: Decoder Bool +dumpMwmInfo :: HasCallStack => Decoder Bool dumpMwmInfo = do ta <- asks property guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL) ,("window",dumpWindow ,wINDOW ) ] +dumpSizeHints :: HasCallStack => Decoder Bool +dumpSizeHints = do + guardType wM_SIZE_HINTS $ do + -- flags, 4 unused CARD32s, fields as specified by flags + msk <- fmap fromIntegral <$> getInt' 32 + eat (4 * 4) >> pure False + case msk of + Nothing -> propShortErr' 9 + Just msk' -> dumpListByMask' msk' [("min size" ,dumpSize ,cARDINAL) + ,("max size" ,dumpSize ,cARDINAL) + ,("increment" ,dumpSize ,cARDINAL) + ,("aspect ratio",dumpAspect,cARDINAL) + ,("base size" ,dumpSize ,cARDINAL) + ,("gravity" ,dumpGrav ,cARDINAL) + ] + +dumpSize :: HasCallStack => Decoder Bool +dumpSize = append "(" >> dump32 >> append "," >> dump32 >> append ")" + +dumpAspect :: HasCallStack => Decoder Bool +dumpAspect = do + -- have to do this manually since it doesn't really fit + append "min = " + dump32 + append "/" + dump32 + append ", max = " + dump32 + append "/" + dump32 + +dumpGrav :: HasCallStack => Decoder Bool +dumpGrav = dumpEnum wmGravity + -- the most common case -dumpEnum :: [String] -> Decoder Bool +dumpEnum :: HasCallStack => [String] -> Decoder Bool dumpEnum ss = dumpEnum' ss cARDINAL -- implement exceptional cases atop a normal dumper -- @@@ there's gotta be a better way -dumpExcept :: [(Integer,String)] -> Decoder Bool -> Decoder Bool +dumpExcept :: HasCallStack => [(Integer,String)] -> Decoder Bool -> Decoder Bool dumpExcept xs item = do -- this horror brought to you by reparsing to get the right value for our use sp <- get @@ -887,7 +985,8 @@ -- and after all that, we can process the exception list dumpExcept' xs that v -dumpExcept' :: [(Integer,String)] +dumpExcept' :: HasCallStack + => [(Integer,String)] -> DecodeState -> Integer -> Decoder Bool @@ -897,7 +996,7 @@ -- use @ps@ to get process information. -- @@@@ assumes a POSIX @ps@, not a BSDish one. -dumpPid :: Decoder Bool +dumpPid :: HasCallStack => Decoder Bool dumpPid = guardType cARDINAL $ do n <- getInt' 32 case n of @@ -915,17 +1014,17 @@ then "pid " ++ pid else prc !! 1 -dumpTime :: Decoder Bool +dumpTime :: HasCallStack => Decoder Bool dumpTime = append "server event # " >> dump32 -dumpState :: Decoder Bool +dumpState :: HasCallStack => Decoder Bool dumpState = do wM_STATE <- inX $ getAtom "WM_STATE" guardType wM_STATE $ dumpList' [("state" ,dumpEnum wmState,cARDINAL) ,("icon window",dumpWindow ,wINDOW ) ] -dumpMotifDragReceiver :: Decoder Bool +dumpMotifDragReceiver :: HasCallStack => Decoder Bool dumpMotifDragReceiver = do ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO" guardType ta $ dumpList' [("endian" ,dumpMotifEndian,cARDINAL) @@ -933,11 +1032,11 @@ ,("style" ,dumpMDropStyle ,cARDINAL) -- @@@ dummy ] -dumpMDropStyle :: Decoder Bool +dumpMDropStyle :: HasCallStack => Decoder Bool dumpMDropStyle = do d <- getInt' 8 pad 1 $ case d of - Nothing -> propShortErr + Nothing -> propShortErr' 9 Just ps | ps == 0 -> pad 12 $ append "none" | ps == 1 -> pad 12 $ append "drop only" | ps == 2 -> append "prefer preregister " >> dumpMDPrereg @@ -947,7 +1046,7 @@ | ps == 6 -> pad 12 $ append "prefer receiver" | otherwise -> failure $ "unknown drop style " ++ show ps -dumpMDPrereg :: Decoder Bool +dumpMDPrereg :: HasCallStack => Decoder Bool dumpMDPrereg = do -- this is a bit ugly; we pretend to be extending the above dumpList' append "," @@ -957,7 +1056,7 @@ append "drop sites = " dsc' <- getInt' 16 case dsc' of - Nothing -> propShortErr + Nothing -> propShortErr' 10 Just dsc -> do withIndent 13 $ append (show dsc) pad 2 $ do @@ -969,7 +1068,7 @@ dumpMDBlocks :: Int -> Decoder Bool dumpMDBlocks _ = propSimple "(drop site info)" -- @@@ maybe later if needed -dumpMotifEndian :: Decoder Bool +dumpMotifEndian :: HasCallStack => Decoder Bool dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do c <- map twiddle <$> eat 1 case c of @@ -977,14 +1076,14 @@ ['B'] -> append "big" _ -> failure "bad endian flag" -pad :: Int -> Decoder Bool -> Decoder Bool +pad :: HasCallStack => Int -> Decoder Bool -> Decoder Bool pad n p = do vs <- gets value if length vs < n - then propShortErr + then propShortErr' 11 else modify (\r -> r {value = drop n vs}) >> p -dumpPercent :: Decoder Bool +dumpPercent :: HasCallStack => Decoder Bool dumpPercent = guardType cARDINAL $ do n <- getInt' 32 case n of @@ -994,7 +1093,7 @@ pct :: Double in append $ show (round pct :: Integer) ++ "%" -dumpWmHints :: Decoder Bool +dumpWmHints :: HasCallStack => Decoder Bool dumpWmHints = guardType wM_HINTS $ do msk <- getInt' 32 @@ -1011,7 +1110,7 @@ ,("window_group" ,dumpWindow ,wINDOW ) ] -dumpBits :: [String] -> Decoder Bool +dumpBits :: HasCallStack => [String] -> Decoder Bool dumpBits bs = guardType cARDINAL $ do n <- getInt' 32 case n of @@ -1069,6 +1168,9 @@ ,"pager/task list" ] +cpState :: [String] +cpState = ["no preference","disable compositing","force compositing"] + {- eventually... wmHintsFlags :: [String] wmHintsFlags = ["Input" @@ -1112,6 +1214,12 @@ wmState :: [String] wmState = ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"] +nwAction :: [String] +nwAction = ["Clear", "Set", "Toggle"] + +wmGravity :: [String] +wmGravity = ["forget/unmap","NW","N","NE","W","C","E","SW","S","SE","static"] + nwmEnum :: Maybe String -> [String] -> [String] @@ -1121,7 +1229,7 @@ -- and the lowest level coercions -- -- parse and return an integral value -getInt' :: Int -> Decoder (Maybe Integer) +getInt' :: HasCallStack => Int -> Decoder (Maybe Integer) -- see XSync documentation for this insanity getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $ guardSize' 8 (propShortErr >> return Nothing) $ do @@ -1129,7 +1237,7 @@ hi <- inhale 32 return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1) getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $ - guardSize' (bytes w) (propShortErr >> return Nothing) $ + guardSize' (bytes w) (propShortErr' 13 >> return Nothing) $ Just <$> inhale w -- parse an integral value and feed it to a show-er of some kind @@ -1171,8 +1279,8 @@ append = append' True -- and the same but for errors -failure :: String -> Decoder Bool -failure = append' False +failure :: HasCallStack => String -> Decoder Bool +failure = append' False . (++ prettyCallStack callStack) -- common appender append' :: Bool -> String -> Decoder Bool @@ -1186,8 +1294,12 @@ propSimple s = modify (\r -> r {value = []}) >> append s -- report various errors -propShortErr :: Decoder Bool +propShortErr :: HasCallStack => Decoder Bool propShortErr = failure "(property ended prematurely)" + +-- debug version +propShortErr' :: HasCallStack => Int -> Decoder Bool +propShortErr' n = failure $ "(short prop " ++ show n ++ ")" propSizeErr :: Int -> Int -> Decoder Bool propSizeErr e a = failure $ "(bad bit width " ++ diff --git a/XMonad/Hooks/DebugKeyEvents.hs b/XMonad/Hooks/DebugKeyEvents.hs --- a/XMonad/Hooks/DebugKeyEvents.hs +++ b/XMonad/Hooks/DebugKeyEvents.hs @@ -51,9 +51,8 @@ -- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after -- sanitizing it (removing @numberLockMask@, etc.) -- --- For more detailed instructions on editing the logHook see: --- --- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" +-- For more detailed instructions on editing the logHook see +-- . -- | Print key events to stderr for debugging debugKeyEvents :: Event -> X All diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -76,7 +76,7 @@ import XMonad.Hooks.StatusBar -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.DynamicLog diff --git a/XMonad/Hooks/DynamicProperty.hs b/XMonad/Hooks/DynamicProperty.hs --- a/XMonad/Hooks/DynamicProperty.hs +++ b/XMonad/Hooks/DynamicProperty.hs @@ -1,113 +1,24 @@ ------------------------------------------------------------------------------ -- | -- Module : XMonad.Hooks.DynamicProperty -- Description : Apply a ManageHook to an already-mapped window. -- Copyright : (c) Brandon S Allbery, 2015 -- License : BSD3-style (see LICENSE) --- -- Maintainer : allbery.b@gmail.com --- Stability : unstable --- Portability : not portable -- --- Module to apply a ManageHook to an already-mapped window when a property --- changes. This would commonly be used to match browser windows by title, --- since the final title will only be set after (a) the window is mapped, --- (b) its document has been loaded, (c) all load-time scripts have run. --- (Don't blame browsers for this; it's inherent in HTML and the DOM. And --- changing title dynamically is explicitly permitted by ICCCM and EWMH; --- you don't really want to have your editor window umapped/remapped to --- show the current document and modified state in the titlebar, do you?) --- --- This is a handleEventHook that triggers on a PropertyChange event. It --- currently ignores properties being removed, in part because you can't --- do anything useful in a ManageHook involving nonexistence of a property. --- --- This module could also be useful for Electron applications like Spotify --- which sets its WM_CLASS too late for window manager to map it properly. --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.DynamicProperty ( -- * Usage - -- $usage - - -- * Documentation - dynamicPropertyChange +module XMonad.Hooks.DynamicProperty {-# DEPRECATED "Use \"XMonad.Hooks.OnPropertyChange\" instead." #-} + ( module XMonad.Hooks.OnPropertyChange + , dynamicPropertyChange , dynamicTitle ) where import XMonad +import XMonad.Hooks.OnPropertyChange import XMonad.Prelude --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.DynamicProperty --- --- Enable it by including in you handleEventHook definition: --- --- > main = xmonad $ def --- > { ... --- > , handleEventHook = dynamicPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")) --- > , ... --- > } --- --- Or you could create a dynamicManageHook as below: --- --- > myDynamicManageHook :: ManageHook --- > myDynamicManageHook = --- > composeAll --- > [ className =? "Spotify" --> doShift (myWorkspaces !! 4), --- > title =? "maybe_special_terminal" <||> title =? "special_terminal" --> doCenterFloat, --- > className =? "dynamicApp" <&&> title =? "dynamic_app" --> doCenterFloat --- > ] --- --- And then use it in your handleEventHookDefinition: --- --- > main = xmonad $ def --- > { ... --- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynamicManageHook <> handleEventHook baseConfig --- > , ... --- > } --- - --- | --- Run a 'ManageHook' when a specific property is changed on a window. Note --- that this will run on any window which changes the property, so you should --- be very specific in your 'ManageHook' matching (lots of windows change --- their titles on the fly!): --- --- > dynamicPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2") --- --- Note that the fixity of (-->) won't allow it to be mixed with ($), so you --- can't use the obvious $ shorthand. --- --- > dynamicPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work! --- --- Consider instead phrasing it like any --- other 'ManageHook': --- --- > main = xmonad $ def --- > { ... --- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <> handleEventHook baseConfig --- > , ... --- > } --- > --- > myDynHook = composeAll [...] --- +-- | 'dynamicPropertyChange' = 'onXPropertyChange' dynamicPropertyChange :: String -> ManageHook -> Event -> X All -dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do - pa <- getAtom prop - when (ps == propertyNewValue && a == pa) $ do - g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w) - windows g - return mempty -- so anything else also processes it -dynamicPropertyChange _ _ _ = return mempty +dynamicPropertyChange = onXPropertyChange --- | A shorthand for the most common case, dynamic titles +-- | 'dynamicTitle' = 'onTitleChange' dynamicTitle :: ManageHook -> Event -> X All --- strictly, this should also check _NET_WM_NAME. practically, both will --- change and each gets its own PropertyEvent, so we'd need to record that --- we saw the event for that window and ignore the second one. Instead, just --- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false, --- since there's always someone who can't bother being compliant.) -dynamicTitle = dynamicPropertyChange "WM_NAME" +dynamicTitle = onTitleChange diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -24,6 +24,8 @@ -- $usage ewmh, ewmhFullscreen, + ewmhDesktopsManageHook, + ewmhDesktopsMaybeManageHook, -- * Customization -- $customization @@ -40,6 +42,14 @@ -- $customActivate setEwmhActivateHook, + -- ** Fullscreen + -- $customFullscreen + setEwmhFullscreenHooks, + + -- ** @_NET_DESKTOP_VIEWPORT@ + -- $customManageDesktopViewport + disableEwmhManageDesktopViewport, + -- * Standalone hooks (deprecated) ewmhDesktopsStartup, ewmhDesktopsLogHook, @@ -66,7 +76,7 @@ import qualified XMonad.Util.ExtensibleState as XS -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.EwmhDesktops @@ -102,6 +112,10 @@ -- ^ configurable workspace rename (see 'XMonad.Hooks.StatusBar.PP.ppRename') , activateHook :: ManageHook -- ^ configurable handling of window activation requests + , fullscreenHooks :: (ManageHook, ManageHook) + -- ^ configurable handling of fullscreen state requests + , manageDesktopViewport :: Bool + -- ^ manage @_NET_DESKTOP_VIEWPORT@? } instance Default EwmhDesktopsConfig where @@ -109,6 +123,8 @@ { workspaceSort = getSortByIndex , workspaceRename = pure pure , activateHook = doFocus + , fullscreenHooks = (doFullFloat, doSink) + , manageDesktopViewport = True } @@ -229,6 +245,45 @@ setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h } +-- $customFullscreen +-- When a client sends a @_NET_WM_STATE@ request to add\/remove\/toggle the +-- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to +-- make the window fullscreen and revert its state. The default hooks are +-- stateless: windows are fullscreened by turning them into fullscreen floats, +-- and reverted by sinking them into the tiling layer. This behaviour can be +-- configured by supplying a pair of 'ManageHook's to 'setEwmhFullscreenHooks'. +-- +-- See "XMonad.Actions.ToggleFullFloat" for a pair of hooks that store the +-- original state of floating windows. + +-- | Set (replace) the hooks invoked when clients ask to add/remove the +-- $_NET_WM_STATE_FULLSCREEN@ state. The defaults are 'doFullFloat' and +-- 'doSink'. +setEwmhFullscreenHooks :: ManageHook -> ManageHook -> XConfig l -> XConfig l +setEwmhFullscreenHooks f uf = XC.modifyDef $ \c -> c{ fullscreenHooks = (f, uf) } + + +-- $customManageDesktopViewport +-- Setting @_NET_DESKTOP_VIEWPORT@ is typically desired but can lead to a +-- confusing workspace list in polybar, where this information is used to +-- re-group the workspaces by monitor. See +-- . +-- +-- To avoid this, you can use: +-- +-- > main = xmonad $ … . disableEwmhManageDesktopViewport . ewmh . … $ def{…} +-- +-- Note that if you apply this configuration in an already running environment, +-- the property may remain at its previous value. It can be removed by running: +-- +-- > xprop -root -remove _NET_DESKTOP_VIEWPORT +-- +-- Which should immediately fix your bar. +-- +disableEwmhManageDesktopViewport :: XConfig l -> XConfig l +disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False } + + -- | Initializes EwmhDesktops and advertises EWMH support to the X server. {-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-} ewmhDesktopsStartup :: X () @@ -303,7 +358,7 @@ whenChanged = whenX . XS.modified . const ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X () -ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename} = withWindowSet $ \s -> do +ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport} = withWindowSet $ \s -> do sort' <- workspaceSort let ws = sort' $ W.workspaces s @@ -320,10 +375,33 @@ let clientList = nub . concatMap (W.integrate' . W.stack) $ ws whenChanged (ClientList clientList) $ setClientList clientList - -- Set stacking client list which should have bottom-to-top - -- stacking order, i.e. focused window should be last - let clientListStacking = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws - whenChanged (ClientListStacking clientListStacking) $ setClientListStacking clientListStacking + -- @ws@ is sorted in the "workspace order", which, by default, is + -- the lexicographical sorting on @WorkspaceId@. + -- @_NET_CLIENT_LIST_STACKING@ is expected to be in the "bottom-to-top + -- stacking order". It is unclear what that would mean for windows on + -- invisible workspaces, but it seems reasonable to assume that windows on + -- the current workspace should be "at the top". With the focused window to + -- be the top most, meaning the last. + -- + -- There has been a number of discussions on the order of windows within a + -- workspace. See: + -- + -- https://github.com/xmonad/xmonad-contrib/issues/567 + -- https://github.com/xmonad/xmonad-contrib/pull/568 + -- https://github.com/xmonad/xmonad-contrib/pull/772 + let clientListStacking = + let wsInFocusOrder = W.hidden s + ++ (map W.workspace . W.visible) s + ++ [W.workspace $ W.current s] + stackWindows (W.Stack cur up down) = reverse up ++ down ++ [cur] + workspaceWindows = maybe [] stackWindows . W.stack + -- In case a window is a member of multiple workspaces, we keep + -- only the last occurrence in the list. One that is closer to + -- the top in the focus order. + uniqueKeepLast = reverse . nub . reverse + in uniqueKeepLast $ concatMap workspaceWindows wsInFocusOrder + whenChanged (ClientListStacking clientListStacking) $ + setClientListStacking clientListStacking -- Set current desktop number let current = W.currentTag s `elemIndex` map W.tag ws @@ -342,9 +420,10 @@ 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) + when manageDesktopViewport $ do + let visibleScreens = W.current s : W.visible s + currentTags = map (W.tag . W.workspace) visibleScreens + whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws) -- | Create the viewports from the current 'WindowSet' and a list of -- already sorted workspace IDs. @@ -404,6 +483,31 @@ mempty ewmhDesktopsEventHook' _ _ = mempty +-- | A 'ManageHook' that shifts windows to the workspace they want to be in. +-- Useful for restoring browser windows to where they were before restart. +-- +-- To only use this for browsers (which might be a good idea, as many apps try +-- to restore their window to their original position, but it's rarely +-- desirable outside of security updates of multi-window apps like a browser), +-- use this: +-- +-- > stringProperty "WM_WINDOW_ROLE" =? "browser" --> ewmhDesktopsManageHook +ewmhDesktopsManageHook :: ManageHook +ewmhDesktopsManageHook = maybeToDefinite ewmhDesktopsMaybeManageHook + +-- | 'ewmhDesktopsManageHook' as a 'MaybeManageHook' for use with +-- 'composeOne'. Returns 'Nothing' if the window didn't indicate any desktop +-- preference, otherwise 'Just' (even if the preferred desktop was out of +-- bounds). +ewmhDesktopsMaybeManageHook :: MaybeManageHook +ewmhDesktopsMaybeManageHook = desktop >>= traverse doShiftI + where + doShiftI :: Int -> ManageHook + doShiftI d = do + sort' <- liftX . XC.withDef $ \EwmhDesktopsConfig{workspaceSort} -> workspaceSort + ws <- liftX . gets $ map W.tag . sort' . W.workspaces . windowset + maybe idHook doShift $ ws !? d + -- | Add EWMH fullscreen functionality to the given config. ewmhFullscreen :: XConfig a -> XConfig a ewmhFullscreen c = c { startupHook = startupHook c <> fullscreenStartup @@ -421,7 +525,12 @@ -- Note this is not included in 'ewmh'. {-# DEPRECATED fullscreenEventHook "Use ewmhFullscreen instead." #-} fullscreenEventHook :: Event -> X All -fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do +fullscreenEventHook = XC.withDef . fullscreenEventHook' + +fullscreenEventHook' :: Event -> EwmhDesktopsConfig -> X All +fullscreenEventHook' + ClientMessageEvent{ev_event_display = dpy, ev_window = win, ev_message_type = typ, ev_data = action:dats} + EwmhDesktopsConfig{fullscreenHooks = (fullscreenHook, unFullscreenHook)} = do managed <- isClient win wmstate <- getAtom "_NET_WM_STATE" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" @@ -436,16 +545,16 @@ chWstate f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate) when (managed && typ == wmstate && fi fullsc `elem` dats) $ do - when (action == add || (action == toggle && not isFull)) $ do + when (not isFull && (action == add || action == toggle)) $ do chWstate (fi fullsc:) - windows $ W.float win $ W.RationalRect 0 0 1 1 - when (action == remove || (action == toggle && isFull)) $ do + windows . appEndo =<< runQuery fullscreenHook win + when (isFull && (action == remove || action == toggle)) $ do chWstate $ delete (fi fullsc) - windows $ W.sink win + windows . appEndo =<< runQuery unFullscreenHook win return $ All True -fullscreenEventHook _ = return $ All True +fullscreenEventHook' _ _ = return $ All True setNumberOfDesktops :: (Integral a) => a -> X () setNumberOfDesktops n = withDisplay $ \dpy -> do @@ -511,6 +620,7 @@ ,"_NET_ACTIVE_WINDOW" ,"_NET_WM_DESKTOP" ,"_NET_WM_STRUT" + ,"_NET_WM_STRUT_PARTIAL" ,"_NET_DESKTOP_VIEWPORT" ] io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp) diff --git a/XMonad/Hooks/FadeInactive.hs b/XMonad/Hooks/FadeInactive.hs --- a/XMonad/Hooks/FadeInactive.hs +++ b/XMonad/Hooks/FadeInactive.hs @@ -32,7 +32,7 @@ import qualified XMonad.StackSet as W -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.FadeInactive @@ -47,13 +47,12 @@ -- you will need to have xcompmgr -- or something similar for this to do anything -- --- For more detailed instructions on editing the logHook see: --- --- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" --- --- For more detailed instructions on editing the layoutHook see: +-- For more detailed instructions on editing the logHook see +-- . -- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY rationalToOpacity :: Integral a => Rational -> a diff --git a/XMonad/Hooks/FadeWindows.hs b/XMonad/Hooks/FadeWindows.hs --- a/XMonad/Hooks/FadeWindows.hs +++ b/XMonad/Hooks/FadeWindows.hs @@ -96,7 +96,7 @@ -- -- at the top of @myFadeHook@. -- --- This module is best used with "XMonad.Hooks.MoreManageHelpers", which +-- This module is best used with "XMonad.Hooks.ManageHelpers", which -- exports a number of Queries that can be used in either @ManageHook@ -- or @FadeHook@. -- @@ -105,9 +105,8 @@ -- aren't running a compositing manager, the opacity will be recorded -- but won't take effect until a compositing manager is started. -- --- For more detailed instructions on editing the 'logHook' see: --- --- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" +-- For more detailed instructions on editing the 'logHook' see +-- . -- -- For more detailed instructions on editing the 'handleEventHook', -- see: @@ -217,7 +216,7 @@ -- | A 'handleEventHook' to handle fading and unfading of newly mapped -- or unmapped windows; this avoids problems with layouts such as --- "XMonad.Layout.Full" or "XMonad.Layout.Tabbed". This hook may +-- 'XMonad.Layout.Full' or "XMonad.Layout.Tabbed". This hook may -- also be useful with "XMonad.Hooks.FadeInactive". fadeWindowsEventHook :: Event -> X All fadeWindowsEventHook MapNotifyEvent{} = diff --git a/XMonad/Hooks/FloatNext.hs b/XMonad/Hooks/FloatNext.hs --- a/XMonad/Hooks/FloatNext.hs +++ b/XMonad/Hooks/FloatNext.hs @@ -47,7 +47,7 @@ -- to automatically send the next spawned window(s) to the floating -- layer. -- --- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use it by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.FloatNext -- diff --git a/XMonad/Hooks/Focus.hs b/XMonad/Hooks/Focus.hs --- a/XMonad/Hooks/Focus.hs +++ b/XMonad/Hooks/Focus.hs @@ -1,6 +1,8 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# OPTIONS_HADDOCK show-extensions #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module: XMonad.Hooks.Focus @@ -212,7 +214,7 @@ -- -- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor -- workspace won't be switched). --- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window +-- - I need "XMonad.Hooks.EwmhDesktops" module for enabling window -- activation. -- - 'FocusHook' in 'manageHook' will be called /only/ for new windows. -- - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows. @@ -355,28 +357,13 @@ -- | Monad on top of 'Query' providing additional information about new -- window. newtype FocusQuery a = FocusQuery (ReaderT Focus Query a) -instance Functor FocusQuery where - fmap f (FocusQuery x) = FocusQuery (fmap f x) -instance Applicative FocusQuery where - pure x = FocusQuery (pure x) - (FocusQuery f) <*> (FocusQuery mx) = FocusQuery (f <*> mx) -instance Monad FocusQuery where - (FocusQuery mx) >>= f = FocusQuery $ mx >>= \x -> - let FocusQuery y = f x in y -instance MonadReader Focus FocusQuery where - ask = FocusQuery ask - local f (FocusQuery mx) = FocusQuery (local f mx) -instance MonadIO FocusQuery where - liftIO mx = FocusQuery (liftIO mx) -instance Semigroup a => Semigroup (FocusQuery a) where - (<>) = liftM2 (<>) -instance Monoid a => Monoid (FocusQuery a) where - mempty = return mempty + deriving newtype (Functor, Applicative, Monad, MonadReader Focus, MonadIO) + deriving (Semigroup, Monoid) via Ap FocusQuery a runFocusQuery :: FocusQuery a -> Focus -> Query a runFocusQuery (FocusQuery m) = runReaderT m -type FocusHook = FocusQuery (Endo WindowSet) +type FocusHook = FocusQuery (Endo WindowSet) -- Lifting into 'FocusQuery'. diff --git a/XMonad/Hooks/ICCCMFocus.hs b/XMonad/Hooks/ICCCMFocus.hs deleted file mode 100644 --- a/XMonad/Hooks/ICCCMFocus.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.ICCCMFocus --- Description : Deprecated. --- License : BSD --- --- Maintainer : Tony Morris --- --- Implemented in your @logHook@, Java swing applications will not misbehave --- when it comes to taking and losing focus. --- --- This has been done by taking the patch in and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@. --- --- @ --- conf' = --- conf { --- logHook = takeTopFocus --- } --- @ ------------------------------------------------------------------------------ -module XMonad.Hooks.ICCCMFocus -{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-} -( - atom_WM_TAKE_FOCUS -, takeFocusX -, takeTopFocus -) where - -import XMonad -import XMonad.Hooks.SetWMName -import qualified XMonad.StackSet as W - -takeFocusX :: - Window - -> X () -takeFocusX _w = return () - --- | The value to add to your log hook configuration. -takeTopFocus :: - X () -takeTopFocus = - withWindowSet (maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D" diff --git a/XMonad/Hooks/InsertPosition.hs b/XMonad/Hooks/InsertPosition.hs --- a/XMonad/Hooks/InsertPosition.hs +++ b/XMonad/Hooks/InsertPosition.hs @@ -17,21 +17,30 @@ module XMonad.Hooks.InsertPosition ( -- * Usage -- $usage - insertPosition + setupInsertPosition, insertPosition ,Focus(..), Position(..) ) where -import XMonad(ManageHook, MonadReader(ask)) +import XMonad (ManageHook, MonadReader (ask), XConfig (manageHook)) import XMonad.Prelude (Endo (Endo), find) import qualified XMonad.StackSet as W -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module by importing it in your @xmonad.hs@: -- -- > import XMonad.Hooks.InsertPosition +-- +-- You then just have to add 'setupInsertPosition' to your @main@ function: +-- +-- > main = xmonad $ … $ setupInsertPosition Master Newer $ def { … } +-- +-- Alternatively (i.e., you should /not/ do this if you already have set +-- up the above combinator), you can also directly insert +-- 'insertPosition' into your manageHook: +-- -- > xmonad def { manageHook = insertPosition Master Newer <> myManageHook } -- --- You should you put the manageHooks that use 'doShift' to take effect +-- NOTE: You should you put the manageHooks that use 'doShift' to take effect -- /before/ 'insertPosition', so that the window order will be consistent. -- Because ManageHooks compose from right to left (like function composition -- '.'), this means that 'insertPosition' should be the leftmost ManageHook. @@ -39,6 +48,11 @@ data Position = Master | End | Above | Below data Focus = Newer | Older +-- | A combinator for setting up 'insertPosition'. +setupInsertPosition :: Position -> Focus -> XConfig a -> XConfig a +setupInsertPosition pos foc cfg = + cfg{ manageHook = insertPosition pos foc <> manageHook cfg } + -- | insertPosition. A manage hook for placing new windows. XMonad's default is -- the same as using: @insertPosition Above Newer@. insertPosition :: Position -> Focus -> ManageHook @@ -68,5 +82,7 @@ insertDown w = W.swapDown . W.insertUp w focusLast' :: W.Stack a -> W.Stack a -focusLast' st = let ws = W.integrate st - in W.Stack (last ws) (tail $ reverse ws) [] +focusLast' st = + case reverse (W.integrate st) of + [] -> st + (l : ws) -> W.Stack l ws [] diff --git a/XMonad/Hooks/ManageDebug.hs b/XMonad/Hooks/ManageDebug.hs --- a/XMonad/Hooks/ManageDebug.hs +++ b/XMonad/Hooks/ManageDebug.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageDebug --- Description : A manageHook and associated logHook for debugging "ManageHooks". +-- Description : A manageHook and associated logHook for debugging ManageHooks. -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD3-style (see LICENSE) -- @@ -12,7 +12,7 @@ -- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's. -- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator. -- Or use @debugManageHookOn@ for a triggerable version, specifying the --- triggering key sequence in 'XMonad.Util.EZConfig' syntax. Or use the +-- triggering key sequence in "XMonad.Util.EZConfig" syntax. Or use the -- individual hooks in whatever way you see fit. -- ----------------------------------------------------------------------------- @@ -47,7 +47,7 @@ } -- | A combinator to add triggerable 'ManageHook' debugging in a single operation. --- Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press +-- Specify a key sequence as a string in "XMonad.Util.EZConfig" syntax; press -- this key before opening the window to get just that logged. debugManageHookOn :: String -> XConfig l -> XConfig l debugManageHookOn key cf = cf {logHook = manageDebugLogHook <> logHook cf diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -49,7 +49,7 @@ import qualified XMonad.StackSet as W -- $usage --- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Hooks.ManageDocks -- @@ -83,7 +83,7 @@ -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- | Add docks functionality to the given config. See above for an example. diff --git a/XMonad/Hooks/ManageHelpers.hs b/XMonad/Hooks/ManageHelpers.hs --- a/XMonad/Hooks/ManageHelpers.hs +++ b/XMonad/Hooks/ManageHelpers.hs @@ -52,6 +52,7 @@ isMinimized, isDialog, pid, + desktop, transientTo, maybeToDefinite, MaybeManageHook, @@ -199,6 +200,15 @@ -- See . pid :: Query (Maybe ProcessID) pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w <&> \case + Just [x] -> Just (fromIntegral x) + _ -> Nothing + +-- | This function returns 'Just' the @_NET_WM_DESKTOP@ property for a +-- particular window if set, 'Nothing' otherwise. +-- +-- See . +desktop :: Query (Maybe Int) +desktop = ask >>= \w -> liftX $ getProp32s "_NET_WM_DESKTOP" w <&> \case Just [x] -> Just (fromIntegral x) _ -> Nothing diff --git a/XMonad/Hooks/Minimize.hs b/XMonad/Hooks/Minimize.hs --- a/XMonad/Hooks/Minimize.hs +++ b/XMonad/Hooks/Minimize.hs @@ -25,7 +25,7 @@ import XMonad.Prelude -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Minimize -- > import XMonad.Layout.Minimize @@ -43,10 +43,12 @@ a_cs <- getAtom "WM_CHANGE_STATE" when (mt == a_aw) $ maximizeWindow w - when (mt == a_cs) $ do - let message = fromIntegral . head $ dt - when (message == normalState) $ maximizeWindow w - when (message == iconicState) $ minimizeWindow w + when (mt == a_cs) $ case listToMaybe dt of + Nothing -> pure () + Just dth -> do + let message = fromIntegral dth + when (message == normalState) $ maximizeWindow w + when (message == iconicState) $ minimizeWindow w return (All True) minimizeEventHook _ = return (All True) diff --git a/XMonad/Hooks/Modal.hs b/XMonad/Hooks/Modal.hs --- a/XMonad/Hooks/Modal.hs +++ b/XMonad/Hooks/Modal.hs @@ -117,7 +117,7 @@ -- -- - @[(String, X ())]@, or -- --- - @XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())@). +-- - @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 @@ -135,21 +135,17 @@ -- --< 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 +-- | From a list of "XMonad.Util.EZConfig"-style bindings, generate a -- key representation. -- -- >>> mkKeysEz [("h", xmessage "Hello, world!")] -mkKeysEz :: [(String, X ())] -> Keys +mkKeysEz :: [(String, X ())] -> (XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())) mkKeysEz = flip mkKeymap -- | The mode type. Use 'mode' or 'modeWithExit' to create modes. data Mode = Mode { label :: !String - , boundKeys :: !Keys + , boundKeys :: !(XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())) } -- | Newtype for the extensible config. @@ -213,14 +209,14 @@ -- | Create a 'Mode' from the given binding to 'exitMode', label and -- keybindings. -modeWithExit :: String -> String -> Keys -> Mode +modeWithExit :: String -> String -> (XConfig Layout -> M.Map (KeyMask, KeySym) (X ())) -> Mode modeWithExit exitKey mlabel keys = Mode mlabel $ \cnf -> let exit = fromMaybe (0, xK_Escape) $ runParser (parseKeyCombo cnf) exitKey in M.insert exit exitMode (keys cnf) -- | Create a 'Mode' from the given label and keybindings. Sets the -- @escape@ key to 'exitMode'. -mode :: String -> Keys -> Mode +mode :: String -> (XConfig Layout -> M.Map (KeyMask, KeySym) (X ())) -> Mode mode = modeWithExit "" -- | Set the current 'Mode' based on its label. diff --git a/XMonad/Hooks/OnPropertyChange.hs b/XMonad/Hooks/OnPropertyChange.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/OnPropertyChange.hs @@ -0,0 +1,119 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.OnPropertyChange +-- Description : Apply a manageHook on a property (e.g., @WM_CLASS@) change +-- Copyright : (c) Brandon S Allbery, 2015 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : allbery.b@gmail.com +-- Stability : unstable +-- Portability : not portable +-- +-- Module to apply a ManageHook to an already-mapped window when a property +-- changes. This would commonly be used to match browser windows by title, +-- since the final title will only be set after (a) the window is mapped, +-- (b) its document has been loaded, (c) all load-time scripts have run. +-- (Don't blame browsers for this; it's inherent in HTML and the DOM. And +-- changing title dynamically is explicitly permitted by ICCCM and EWMH; +-- you don't really want to have your editor window umapped/remapped to +-- show the current document and modified state in the titlebar, do you?) +-- +-- This is a handleEventHook that triggers on a PropertyChange event. It +-- currently ignores properties being removed, in part because you can't +-- do anything useful in a ManageHook involving nonexistence of a property. +-- +-- This module could also be useful for Electron applications like Spotify +-- which sets its WM_CLASS too late for window manager to map it properly. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.OnPropertyChange ( + -- * Usage + -- $usage + onXPropertyChange, + onTitleChange, + onClassChange, +) where + +import XMonad +import XMonad.Prelude + +-- $usage +-- You can use this module with the following in your @xmonad.hs@: +-- +-- > import XMonad.Hooks.DynamicProperty +-- +-- Enable it by including in you handleEventHook definition: +-- +-- > main = xmonad $ def +-- > { ... +-- > , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")) +-- > , ... +-- > } +-- +-- Or you could create a dynamicManageHook as below: +-- +-- > myDynamicManageHook :: ManageHook +-- > myDynamicManageHook = +-- > composeAll +-- > [ className =? "Spotify" --> doShift (myWorkspaces !! 4), +-- > title =? "maybe_special_terminal" <||> title =? "special_terminal" --> doCenterFloat, +-- > className =? "dynamicApp" <&&> title =? "dynamic_app" --> doCenterFloat +-- > ] +-- +-- And then use it in your handleEventHookDefinition: +-- +-- > main = xmonad $ def +-- > { ... +-- > , handleEventHook = onXPropertyChange "WM_NAME" myDynamicManageHook +-- > , ... +-- > } +-- + +-- | +-- Run a 'ManageHook' when a specific property is changed on a window. Note +-- that this will run on any window which changes the property, so you should +-- be very specific in your 'ManageHook' matching (lots of windows change +-- their titles on the fly!): +-- +-- > onXPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2") +-- +-- Note that the fixity of (-->) won't allow it to be mixed with ($), so you +-- can't use the obvious $ shorthand. +-- +-- > onXPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work! +-- +-- Consider instead phrasing it like any +-- other 'ManageHook': +-- +-- > main = xmonad $ def +-- > { ... +-- > , handleEventHook = onXPropertyChange "WM_NAME" myDynHook +-- > , ... +-- > } +-- > +-- > myDynHook = composeAll [...] +-- +onXPropertyChange :: String -> ManageHook -> Event -> X All +onXPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do + pa <- getAtom prop + when (ps == propertyNewValue && a == pa) $ do + g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w) + windows g + return mempty -- so anything else also processes it +onXPropertyChange _ _ _ = return mempty + +-- | A shorthand for dynamic titles; i.e., applications changing their +-- @WM_NAME@ property. +onTitleChange :: ManageHook -> Event -> X All +-- strictly, this should also check _NET_WM_NAME. practically, both will +-- change and each gets its own PropertyEvent, so we'd need to record that +-- we saw the event for that window and ignore the second one. Instead, just +-- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false, +-- since there's always someone who can't bother being compliant.) +onTitleChange = onXPropertyChange "WM_NAME" + +-- | A shorthand for dynamic resource and class names; i.e., +-- applications changing their @WM_CLASS@ property. +onClassChange :: ManageHook -> Event -> X All +onClassChange = onXPropertyChange "WM_CLASS" diff --git a/XMonad/Hooks/Place.hs b/XMonad/Hooks/Place.hs --- a/XMonad/Hooks/Place.hs +++ b/XMonad/Hooks/Place.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Place @@ -50,7 +51,7 @@ -- floating windows at appropriate positions on the screen, as well -- as an 'X' action to manually trigger repositioning. -- --- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Place -- @@ -185,21 +186,22 @@ -- spawned. Each of them also needs an associated screen -- rectangle; for hidden workspaces, we use the current -- workspace's screen. - let infos = filter ((window `elem`) . stackContents . S.stack . fst) + let infos = find ((window `elem`) . stackContents . S.stack . fst) $ [screenInfo $ S.current theWS] ++ map screenInfo (S.visible theWS) - ++ zip (S.hidden theWS) (repeat currentRect) - - guard(not $ null infos) + ++ map (, currentRect) (S.hidden theWS) - let (workspace, screen) = head infos - rs = mapMaybe (`M.lookup` allRs) - $ organizeClients workspace window floats - r' = purePlaceWindow p screen rs pointer r - newRect = r2rr screen r' - newFloats = M.insert window newRect (S.floating theWS) + case infos of + Nothing -> empty + Just info -> do + let (workspace, screen) = info + rs = mapMaybe (`M.lookup` allRs) + $ organizeClients workspace window floats + r' = purePlaceWindow p screen rs pointer r + newRect = r2rr screen r' + newFloats = M.insert window newRect (S.floating theWS) - return $ theWS { S.floating = newFloats } + return $ theWS { S.floating = newFloats } placeWindow :: Placement -> Window diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs --- a/XMonad/Hooks/PositionStoreHooks.hs +++ b/XMonad/Hooks/PositionStoreHooks.hs @@ -45,7 +45,7 @@ import qualified Data.Set as S -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.PositionStoreHooks -- diff --git a/XMonad/Hooks/Rescreen.hs b/XMonad/Hooks/Rescreen.hs --- a/XMonad/Hooks/Rescreen.hs +++ b/XMonad/Hooks/Rescreen.hs @@ -32,7 +32,7 @@ -- ('XMonad.Hooks.StatusBar.dynamicSBs' uses this module internally), as well -- as to actually invoke xrandr or autorandr when an output is (dis)connected. -- --- To use this, include the following in your @~\/.xmonad\/xmonad.hs@: +-- To use this, include the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.Rescreen -- diff --git a/XMonad/Hooks/RestoreMinimized.hs b/XMonad/Hooks/RestoreMinimized.hs deleted file mode 100644 --- a/XMonad/Hooks/RestoreMinimized.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.RestoreMinimized --- Description : Deprecated: Use XMonad.Hooks.Minimize. --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized --- windows (see "XMonad.Layout.Minimize") by selecting them on a --- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE). --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.RestoreMinimized - {-# DEPRECATED "Use XMonad.Hooks.Minimize instead, this module has no effect" #-} - ( -- * Usage - -- $usage - RestoreMinimized (..) - , restoreMinimizedEventHook - ) where - -import XMonad.Prelude - -import XMonad - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.RestoreMinimized --- > --- > myHandleEventHook = restoreMinimizedEventHook --- > --- > main = xmonad def { handleEventHook = myHandleEventHook } - -data RestoreMinimized = RestoreMinimized deriving ( Show, Read ) - -restoreMinimizedEventHook :: Event -> X All -restoreMinimizedEventHook _ = return (All True) diff --git a/XMonad/Hooks/ServerMode.hs b/XMonad/Hooks/ServerMode.hs --- a/XMonad/Hooks/ServerMode.hs +++ b/XMonad/Hooks/ServerMode.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ServerMode @@ -35,7 +36,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode -- @@ -89,13 +90,14 @@ -- serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do - d <- asks display - atm <- io $ internAtom d key False - when (mt == atm && dt /= []) $ do - let atom = fromIntegral (head dt) + d <- asks display + atm <- io $ internAtom d key False + if | mt == atm, Just dth <- listToMaybe dt -> do + let atom = fromIntegral dth cmd <- io $ getAtomName d atom case cmd of - Just command -> func command - Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom) - return (All True) + Just command -> func command + Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom) + | otherwise -> pure () + return (All True) serverModeEventHookF _ _ _ = return (All True) diff --git a/XMonad/Hooks/SetWMName.hs b/XMonad/Hooks/SetWMName.hs --- a/XMonad/Hooks/SetWMName.hs +++ b/XMonad/Hooks/SetWMName.hs @@ -12,10 +12,10 @@ -- Sets the WM name to a given string, so that it could be detected using -- _NET_SUPPORTING_WM_CHECK protocol. -- --- May be useful for making Java GUI programs work, just set WM name to "LG3D" +-- May be useful for making Java GUI programs work, just set WM name to \"LG3D\" -- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later. -- --- To your @~\/.xmonad\/xmonad.hs@ file, add the following line: +-- To your @xmonad.hs@ file, add the following line: -- -- > import XMonad.Hooks.SetWMName -- @@ -33,7 +33,7 @@ -- fails miserably by guessing absolutely bogus values. -- -- For detailed instructions on editing your hooks, see --- "XMonad.Doc.Extending#4". +-- and "XMonad.Doc.Extending". ----------------------------------------------------------------------------- module XMonad.Hooks.SetWMName ( diff --git a/XMonad/Hooks/ShowWName.hs b/XMonad/Hooks/ShowWName.hs --- a/XMonad/Hooks/ShowWName.hs +++ b/XMonad/Hooks/ShowWName.hs @@ -9,7 +9,7 @@ -- Maintainer : Tony Zorman -- -- Flash the names of workspaces name when switching to them. This is a --- reimplementation of 'XMonad.Layout.ShowWName' as a logHook. +-- reimplementation of "XMonad.Layout.ShowWName" as a logHook. ----------------------------------------------------------------------------- module XMonad.Hooks.ShowWName ( @@ -33,7 +33,7 @@ {- $usage You can use this module with the following in your -@~\/.xmonad\/xmonad.hs@: +@xmonad.hs@: > import XMonad.Hooks.ShowWName > diff --git a/XMonad/Hooks/StatusBar.hs b/XMonad/Hooks/StatusBar.hs --- a/XMonad/Hooks/StatusBar.hs +++ b/XMonad/Hooks/StatusBar.hs @@ -56,6 +56,7 @@ spawnStatusBar, killStatusBar, killAllStatusBars, + startAllStatusBars, ) where import Control.Exception (SomeException, try) @@ -81,7 +82,7 @@ import qualified XMonad.StackSet as W -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.StatusBar @@ -564,3 +565,9 @@ killAllStatusBars :: X () killAllStatusBars = XS.gets (M.elems . getPIDs) >>= io . traverse_ killPid >> XS.put (StatusBarPIDs mempty) + +-- | Start all status bars. Note that you do not need this in your startup hook. +-- This can be bound to a keybinding for example to be used in tandem with +-- `killAllStatusBars`. +startAllStatusBars :: X () +startAllStatusBars = XS.get >>= traverse_ (sbStartupHook . snd) . getASBs diff --git a/XMonad/Hooks/StatusBar/PP.hs b/XMonad/Hooks/StatusBar/PP.hs --- a/XMonad/Hooks/StatusBar/PP.hs +++ b/XMonad/Hooks/StatusBar/PP.hs @@ -32,6 +32,7 @@ -- * Build your own formatter PP(..), def, dynamicLogString, + dynamicLogString', dynamicLogWithPP, -- * Predicates and formatters @@ -55,6 +56,8 @@ ) where import Control.Monad.Reader +import Control.DeepSeq +import qualified Data.List.NonEmpty as NE import XMonad import XMonad.Prelude @@ -181,8 +184,15 @@ -- allow for further processing, or use in some application other than -- a status bar. dynamicLogString :: PP -> X String -dynamicLogString pp = do +dynamicLogString pp = userCodeDef "_|_" (dynamicLogString' pp) +-- | The guts of 'dynamicLogString'. Forces the result, so it may throw +-- an exception (most commonly because 'ppOrder' is non-total). Use +-- 'dynamicLogString' for a version that catches the exception and +-- produces an error string. +dynamicLogString' :: PP -> X String +dynamicLogString' pp = do + winset <- gets windowset urgents <- readUrgents sort' <- ppSort pp @@ -199,7 +209,7 @@ -- window title wt <- maybe (pure "") (fmap show . getName) . S.peek $ winset - return $ sepBy (ppSep pp) . ppOrder pp $ + return $! force $ sepBy (ppSep pp) . ppOrder pp $ [ ws , ppLayout pp ld , ppTitle pp $ ppTitleSanitize pp wt @@ -392,7 +402,7 @@ strip keep x | null x = keep | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x) - | '^' == head x = strip keep (drop 1 . dropWhile (/= ')') $ x) + | "^" `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= ')') $ x) | otherwise = let (good,x') = span (/= '^') x in strip (keep ++ good) x' @@ -448,17 +458,21 @@ xmobarRaw "" = "" xmobarRaw s = concat [""] --- | Strip xmobar markup, specifically the , and tags and --- the matching tags like . +-- | Strip xmobar markup, specifically the \, \ and \ tags +-- and the matching tags like \. xmobarStrip :: String -> String xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) converge :: (Eq a) => (a -> a) -> a -> a -converge f a = let xs = iterate f a - in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs +converge f a + = fst . NE.head . notEmpty -- If this function terminates, we will find a match. + . dropWhile (uncurry (/=)) + . zip xs + $ drop 1 xs + where xs = iterate f a xmobarStripTags :: [String] -- ^ tags - -> String -> String -- ^ with all ... removed + -> String -> String -- ^ with all \...\ removed xmobarStripTags tags = strip [] where strip keep [] = keep strip keep x diff --git a/XMonad/Hooks/StatusBar/WorkspaceScreen.hs b/XMonad/Hooks/StatusBar/WorkspaceScreen.hs --- a/XMonad/Hooks/StatusBar/WorkspaceScreen.hs +++ b/XMonad/Hooks/StatusBar/WorkspaceScreen.hs @@ -34,7 +34,7 @@ import qualified XMonad.StackSet as W {- $usage - You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: + You can use this module with the following in your @xmonad.hs@: > import XMonad > import XMonad.Hooks.StatusBar diff --git a/XMonad/Hooks/ToggleHook.hs b/XMonad/Hooks/ToggleHook.hs --- a/XMonad/Hooks/ToggleHook.hs +++ b/XMonad/Hooks/ToggleHook.hs @@ -77,7 +77,7 @@ -- This module provides actions (that can be set as keybindings) -- to be able to cause hooks to be occur on a conditional basis. -- --- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use it by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.ToggleHook -- diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -242,8 +242,8 @@ -- -- The interval arguments are in seconds. See the 'minutes' helper. data RemindWhen = Dont -- ^ triggering once is enough - | Repeatedly Int Interval -- ^ repeat times every seconds - | Every Interval -- ^ repeat every until the urgency hint is cleared + | Repeatedly Int Interval -- ^ repeat \ times every \ seconds + | Every Interval -- ^ repeat every \ until the urgency hint is cleared deriving (Read, Show) -- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@. diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs --- a/XMonad/Hooks/WallpaperSetter.hs +++ b/XMonad/Hooks/WallpaperSetter.hs @@ -140,7 +140,7 @@ direxists <- doesDirectoryExist $ wallpaperBaseDir conf dir if direxists then do files <- getDirectoryContents $ wallpaperBaseDir conf dir - let files' = filter ((/='.').head) files + let files' = filter (not . ("." `isPrefixOf`)) files file <- pickFrom files' return $ Just $ wallpaperBaseDir conf dir file else return Nothing diff --git a/XMonad/Hooks/WindowSwallowing.hs b/XMonad/Hooks/WindowSwallowing.hs --- a/XMonad/Hooks/WindowSwallowing.hs +++ b/XMonad/Hooks/WindowSwallowing.hs @@ -54,7 +54,7 @@ import System.Posix.Types ( ProcessID ) -- $usage --- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: +-- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WindowSwallowing -- @@ -62,11 +62,11 @@ -- -- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True) -- --- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layouts.SubLayouts" is used; +-- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layout.SubLayouts" is used; -- instead of swallowing the window it will merge the child window with the parent. (this does not work with floating windows) -- -- For more information on editing your handleEventHook and key bindings, --- see "XMonad.Doc.Extending". +-- see and "XMonad.Doc.Extending". -- | Run @action@ iff both parent- and child queries match and the child -- is a child by PID. @@ -98,7 +98,7 @@ return () -- | handleEventHook that will merge child windows via --- "XMonad.Layouts.SubLayouts" when they are opened from another window. +-- "XMonad.Layout.SubLayouts" when they are opened from another window. swallowEventHookSub :: Query Bool -- ^ query the parent window has to match for window swallowing to occur. -- Set this to @return True@ to run swallowing for every parent. diff --git a/XMonad/Hooks/WorkspaceByPos.hs b/XMonad/Hooks/WorkspaceByPos.hs --- a/XMonad/Hooks/WorkspaceByPos.hs +++ b/XMonad/Hooks/WorkspaceByPos.hs @@ -26,10 +26,11 @@ import XMonad.Prelude import qualified XMonad.StackSet as W -import Control.Monad.Except (lift, runExceptT, throwError) +import Control.Monad.Except (runExceptT, throwError) +import Control.Monad.Trans (lift) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceByPos -- > diff --git a/XMonad/Hooks/WorkspaceHistory.hs b/XMonad/Hooks/WorkspaceHistory.hs --- a/XMonad/Hooks/WorkspaceHistory.hs +++ b/XMonad/Hooks/WorkspaceHistory.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DerivingVia #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.WorkspaceHistory @@ -33,12 +34,12 @@ import Prelude import XMonad import XMonad.StackSet hiding (delete, filter, new) -import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy) +import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy, listToMaybe) import qualified XMonad.Util.ExtensibleState as XS -- $usage -- To record the order in which you view workspaces, you can use this --- module with the following in your @~\/.xmonad\/xmonad.hs@: +-- module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook) -- @@ -63,14 +64,9 @@ newtype WorkspaceHistory = WorkspaceHistory { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in -- 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 + } + deriving (Read, Show) + deriving NFData via [(Int, WorkspaceId)] instance ExtensionClass WorkspaceHistory where initialValue = WorkspaceHistory [] @@ -94,7 +90,7 @@ workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])] workspaceHistoryByScreen = - map (\wss -> (fst $ head wss, map snd wss)) . + map (\wss -> (maybe 0 fst (listToMaybe wss), map snd wss)) . groupBy (\a b -> fst a == fst b) . sortBy (\a b -> compare (fst a) $ fst b)<$> workspaceHistoryWithScreen diff --git a/XMonad/Hooks/XPropManage.hs b/XMonad/Hooks/XPropManage.hs --- a/XMonad/Hooks/XPropManage.hs +++ b/XMonad/Hooks/XPropManage.hs @@ -26,7 +26,7 @@ import XMonad.Prelude (Endo (..), chr) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Hooks.XPropManage -- > import qualified XMonad.StackSet as W diff --git a/XMonad/Layout/Accordion.hs b/XMonad/Layout/Accordion.hs --- a/XMonad/Layout/Accordion.hs +++ b/XMonad/Layout/Accordion.hs @@ -25,7 +25,7 @@ import Data.Ratio -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Accordion -- @@ -34,9 +34,9 @@ -- > myLayout = Accordion ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data Accordion a = Accordion deriving ( Read, Show ) diff --git a/XMonad/Layout/AvoidFloats.hs b/XMonad/Layout/AvoidFloats.hs --- a/XMonad/Layout/AvoidFloats.hs +++ b/XMonad/Layout/AvoidFloats.hs @@ -35,7 +35,7 @@ import qualified Data.Set as S -- $usage --- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Layout.AvoidFloats -- @@ -44,8 +44,9 @@ -- -- > layoutHook = ... ||| avoidFloats Full ||| ... -- --- For more detailed instructions on editing the layoutHook see: --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Then add appropriate key bindings, for example: -- @@ -54,7 +55,7 @@ -- > ,((modm .|. shiftMask .|. controlMask, xK_b), sendMessage (AvoidFloatSet False) >> sendMessage AvoidFloatClearItems) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- Note that this module is incompatible with an old way of configuring -- "XMonad.Actions.FloatSnap". If you are having problems, please update your diff --git a/XMonad/Layout/BinaryColumn.hs b/XMonad/Layout/BinaryColumn.hs --- a/XMonad/Layout/BinaryColumn.hs +++ b/XMonad/Layout/BinaryColumn.hs @@ -14,7 +14,7 @@ -- Each window is half the height of the previous, -- except for the last pair of windows. -- --- Note: Originally based on 'XMonad.Layout.Column' with changes: +-- Note: Originally based on "XMonad.Layout.Column" with changes: -- -- * Adding/removing windows doesn't resize all other windows. -- (last window pair exception). diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs --- a/XMonad/Layout/BinarySpacePartition.hs +++ b/XMonad/Layout/BinarySpacePartition.hs @@ -52,7 +52,7 @@ import Data.Ratio ((%)) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.BinarySpacePartition -- diff --git a/XMonad/Layout/BorderResize.hs b/XMonad/Layout/BorderResize.hs --- a/XMonad/Layout/BorderResize.hs +++ b/XMonad/Layout/BorderResize.hs @@ -24,6 +24,7 @@ ( -- * Usage -- $usage borderResize + , borderResizeNear , BorderResize (..) , RectWithBorders, BorderInfo, ) where @@ -37,7 +38,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.BorderResize -- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...) @@ -58,27 +59,34 @@ type RectWithBorders = (Rectangle, [BorderInfo]) -newtype BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) - -brBorderSize :: Dimension -brBorderSize = 2 +data BorderResize a = BR + { brBorderSize :: !Dimension + -- ^ Still resize when this number of pixels around the border. + , brWrsLastTime :: !(M.Map Window RectWithBorders) + } + deriving (Show, Read) borderResize :: l a -> ModifiedLayout BorderResize l a -borderResize = ModifiedLayout (BR M.empty) +borderResize = borderResizeNear 2 +-- | Like 'borderResize', but takes the number of pixels near the border +-- up to which dragging still resizes a window. +borderResizeNear :: Dimension -> l a -> ModifiedLayout BorderResize l a +borderResizeNear borderSize = ModifiedLayout (BR borderSize M.empty) + instance LayoutModifier BorderResize Window where redoLayout _ _ Nothing wrs = return (wrs, Nothing) - redoLayout (BR wrsLastTime) _ _ wrs = do + redoLayout (BR borderSize wrsLastTime) _ _ wrs = do let correctOrder = map fst wrs wrsCurrent = M.fromList wrs wrsGone = M.difference wrsLastTime wrsCurrent wrsAppeared = M.difference wrsCurrent wrsLastTime wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent handleGone wrsGone - wrsCreated <- handleAppeared wrsAppeared - let wrsChanged = handleStillThere wrsStillThere + wrsCreated <- handleAppeared borderSize wrsAppeared + let wrsChanged = handleStillThere borderSize wrsStillThere wrsThisTime = M.union wrsChanged wrsCreated - return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime) + return (compileWrs wrsThisTime correctOrder, Just $ BR borderSize wrsThisTime) -- What we return is the original wrs with the new border -- windows inserted at the correct positions - this way, the core -- will restack the borders correctly. @@ -91,11 +99,11 @@ then (Nothing, entry) else (Just rCurrent, entry) - handleMess (BR wrsLastTime) m + handleMess (BR borderSize wrsLastTime) m | Just e <- fromMessage m :: Maybe Event = handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing | Just _ <- fromMessage m :: Maybe LayoutMessages = - handleGone wrsLastTime >> return (Just $ BR M.empty) + handleGone wrsLastTime >> return (Just $ BR borderSize M.empty) handleMess _ _ = return Nothing compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] @@ -112,26 +120,26 @@ where borderWins = map bWin . concatMap snd . M.elems $ wrsGone -handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders) -handleAppeared wrsAppeared = do +handleAppeared :: Dimension -> M.Map Window Rectangle -> X (M.Map Window RectWithBorders) +handleAppeared borderSize wrsAppeared = do let wrs = M.toList wrsAppeared - wrsCreated <- mapM handleSingleAppeared wrs + wrsCreated <- mapM (handleSingleAppeared borderSize) wrs return $ M.fromList wrsCreated -handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders) -handleSingleAppeared (w, r) = do - let borderBlueprints = prepareBorders r +handleSingleAppeared :: Dimension ->(Window, Rectangle) -> X (Window, RectWithBorders) +handleSingleAppeared borderSize (w, r) = do + let borderBlueprints = prepareBorders borderSize r borderInfos <- mapM createBorder borderBlueprints return (w, (r, borderInfos)) -handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders -handleStillThere = M.map handleSingleStillThere +handleStillThere :: Dimension -> M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders +handleStillThere borderSize = M.map (handleSingleStillThere borderSize) -handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders -handleSingleStillThere (Nothing, entry) = entry -handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) +handleSingleStillThere :: Dimension -> (Maybe Rectangle, RectWithBorders) -> RectWithBorders +handleSingleStillThere _ (Nothing, entry) = entry +handleSingleStillThere borderSize (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) where - changedBorderBlueprints = prepareBorders rCurrent + changedBorderBlueprints = prepareBorders borderSize rCurrent updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints -- assuming that the four borders are always in the same order @@ -144,12 +152,12 @@ processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))] processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) -prepareBorders :: Rectangle -> [BorderBlueprint] -prepareBorders (Rectangle x y wh ht) = - [(Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht, xC_right_side , RightSideBorder), - (Rectangle x y brBorderSize ht , xC_left_side , LeftSideBorder), - (Rectangle x y wh brBorderSize , xC_top_side , TopSideBorder), - (Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize, xC_bottom_side, BottomSideBorder) +prepareBorders :: Dimension -> Rectangle -> [BorderBlueprint] +prepareBorders borderSize (Rectangle x y wh ht) = + [(Rectangle (x + fi wh - fi borderSize) y borderSize ht, xC_right_side , RightSideBorder), + (Rectangle x y borderSize ht , xC_left_side , LeftSideBorder), + (Rectangle x y wh borderSize , xC_top_side , TopSideBorder), + (Rectangle x (y + fi ht - fi borderSize) wh borderSize, xC_bottom_side, BottomSideBorder) ] handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () diff --git a/XMonad/Layout/BoringWindows.hs b/XMonad/Layout/BoringWindows.hs --- a/XMonad/Layout/BoringWindows.hs +++ b/XMonad/Layout/BoringWindows.hs @@ -45,7 +45,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.BoringWindows -- @@ -60,9 +60,9 @@ -- > , ((modm, xK_k), focusDown) -- > , ((modm, xK_m), focusMaster) -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring @@ -93,7 +93,7 @@ siftDown = sendMessage UpdateBoring >> sendMessage SiftDown -- | Mark current focused window boring for all layouts. --- This is useful in combination with the 'XMonad.Actions.CopyWindow' module. +-- This is useful in combination with the "XMonad.Actions.CopyWindow" module. markBoringEverywhere :: X () markBoringEverywhere = withFocused (broadcastMessage . IsBoring) diff --git a/XMonad/Layout/ButtonDecoration.hs b/XMonad/Layout/ButtonDecoration.hs --- a/XMonad/Layout/ButtonDecoration.hs +++ b/XMonad/Layout/ButtonDecoration.hs @@ -33,7 +33,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationAddons -- > import XMonad.Layout.ButtonDecoration diff --git a/XMonad/Layout/CenterMainFluid.hs b/XMonad/Layout/CenterMainFluid.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/CenterMainFluid.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.CenterMainFluid +-- Description : Three column layout with master in center and unoccupied spaces reserved. +-- Copyright : (c) 2023 Mahdi Seyedan +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : Mahdi Seyedan. +-- Stability : unstable +-- Portability : unportable +-- +-- A three column layout with main column in the center and +-- two stack columns surrounding it. There will be always +-- a pane in the center column and unoccupied spaces on the +-- sides are reserved. +-- It's best suited for ultrawide montiors, where a single +-- stretched window might be annoying. +----------------------------------------------------------------------------- + +module XMonad.Layout.CenterMainFluid + ( -- * Usage + -- $usage + CenterMainFluid (..) + ) where + +import XMonad +import qualified XMonad.StackSet as W +import Control.Monad (msum) + +-- $usage +-- You can use this module by adding following in your @xmonad.hs@: +-- +-- > import XMonad.Layout.CenterMainFluid +-- +-- Then edit your @layoutHook@ by adding the CenterMainFluid layout: +-- +-- > myLayoutHook = CenterMainFluid 1 (3/100) (70/100) ||| ... +-- > main = xmonad def { layoutHook = myLayout } +-- +-- The first argument specifies how many windows initially appear in the center +-- column. The second argument specifies the amount to resize while resizing +-- and the third argument specifies the initial size of the center column. +-- +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". + + +-- | Arguments are nmaster, delta, fraction. Supports 'Shrink', 'Expand' and +-- 'IncMasterN' +data CenterMainFluid a = CenterMainFluid + { cmfNMaster :: !Int -- ^ The default number of windows in the center pane (default: 1) + , cmfRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100) + , cmfRatio :: !Rational -- ^ Default proportion of screen occupied by the center pane (default: 70/100) + } + deriving (Show,Read) + +instance LayoutClass CenterMainFluid a where + + pureLayout (CenterMainFluid nmaster _ frac) r s + | frac == 0 = drop nmaster layout + | frac == 1 = take nmaster layout + | otherwise = layout + where layout = zip ws rs + ws = W.integrate s + rs = tile3 frac r nmaster (length ws) + + pureMessage (CenterMainFluid nmaster delta frac) m = + msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + + where resize Shrink = CenterMainFluid nmaster delta (max 0 $ frac-delta) + resize Expand = CenterMainFluid nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = CenterMainFluid (max 0 (nmaster+d)) delta frac + + description _ = "CenterMainFluid" + +tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] +tile3 f r nmaster n + | nmaster <= 0 || n <= nmaster = splitVertically n middleR + | otherwise = masters ++ rights ++ lefts + where (leftR, middleR, rightR) = split3HorizontallyBy f r + (halfN, remaining) = (n - nmaster) `divMod` 2 + masters = splitVertically nmaster middleR + lefts = splitVertically halfN leftR + rights = splitVertically (halfN + remaining) rightR + +-- | Divide the screen into three rectangles, using a rational to specify the ratio of center one +split3HorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle, Rectangle) +split3HorizontallyBy f (Rectangle sx sy sw sh) = + ( Rectangle sx sy sidew sh + , Rectangle (sx + fromIntegral sidew) sy middlew sh + , Rectangle (sx + fromIntegral sidew + fromIntegral middlew) sy sidew sh + ) + where middlew = floor $ fromIntegral sw * f + sidew = (sw - fromIntegral middlew) `div` 2 diff --git a/XMonad/Layout/CenteredIfSingle.hs b/XMonad/Layout/CenteredIfSingle.hs --- a/XMonad/Layout/CenteredIfSingle.hs +++ b/XMonad/Layout/CenteredIfSingle.hs @@ -30,7 +30,7 @@ import XMonad.Prelude (fi) -- $usage --- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: +-- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Layout.CenteredIfSingle -- @@ -38,7 +38,9 @@ -- -- > myLayoutHook = centeredIfSingle 0.7 0.8 Grid ||| ... -- --- For more information on configuring your layouts see "XMonad.Doc.Extending". +-- For more information on configuring your layouts see +-- +-- and "XMonad.Doc.Extending". -- | Layout Modifier that places a window in the center of the screen, diff --git a/XMonad/Layout/CenteredMaster.hs b/XMonad/Layout/CenteredMaster.hs --- a/XMonad/Layout/CenteredMaster.hs +++ b/XMonad/Layout/CenteredMaster.hs @@ -80,11 +80,9 @@ applyPosition pos wksp rect = do let stack = W.stack wksp let ws = W.integrate' stack - if null ws then - runLayout wksp rect - else do - let firstW = head ws - let other = tail ws + case ws of + [] -> runLayout wksp rect + (firstW : other) -> do let filtStack = stack >>= W.filter (firstW /=) wrs <- runLayout (wksp {W.stack = filtStack}) rect return $ first ((firstW, place pos other rect) :) wrs diff --git a/XMonad/Layout/Circle.hs b/XMonad/Layout/Circle.hs --- a/XMonad/Layout/Circle.hs +++ b/XMonad/Layout/Circle.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- -- | @@ -15,18 +16,17 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.Circle ( - -- * Usage - -- $usage - Circle (..) - ) where -- actually it's an ellipse +module XMonad.Layout.Circle {-# DEPRECATED "Use XMonad.Layout.CircleEx instead" #-} + ( -- * Usage + -- $usage + pattern Circle + ) where -- actually it's an ellipse -import XMonad.Prelude -import XMonad -import XMonad.StackSet (integrate, peek) +import GHC.Real (Ratio(..)) +import XMonad.Layout.CircleEx -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Circle -- @@ -35,41 +35,10 @@ -- > myLayout = Circle ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - -data Circle a = Circle deriving ( Read, Show ) - -instance LayoutClass Circle Window where - doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s - return (layout, Nothing) - -circleLayout :: Rectangle -> [a] -> [(a, Rectangle)] -circleLayout _ [] = [] -circleLayout r (w:ws) = master : rest - where master = (w, center r) - rest = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..] - -raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] -raiseFocus xs = do focused <- withWindowSet (return . peek) - return $ case find ((== focused) . Just . fst) xs of - Just x -> x : delete x xs - Nothing -> xs +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -center :: Rectangle -> Rectangle -center (Rectangle sx sy sw sh) = Rectangle x y w h - where s = sqrt 2 :: Double - w = round (fromIntegral sw / s) - h = round (fromIntegral sh / s) - x = sx + fromIntegral (sw - w) `div` 2 - y = sy + fromIntegral (sh - h) `div` 2 +pattern Circle :: CircleEx a +pattern Circle = CircleEx 1 (70 :% 99) (2 :% 5) 1 0 -satellite :: Rectangle -> Double -> Rectangle -satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a)) - (sy + round (ry + ry * sin a)) - w h - where rx = fromIntegral (sw - w) / 2 - ry = fromIntegral (sh - h) / 2 - w = sw * 10 `div` 25 - h = sh * 10 `div` 25 diff --git a/XMonad/Layout/CircleEx.hs b/XMonad/Layout/CircleEx.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/CircleEx.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.CircleEx +-- Description : An elliptical, overlapping layout—extended version. +-- Copyright : (c) Peter De Wachter, Ilya V. Portnov +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Ilya V. Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Circle is an elliptical, overlapping layout. Original code by Peter De Wachter, +-- extended by Ilya Porntov. +----------------------------------------------------------------------------- + +module XMonad.Layout.CircleEx ( + -- * Usage + -- $usage + CircleEx (..), circle, circleEx, + CircleExMsg (..) + ) + where + +import Data.Ratio + +import XMonad +import XMonad.StackSet (Stack) +import XMonad.Prelude +import qualified XMonad.StackSet as W + +-- $usage +-- +-- The layout puts the first N windows (called master) into the center of +-- screen. All others (called secondary, or stack) are organized in a circle +-- (well, ellipse). When opening a new secondary window, its size will be +-- slightly smaller than that of its predecessor (this is configurable). If +-- the number of master windows is set to zero, all windows will be arranged +-- in a circle. If there is more than one master window, they will be stacked +-- in the center on top of each other. The size of each additional master +-- window will again be slightly smaller than that of the former. +-- +-- Since a picture says more than a thousand words, you see one +-- . +-- +-- You can use this module with the following in your @xmonad.hs@: +-- +-- > import XMonad.Layout.CircleEx +-- +-- Then edit your @layoutHook@ by adding the 'CircleEx' layout: +-- +-- > myCircle = circleEx {cDelta = -3*pi/4} +-- > myLayout = myCircle ||| Full ||| etc.. +-- > main = xmonad def { layoutHook = myLayout } +-- +-- This layout understands standard messages: +-- +-- * 'IncMasterN': increase or decrease the number of master windows. +-- * 'Shrink' and 'Expand': change the size of master windows. +-- +-- More layout-specific messages are also supported, see 'CircleExMsg' below. +-- +-- For more detailed instructions on editing the layoutHook see: +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | The layout data type. It is recommended to not use the 'CircleEx' data +-- constructor directly, and instead rely on record update syntax; for +-- example: @circleEx {cMasterRatio = 4%5}@. In this way you can avoid nasty +-- surprises if one day additional fields are added to @CircleEx@. +data CircleEx a = CircleEx + { cNMaster :: !Int -- ^ Number of master windows. Default value is 1. + , cMasterRatio :: !Rational -- ^ Size of master window in relation to screen size. + -- Default value is @4%5@. + , cStackRatio :: !Rational -- ^ Size of first secondary window in relation to screen size. + -- Default value is @3%5@. + , cMultiplier :: !Rational -- ^ Coefficient used to calculate the sizes of subsequent secondary + -- windows. The size of the next window is calculated as the + -- size of the previous one multiplied by this value. + -- This value is also used to scale master windows, in case + -- there is more than one. + -- Default value is @5%6@. Set this to 1 if you want all secondary + -- windows to have the same size. + , cDelta :: !Double -- ^ Angle of rotation of the whole circle layout. Usual values + -- are from 0 to 2π, although it will work outside + -- this range as well. Default value of 0 means that the first + -- secondary window will be placed at the right side of screen. + } deriving (Eq, Show, Read) + +-- | Circle layout with default settings: +-- +-- * Number of master windows is set to 1 +-- * @cMasterRatio@ is set to @70/99@, which is nearly @1/sqrt(2)@ +-- * @cStackRatio@ is set to @2/5@ +-- * @cMultiplier@ is set to 1, which means all secondary windows +-- will have the same size +-- +-- This can be used as a drop-in replacement for "XMonad.Layout.Circle". +circle :: CircleEx a +circle = CircleEx 1 (70%99) (2%5) 1 0 + +-- | Another variant of default settings for circle layout: +-- +-- * Number of master windows is set to 1 +-- * @cMasterRatio@ is set to @4/5@ +-- * @cStackRatio@ is set to @3/5@ +-- * @cMultiplier@ is set to @5/6@ +-- +circleEx :: CircleEx a +circleEx = CircleEx 1 (4%5) (3%5) (5%6) 0 + +-- | Specific messages understood by CircleEx layout. +data CircleExMsg + = Rotate !Double -- ^ Rotate secondary windows by specific angle + | IncStackRatio !Rational -- ^ Increase (or decrease, with negative value) sizes of secondary windows + | IncMultiplier !Rational -- ^ Increase 'cMultiplier'. + deriving (Eq, Show, Typeable) + +instance Message CircleExMsg + +instance LayoutClass CircleEx Window where + doLayout :: CircleEx Window -> Rectangle -> Stack Window -> X ([(Window, Rectangle)], Maybe (CircleEx Window)) + doLayout layout rect stack = do + result <- raiseFocus $ circleLayout layout rect $ W.integrate stack + return (result, Nothing) + + pureMessage :: CircleEx Window -> SomeMessage -> Maybe (CircleEx Window) + pureMessage layout m = + msum [changeMasterN <$> fromMessage m, + resize <$> fromMessage m, + specific <$> fromMessage m] + where + deltaSize = 11 % 10 + + resize :: Resize -> CircleEx a + resize Shrink = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout / deltaSize} + resize Expand = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout * deltaSize} + + changeMasterN :: IncMasterN -> CircleEx a + changeMasterN (IncMasterN d) = layout {cNMaster = max 0 (cNMaster layout + d)} + + specific :: CircleExMsg -> CircleEx a + specific (Rotate delta) = layout {cDelta = delta + cDelta layout} + specific (IncStackRatio delta) = layout {cStackRatio = max 0.1 $ min 2.0 $ delta + cStackRatio layout} + specific (IncMultiplier delta) = layout {cMultiplier = max 0.1 $ min 2.0 $ delta + cMultiplier layout} + +circleLayout :: CircleEx a -> Rectangle -> [a] -> [(a, Rectangle)] +circleLayout _ _ [] = [] +circleLayout (CircleEx {..}) rectangle wins = + master (take cNMaster wins) ++ rest (drop cNMaster wins) + where + master :: [a] -> [(a, Rectangle)] + master ws = zip ws $ map (placeCenter cMasterRatio cMultiplier rectangle) + [cNMaster-1, cNMaster-2 .. 0] + rest :: [a] -> [(a, Rectangle)] + rest ws = zip ws $ zipWith (placeSatellite cStackRatio cMultiplier rectangle) + (map (+ cDelta) [0, pi*2 / fromIntegral (length ws) ..]) + [0 ..] + + +raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] +raiseFocus wrs = do + focused <- withWindowSet (return . W.peek) + return $ case find ((== focused) . Just . fst) wrs of + Just x -> x : delete x wrs + Nothing -> wrs + +placeCenter :: Rational -> Rational -> Rectangle -> Int -> Rectangle +placeCenter ratio multiplier (Rectangle x y width height) n = Rectangle x' y' width' height' + where + m = ratio * multiplier ^ n + width' = round (m * fromIntegral width) + height' = round (m * fromIntegral height) + x' = x + fromIntegral (width - width') `div` 2 + y' = y + fromIntegral (height - height') `div` 2 + +placeSatellite :: Rational -> Rational -> Rectangle -> Double -> Int -> Rectangle +placeSatellite ratio multiplier (Rectangle x y width height) alpha n = + Rectangle x' y' width' height' + where + m = ratio * multiplier ^ n + x' = x + round (rx + rx * cos alpha) + y' = y + round (ry + ry * sin alpha) + rx = fromIntegral (width - width') / 2 + ry = fromIntegral (height - height') / 2 + width' = round (fromIntegral width * m) + height' = round (fromIntegral height * m) diff --git a/XMonad/Layout/Combo.hs b/XMonad/Layout/Combo.hs --- a/XMonad/Layout/Combo.hs +++ b/XMonad/Layout/Combo.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, - UndecidableInstances, PatternGuards #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | @@ -24,13 +27,13 @@ ) where import XMonad hiding (focus) -import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\)) -import XMonad.StackSet ( integrate', Workspace (..), Stack(..) ) -import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) ) -import qualified XMonad.StackSet as W ( differentiate ) +import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..)) +import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe) +import XMonad.StackSet (Stack (..), Workspace (..), integrate') +import XMonad.Util.Stack (zipperFocusedAtFirstOf) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Combo -- @@ -40,9 +43,9 @@ -- -- to your layouts. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- combineTwo is a new simple layout combinator. It allows the -- combination of two layouts using a third to split the screen @@ -57,7 +60,7 @@ -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- These bindings will move a window into the sublayout that is -- up\/down\/left\/right of its current position. Note that there is some @@ -88,14 +91,14 @@ handleMessage super (SomeMessage ReleaseResources) return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') arrange origws = - do let w2' = case origws `intersect` w2 of [] -> [head origws] + do let w2' = case origws `intersect` w2 of [] -> take 1 origws [x] -> [x] x -> case origws \\ x of [] -> init x _ -> x superstack = Stack { focus=(), up=[], down=[()] } - s1 = differentiate f' (origws \\ w2') - s2 = differentiate f' w2' + s1 = zipperFocusedAtFirstOf f' (origws \\ w2') + s2 = zipperFocusedAtFirstOf f' w2' f' = case s of (Just s') -> focus s':delete (focus s') f Nothing -> f ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput @@ -121,20 +124,12 @@ msuper' <- broadcastPrivate m [super] if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2 f ws2 - (maybe super head msuper') - (maybe l1 head ml1') - (maybe l2 head ml2') + (fromMaybe super (listToMaybe =<< msuper')) + (fromMaybe l1 (listToMaybe =<< ml1')) + (fromMaybe l2 (listToMaybe =<< ml2')) else return Nothing description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++ description l2 ++" with "++ description super - - -differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) -differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z - , up = reverse $ takeWhile (/=z) xs - , down = tail $ dropWhile (/=z) xs } - | otherwise = differentiate zs xs -differentiate [] xs = W.differentiate xs broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b]) broadcastPrivate a ol = do nml <- mapM f ol diff --git a/XMonad/Layout/ComboP.hs b/XMonad/Layout/ComboP.hs --- a/XMonad/Layout/ComboP.hs +++ b/XMonad/Layout/ComboP.hs @@ -25,15 +25,16 @@ Property(..) ) where -import XMonad.Prelude import XMonad hiding (focus) -import XMonad.StackSet ( Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation -import XMonad.Util.WindowProperties +import XMonad.Prelude +import XMonad.StackSet ( Workspace (..), Stack(..) ) import qualified XMonad.StackSet as W +import XMonad.Util.Stack (zipperFocusedAtFirstOf) +import XMonad.Util.WindowProperties -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ComboP -- @@ -44,9 +45,9 @@ -- to your layouts. This way all windows with class = \"Firefox\" will always go -- to the left pane, all others - to the right. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with -- addition of a 'Property' which tells where to put new windows. Windows mathing @@ -64,7 +65,7 @@ -- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage $ SwapWindow) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data SwapWindow = SwapWindow -- ^ Swap window between panes | SwapWindowN Int -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow @@ -99,10 +100,10 @@ f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most in do matching <- hasProperty prop `filterM` new -- new windows matching predecate - let w1' = w1c ++ matching -- updated first pane windows - w2' = w2c ++ (new \\ matching) -- updated second pane windows - s1 = differentiate f' w1' -- first pane stack - s2 = differentiate f' w2' -- second pane stack + let w1' = w1c ++ matching -- updated first pane windows + w2' = w2c ++ (new \\ matching) -- updated second pane windows + s1 = zipperFocusedAtFirstOf f' w1' -- first pane stack + s2 = zipperFocusedAtFirstOf f' w2' -- second pane stack ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 @@ -176,16 +177,5 @@ send st = if W.focus st `elem` w then handleMessage l m else return Nothing - --- code from CombineTwo --- given two sets of zs and xs takes the first z from zs that also belongs to xs --- and turns xs into a stack with z being current element. Acts as --- StackSet.differentiate if zs and xs don't intersect -differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) -differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z - , up = reverse $ takeWhile (/=z) xs - , down = tail $ dropWhile (/=z) xs } - | otherwise = differentiate zs xs -differentiate [] xs = W.differentiate xs -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: diff --git a/XMonad/Layout/Cross.hs b/XMonad/Layout/Cross.hs --- a/XMonad/Layout/Cross.hs +++ b/XMonad/Layout/Cross.hs @@ -12,7 +12,7 @@ -- -- A Cross Layout with the main window in the center. -- -module XMonad.Layout.Cross( +module XMonad.Layout.Cross {-# DEPRECATED "Use XMonad.Layout.Circle or XMonad.Layout.ThreeColumn.ThreeColMid instead" #-} ( -- * Usage -- $usage simpleCross @@ -23,7 +23,7 @@ import XMonad.Prelude( msum ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Cross -- diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -1,8 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Decoration @@ -241,7 +242,7 @@ toDel = todel d dwrs toAdd = toadd a wrs deleteDecos (map snd toDel) - let ndwrs = zip toAdd $ repeat (Nothing,Nothing) + let ndwrs = map (, (Nothing,Nothing)) toAdd ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs processState (s {decos = ndecos }) @@ -399,7 +400,11 @@ -- structure and the needed 'Rectangle's updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X () updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do - nw <- getName w + -- xmonad-contrib #809 + -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@ + -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is + -- quadratic due to using 'init' + nw <- fmap (take 2048 . takeWhile (/= '\n') . show) (getName w) ur <- readUrgents dpy <- asks display let focusColor win ic ac uc = maybe ic (\focusw -> case () of @@ -413,7 +418,7 @@ (urgentColor t, urgentBorderColor t, urgentBorderWidth t, urgentTextColor t) let s = shrinkIt sh name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n - return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) nw let als = AlignCenter : map snd (windowTitleAddons t) strs = name : map fst (windowTitleAddons t) i_als = map snd (windowTitleIcons t) diff --git a/XMonad/Layout/DecorationEx.hs b/XMonad/Layout/DecorationEx.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx.hs @@ -0,0 +1,106 @@ + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx +-- Description : Advanced window decorations module for XMonad +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This set of modules contains a set of type classes and their implementations +-- which define a flexible and extensible mechanism of window decorations. +-- +-- <> +-- Click +-- for a larger version. +-- +-- Within this mechanism, there are the following entities which define +-- how decorations will look and work: +-- +-- * Main object is @DecorationEx@ layout modifier. It is from where everything +-- starts. It creates, shows and hides decoration windows (rectangles) when +-- needed. It is parameterized with decoration geometry, decoration engine and +-- theme. It calls these components to do their parts of the work. +-- * @DecorationGeometry@ defines where decoration rectangles should be placed. +-- For example, standard horizontal bar above each window; or tab bar. +-- * @DecorationEngine@ defines how decorations look and how they react on clicks. +-- Different implementations of the decoration engine can use different APIs +-- to draw decorations. Within this package, there is one implementation +-- (@TextDecoration@), which uses plain Xlib calls, and displays decoration +-- widgets with text fragments, like @[X]@ or @[_]@. Other engines can, for +-- example, use the Cairo library to draw nice gradients and image-based widgets. +-- * A Decoration widget is an element placed on a window decoration. It defines how +-- it looks and how it responds to clicks. Examples include usual window +-- buttons (minimize, maximize, close), window icon, window title. +-- * A Decoration theme defines colors and fonts for the decoration engine. It also +-- contains a list of decoration widgets and says where to place them (at the +-- left, at the right or in the center). +-- +-- This mechanism makes major use of parameterized data types and type families, +-- in order to make it possible to define different types of decorations, and +-- easily combine different aspects of decorations. For example, each decoration +-- engine can be combined with each decoration geometry. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx ( + -- * Usage: + -- $usage + + -- * Standard decoration settings + decorationEx, + textDecoration, textTabbed, dwmStyleDeco, + -- * Decoration-related types + TextDecoration (..), DefaultGeometry (..), + TabbedGeometry (..), DwmGeometry (..), + DecorationEx, + -- * Theme types + BoxBorders (..), BorderColors, + SimpleStyle (..), GenericTheme (..), + ThemeEx, + -- * Widget types + StandardCommand (..), GenericWidget (..), + StandardWidget, + -- * Utility functions for themes + themeEx, borderColor, shadowBorder, + -- * Convinience re-exports + Shrinker (..), shrinkText, + -- * Standard widgets + titleW, toggleStickyW, minimizeW, + maximizeW, closeW, dwmpromoteW, + moveToNextGroupW, moveToPrevGroupW + ) where + +import XMonad.Layout.Decoration +import XMonad.Layout.DecorationEx.Common +import XMonad.Layout.DecorationEx.Widgets +import XMonad.Layout.DecorationEx.Geometry +import XMonad.Layout.DecorationEx.LayoutModifier +import XMonad.Layout.DecorationEx.TextEngine +import XMonad.Layout.DecorationEx.TabbedGeometry +import XMonad.Layout.DecorationEx.DwmGeometry + +-- $usage +-- +-- You can use this module with the following in your +-- @xmonad.hs@: +-- +-- > import XMonad.Layout.DecorationEx +-- Then edit your @layoutHook@ by adding the DwmStyle decoration to +-- your layout: +-- +-- > myTheme = ThemeEx {...} +-- > myL = textDecoration shrinkText myTheme (layoutHook def) +-- > main = xmonad def { layoutHook = myL } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- This module exports only some definitions from it's submodules, +-- most likely to be used from user configurations. To define +-- your own decoration types you will likely have to import specific +-- submodules. + diff --git a/XMonad/Layout/DecorationEx/Common.hs b/XMonad/Layout/DecorationEx/Common.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/Common.hs @@ -0,0 +1,272 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.Common +-- Description : Declaration of types used by DecorationEx module, +-- and commonly used utility functions. +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This module exposes a number of types which are used by other sub-modules +-- of "XMonad.Layout.DecorationEx" module. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.Common ( + -- * Common types + WindowDecoration (..) + , WindowCommand (..) + , DecorationWidget (..) + , WidgetPlace (..) + , WidgetLayout (..) + , HasWidgets (..) + , ClickHandler (..) + , ThemeAttributes (..) + , XPaintingContext + , BoxBorders (..) + , BorderColors + , ThemeStyleType (..) + , SimpleStyle (..) + , GenericTheme (..) + , ThemeEx + -- * Utilities + , widgetLayout + , windowStyleType + , genericWindowStyle + , themeEx + , borderColor + , shadowBorder + ) where + +import qualified Data.Map as M +import Data.Bits (testBit) + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Hooks.UrgencyHook +import qualified XMonad.Layout.Decoration as D + +-- | Information about decoration of one window +data WindowDecoration = WindowDecoration { + wdOrigWindow :: !Window -- ^ Original window (one being decorated) + , wdOrigWinRect :: !Rectangle -- ^ Rectangle of original window + , wdDecoWindow :: !(Maybe Window) -- ^ Decoration window, or Nothing if this window should not be decorated + , wdDecoRect :: !(Maybe Rectangle) -- ^ Rectangle for decoration window + , wdWidgets :: ![WidgetPlace] -- ^ Places for widgets + } + +-- | Type class for window commands (such as maximize or close window) +class (Read cmd, Show cmd) => WindowCommand cmd where + -- | Execute the command + executeWindowCommand :: cmd -> Window -> X Bool + + -- | Is the command currently in `checked' state. + -- For example, for 'sticky' command, check if the + -- window is currently sticky. + isCommandChecked :: cmd -> Window -> X Bool + +-- | Type class for decoration widgets +class (WindowCommand (WidgetCommand widget), Read widget, Show widget) + => DecorationWidget widget where + -- | Type of window commands which this type of widgets can execute + type WidgetCommand widget + + -- | Get window command which is associated with this widget. + widgetCommand :: widget -> Int -> WidgetCommand widget + + -- | Check if the widget is shrinkable, i.e. if it's width + -- can be reduced if there is not enough place in the decoration. + isShrinkable :: widget -> Bool + +-- | Layout of widgets +data WidgetLayout a = WidgetLayout { + wlLeft :: ![a] -- ^ Widgets that should be aligned to the left side of decoration + , wlCenter :: ![a] -- ^ Widgets that should be in the center of decoration + , wlRight :: ![a] -- ^ Widgets taht should be aligned to the right side of decoration + } + +-- | Data type describing where the decoration widget (e.g. window button) +-- should be placed. +-- All coordinates are relative to decoration rectangle. +data WidgetPlace = WidgetPlace { + wpTextYPosition :: !Position -- ^ Y position of text base line + -- (for widgets like window title or text-based buttons) + , wpRectangle :: !Rectangle -- ^ Rectangle where to place the widget + } + deriving (Show) + +-- | Generic data type which is used to +-- describe characteristics of rectangle borders. +data BoxBorders a = BoxBorders { + bxTop :: !a + , bxRight :: !a + , bxBottom :: !a + , bxLeft :: !a + } deriving (Eq, Read, Show) + +-- | Convinience data type describing colors of decoration rectangle borders. +type BorderColors = BoxBorders String + +-- | Data type describing look of window decoration +-- in particular state (active or inactive) +data SimpleStyle = SimpleStyle { + sBgColor :: !String -- ^ Decoration background color + , sTextColor :: !String -- ^ Text (foreground) color + , sTextBgColor :: !String -- ^ Text background color + , sDecoBorderWidth :: !Dimension -- ^ Width of border of decoration rectangle. Set to 0 to disable the border. + , sDecorationBorders :: !BorderColors -- ^ Colors of borders of decoration rectangle. + } + deriving (Show, Read) + +-- | Type class for themes, which claims that +-- the theme contains the list of widgets and their alignments. +class HasWidgets theme widget where + themeWidgets :: theme widget -> WidgetLayout widget + +-- | Type class for themes, which claims that +-- the theme can describe how the decoration should respond +-- to clicks on decoration itself (between widgets). +class ClickHandler theme widget where + -- | This is called when the user clicks on the decoration rectangle + -- (not on one of widgets). + onDecorationClick :: theme widget + -> Int -- ^ Mouse button number + -> Maybe (WidgetCommand widget) + + -- | Determine if it is possible to drag window by it's decoration + -- with mouse button. + isDraggingEnabled :: theme widget + -> Int -- ^ Mouse button number + -> Bool + +-- | Type class for themes, which claims that the theme +-- is responsible for determining looks of decoration. +class (Read theme, Show theme) => ThemeAttributes theme where + -- | Type which describes looks of decoration in one + -- of window states (active, inactive, urgent, etc). + type Style theme + + -- | Select style based on window state. + selectWindowStyle :: theme -> Window -> X (Style theme) + + -- | Define padding between decoration rectangle and widgets. + widgetsPadding :: theme -> BoxBorders Dimension + + -- | Initial background color of decoration rectangle. + -- When decoration widget is created, it is initially filled + -- with this color. + defaultBgColor :: theme -> String + + -- | Font name defined in the theme. + themeFontName :: theme -> String + +-- | Generic Theme data type. This is used +-- by @TextEngine@ and can be used by other relatively +-- simple decoration engines. +data GenericTheme style widget = GenericTheme { + exActive :: !style -- ^ Decoration style for active (focused) windows + , exInactive :: !style -- ^ Decoration style for inactive (unfocused) windows + , exUrgent :: !style -- ^ Decoration style for urgent windows + , exPadding :: !(BoxBorders Dimension) -- ^ Padding between decoration rectangle and widgets + , exFontName :: !String -- ^ Font name + , exOnDecoClick :: !(M.Map Int (WidgetCommand widget)) -- ^ Correspondence between mouse button number and window command. + , exDragWindowButtons :: ![Int] -- ^ For which mouse buttons dragging is enabled + , exWidgetsLeft :: ![widget] -- ^ Widgets that should appear at the left of decoration rectangle (listed left to right) + , exWidgetsCenter :: ![widget] -- ^ Widgets that should appear in the center of decoration rectangle (listed left to right) + , exWidgetsRight :: ![widget] -- ^ Widgets that should appear at the right of decoration rectangle (listed left to right) + } + +deriving instance (Show widget, Show (WidgetCommand widget), Show style) => Show (GenericTheme style widget) +deriving instance (Read widget, Read (WidgetCommand widget), Read style) => Read (GenericTheme style widget) + +-- | Convience type for themes used by @TextDecoration@. +type ThemeEx widget = GenericTheme SimpleStyle widget + +instance HasWidgets (GenericTheme style) widget where + themeWidgets theme = WidgetLayout (exWidgetsLeft theme) (exWidgetsCenter theme) (exWidgetsRight theme) + +-- | Supported states of windows (on which looks of decorations can depend). +data ThemeStyleType = ActiveWindow | UrgentWindow | InactiveWindow + deriving (Eq, Show, Read) + +-- | Utility function to convert WidgetLayout to plain list of widgets. +widgetLayout :: WidgetLayout widget -> [widget] +widgetLayout ws = wlLeft ws ++ wlCenter ws ++ wlRight ws + +-- | Painting context for decoration engines based on plain X11 calls. +type XPaintingContext = (Display, Pixmap, GC) + +instance (Show widget, Read widget, Read (WidgetCommand widget), Show (WidgetCommand widget)) + => ThemeAttributes (ThemeEx widget) where + type Style (ThemeEx widget) = SimpleStyle + selectWindowStyle theme w = genericWindowStyle w theme + defaultBgColor t = sBgColor $ exInactive t + widgetsPadding = exPadding + themeFontName = exFontName + +instance ClickHandler (GenericTheme SimpleStyle) widget where + onDecorationClick theme button = M.lookup button (exOnDecoClick theme) + isDraggingEnabled theme button = button `elem` exDragWindowButtons theme + +-- | Generic utility function to select style from @GenericTheme@ +-- based on current state of the window. +genericWindowStyle :: Window -> GenericTheme style widget -> X style +genericWindowStyle win theme = do + styleType <- windowStyleType win + return $ case styleType of + ActiveWindow -> exActive theme + InactiveWindow -> exInactive theme + UrgentWindow -> exUrgent theme + +-- | Detect type of style to be used from current state of the window. +windowStyleType :: Window -> X ThemeStyleType +windowStyleType win = do + mbFocused <- W.peek <$> gets windowset + isWmStateUrgent <- (win `elem`) <$> readUrgents + isUrgencyBitSet <- withDisplay $ \dpy -> do + hints <- io $ getWMHints dpy win + return $ wmh_flags hints `testBit` urgencyHintBit + if isWmStateUrgent || isUrgencyBitSet + then return UrgentWindow + else return $ + case mbFocused of + Nothing -> InactiveWindow + Just focused + | focused == win -> ActiveWindow + | otherwise -> InactiveWindow + +-- | Convert Theme type from "XMonad.Layout.Decoration" to +-- theme type used by "XMonad.Layout.DecorationEx.TextEngine". +themeEx :: Default (WidgetCommand widget) => D.Theme -> ThemeEx widget +themeEx t = + GenericTheme { + exActive = SimpleStyle (D.activeColor t) (D.activeTextColor t) (D.activeColor t) (D.activeBorderWidth t) (borderColor $ D.activeColor t) + , exInactive = SimpleStyle (D.inactiveColor t) (D.inactiveTextColor t) (D.inactiveColor t) (D.inactiveBorderWidth t) (borderColor $ D.inactiveColor t) + , exUrgent = SimpleStyle (D.urgentColor t) (D.urgentTextColor t) (D.urgentColor t) (D.urgentBorderWidth t) (borderColor $ D.urgentColor t) + , exPadding = BoxBorders 0 4 0 4 + , exFontName = D.fontName t + , exOnDecoClick = M.fromList [(1, def)] + , exDragWindowButtons = [1] + , exWidgetsLeft = [] + , exWidgetsCenter = [] + , exWidgetsRight = [] + } + +instance Default (WidgetCommand widget) => Default (ThemeEx widget) where + def = themeEx (def :: D.Theme) + +borderColor :: String -> BorderColors +borderColor c = BoxBorders c c c c + +shadowBorder :: String -> String -> BorderColors +shadowBorder highlight shadow = BoxBorders highlight shadow shadow highlight + diff --git a/XMonad/Layout/DecorationEx/DwmGeometry.hs b/XMonad/Layout/DecorationEx/DwmGeometry.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/DwmGeometry.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.DwmGeometry +-- Description : DWM-style window decoration geometry +-- Copyright : (c) 2007 Andrea Rossato, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This defines window decorations which are shown as a bar of fixed width +-- on top of window. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.DwmGeometry ( + -- * Usage: + -- $usage + DwmGeometry (..), + dwmStyleDeco, dwmStyleDecoEx + ) where + +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutModifier +import qualified XMonad.Layout.Decoration as D + +import XMonad.Layout.DecorationEx.LayoutModifier +import XMonad.Layout.DecorationEx.Common +import XMonad.Layout.DecorationEx.Geometry +import XMonad.Layout.DecorationEx.Widgets +import XMonad.Layout.DecorationEx.TextEngine + +-- $usage +-- You can use this module with the following in your +-- @xmonad.hs@: +-- +-- > import XMonad.Layout.DecorationEx.DwmStyle +-- Then edit your @layoutHook@ by adding the DwmStyle decoration to +-- your layout: +-- +-- > myL = dwmStyleDeco shrinkText (layoutHook def) +-- > main = xmonad def { layoutHook = myL } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | Decoration geometry data type +data DwmGeometry a = DwmGeometry { + dwmShowForFocused :: !Bool -- ^ Whether to show decorations on focused windows + , dwmHorizontalPosition :: !Rational -- ^ Horizontal position of decoration rectangle. + -- 0 means place it at left corner, 1 - place it at + -- right corner, @1%2@ - place it at center. + , dwmDecoHeight :: !Dimension -- ^ Height of decoration rectangle + , dwmDecoWidth :: !Dimension -- ^ Width of decoration rectangle + } + deriving (Show, Read) + +instance Default (DwmGeometry a) where + def = DwmGeometry False 1 20 200 + +instance DecorationGeometry DwmGeometry Window where + describeGeometry _ = "DwmStyle" + + pureDecoration (DwmGeometry {..}) _ stack _ (w, Rectangle x y windowWidth _) = + let width = min windowWidth dwmDecoWidth + halfWidth = width `div` 2 + minCenterX = x + fi halfWidth + maxCenterX = x + fi windowWidth - fromIntegral halfWidth + centerX = round ((1 - dwmHorizontalPosition)*fi minCenterX + dwmHorizontalPosition*fi maxCenterX) :: Position + decoX = centerX - fi halfWidth + focusedWindow = W.focus stack + isFocused = focusedWindow == w + in if (not dwmShowForFocused && isFocused) || not (D.isInStack stack w) + then Nothing + else Just $ Rectangle decoX y width dwmDecoHeight + + shrinkWindow _ _ windowRect = windowRect + +-- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration; +-- decoration placement can be adjusted. +dwmStyleDecoEx :: D.Shrinker shrinker + => shrinker -- ^ Strings shrinker, for example @shrinkText@ + -> DwmGeometry Window + -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc) + -> l Window -- ^ Layout to be decorated + -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window +dwmStyleDecoEx shrinker geom theme = decorationEx shrinker theme TextDecoration geom + +-- | Add a decoration to window layout. Widgets are indicated with text fragments using TextDecoration; +-- decoration placement is similar to DWM. +dwmStyleDeco :: D.Shrinker shrinker + => shrinker -- ^ Strings shrinker, for example @shrinkText@ + -> ThemeEx StandardWidget -- ^ Decoration theme (font, colors, widgets, etc) + -> l Window -- ^ Layout to be decorated + -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window +dwmStyleDeco shrinker = dwmStyleDecoEx shrinker def + diff --git a/XMonad/Layout/DecorationEx/Engine.hs b/XMonad/Layout/DecorationEx/Engine.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/Engine.hs @@ -0,0 +1,511 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.Engine +-- Description : Type class and its default implementation for window decoration engines. +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This module defines @DecorationEngine@ type class, and default implementation for it. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.Engine ( + -- * DecorationEngine class + DecorationEngine (..), + -- * Auxiliary data types + DrawData (..), + DecorationLayoutState (..), + -- * Re-exports from X.L.Decoration + Shrinker (..), shrinkText, + -- * Utility functions + mkDrawData, + paintDecorationSimple + ) where + +import Control.Monad +import Data.Kind +import Foreign.C.Types (CInt) + +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W +import XMonad.Layout.Decoration (Shrinker (..), shrinkWhile, shrinkText) +import XMonad.Layout.DraggingVisualizer (DraggingVisualizerMsg (..)) +import XMonad.Layout.DecorationAddons (handleScreenCrossing) +import XMonad.Util.Font +import XMonad.Util.NamedWindows (getName) + +import XMonad.Layout.DecorationEx.Common + +-- | Auxiliary type for data which are passed from +-- decoration layout modifier to decoration engine. +data DrawData engine widget = DrawData { + ddEngineState :: !(DecorationEngineState engine) -- ^ Decoration engine state + , ddStyle :: !(Style (Theme engine widget)) -- ^ Graphics style of the decoration. This defines colors, fonts etc + -- which are to be used for this particular window in it's current state. + , ddOrigWindow :: !Window -- ^ Original window to be decorated + , ddWindowTitle :: !String -- ^ Original window title (not shrinked yet) + , ddDecoRect :: !Rectangle -- ^ Decoration rectangle + , ddWidgets :: !(WidgetLayout widget) -- ^ Widgets to be placed on decoration + , ddWidgetPlaces :: !(WidgetLayout WidgetPlace) -- ^ Places where widgets must be shown + } + +-- | State of decoration engine +data DecorationLayoutState engine = DecorationLayoutState { + dsStyleState :: !(DecorationEngineState engine) -- ^ Engine-specific state + , dsDecorations :: ![WindowDecoration] -- ^ Mapping between decoration windows and original windows + } + +-- | Decoration engines type class. +-- Decoration engine is responsible for drawing something inside decoration rectangle. +-- It is also responsible for handling X11 events (such as clicks) which happen +-- within decoration rectangle. +-- Decoration rectangles are defined by DecorationGeometry implementation. +class (Read (engine widget a), Show (engine widget a), + Eq a, + DecorationWidget widget, + HasWidgets (Theme engine) widget, + ClickHandler (Theme engine) widget, + ThemeAttributes (Theme engine widget)) + => DecorationEngine engine widget a where + + -- | Type of themes used by decoration engine. + -- This type must be parameterized over a widget type, + -- because a theme will contain a list of widgets. + type Theme engine :: Type -> Type + + -- | Type of data used by engine as a context during painting; + -- for plain X11-based implementation this is Display, Pixmap + -- and GC. + type DecorationPaintingContext engine + + -- | Type of state used by the decoration engine. + -- This can contain some resources that should be initialized + -- and released at time, such as X11 fonts. + type DecorationEngineState engine + + -- | Give a name to decoration engine. + describeEngine :: engine widget a -> String + + -- | Initialize state of the engine. + initializeState :: engine widget a -- ^ Decoration engine instance + -> geom a -- ^ Decoration geometry instance + -> Theme engine widget -- ^ Theme to be used + -> X (DecorationEngineState engine) + + -- | Release resources held in engine state. + releaseStateResources :: engine widget a -- ^ Decoration engine instance + -> DecorationEngineState engine -- ^ Engine state + -> X () + + -- | Calculate place which will be occupied by one widget. + -- NB: X coordinate of the returned rectangle will be ignored, because + -- the rectangle will be moved to the right or to the left for proper alignment + -- of widgets. + calcWidgetPlace :: engine widget a -- ^ Decoration engine instance + -> DrawData engine widget -- ^ Information about window and decoration + -> widget -- ^ Widget to be placed + -> X WidgetPlace + + -- | Place widgets along the decoration bar. + placeWidgets :: Shrinker shrinker + => engine widget a -- ^ Decoration engine instance + -> Theme engine widget -- ^ Theme to be used + -> shrinker -- ^ Strings shrinker + -> DecorationEngineState engine -- ^ Current state of the engine + -> Rectangle -- ^ Decoration rectangle + -> Window -- ^ Original window to be decorated + -> WidgetLayout widget -- ^ Widgets layout + -> X (WidgetLayout WidgetPlace) + placeWidgets engine theme _ decoStyle decoRect window wlayout = do + let leftWidgets = wlLeft wlayout + rightWidgets = wlRight wlayout + centerWidgets = wlCenter wlayout + + dd <- mkDrawData engine theme decoStyle window decoRect + let paddedDecoRect = pad (widgetsPadding theme) (ddDecoRect dd) + paddedDd = dd {ddDecoRect = paddedDecoRect} + rightRects <- alignRight engine paddedDd rightWidgets + leftRects <- alignLeft engine paddedDd leftWidgets + let wantedLeftWidgetsWidth = sum $ map (rect_width . wpRectangle) leftRects + wantedRightWidgetsWidth = sum $ map (rect_width . wpRectangle) rightRects + hasShrinkableOnLeft = any isShrinkable leftWidgets + hasShrinkableOnRight = any isShrinkable rightWidgets + decoWidth = rect_width decoRect + (leftWidgetsWidth, rightWidgetsWidth) + | hasShrinkableOnLeft = + (min (decoWidth - wantedRightWidgetsWidth) wantedLeftWidgetsWidth, + wantedRightWidgetsWidth) + | hasShrinkableOnRight = + (wantedLeftWidgetsWidth, + min (decoWidth - wantedLeftWidgetsWidth) wantedRightWidgetsWidth) + | otherwise = (wantedLeftWidgetsWidth, wantedRightWidgetsWidth) + ddForCenter = paddedDd {ddDecoRect = padCenter leftWidgetsWidth rightWidgetsWidth paddedDecoRect} + centerRects <- alignCenter engine ddForCenter centerWidgets + let shrinkedLeftRects = packLeft (rect_x paddedDecoRect) $ shrinkPlaces leftWidgetsWidth $ zip leftRects (map isShrinkable leftWidgets) + shrinkedRightRects = packRight (rect_width paddedDecoRect) $ shrinkPlaces rightWidgetsWidth $ zip rightRects (map isShrinkable rightWidgets) + return $ WidgetLayout shrinkedLeftRects centerRects shrinkedRightRects + where + shrinkPlaces targetWidth ps = + let nShrinkable = length (filter snd ps) + totalUnshrinkedWidth = sum $ map (rect_width . wpRectangle . fst) $ filter (not . snd) ps + shrinkedWidth = (targetWidth - totalUnshrinkedWidth) `div` fi nShrinkable + + resetX place = place {wpRectangle = (wpRectangle place) {rect_x = 0}} + + adjust (place, True) = resetX $ place {wpRectangle = (wpRectangle place) {rect_width = shrinkedWidth}} + adjust (place, False) = resetX place + in map adjust ps + + pad p (Rectangle _ _ w h) = + Rectangle (fi (bxLeft p)) (fi (bxTop p)) + (w - bxLeft p - bxRight p) + (h - bxTop p - bxBottom p) + + padCenter left right (Rectangle x y w h) = + Rectangle (x + fi left) y + (w - left - right) h + + -- | Shrink window title so that it would fit in decoration. + getShrinkedWindowName :: Shrinker shrinker + => engine widget a -- ^ Decoration engine instance + -> shrinker -- ^ Strings shrinker + -> DecorationEngineState engine -- ^ State of decoration engine + -> String -- ^ Original window title + -> Dimension -- ^ Width of rectangle in which the title should fit + -> Dimension -- ^ Height of rectangle in which the title should fit + -> X String + + default getShrinkedWindowName :: (Shrinker shrinker, DecorationEngineState engine ~ XMonadFont) + => engine widget a -> shrinker -> DecorationEngineState engine -> String -> Dimension -> Dimension -> X String + getShrinkedWindowName _ shrinker font name wh _ = do + let s = shrinkIt shrinker + dpy <- asks display + shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy font n + return $ size > fromIntegral wh) name + + -- | Mask of X11 events on which the decoration engine should do something. + -- @exposureMask@ should be included here so that decoration engine could + -- repaint decorations when they are shown on screen. + -- @buttonPressMask@ should be included so that decoration engine could + -- response to mouse clicks. + -- Other events can be added to custom implementations of DecorationEngine. + decorationXEventMask :: engine widget a -> EventMask + decorationXEventMask _ = exposureMask .|. buttonPressMask + + -- | List of X11 window property atoms of original (client) windows, + -- change of which should trigger repainting of decoration. + -- For example, if @WM_NAME@ changes it means that we have to redraw + -- window title. + propsToRepaintDecoration :: engine widget a -> X [Atom] + propsToRepaintDecoration _ = + mapM getAtom ["WM_NAME", "_NET_WM_NAME", "WM_STATE", "WM_HINTS"] + + -- | Generic event handler, which recieves X11 events on decoration + -- window. + -- Default implementation handles mouse clicks and drags. + decorationEventHookEx :: Shrinker shrinker + => engine widget a + -> Theme engine widget + -> DecorationLayoutState engine + -> shrinker + -> Event + -> X () + decorationEventHookEx = handleMouseFocusDrag + + -- | Event handler for clicks on decoration window. + -- This is called from default implementation of "decorationEventHookEx". + -- This should return True, if the click was handled (something happened + -- because of that click). If this returns False, the click can be considered + -- as a beginning of mouse drag. + handleDecorationClick :: engine widget a -- ^ Decoration engine instance + -> Theme engine widget -- ^ Decoration theme + -> Rectangle -- ^ Decoration rectangle + -> [Rectangle] -- ^ Rectangles where widgets are placed + -> Window -- ^ Original (client) window + -> Int -- ^ Mouse click X coordinate + -> Int -- ^ Mouse click Y coordinate + -> Int -- ^ Mouse button number + -> X Bool + handleDecorationClick = decorationHandler + + -- | Event handler which is called during mouse dragging. + -- This is called from default implementation of "decorationEventHookEx". + decorationWhileDraggingHook :: engine widget a -- ^ Decoration engine instance + -> CInt -- ^ Event X coordinate + -> CInt -- ^ Event Y coordinate + -> (Window, Rectangle) -- ^ Original window and it's rectangle + -> Position -- ^ X coordinate of new pointer position during dragging + -> Position -- ^ Y coordinate of new pointer position during dragging + -> X () + decorationWhileDraggingHook _ = handleDraggingInProgress + + -- | This hoook is called after a window has been dragged using the decoration. + -- This is called from default implementation of "decorationEventHookEx". + decorationAfterDraggingHook :: engine widget a -- ^ Decoration engine instance + -> (Window, Rectangle) -- ^ Original window and its rectangle + -> Window -- ^ Decoration window + -> X () + decorationAfterDraggingHook _ds (w, _r) decoWin = do + focus w + hasCrossed <- handleScreenCrossing w decoWin + unless hasCrossed $ do + sendMessage DraggingStopped + performWindowSwitching w + + -- | Draw everything required on the decoration window. + -- This method should draw background (flat or gradient or whatever), + -- borders, and call @paintWidget@ method to draw window widgets + -- (buttons and title). + paintDecoration :: Shrinker shrinker + => engine widget a -- ^ Decoration engine instance + -> a -- ^ Decoration window + -> Dimension -- ^ Decoration window width + -> Dimension -- ^ Decoration window height + -> shrinker -- ^ Strings shrinker instance + -> DrawData engine widget -- ^ Details about what to draw + -> Bool -- ^ True when this method is called during Expose event + -> X () + + -- | Paint one widget on the decoration window. + paintWidget :: Shrinker shrinker + => engine widget a -- ^ Decoration engine instance + -> DecorationPaintingContext engine -- ^ Decoration painting context + -> WidgetPlace -- ^ Place (rectangle) where the widget should be drawn + -> shrinker -- ^ Strings shrinker instance + -> DrawData engine widget -- ^ Details about window decoration + -> widget -- ^ Widget to be drawn + -> Bool -- ^ True when this method is called during Expose event + -> X () + +handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () +handleDraggingInProgress ex ey (mainw, r) x y = do + let rect = Rectangle (x - (fi ex - rect_x r)) + (y - (fi ey - rect_y r)) + (rect_width r) + (rect_height r) + sendMessage $ DraggingWindow mainw rect + +performWindowSwitching :: Window -> X () +performWindowSwitching win = + withDisplay $ \d -> do + root <- asks theRoot + (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root + ws <- gets windowset + let allWindows = W.index ws + -- do a little double check to be sure + when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do + let allWindowsSwitched = map (switchEntries win selWin) allWindows + let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched + let newStack = W.Stack t (reverse ls) rs + windows $ W.modify' $ const newStack + where + switchEntries a b x + | x == a = b + | x == b = a + | otherwise = x + +ignoreX :: WidgetPlace -> WidgetPlace +ignoreX place = place {wpRectangle = (wpRectangle place) {rect_x = 0}} + +alignLeft :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace] +alignLeft engine dd widgets = do + places <- mapM (calcWidgetPlace engine dd) widgets + return $ packLeft (rect_x $ ddDecoRect dd) $ map ignoreX places + +packLeft :: Position -> [WidgetPlace] -> [WidgetPlace] +packLeft _ [] = [] +packLeft x0 (place : places) = + let rect = wpRectangle place + x' = x0 + rect_x rect + rect' = rect {rect_x = x'} + place' = place {wpRectangle = rect'} + in place' : packLeft (x' + fi (rect_width rect)) places + +alignRight :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace] +alignRight engine dd widgets = do + places <- mapM (calcWidgetPlace engine dd) widgets + return $ packRight (rect_width $ ddDecoRect dd) $ map ignoreX places + +packRight :: Dimension -> [WidgetPlace] -> [WidgetPlace] +packRight x0 places = reverse $ go x0 places + where + go _ [] = [] + go x (place : rest) = + let rect = wpRectangle place + x' = x - rect_width rect + rect' = rect {rect_x = fi x'} + place' = place {wpRectangle = rect'} + in place' : go x' rest + +alignCenter :: forall engine widget a. DecorationEngine engine widget a => engine widget a -> DrawData engine widget -> [widget] -> X [WidgetPlace] +alignCenter engine dd widgets = do + places <- alignLeft engine dd widgets + let totalWidth = sum $ map (rect_width . wpRectangle) places + availableWidth = fi (rect_width (ddDecoRect dd)) :: Position + x0 = max 0 $ (availableWidth - fi totalWidth) `div` 2 + places' = map (shift x0) places + return $ pack (fi availableWidth) places' + where + shift x0 place = + let rect = wpRectangle place + rect' = rect {rect_x = rect_x rect + fi x0} + in place {wpRectangle = rect'} + + pack _ [] = [] + pack available (place : places) = + let rect = wpRectangle place + placeWidth = rect_width rect + widthToUse = min available placeWidth + remaining = available - widthToUse + rect' = rect {rect_width = widthToUse} + place' = place {wpRectangle = rect'} + in place' : pack remaining places + +-- | Build an instance of 'DrawData' type. +mkDrawData :: (DecorationEngine engine widget a, ThemeAttributes (Theme engine widget), HasWidgets (Theme engine) widget) + => engine widget a + -> Theme engine widget -- ^ Decoration theme + -> DecorationEngineState engine -- ^ State of decoration engine + -> Window -- ^ Original window (to be decorated) + -> Rectangle -- ^ Decoration rectangle + -> X (DrawData engine widget) +mkDrawData _ theme decoState origWindow decoRect = do + -- xmonad-contrib #809 + -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@ + -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is + -- quadratic due to using 'init' + name <- fmap (take 2048 . takeWhile (/= '\n') . show) (getName origWindow) + style <- selectWindowStyle theme origWindow + return $ DrawData { + ddEngineState = decoState, + ddStyle = style, + ddOrigWindow = origWindow, + ddWindowTitle = name, + ddDecoRect = decoRect, + ddWidgets = themeWidgets theme, + ddWidgetPlaces = WidgetLayout [] [] [] + } + +-- | Mouse focus and mouse drag are handled by the same function, this +-- way we can start dragging unfocused windows too. +handleMouseFocusDrag :: (DecorationEngine engine widget a, Shrinker shrinker) => engine widget a -> Theme engine widget -> DecorationLayoutState engine -> shrinker -> Event -> X () +handleMouseFocusDrag ds theme (DecorationLayoutState {dsDecorations}) _ (ButtonEvent {ev_window, ev_x_root, ev_y_root, ev_event_type, ev_button}) + | ev_event_type == buttonPress + , Just (WindowDecoration {..}) <- findDecoDataByDecoWindow ev_window dsDecorations = do + let decoRect@(Rectangle dx dy _ _) = fromJust wdDecoRect + x = fi $ ev_x_root - fi dx + y = fi $ ev_y_root - fi dy + button = fi ev_button + dealtWith <- handleDecorationClick ds theme decoRect (map wpRectangle wdWidgets) wdOrigWindow x y button + unless dealtWith $ when (isDraggingEnabled theme button) $ + mouseDrag (\dragX dragY -> focus wdOrigWindow >> decorationWhileDraggingHook ds ev_x_root ev_y_root (wdOrigWindow, wdOrigWinRect) dragX dragY) + (decorationAfterDraggingHook ds (wdOrigWindow, wdOrigWinRect) ev_window) +handleMouseFocusDrag _ _ _ _ _ = return () + +-- | Given a window and the state, if a matching decoration is in the +-- state return it with its ('Maybe') 'Rectangle'. +findDecoDataByDecoWindow :: Window -> [WindowDecoration] -> Maybe WindowDecoration +findDecoDataByDecoWindow decoWin = find (\dd -> wdDecoWindow dd == Just decoWin) + +decorationHandler :: forall engine widget a. + (DecorationEngine engine widget a, + ClickHandler (Theme engine) widget) + => engine widget a + -> Theme engine widget + -> Rectangle + -> [Rectangle] + -> Window + -> Int + -> Int + -> Int + -> X Bool +decorationHandler _ theme _ widgetPlaces window x y button = do + widgetDone <- go $ zip (widgetLayout $ themeWidgets theme) widgetPlaces + if widgetDone + then return True + else case onDecorationClick theme button of + Just cmd -> do + executeWindowCommand cmd window + Nothing -> return False + where + go :: [(widget, Rectangle)] -> X Bool + go [] = return False + go ((w, rect) : rest) = do + if pointWithin (fi x) (fi y) rect + then do + executeWindowCommand (widgetCommand w button) window + else go rest + +-- | Simple implementation of @paintDecoration@ method. +-- This is used by @TextEngine@ and can be re-used by other decoration +-- engines. +paintDecorationSimple :: forall engine shrinker widget. + (DecorationEngine engine widget Window, + DecorationPaintingContext engine ~ XPaintingContext, + Shrinker shrinker, + Style (Theme engine widget) ~ SimpleStyle) + => engine widget Window + -> Window + -> Dimension + -> Dimension + -> shrinker + -> DrawData engine widget + -> Bool + -> X () +paintDecorationSimple deco win windowWidth windowHeight shrinker dd isExpose = do + dpy <- asks display + let widgets = widgetLayout $ ddWidgets dd + style = ddStyle dd + pixmap <- io $ createPixmap dpy win windowWidth windowHeight (defaultDepthOfScreen $ defaultScreenOfDisplay dpy) + gc <- io $ createGC dpy pixmap + -- draw + io $ setGraphicsExposures dpy gc False + bgColor <- stringToPixel dpy (sBgColor style) + -- we start with the border + let borderWidth = sDecoBorderWidth style + borderColors = sDecorationBorders style + when (borderWidth > 0) $ do + drawLineWith dpy pixmap gc 0 0 windowWidth borderWidth (bxTop borderColors) + drawLineWith dpy pixmap gc 0 0 borderWidth windowHeight (bxLeft borderColors) + drawLineWith dpy pixmap gc 0 (fi (windowHeight - borderWidth)) windowWidth borderWidth (bxBottom borderColors) + drawLineWith dpy pixmap gc (fi (windowWidth - borderWidth)) 0 borderWidth windowHeight (bxRight borderColors) + + -- and now again + io $ setForeground dpy gc bgColor + io $ fillRectangle dpy pixmap gc (fi borderWidth) (fi borderWidth) (windowWidth - (borderWidth * 2)) (windowHeight - (borderWidth * 2)) + + -- paint strings + forM_ (zip widgets $ widgetLayout $ ddWidgetPlaces dd) $ \(widget, place) -> + paintWidget deco (dpy, pixmap, gc) place shrinker dd widget isExpose + + -- debug + -- black <- stringToPixel dpy "black" + -- io $ setForeground dpy gc black + -- forM_ (ddWidgetPlaces dd) $ \(WidgetPlace {wpRectangle = Rectangle x y w h}) -> + -- io $ drawRectangle dpy pixmap gc x y w h + + -- copy the pixmap over the window + io $ copyArea dpy pixmap win gc 0 0 windowWidth windowHeight 0 0 + -- free the pixmap and GC + io $ freePixmap dpy pixmap + io $ freeGC dpy gc + where + drawLineWith dpy pixmap gc x y w h colorName = do + color <- stringToPixel dpy colorName + io $ setForeground dpy gc color + io $ fillRectangle dpy pixmap gc x y w h + diff --git a/XMonad/Layout/DecorationEx/Geometry.hs b/XMonad/Layout/DecorationEx/Geometry.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/Geometry.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.Geometry +-- Description : Type class which is responsible for defining the placement +-- of window decorations +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This module defines @DecorationGeometry@ type class, and default implementation for it. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.Geometry ( + DecorationGeometry (..), + DefaultGeometry (..) + ) where + +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W +import qualified XMonad.Layout.Decoration as D + +-- | Decoration geometry class. +-- Decoration geometry is responsible for placement of window decorations: whether +-- they should be on the top of the window or on the bottom, should they go for +-- full window width or only be of certain width, etc. +-- This does not know what will be drawn inside decorations. +class (Read (geom a), Show (geom a), + Eq a) + => DecorationGeometry geom a where + + -- | Give a name to decoration geometry implementation. + describeGeometry :: geom a -> String + + -- | Reduce original window size to make space for decoration, if necessary. + shrinkWindow :: geom a -> Rectangle -> Rectangle -> Rectangle + shrinkWindow _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) + + -- | The pure version of the main method, 'decorate'. + -- The method should return a rectangle where to place window decoration, + -- or 'Nothing' if this window is not to be decorated. + pureDecoration :: geom a -- ^ Decoration geometry instance + -> Rectangle -- ^ Screen rectangle + -> W.Stack a -- ^ Current stack of windows being displayed + -> [(a,Rectangle)] -- ^ Set of all windows with their corresponding rectangle + -> (a,Rectangle) -- ^ Window being decorated and its rectangle + -> Maybe Rectangle + + -- | The method should return a rectangle where to place window decoration, + -- or 'Nothing' if this window is not to be decorated. + decorateWindow :: geom a -- ^ Decoration geometry instance + -> Rectangle -- ^ Screen rectangle + -> W.Stack a -- ^ Current stack of windows being displayed + -> [(a, Rectangle)] -- ^ Set of all windows with their corresponding rectangle + -> (a, Rectangle) -- ^ Window being decorated and its rectangle + -> X (Maybe Rectangle) + decorateWindow geom r s wrs wr = return $ pureDecoration geom r s wrs wr + +-- | Data type for default implementation of 'DecorationGeometry'. +-- This defines simple decorations: a horizontal bar at the top of each window, +-- running for full width of the window. +newtype DefaultGeometry a = DefaultGeometry { + gDecorationHeight :: Dimension + } + deriving (Read, Show) + +instance Eq a => DecorationGeometry DefaultGeometry a where + describeGeometry _ = "Default" + + pureDecoration (DefaultGeometry {..}) _ s _ (w, Rectangle x y windowWidth windowHeight) = + if D.isInStack s w && (gDecorationHeight < windowHeight) + then Just $ Rectangle x y windowWidth gDecorationHeight + else Nothing + +instance Default (DefaultGeometry a) where + def = DefaultGeometry 20 + diff --git a/XMonad/Layout/DecorationEx/LayoutModifier.hs b/XMonad/Layout/DecorationEx/LayoutModifier.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/LayoutModifier.hs @@ -0,0 +1,322 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.LayoutModifier +-- Description : Layout modifier which adds decorations to windows. +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- Layout modifier, which is responsible for creation of decoration rectangles +-- (windows), updating and removing them when needed. It is parameterized by +-- @DecorationGeometry@, which says where decorations should be placed, and by +-- @DecorationEngine@, which says how decorations should look. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.LayoutModifier ( + -- * Usage + -- + -- $usage + decorationEx, + DecorationEx + ) where + +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutModifier +import XMonad.Layout.WindowArranger (diff, listFromList) +import XMonad.Util.Invisible +import XMonad.Util.XUtils hiding (paintTextAndIcons) + +import XMonad.Layout.DecorationEx.Common +import XMonad.Layout.DecorationEx.Engine +import XMonad.Layout.DecorationEx.Geometry + +-- $usage +-- +-- This module exports @decorationEx@ function, which is a generic function for +-- adding decorations to your layouts. It can be used to use different +-- decoration geometries and engines in any combination. +-- For most used combinations, there are convenience functions in +-- "XMonad.Layout.DecorationEx.TextEngine", "XMonad.Layout.DecorationEx.TabbedGeometry", +-- and "XMonad.Layout.DecorationEx.DwmGeometry". +-- +-- You can use this module with the following in your +-- @xmonad.hs@: +-- +-- > import XMonad.Layout.DecorationEx.LayoutModifier +-- Then edit your @layoutHook@ by adding the DwmStyle decoration to +-- your layout: +-- +-- > myL = decorationEx shrinkText myTheme myEngine myGeometry (layoutHook def) +-- > where +-- > myGeometry = DefaultGeometry -- or another geometry type +-- > myEngine = TextDecoration -- or another decoration engine +-- > myTheme = GenericTheme {...} -- theme type should correspond to selected engine type +-- > +-- > main = xmonad def { layoutHook = myL } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + + +-- | The 'DecorationEx' 'LayoutModifier'. This data type is an instance +-- of the 'LayoutModifier' class. This data type will be passed, +-- together with a layout, to the 'ModifiedLayout' type constructor +-- to modify the layout by adding decorations according to a +-- 'DecorationEngine'. +data DecorationEx engine widget geom shrinker a = + DecorationEx (Invisible Maybe (DecorationLayoutState engine)) shrinker (Theme engine widget) (engine widget a) (geom a) + +deriving instance (Show (Theme engine widget), Show shrinker, Show (engine widget a), Show (geom a)) => Show (DecorationEx engine widget geom shrinker a) +deriving instance (Read (Theme engine widget), Read shrinker, Read (engine widget a), Read (geom a)) => Read (DecorationEx engine widget geom shrinker a) + +-- | The long 'LayoutModifier' instance for the 'DecorationEx' type. +-- +-- In 'redoLayout' we check the state: if there is no state we +-- initialize it. +-- +-- The state is @diff@ed against the list of windows produced by the +-- underlying layout: removed windows get deleted and new ones +-- decorated by 'createDecos', which will call 'decorate' to decide if +-- a window must be given a 'Rectangle', in which case a decoration +-- window will be created. +-- +-- After that we resync the updated state with the windows' list and +-- then we process the resynced stated (as we do with a new state). +-- +-- First we map the decoration windows, we update each decoration to +-- reflect any decorated window's change, and we insert, in the list +-- of windows and rectangles returned by the underlying layout, the +-- decoration for each window. This way xmonad will restack the +-- decorations and their windows accordingly. At the end we remove +-- invisible\/stacked windows. +-- +-- Message handling is quite simple: when needed we release the state +-- component of the 'DecorationEx' 'LayoutModifier'. Otherwise we call +-- 'handleEvent', which will call the appropriate 'DecorationEngine' +-- methods to perform its tasks. +instance (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) => LayoutModifier (DecorationEx engine widget geom shrinker) Window where + redoLayout (DecorationEx (I (Just decoState)) shrinker theme engine geom) _ Nothing _ = do + releaseResources engine decoState + return ([], Just $ DecorationEx (I Nothing) shrinker theme engine geom) + redoLayout _ _ Nothing _ = return ([], Nothing) + + redoLayout (DecorationEx invState shrinker theme engine geom) screenRect (Just stack) srcPairs + | I Nothing <- invState = initState theme engine geom shrinker screenRect stack srcPairs >>= processState + | I (Just s) <- invState = do + let decorations = dsDecorations s + (d,a) = curry diff (getOrigWindows decorations) srcWindows + toDel = todel d decorations + toAdd = toadd a srcPairs + deleteDecos toDel + let decosToBeAdded = [WindowDecoration win rect Nothing Nothing [] | (win, rect) <- toAdd] + newDecorations <- resync (dsStyleState s) (decosToBeAdded ++ del_dwrs d decorations) srcPairs + processState (s {dsDecorations = newDecorations}) + + where + srcWindows = map fst srcPairs + + getOrigWindows :: [WindowDecoration] -> [Window] + getOrigWindows = map wdOrigWindow + + del_dwrs :: [Window] -> [WindowDecoration] -> [WindowDecoration] + del_dwrs = listFromList wdOrigWindow notElem + + findDecoWindow :: Int -> [WindowDecoration] -> Maybe Window + findDecoWindow i d = wdDecoWindow $ d !! i + + todel :: [Window] -> [WindowDecoration] -> [WindowDecoration] + todel d = filter (\dd -> wdOrigWindow dd `elem` d) + + toadd :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)] + toadd a = filter (\p -> fst p `elem` a) + + createDecoWindowIfNeeded :: Maybe Window -> Maybe Rectangle -> X (Maybe Window) + createDecoWindowIfNeeded mbDecoWindow mbDecoRect = + case (mbDecoWindow, mbDecoRect) of + (Nothing, Just decoRect) -> do + decoWindow <- createDecoWindow engine theme decoRect + return $ Just decoWindow + _ -> return mbDecoWindow + + resync :: DecorationEngineState engine -> [WindowDecoration] -> [(Window,Rectangle)] -> X [WindowDecoration] + resync _ _ [] = return [] + resync decoState dd ((window,rect):xs) = + case window `elemIndex` getOrigWindows dd of + Just i -> do + mbDecoRect <- decorateWindow geom screenRect stack srcPairs (window,rect) + widgetPlaces <- case mbDecoRect of + Nothing -> return $ WidgetLayout [] [] [] + Just decoRect -> placeWidgets engine theme shrinker decoState decoRect window (themeWidgets theme) + mbDecoWindow <- createDecoWindowIfNeeded (findDecoWindow i dd) mbDecoRect + let newDd = WindowDecoration window rect mbDecoWindow mbDecoRect (widgetLayout widgetPlaces) + restDd <- resync decoState dd xs + return $ newDd : restDd + Nothing -> resync decoState dd xs + + -- We drop any windows that are *precisely* stacked underneath + -- another window: these must be intended to be tabbed! + removeTabbed :: [Rectangle] -> [(Window, Rectangle)] -> [(Window, Rectangle)] + removeTabbed _ [] = [] + removeTabbed rs ((w,r):xs) + | r `elem` rs = removeTabbed rs xs + | otherwise = (w,r) : removeTabbed (r:rs) xs + + insertDwr :: WindowDecoration -> [(Window, Rectangle)] -> [(Window, Rectangle)] + insertDwr dd wrs = + case (wdDecoWindow dd, wdDecoRect dd) of + (Just decoWindow, Just decoRect) -> (decoWindow, decoRect) : (wdOrigWindow dd, shrinkWindow geom decoRect (wdOrigWinRect dd)) : wrs + _ -> (wdOrigWindow dd, wdOrigWinRect dd) : wrs + + dwrs_to_wrs :: [WindowDecoration] -> [(Window, Rectangle)] + dwrs_to_wrs = removeTabbed [] . foldr insertDwr [] + + processState :: DecorationLayoutState engine -> X ([(Window, Rectangle)], Maybe (DecorationEx engine widget geom shrinker Window)) + processState st = do + let decorations = dsDecorations st + showDecos decorations + updateDecos engine shrinker theme (dsStyleState st) decorations + return (dwrs_to_wrs decorations, Just (DecorationEx (I (Just (st {dsDecorations = decorations}))) shrinker theme engine geom)) + + handleMess (DecorationEx (I (Just st)) shrinker theme engine geom) m + | Just Hide <- fromMessage m = do + hideDecos $ dsDecorations st + return Nothing +-- | Just (SetTheme nt) <- fromMessage m = do +-- releaseResources engine st +-- let t' = themeEx nt +-- return $ Just $ DecorationEx (I Nothing) shrinker t' engine + | Just ReleaseResources <- fromMessage m = do + releaseResources engine st + return $ Just $ DecorationEx (I Nothing) shrinker theme engine geom + | Just e <- fromMessage m = do + decorationEventHookEx engine theme st shrinker e + handleEvent engine shrinker theme st e + return Nothing + handleMess _ _ = return Nothing + + modifierDescription (DecorationEx _ _ _ engine geom) = describeEngine engine ++ describeGeometry geom + +-- | By default 'DecorationEx' handles 'PropertyEvent' and 'ExposeEvent' +-- only. +handleEvent :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationLayoutState engine -> Event -> X () +handleEvent engine shrinker theme (DecorationLayoutState {..}) e + | PropertyEvent {ev_window = w, ev_atom = atom} <- e + , Just i <- w `elemIndex` map wdOrigWindow dsDecorations = do + supportedAtoms <- propsToRepaintDecoration engine + when (atom `elem` supportedAtoms) $ do + -- io $ putStrLn $ "property event on " ++ show w -- ++ ": " ++ fromMaybe "" atomName + updateDeco engine shrinker theme dsStyleState (dsDecorations !! i) False + | ExposeEvent {ev_window = w} <- e + , Just i <- w `elemIndex` mapMaybe wdDecoWindow dsDecorations = do + -- io $ putStrLn $ "expose event on " ++ show w + updateDeco engine shrinker theme dsStyleState (dsDecorations !! i) True +handleEvent _ _ _ _ _ = return () + +-- | Initialize the 'DecorationState' by initializing the font +-- structure and by creating the needed decorations. +initState :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) + => Theme engine widget + -> engine widget Window + -> geom Window + -> shrinker + -> Rectangle + -> W.Stack Window + -> [(Window,Rectangle)] -> X (DecorationLayoutState engine) +initState theme engine geom shrinker screenRect stack wrs = do + styleState <- initializeState engine geom theme + decorations <- createDecos theme engine geom shrinker styleState screenRect stack wrs wrs + return $ DecorationLayoutState styleState decorations + +-- | Delete windows stored in the state and release the font structure. +releaseResources :: DecorationEngine engine widget Window => engine widget Window -> DecorationLayoutState engine -> X () +releaseResources engine st = do + deleteDecos (dsDecorations st) + releaseStateResources engine (dsStyleState st) + +-- | Create the decoration windows of a list of windows and their +-- rectangles, by calling the 'decorate' method of the +-- 'DecorationStyle' received. +createDecos :: (DecorationEngine engine widget Window, DecorationGeometry geom Window, Shrinker shrinker) + => Theme engine widget + -> engine widget Window + -> geom Window + -> shrinker + -> DecorationEngineState engine + -> Rectangle + -> W.Stack Window + -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [WindowDecoration] +createDecos theme engine geom shrinker decoState screenRect stack wrs ((w,r):xs) = do + mbDecoRect <- decorateWindow geom screenRect stack wrs (w,r) + case mbDecoRect of + Just decoRect -> do + decoWindow <- createDecoWindow engine theme decoRect + widgetPlaces <- placeWidgets engine theme shrinker decoState decoRect w (themeWidgets theme) + restDd <- createDecos theme engine geom shrinker decoState screenRect stack wrs xs + let newDd = WindowDecoration w r (Just decoWindow) (Just decoRect) $ widgetLayout widgetPlaces + return $ newDd : restDd + Nothing -> do + restDd <- createDecos theme engine geom shrinker decoState screenRect stack wrs xs + let newDd = WindowDecoration w r Nothing Nothing [] + return $ newDd : restDd +createDecos _ _ _ _ _ _ _ _ [] = return [] + +createDecoWindow :: (DecorationEngine engine widget Window) => engine widget Window -> Theme engine widget -> Rectangle -> X Window +createDecoWindow engine theme rect = do + let mask = Just $ decorationXEventMask engine + w <- createNewWindow rect mask (defaultBgColor theme) True + d <- asks display + io $ setClassHint d w (ClassHint "xmonad-decoration" "xmonad") + return w + +showDecos :: [WindowDecoration] -> X () +showDecos dd = + showWindows $ mapMaybe wdDecoWindow $ filter (isJust . wdDecoRect) dd + +hideDecos :: [WindowDecoration] -> X () +hideDecos = hideWindows . mapMaybe wdDecoWindow + +deleteDecos :: [WindowDecoration] -> X () +deleteDecos = deleteWindows . mapMaybe wdDecoWindow + +updateDecos :: (Shrinker shrinker, DecorationEngine engine widget Window) + => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> [WindowDecoration] -> X () +updateDecos engine shrinker theme decoState = mapM_ (\wd -> updateDeco engine shrinker theme decoState wd False) + +-- | Update a decoration window given a shrinker, a theme, the font +-- structure and the needed 'Rectangle's +updateDeco :: (Shrinker shrinker, DecorationEngine engine widget Window) => engine widget Window -> shrinker -> Theme engine widget -> DecorationEngineState engine -> WindowDecoration -> Bool -> X () +updateDeco engine shrinker theme decoState wd isExpose = + case (wdDecoWindow wd, wdDecoRect wd) of + (Just decoWindow, Just decoRect@(Rectangle _ _ wh ht)) -> do + let origWin = wdOrigWindow wd + drawData <- mkDrawData engine theme decoState origWin decoRect + widgetPlaces <- placeWidgets engine theme shrinker decoState decoRect (wdOrigWindow wd) (themeWidgets theme) + -- io $ print widgetPlaces + paintDecoration engine decoWindow wh ht shrinker (drawData {ddWidgetPlaces = widgetPlaces}) isExpose + (Just decoWindow, Nothing) -> hideWindow decoWindow + _ -> return () + +-- | Apply a DecorationEx modifier to an underlying layout +decorationEx :: (DecorationEngine engine widget a, DecorationGeometry geom a, Shrinker shrinker) + => shrinker -- ^ Strings shrinker, for example @shrinkText@ + -> Theme engine widget -- ^ Decoration theme + -> engine widget a -- ^ Decoration engine instance + -> geom a -- ^ Decoration geometry instance + -> l a -- ^ Underlying layout to be decorated + -> ModifiedLayout (DecorationEx engine widget geom shrinker) l a +decorationEx shrinker theme engine geom = ModifiedLayout (DecorationEx (I Nothing) shrinker theme engine geom) + diff --git a/XMonad/Layout/DecorationEx/TabbedGeometry.hs b/XMonad/Layout/DecorationEx/TabbedGeometry.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/TabbedGeometry.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.TabbedGeometry +-- Description : Tab-based window decoration geometry +-- Copyright : (c) 2007 Andrea Rossato, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This module defines window decoration geometry based on tabs. +-- The tabs can follow horizontally and be placed above or below windows; +-- in such case, tabs can occupy full width of the window or be aligned to +-- left or right. Or tabs can go vertically near left or right side of +-- the window. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.TabbedGeometry ( + textTabbed, + TabbedGeometry (..), + HorizontalTabPlacement (..), + VerticalTabPlacement (..), + HorizontalTabWidth (..), + HorizontalTabsAlignment (..), + SingleTabMode (..) + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Prelude +import XMonad.Layout.Decoration (ModifiedLayout, Shrinker (..)) + +import XMonad.Layout.DecorationEx.LayoutModifier +import XMonad.Layout.DecorationEx.Common +import XMonad.Layout.DecorationEx.Geometry +import XMonad.Layout.DecorationEx.Widgets +import XMonad.Layout.DecorationEx.TextEngine + +-- | Placement of tabs when they go horizontally: +-- should they be placed above or below the window. +data HorizontalTabPlacement = Top | Bottom + deriving (Eq, Read, Show) + +-- | Placement of tabs when they go vertically: +-- should they appear at left or at right side of the window. +data VerticalTabPlacement = TabsAtLeft | TabsAtRight + deriving (Eq, Read, Show) + +-- | Width of tabs when they go horizontally. +data HorizontalTabWidth = + AutoWidth -- ^ Define the width automatically by evenly dividing windows' width + | FixedWidth !Dimension -- ^ Use fixed width of the tab + deriving (Eq, Read, Show) + +-- | Alignment of tabs when they go horizontally. +data HorizontalTabsAlignment = AlignTabsLeft | AlignTabsCenter | AlignTabsRight + deriving (Eq, Read, Show) + +-- | What to do if there is only one tab. +data SingleTabMode = ShowTab | HideTab + deriving (Eq, Read, Show) + +data TabbedGeometry a = + HorizontalTabs { + showIfSingleWindow :: !SingleTabMode -- ^ What to do if there is only one tab + , hTabPlacement :: !HorizontalTabPlacement -- ^ Where to place horizontal tabs + , hTabAlignment :: !HorizontalTabsAlignment -- ^ How to align horizontal tabs (makes sense with fixed width of tabs). + , hTabWidth :: !HorizontalTabWidth -- ^ Width of horizontal tabs + , hTabHeight :: !Dimension -- ^ Height of horizontal tabs + } + | VerticalTabs { + showIfSingleWindow :: !SingleTabMode -- ^ What to do if there is only one tab + , vTabPlacement :: !VerticalTabPlacement -- ^ Where to place vertical tabs + , vTabWidth :: !Dimension -- ^ Width of vertical tabs + , vTabHeight :: !Dimension -- ^ Height of vertical tabs + } + deriving (Show, Read) + +instance Default (TabbedGeometry a) where + def = HorizontalTabs ShowTab Top AlignTabsLeft AutoWidth 20 + +instance DecorationGeometry TabbedGeometry Window where + + describeGeometry _ = "Tabbed" + + pureDecoration tabs _ stack wrs (window, windowRect) = + let Rectangle windowX windowY windowWidth windowHeight = windowRect + -- windows that are mapped onto the same rectangle as current one are considered to + -- be in one tabs group + tabbedWindows = filter (`elem` map fst (filter ((==windowRect) . snd) wrs)) (W.integrate stack) + mbWindowIndex = window `elemIndex` tabbedWindows + numWindows = length tabbedWindows + in if numWindows > 1 || (showIfSingleWindow tabs == ShowTab && numWindows > 0) + then + case tabs of + HorizontalTabs {..} -> + Just $ case hTabPlacement of + Top -> Rectangle decoX windowY effectiveTabWidth hTabHeight + Bottom -> Rectangle decoX (windowY + fi (windowHeight - hTabHeight)) effectiveTabWidth hTabHeight + where + decoX = maybe windowX tabX mbWindowIndex + + -- If there are too many windows or configured tab width + -- is too big, then we have to switch to 'auto' mode. + hTabWidth' = + case hTabWidth of + AutoWidth -> AutoWidth + FixedWidth tabWidth + | tabWidth * fi numWindows > windowWidth -> AutoWidth + | otherwise -> FixedWidth tabWidth + + effectiveTabWidth = + case hTabWidth' of + AutoWidth -> fi $ maybe windowX (\i -> tabX (i+1) - tabX i) mbWindowIndex + FixedWidth tabWidth -> tabWidth + + allTabsWidth = + case hTabWidth' of + AutoWidth -> fi windowWidth + FixedWidth _ -> fi $ min windowWidth $ effectiveTabWidth * max 1 (fi numWindows) + + tabsStartX = + case hTabAlignment of + AlignTabsLeft -> windowX + AlignTabsRight -> windowX + fi windowWidth - allTabsWidth + AlignTabsCenter -> windowX + (fi windowWidth - allTabsWidth) `div` 2 + + -- X coordinate of i'th window in horizontal tabs layout + tabX i = tabsStartX + + case hTabWidth' of + AutoWidth -> fi ((windowWidth * fi i) `div` max 1 (fi numWindows)) + FixedWidth _ -> fi effectiveTabWidth * fi i + + VerticalTabs {..} -> + Just $ case vTabPlacement of + TabsAtLeft -> fixHeightTab windowX + TabsAtRight -> fixHeightTab (windowX + fi (windowWidth - vTabWidth)) + where + fixHeightLoc i = windowY + fi vTabHeight * fi i + fixHeightTab x = Rectangle x + (maybe windowY fixHeightLoc mbWindowIndex) vTabWidth vTabHeight + else Nothing + + shrinkWindow tabs (Rectangle _ _ dw dh) (Rectangle x y w h) = + case tabs of + HorizontalTabs {..} -> + case hTabPlacement of + Top -> Rectangle x (y + fi dh) w (h - dh) + Bottom -> Rectangle x y w (h - dh) + VerticalTabs {..} -> + case vTabPlacement of + TabsAtLeft -> Rectangle (x + fi dw) y (w - dw) h + TabsAtRight -> Rectangle x y (w - dw) h + +-- | Add tabbed decorations (with default settings) with text-based widgets to a layout. +textTabbed :: (Shrinker shrinker) + => shrinker -- ^ Strings shrinker, e.g. @shrinkText@ + -> ThemeEx StandardWidget -- ^ Decoration theme + -> l Window -- ^ Layout to be decorated + -> ModifiedLayout (DecorationEx TextDecoration StandardWidget TabbedGeometry shrinker) l Window +textTabbed shrinker theme = decorationEx shrinker theme TextDecoration def + diff --git a/XMonad/Layout/DecorationEx/TextEngine.hs b/XMonad/Layout/DecorationEx/TextEngine.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/TextEngine.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.TextEngine +-- Description : Text-based window decoration engine +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- Window decoration engine, that uses text fragments (like @"[X]"@) to indicate +-- widgets (window buttons). +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.TextEngine ( + textDecoration, + TextDecoration (..) + ) where + +import XMonad +import XMonad.Prelude +import XMonad.Layout.LayoutModifier +import XMonad.Util.Font + +import XMonad.Layout.DecorationEx.LayoutModifier +import XMonad.Layout.DecorationEx.Common +import XMonad.Layout.DecorationEx.Engine +import XMonad.Layout.DecorationEx.Geometry +import XMonad.Layout.DecorationEx.Widgets + +-- | Decoration engine data type +data TextDecoration widget a = TextDecoration + deriving (Show, Read) + +instance (TextWidget widget, ClickHandler (GenericTheme SimpleStyle) widget) + => DecorationEngine TextDecoration widget Window where + type Theme TextDecoration = GenericTheme SimpleStyle + type DecorationPaintingContext TextDecoration = XPaintingContext + type DecorationEngineState TextDecoration = XMonadFont + + describeEngine _ = "TextDecoration" + + calcWidgetPlace = calcTextWidgetPlace + + paintWidget = paintTextWidget + + paintDecoration = paintDecorationSimple + + initializeState _ _ theme = initXMF (themeFontName theme) + releaseStateResources _ = releaseXMF + +-- | Implementation of @paintWidget@ for decoration engines based on @TextDecoration@. +paintTextWidget :: (TextWidget widget, + Style (Theme engine widget) ~ SimpleStyle, + DecorationPaintingContext engine ~ XPaintingContext, + DecorationEngineState engine ~ XMonadFont, + Shrinker shrinker, + DecorationEngine engine widget Window) + => engine widget Window + -> DecorationPaintingContext engine + -> WidgetPlace + -> shrinker + -> DrawData engine widget + -> widget + -> Bool + -> X () +paintTextWidget engine (dpy, pixmap, gc) place shrinker dd widget _ = do + let style = ddStyle dd + rect = wpRectangle place + x = rect_x rect + y = wpTextYPosition place + str <- widgetString dd widget + str' <- if isShrinkable widget + then getShrinkedWindowName engine shrinker (ddEngineState dd) str (rect_width rect) (rect_height rect) + else return str + printStringXMF dpy pixmap (ddEngineState dd) gc (sTextColor style) (sTextBgColor style) x y str' + +-- | Implementation of @calcWidgetPlace@ for decoration engines based on @TextDecoration@. +calcTextWidgetPlace :: (TextWidget widget, + DecorationEngineState engine ~ XMonadFont, + DecorationEngine engine widget Window) + => engine widget Window + -> DrawData engine widget + -> widget + -> X WidgetPlace +calcTextWidgetPlace _ dd widget = do + str <- widgetString dd widget + let h = rect_height (ddDecoRect dd) + font = ddEngineState dd + withDisplay $ \dpy -> do + width <- fi <$> textWidthXMF dpy (ddEngineState dd) str + (a, d) <- textExtentsXMF font str + let height = a + d + y = fi $ (h - fi height) `div` 2 + y0 = y + fi a + rect = Rectangle 0 y width (fi height) + return $ WidgetPlace y0 rect + +-- | Add decoration to existing layout. Widgets are indicated by text fragments, like @"[+]"@. +-- Geometry is simple: a horizontal panel at the top of each window, going for the full width +-- of the window. +textDecoration :: (Shrinker shrinker) + => shrinker -- ^ String shrinker, for example @shrinkText@ + -> Theme TextDecoration StandardWidget -- ^ Decoration theme (font, colors, widgets, etc) + -> l Window -- ^ Layout to be decorated + -> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window +textDecoration shrinker theme = decorationEx shrinker theme TextDecoration def + diff --git a/XMonad/Layout/DecorationEx/Widgets.hs b/XMonad/Layout/DecorationEx/Widgets.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DecorationEx/Widgets.hs @@ -0,0 +1,208 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationEx.Widgets +-- Description : Definitions for decoration widgets (window buttons etc) +-- Copyright : 2023 Ilya Portnov +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : portnov84@rambler.ru +-- Stability : unstable +-- Portability : unportable +-- +-- This module contains data types and utilities to deal with decoration +-- widgets. A widget is anything that is displayed on window decoration, +-- and, optionally, can react on clicks. Examples of widgets are usual +-- window buttons (minimize, maximize, close), window icon and window title. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationEx.Widgets ( + -- * Data types + StandardCommand (..), + TextWidget (..), + GenericWidget (..), + StandardWidget, + -- * Utility functions + isWidgetChecked, + -- * Presets for standard widgets + titleW, toggleStickyW, minimizeW, + maximizeW, closeW, dwmpromoteW, + moveToNextGroupW,moveToPrevGroupW + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Actions.DwmPromote +import qualified XMonad.Actions.CopyWindow as CW +import qualified XMonad.Layout.Groups.Examples as Ex +import XMonad.Layout.Maximize +import XMonad.Actions.Minimize +import XMonad.Actions.WindowMenu + +import XMonad.Layout.DecorationEx.Common +import XMonad.Layout.DecorationEx.Engine + +-- | Standard window commands. +-- +-- One can extend this list by simply doing +-- +-- > data MyWindowCommand = +-- > Std StandardCommand +-- > | SomeFancyCommand +-- +-- > instance WindowCommand MyWindowCommand where ... +-- +-- > type MyWidget = GenericWidget MyWindowCommand +-- +data StandardCommand = + FocusWindow -- ^ Focus the window + | FocusUp -- ^ Move focus to previous window + | FocusDown -- ^ Move focus to following window + | MoveToNextGroup -- ^ Move the window to the next group (see "XMonad.Layout.Groups") + | MoveToPrevGroup -- ^ Move the window to the previous group + | DwmPromote -- ^ Execute @dwmpromote@ (see "XMonad.Actions.DwmPromote") + | ToggleSticky -- ^ Make window sticky or unstick it (see "XMonad.Actions.CopyWindow") + | ToggleMaximize -- ^ Maximize or restore window (see "XMonad.Layout.Maximize") + | Minimize -- ^ Minimize window (see "XMonad.Actions.Minimize") + | CloseWindow -- ^ Close the window + | GridWindowMenu -- ^ Show window menu via "XMonad.Actions.GridSelect" (see "XMonad.Actions.WindowMenu") + deriving (Eq, Show, Read) + +instance Default StandardCommand where + def = FocusWindow + +instance WindowCommand StandardCommand where + executeWindowCommand FocusWindow w = do + focus w + return False + executeWindowCommand FocusUp _ = do + windows W.focusUp + withFocused maximizeWindowAndFocus + return True + executeWindowCommand FocusDown _ = do + windows W.focusDown + withFocused maximizeWindowAndFocus + return True + executeWindowCommand MoveToNextGroup w = do + focus w + Ex.moveToGroupDown False + return True + executeWindowCommand MoveToPrevGroup w = do + focus w + Ex.moveToGroupUp False + return True + executeWindowCommand CloseWindow w = do + killWindow w + return True + executeWindowCommand DwmPromote w = do + focus w + dwmpromote + return True + executeWindowCommand ToggleSticky w = do + focus w + copies <- CW.wsContainingCopies + if null copies + then windows CW.copyToAll + else CW.killAllOtherCopies + return True + executeWindowCommand ToggleMaximize w = do + sendMessage $ maximizeRestore w + focus w + return True + executeWindowCommand Minimize w = do + minimizeWindow w + return True + executeWindowCommand GridWindowMenu w = do + focus w + windowMenu + return True + + isCommandChecked FocusWindow _ = return False + isCommandChecked DwmPromote w = do + withWindowSet $ \ws -> return $ Just w == master ws + where + master ws = + case W.integrate' $ W.stack $ W.workspace $ W.current ws of + [] -> Nothing + (x:_) -> Just x + isCommandChecked ToggleSticky w = do + ws <- gets windowset + let copies = CW.copiesOfOn (Just w) (CW.taggedWindows $ W.hidden ws) + return $ not $ null copies + isCommandChecked _ _ = return False + +-- | Generic data type for decoration widgets. +data GenericWidget cmd = + TitleWidget -- ^ Window title (just text label) + | WindowIcon { swCommand :: !cmd } -- ^ Window icon with some associated command + -- | Other widgets + | GenericWidget { + swCheckedText :: !String -- ^ Text for checked widget state + , swUncheckedText :: !String -- ^ Text for unchecked widget state + , swCommand :: !cmd -- ^ Window command + } + deriving (Show, Read) + +-- | Generic widget type specialized for 'StandardCommand' +type StandardWidget = GenericWidget StandardCommand + +instance (Default cmd, Read cmd, Show cmd, WindowCommand cmd) => DecorationWidget (GenericWidget cmd) where + + type WidgetCommand (GenericWidget cmd) = cmd + + widgetCommand TitleWidget _ = def + widgetCommand w 1 = swCommand w + widgetCommand _ _ = def + + isShrinkable TitleWidget = True + isShrinkable _ = False + +-- | Check if the widget should be displayed in `checked' state. +isWidgetChecked :: DecorationWidget widget => widget -> Window -> X Bool +isWidgetChecked wdt = isCommandChecked (widgetCommand wdt 1) + +-- | Type class for widgets that can be displayed as +-- text fragments by 'TextDecoration' engine. +class DecorationWidget widget => TextWidget widget where + widgetString :: DrawData engine widget -> widget -> X String + +instance TextWidget StandardWidget where + widgetString dd TitleWidget = return $ ddWindowTitle dd + widgetString _ (WindowIcon {}) = return "[*]" + widgetString dd w = do + checked <- isWidgetChecked w (ddOrigWindow dd) + if checked + then return $ swCheckedText w + else return $ swUncheckedText w + +-- | Widget for window title +titleW :: StandardWidget +titleW = TitleWidget + +-- | Widget for ToggleSticky command. +toggleStickyW :: StandardWidget +toggleStickyW = GenericWidget "[S]" "[s]" ToggleSticky + +-- | Widget for Minimize command +minimizeW :: StandardWidget +minimizeW = GenericWidget "" "[_]" Minimize + +-- | Widget for ToggleMaximize command +maximizeW :: StandardWidget +maximizeW = GenericWidget "" "[O]" ToggleMaximize + +-- | Widget for CloseWindow command +closeW :: StandardWidget +closeW = GenericWidget "" "[X]" CloseWindow + +dwmpromoteW :: StandardWidget +dwmpromoteW = GenericWidget "[M]" "[m]" DwmPromote + +moveToNextGroupW :: StandardWidget +moveToNextGroupW = GenericWidget "" "[>]" MoveToNextGroup + +moveToPrevGroupW :: StandardWidget +moveToPrevGroupW = GenericWidget "" "[<]" MoveToPrevGroup + diff --git a/XMonad/Layout/DecorationMadness.hs b/XMonad/Layout/DecorationMadness.hs --- a/XMonad/Layout/DecorationMadness.hs +++ b/XMonad/Layout/DecorationMadness.hs @@ -17,7 +17,7 @@ ( -- * Usage -- $usage - -- * Decorated layouts based on Circle + -- * Decorated layouts based on CircleEx -- $circle circleSimpleDefault , circleDefault @@ -94,13 +94,13 @@ import XMonad.Layout.TabBarDecoration import XMonad.Layout.Accordion -import XMonad.Layout.Circle +import XMonad.Layout.CircleEx import XMonad.Layout.WindowArranger import XMonad.Layout.SimpleFloat -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.DecorationMadness -- @@ -108,9 +108,9 @@ -- -- > main = xmonad def { layoutHook = someMadLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default theme: -- @@ -132,39 +132,39 @@ -- "XMonad.Util.Themes" -- $circle --- Here you will find 'Circle' based decorated layouts. +-- Here you will find 'CircleEx' based decorated layouts. --- | A 'Circle' layout with the xmonad default decoration, default +-- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window -circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle +circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) CircleEx Window +circleSimpleDefault = decoration shrinkText def DefaultDecoration circle -- | Similar to 'circleSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. circleDefault :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window -circleDefault s t = decoration s t DefaultDecoration Circle + -> ModifiedLayout (Decoration DefaultDecoration s) CircleEx Window +circleDefault s t = decoration s t DefaultDecoration circle --- | A 'Circle' layout with the xmonad simple decoration, default +-- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window -circleSimpleDeco = decoration shrinkText def (Simple True) Circle +circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) CircleEx Window +circleSimpleDeco = decoration shrinkText def (Simple True) circle -- | Similar to 'circleSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. circleDeco :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window -circleDeco s t = decoration s t (Simple True) Circle + -> ModifiedLayout (Decoration SimpleDecoration s) CircleEx Window +circleDeco s t = decoration s t (Simple True) circle --- | A 'Circle' layout with the xmonad default decoration, default +-- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- @@ -172,17 +172,17 @@ -- -- circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange circle) -- | Similar to 'circleSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange circle) --- | A 'Circle' layout with the xmonad simple decoration, default +-- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- @@ -190,45 +190,45 @@ -- -- circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange circle) -- | Similar to 'circleSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange circle) --- | A 'Circle' layout with the xmonad DwmStyle decoration, default +-- | A 'CircleEx' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window -circleSimpleDwmStyle = decoration shrinkText def Dwm Circle +circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) CircleEx Window +circleSimpleDwmStyle = decoration shrinkText def Dwm circle -- | Similar to 'circleSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. circleDwmStyle :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration DwmStyle s) Circle Window -circleDwmStyle s t = decoration s t Dwm Circle + -> ModifiedLayout (Decoration DwmStyle s) CircleEx Window +circleDwmStyle s t = decoration s t Dwm circle --- | A 'Circle' layout with the xmonad tabbed decoration, default +-- | A 'CircleEx' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window -circleSimpleTabbed = simpleTabBar Circle +circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen CircleEx) Window +circleSimpleTabbed = simpleTabBar circle -- | Similar to 'circleSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. circleTabbed :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window -circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle) + -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen CircleEx) Window +circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) circle) -- $accordion diff --git a/XMonad/Layout/Dishes.hs b/XMonad/Layout/Dishes.hs --- a/XMonad/Layout/Dishes.hs +++ b/XMonad/Layout/Dishes.hs @@ -27,7 +27,7 @@ import XMonad.Prelude (ap) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Dishes -- @@ -36,9 +36,9 @@ -- > myLayout = Dishes 2 (1/6) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data Dishes a = Dishes Int Rational deriving (Show, Read) instance LayoutClass Dishes a where diff --git a/XMonad/Layout/DragPane.hs b/XMonad/Layout/DragPane.hs --- a/XMonad/Layout/DragPane.hs +++ b/XMonad/Layout/DragPane.hs @@ -35,7 +35,7 @@ import XMonad.Util.XUtils -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.DragPane -- @@ -44,9 +44,9 @@ -- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". halfHandleWidth :: Integral a => a halfHandleWidth = 1 diff --git a/XMonad/Layout/Drawer.hs b/XMonad/Layout/Drawer.hs --- a/XMonad/Layout/Drawer.hs +++ b/XMonad/Layout/Drawer.hs @@ -41,7 +41,7 @@ import XMonad.Layout.Reflect -- $usage --- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Layout.Drawer -- diff --git a/XMonad/Layout/Dwindle.hs b/XMonad/Layout/Dwindle.hs --- a/XMonad/Layout/Dwindle.hs +++ b/XMonad/Layout/Dwindle.hs @@ -68,9 +68,9 @@ -- 1.1, is the factor by which the third parameter increases or decreases in -- response to Expand or Shrink messages. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Layouts with geometrically decreasing window sizes. 'Spiral' and 'Dwindle' -- split the screen into a rectangle for the first window and a rectangle for @@ -159,8 +159,8 @@ nwins = length wins sizes = take nwins $ unfoldr (\r -> Just (r * ratio, r * ratio)) 1 totals' = 0 : zipWith (+) sizes totals' - totals = tail totals' - splits = zip (tail sizes) totals + totals = drop 1 totals' + splits = zip (drop 1 sizes) totals ratios = reverse $ map (uncurry (/)) splits rects = genRects rect ratios genRects r [] = [r] diff --git a/XMonad/Layout/DwmStyle.hs b/XMonad/Layout/DwmStyle.hs --- a/XMonad/Layout/DwmStyle.hs +++ b/XMonad/Layout/DwmStyle.hs @@ -30,7 +30,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.DwmStyle -- @@ -40,9 +40,9 @@ -- > myL = dwmStyle shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. -- diff --git a/XMonad/Layout/FixedAspectRatio.hs b/XMonad/Layout/FixedAspectRatio.hs --- a/XMonad/Layout/FixedAspectRatio.hs +++ b/XMonad/Layout/FixedAspectRatio.hs @@ -38,7 +38,7 @@ import XMonad.Layout.LayoutHints -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.FixedAspectRatio -- Then add it to your layout: @@ -53,8 +53,8 @@ -- depending on the size hints (for example for programs like mpv), -- see "XMonad.Layout.LayoutHints" -- --- See "XMonad.Doc.Extending#Editing_the_layout_hook" for more info on --- the 'layoutHook'. +-- See and +-- "XMonad.Doc.Extending#Editing_the_layout_hook" for more info on the 'layoutHook'. -- -- You also want to add keybindings to set and clear the aspect ratio: -- @@ -73,7 +73,7 @@ -- -- > , ((modMask .|. shiftMask, xK_c), withFocused (sendMessage . ResetRatio) >> kill) -- --- See "XMonad.Doc.Extending#Editing_key_bindings" for more info +-- See for more info -- on customizing the keybindings. -- -- This layout also comes with a 'ManageHook' 'doFixAspect' to @@ -84,7 +84,8 @@ -- > ... -- > ] -- --- Check "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on +-- Check and +-- "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on -- customizing the manage hook. -- | Similar to 'layoutHintsWithReplacement', but relies on the user to diff --git a/XMonad/Layout/FixedColumn.hs b/XMonad/Layout/FixedColumn.hs --- a/XMonad/Layout/FixedColumn.hs +++ b/XMonad/Layout/FixedColumn.hs @@ -28,7 +28,7 @@ import qualified XMonad.StackSet as W -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.FixedColumn -- @@ -37,9 +37,9 @@ -- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A tiling mode based on preserving a nice fixed width -- window. Supports 'Shrink', 'Expand' and 'IncMasterN'. diff --git a/XMonad/Layout/FocusTracking.hs b/XMonad/Layout/FocusTracking.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/FocusTracking.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} +{- | + +Module : XMonad.Layout.FocusTracking +Description : Track focus in the tiled layer. +Copyright : (c) 2010 & 2013 Adam Vogt + 2011 Willem Vanlint + 2018 & 2022 L.S.Leary +License : BSD-style (see xmonad/LICENSE) + +Maintainer : @LSLeary (on github) +Stability : unstable +Portability : unportable + +FocusTracking simply holds onto the last true focus it was given and continues +to use it as the focus for the transformed layout until it sees another. It can +be used to improve the behaviour of a child layout that has not been given the +focused window, or equivalently, that of the layout itself when a float has +focus. + +Relevant issues: + + * + * + +-------------------------------------------------------------------------------- +-} +module XMonad.Layout.FocusTracking + ( -- * Usage + -- $usage + FocusTracking(..) + , focusTracking + ) where + +import XMonad.Prelude +import XMonad +import XMonad.Layout.LayoutModifier +import XMonad.Util.Stack (findZ) +import qualified XMonad.StackSet as W + +-- $usage +-- +-- To use the module, first import it: +-- +-- > import XMonad.Layout.FocusTracking +-- +-- Then, a focus-dependent layout can be made to fall back on the last focus it +-- saw, for example: +-- +-- > main = xmonad def +-- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) +-- > , ... +-- > } +-- +-- Or in a simpler case: +-- +-- > main = xmonad def +-- > { layoutHook = myTiledLayout ||| focusTracking Full +-- > , ... +-- > } +-- + +-- | A 'LayoutModifier' that remembers the last focus it saw. +newtype FocusTracking a = FocusTracking (Maybe Window) + deriving (Read, Show) + +instance LayoutModifier FocusTracking Window where + modifyLayoutWithUpdate (FocusTracking mw) ws@W.Workspace{ W.stack = ms } r + = do + xCur <- gets (W.peek . W.view (W.tag ws) . windowset) + let isF = xCur /= (W.focus <$> ms) + -- use the remembered focus point when true focus differs from + -- what this (sub)layout is given, which happens e.g. when true + -- focus is in floating layer or when another sublayout has focus + newStack | isF = (mw >>= \w -> findZ (w==) ms) <|> ms + | otherwise = ms + newState | isF = mw + | otherwise = xCur + ran <- runLayout ws{ W.stack = newStack } r + return (ran, guard (newState /= mw) $> FocusTracking newState) + +-- | Transform a layout into one that remembers and uses the last focus it saw. +focusTracking :: l a -> ModifiedLayout FocusTracking l a +focusTracking = ModifiedLayout (FocusTracking Nothing) + diff --git a/XMonad/Layout/Gaps.hs b/XMonad/Layout/Gaps.hs --- a/XMonad/Layout/Gaps.hs +++ b/XMonad/Layout/Gaps.hs @@ -44,7 +44,7 @@ import XMonad.Util.Types (Direction2D(..)) -- $usage --- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.Gaps -- diff --git a/XMonad/Layout/Grid.hs b/XMonad/Layout/Grid.hs --- a/XMonad/Layout/Grid.hs +++ b/XMonad/Layout/Grid.hs @@ -25,7 +25,7 @@ import XMonad.StackSet -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Grid -- @@ -40,9 +40,9 @@ -- -- > myLayout = GridRatio (4/3) ||| etc. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data Grid a = Grid | GridRatio Double deriving (Read, Show) @@ -61,7 +61,7 @@ mincs = max 1 $ nwins `div` ncols extrs = nwins - ncols * mincs chop :: Int -> Dimension -> [(Position, Dimension)] - chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (, k) . tail . reverse . take n . tail . iterate (subtract k') $ m' + chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (, k) . drop 1 . reverse . take n . drop 1 . iterate (subtract k') $ m' where k :: Dimension k = m `div` fromIntegral n diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -105,8 +105,8 @@ -- seed. All keys generated with this method will be different -- provided you don't use 'gen' again with a key from the list. -- (if you need to do that, see 'split' instead) -gen :: Uniq -> (Uniq, [Uniq]) -gen (U i1 i2) = (U (i1+1) i2, map (U i1) [i2..]) +gen :: Uniq -> (Uniq, Stream Uniq) +gen (U i1 i2) = (U (i1+1) i2, fmap (U i1) (fromList [i2..])) -- | Split an infinite list into two. I ended up not -- needing this, but let's keep it just in case. @@ -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', ids) = gen (seed g) - defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ +modifyGroups f g = let (seed', ident :~ _) = gen (seed g) + defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ in g { groups = fromMaybe defaultGroups . f . Just $ groups g , seed = seed' } modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a))) -> Groups l l2 a -> X (Groups l l2 a) modifyGroupsX f g = do - let (seed', ids) = gen (seed g) - defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ + let (seed', ident :~ _) = gen (seed g) + defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ g' <- f . Just $ groups g return g { groups = fromMaybe defaultGroups g', seed = seed' } @@ -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', ids) = gen $ seed g + (seed', ident :~ _) = gen $ seed g g' = g { seed = seed' } in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) >>> filterKeepLast (isJust . gZipper) >>> findNewWindows (W.integrate' z) - >>> addWindows (ID (head ids) $ baseLayout g) + >>> addWindows (ID ident $ baseLayout g) >>> focusGroup mf >>> onFocusedZ (onZipper $ focusWindow mf) where filterKeepLast _ Nothing = Nothing @@ -379,10 +379,10 @@ -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g = - let (seed', ids) = gen $ seed g - g' = flip modifyGroups g $ f (ID (head ids) $ baseLayout g) + let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list + g' = flip modifyGroups g $ f (ID ident $ baseLayout g) >>> toTags - >>> foldr (reID g) ((tail ids, []), []) + >>> foldr (reID g) ((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', ids) = gen $ seed g - g' <- flip modifyGroupsX g $ f (ID (head ids) $ baseLayout g) + let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list + g' <- flip modifyGroupsX g $ f (ID ident $ baseLayout g) >>> fmap toTags - >>> fmap (foldr (reID g) ((tail ids, []), [])) + >>> fmap (foldr (reID g) ((ids, []), [])) >>> fmap snd >>> fmap fromTags return $ if groups g == groups g' @@ -403,14 +403,13 @@ reID :: Groups l l2 Window -> Either (Group l Window) (Group l Window) - -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]) - -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]) -reID _ _ (([], _), _) = undefined -- The list of ids is infinite -reID g eg ((id:ids, seen), egs) = if myID `elem` seen - then ((ids, seen), mapE_ (setID id) eg:egs) - else ((id:ids, myID:seen), eg:egs) - where myID = getID $ gLayout $ fromE eg - setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z + -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)]) + -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)]) +reID g eg ((ident :~ ids, seen), egs) + | myID `elem` seen = ((ids, seen), mapE_ (setID ident) eg:egs) + | otherwise = ((ident :~ ids, myID:seen), eg:egs) + where myID = getID $ gLayout $ fromE eg + setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z -- ** Misc. ModifySpecs diff --git a/XMonad/Layout/Groups/Examples.hs b/XMonad/Layout/Groups/Examples.hs --- a/XMonad/Layout/Groups/Examples.hs +++ b/XMonad/Layout/Groups/Examples.hs @@ -1,5 +1,8 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -{-# LANGUAGE MultiParamTypeClasses, Rank2Types, TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | @@ -59,7 +62,6 @@ import XMonad.Layout.ZoomRow import XMonad.Layout.Tabbed -import XMonad.Layout.Named import XMonad.Layout.Renamed import XMonad.Layout.Decoration import XMonad.Layout.Simplest @@ -74,7 +76,7 @@ -- -- > import XMonad.Layout.Groups.Examples -- --- to the top of your @.\/.xmonad\/xmonad.hs@. +-- to the top of your @xmonad.hs@. -- -- For more information on using any of the layouts, jump directly -- to its \"Example\" section. @@ -85,8 +87,8 @@ -- the "XMonad.Layout.Groups.Helpers" module, which are all -- re-exported by this module. -- --- For more information on how to extend your layour hook and key bindings, see --- "XMonad.Doc.Extending". +-- For more information on how to extend your layoutHook and key bindings, see +-- and "XMonad.Doc.Extending". -- * Helper: ZoomRow of Group elements @@ -209,13 +211,13 @@ mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c -_tabs = named "Tabs" Simplest +_tabs = renamed [Replace "Tabs"] Simplest _tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l -_vert c = named "Vertical" $ Tall (vNMaster c) (vIncrement c) (vRatio c) +_vert c = renamed [Replace "Vertical"] $ Tall (vNMaster c) (vIncrement c) (vRatio c) -_horiz c = named "Horizontal" $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c) +_horiz c = renamed [Replace "Horizontal"] $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c) -- | Increase the number of master groups by one increaseNMasterGroups :: X () diff --git a/XMonad/Layout/Groups/Helpers.hs b/XMonad/Layout/Groups/Helpers.hs --- a/XMonad/Layout/Groups/Helpers.hs +++ b/XMonad/Layout/Groups/Helpers.hs @@ -58,7 +58,7 @@ -- -- > import XMonad.Layout.Groups.Helpers -- --- to the top of your @.\/.xmonad\/xmonad.hs@. +-- to the top of your @xmonad.hs@. -- -- "XMonad.Layout.Groups"-based layouts do not have the same notion -- of window ordering as the rest of XMonad. For this reason, the usual @@ -83,8 +83,8 @@ -- -- > import qualified XMonad.Layout.Groups as G -- --- For more information on how to extend your layour hook and key bindings, see --- "XMonad.Doc.Extending". +-- For more information on how to extend your layoutHook and key bindings, see +-- and "XMonad.Doc.Extending". -- ** Layout-generic actions -- #Layout-generic actions# @@ -155,7 +155,7 @@ -> X () focusHelper f g = withFocused $ \w -> do ws <- getWindows - let (before, tail -> after) = span (/=w) ws + let (before, drop 1 -> after) = span (/=w) ws let toFocus = g $ after ++ before floats <- getFloats case filter (f . flip elem floats) toFocus of diff --git a/XMonad/Layout/Groups/Wmii.hs b/XMonad/Layout/Groups/Wmii.hs --- a/XMonad/Layout/Groups/Wmii.hs +++ b/XMonad/Layout/Groups/Wmii.hs @@ -41,7 +41,6 @@ import XMonad.Layout.Groups.Helpers import XMonad.Layout.Tabbed -import XMonad.Layout.Named import XMonad.Layout.Renamed import XMonad.Layout.MessageControl import XMonad.Layout.Simplest @@ -67,7 +66,7 @@ -- -- > import XMonad.Layout.Groups.Wmii -- --- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii' +-- to the top of your @xmonad.hs@, and adding 'wmii' -- (with a 'Shrinker' and decoration 'Theme' as -- parameters) to your layout hook, for example: -- @@ -80,8 +79,8 @@ -- -- and so on. -- --- For more information on how to extend your layout hook and key bindings, see --- "XMonad.Doc.Extending". +-- For more information on how to extend your layoutHook and key bindings, see +-- and "XMonad.Doc.Extending". -- -- Finally, you will probably want to be able to move focus and windows -- between groups in a consistent fashion. For this, you should take a look @@ -90,8 +89,8 @@ -- | A layout inspired by wmii wmii s t = G.group innerLayout zoomRowG - where column = named "Column" $ Tall 0 (3/100) (1/2) - tabs = named "Tabs" Simplest + where column = renamed [Replace "Column"] $ Tall 0 (3/100) (1/2) + tabs = renamed [Replace "Tabs"] Simplest innerLayout = renamed [CutWordsLeft 3] $ addTabs s t $ ignore NextLayout diff --git a/XMonad/Layout/Hidden.hs b/XMonad/Layout/Hidden.hs --- a/XMonad/Layout/Hidden.hs +++ b/XMonad/Layout/Hidden.hs @@ -37,7 +37,7 @@ -------------------------------------------------------------------------------- -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Hidden -- @@ -46,9 +46,9 @@ -- > myLayout = hiddenWindows (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key bindings, do something like: -- @@ -58,7 +58,7 @@ -- -- For detailed instruction on editing the key bindings see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -------------------------------------------------------------------------------- newtype HiddenWindows a = HiddenWindows [Window] deriving (Show, Read) diff --git a/XMonad/Layout/HintedGrid.hs b/XMonad/Layout/HintedGrid.hs --- a/XMonad/Layout/HintedGrid.hs +++ b/XMonad/Layout/HintedGrid.hs @@ -36,7 +36,7 @@ (.) = fmap -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.HintedGrid -- @@ -51,6 +51,7 @@ -- > myLayout = GridRatio (4/3) False ||| etc. -- -- For more detailed instructions on editing the layoutHook see +-- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Automatic mirroring of hinted layouts doesn't work very well, so this diff --git a/XMonad/Layout/HintedTile.hs b/XMonad/Layout/HintedTile.hs --- a/XMonad/Layout/HintedTile.hs +++ b/XMonad/Layout/HintedTile.hs @@ -27,7 +27,7 @@ import XMonad.Prelude -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.HintedTile -- @@ -46,9 +46,9 @@ -- built-in Tall with HintedTile, change @import Xmonad@ to -- @import Xmonad hiding (Tall)@. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data HintedTile a = HintedTile { nmaster :: !Int -- ^ number of windows in the master pane diff --git a/XMonad/Layout/IM.hs b/XMonad/Layout/IM.hs --- a/XMonad/Layout/IM.hs +++ b/XMonad/Layout/IM.hs @@ -30,15 +30,16 @@ ) where import XMonad -import qualified XMonad.StackSet as S import XMonad.Layout.Grid import XMonad.Layout.LayoutModifier +import XMonad.Prelude import XMonad.Util.WindowProperties +import qualified XMonad.StackSet as S import Control.Arrow (first) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.IM -- > import Data.Ratio ((%)) @@ -55,9 +56,9 @@ -- -- Screenshot: -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- $hints -- @@ -109,11 +110,6 @@ wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect return (first ((w, masterRect) :) wrs) Nothing -> runLayout wksp rect - --- | Like find, but works with monadic computation instead of pure function. -findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) -findM _ [] = return Nothing -findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs } -- | This is for compatibility with old configs only and will be removed in future versions! data IM a = IM Rational Property deriving (Read, Show) diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs --- a/XMonad/Layout/ImageButtonDecoration.hs +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -47,7 +47,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.ImageButtonDecoration -- diff --git a/XMonad/Layout/IndependentScreens.hs b/XMonad/Layout/IndependentScreens.hs --- a/XMonad/Layout/IndependentScreens.hs +++ b/XMonad/Layout/IndependentScreens.hs @@ -42,7 +42,7 @@ import qualified XMonad.StackSet as W -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.IndependentScreens -- diff --git a/XMonad/Layout/LayoutBuilder.hs b/XMonad/Layout/LayoutBuilder.hs --- a/XMonad/Layout/LayoutBuilder.hs +++ b/XMonad/Layout/LayoutBuilder.hs @@ -57,14 +57,16 @@ LayoutN, ) where +import Data.Maybe (maybeToList) import XMonad import XMonad.Prelude (foldM, (<|>), isJust, fromMaybe, isNothing, listToMaybe) import qualified XMonad.StackSet as W +import XMonad.Util.Stack (zipperFocusedAtFirstOf) import XMonad.Util.WindowProperties -------------------------------------------------------------------------------- -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutBuilder -- @@ -103,9 +105,9 @@ -- -- These examples require "XMonad.Layout.Tabbed". -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may wish to add the following keybindings: -- @@ -114,7 +116,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -------------------------------------------------------------------------------- -- $selectWin @@ -452,11 +454,4 @@ -------------------------------------------------------------------------------- differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) -differentiate' _ [] = Nothing -differentiate' Nothing w = W.differentiate w -differentiate' (Just f) w - | f `elem` w = Just W.Stack { W.focus = f - , W.up = reverse $ takeWhile (/=f) w - , W.down = tail $ dropWhile (/=f) w - } - | otherwise = W.differentiate w +differentiate' = zipperFocusedAtFirstOf . maybeToList diff --git a/XMonad/Layout/LayoutBuilderP.hs b/XMonad/Layout/LayoutBuilderP.hs deleted file mode 100644 --- a/XMonad/Layout/LayoutBuilderP.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.LayoutBuilderP --- Description : (DEPRECATED) An old version of "XMonad.Layout.LayoutBuilderP". --- Copyright : (c) 2009 Anders Engstrom , 2011 Ilya Portnov --- License : BSD3-style (see LICENSE) --- --- Maintainer : Ilya Portnov --- Stability : unstable --- Portability : unportable --- --- DEPRECATED. Use 'XMonad.Layout.LayoutBuilder' instead. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.LayoutBuilderP {-# DEPRECATED "Use XMonad.Layout.LayoutBuilder instead" #-} ( - LayoutP (..), - layoutP, layoutAll, - B.relBox, B.absBox, - -- * Overloading ways to select windows - -- $selectWin - Predicate (..), Proxy(..), - ) where - -import XMonad -import XMonad.Prelude hiding (Const) -import qualified XMonad.StackSet as W -import XMonad.Util.WindowProperties - -import qualified XMonad.Layout.LayoutBuilder as B - --- $selectWin --- --- 'Predicate' exists because layouts are required to be serializable, and --- "XMonad.Util.WindowProperties" is not sufficient (for example it does not --- allow using regular expressions). --- --- compare "XMonad.Util.Invisible" - --- | Type class for predicates. This enables us to manage not only Windows, --- but any objects, for which instance Predicate is defined. --- --- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras -class Predicate p w where - alwaysTrue :: Proxy w -> p -- ^ A predicate that is always True. - checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate - --- | Contains no actual data, but is needed to help select the correct instance --- of 'Predicate' -data Proxy a = Proxy - --- | Data type for our layout. -data LayoutP p l1 l2 a = - LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a)) - deriving (Show,Read) - --- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain. --- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout. -{-# DEPRECATED layoutP "Use XMonad.Layout.LayoutBuilder.layoutP instead." #-} -layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) => - p - -> B.SubBox -- ^ The box to place the windows in - -> Maybe B.SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left - -> l1 a -- ^ The layout to use in the specified area - -> LayoutP p l2 l3 a -- ^ Where to send the remaining windows - -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout -layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next) - --- | Use the specified layout in the described area for all remaining windows. -{-# DEPRECATED layoutAll "Use XMonad.Layout.LayoutBuilder.layoutAll instead." #-} -layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) => - B.SubBox -- ^ The box to place the windows in - -> l1 a -- ^ The layout to use in the specified area - -> LayoutP p l1 Full a -- ^ The resulting layout -layoutAll box sub = - let a = alwaysTrue (Proxy :: Proxy a) - in LayoutP Nothing Nothing a box Nothing sub Nothing - -instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) => - LayoutClass (LayoutP p l1 l2) w where - - -- | Update window locations. - runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect - = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf - let selBox = if isJust nextf' - then box - else fromMaybe box mbox - - (sublist,sub') <- handle sub subs $ calcArea selBox rect - - (nextlist,next') <- case next of Nothing -> return ([],Nothing) - Just n -> do (res,l) <- handle n nexts rect - return (res,Just l) - - return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' ) - where - handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r - let l' = fromMaybe l ml - return (res,l') - - -- | Propagate messages. - handleMessage l m - | Just (IncMasterN _) <- fromMessage m = sendFocus l m - | Just Shrink <- fromMessage m = sendFocus l m - | Just Expand <- fromMessage m = sendFocus l m - | otherwise = sendBoth l m - - -- | Descriptive name for layout. - description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next - description (LayoutP _ _ _ _ _ sub Nothing) = "layoutP "++ description sub - - -sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendSub (LayoutP subf nextf prop box mbox sub next) m = - do sub' <- handleMessage sub m - return $ if isJust sub' - then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') next - else Nothing - -sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m -sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m = - do sub' <- handleMessage sub m - next' <- handleMessage next m - return $ if isJust sub' || isJust next' - then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') (Just $ fromMaybe next next') - else Nothing - -sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing -sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m = - do next' <- handleMessage next m - return $ if isJust next' - then Just $ LayoutP subf nextf prop box mbox sub next' - else Nothing - -sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf - if foc then sendSub l m - else sendNext l m - -isFocus :: (Show a) => Maybe a -> X Bool -isFocus Nothing = return False -isFocus (Just w) = do ms <- W.stack . W.workspace . W.current <$> gets windowset - return $ maybe False (\s -> show w == show (W.focus s)) ms - - --- | Split given list of objects (i.e. windows) using predicate. -splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w]) -splitBy prop = foldM step ([], []) - where - step (good, bad) w = do - ok <- checkPredicate prop w - return $ if ok - then (w:good, bad) - else (good, w:bad) - -splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w) -splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing) -splitStack (Just s) prop subf nextf = do - let ws = W.integrate s - (good, other) <- splitBy prop ws - let subf' = foc good subf - nextf' = foc other nextf - return ( differentiate' subf' good - , differentiate' nextf' other - , subf' - , nextf' - ) - where - foc [] _ = Nothing - foc l f - | W.focus s `elem` l = Just $ W.focus s - | maybe False (`elem` l) f = f - | otherwise = Just $ head l - -calcArea :: B.SubBox -> Rectangle -> Rectangle -calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' - where - xpos' = calc False xpos $ rect_width rect - ypos' = calc False ypos $ rect_height rect - width' = calc True width $ rect_width rect - xpos' - height' = calc True height $ rect_height rect - ypos' - - calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ - case val of B.Rel v -> floor $ v * fromIntegral tot - B.Abs v -> if v<0 || (zneg && v==0) - then fromIntegral tot+v - else v - -differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) -differentiate' _ [] = Nothing -differentiate' Nothing w = W.differentiate w -differentiate' (Just f) w - | f `elem` w = Just $ W.Stack { W.focus = f - , W.up = reverse $ takeWhile (/=f) w - , W.down = tail $ dropWhile (/=f) w - } - | otherwise = W.differentiate w - -instance Predicate Property Window where - alwaysTrue _ = Const True - checkPredicate = hasProperty diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs --- a/XMonad/Layout/LayoutCombinators.hs +++ b/XMonad/Layout/LayoutCombinators.hs @@ -51,7 +51,7 @@ import XMonad.Layout.DragPane -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutCombinators -- @@ -61,9 +61,9 @@ -- > myLayout = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the @layoutHook@ see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the @layoutHook@ see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- $combine @@ -80,7 +80,7 @@ */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */** -- $dpv --- These combinators combine two layouts using "XMonad.DragPane" in +-- These combinators combine two layouts using "XMonad.Layout.DragPane" in -- vertical mode. (*||*),(**||*),(***||*),(****||*), (***||**),(****||***), @@ -100,7 +100,7 @@ (*||**) = combineTwo (dragPane Vertical 0.1 (1/3)) -- $dph --- These combinators combine two layouts using "XMonad.DragPane" in +-- These combinators combine two layouts using "XMonad.Layout.DragPane" in -- horizontal mode. (*//*),(**//*),(***//*),(****//*), (***//**),(****//***), diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -47,7 +47,7 @@ import qualified Data.Set as Set -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.LayoutHints -- @@ -66,9 +66,9 @@ -- -- > myLayout = layoutHintsToCenter (Tall 1 (3/100) (1/2)) -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- To make XMonad reflect changes in window hints immediately, add -- 'hintsEventHook' to your 'handleEventHook'. diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -73,7 +73,7 @@ -- -- * "XMonad.Layout.Reflect" -- --- * "XMonad.Layout.Named" +-- * "XMonad.Layout.Renamed" -- -- * "XMonad.Layout.WindowNavigation" -- diff --git a/XMonad/Layout/LayoutScreens.hs b/XMonad/Layout/LayoutScreens.hs --- a/XMonad/Layout/LayoutScreens.hs +++ b/XMonad/Layout/LayoutScreens.hs @@ -36,7 +36,7 @@ -- email window at all times, a crude mimic of sticky windows). -- -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@ file: +-- @xmonad.hs@ file: -- -- > import XMonad.Layout.LayoutScreens -- > import XMonad.Layout.TwoPane @@ -57,7 +57,7 @@ -- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Modify all screens. layoutScreens :: LayoutClass l Int => Int -> l Int -> X () diff --git a/XMonad/Layout/LimitWindows.hs b/XMonad/Layout/LimitWindows.hs --- a/XMonad/Layout/LimitWindows.hs +++ b/XMonad/Layout/LimitWindows.hs @@ -44,7 +44,7 @@ import qualified XMonad.StackSet as W -- $usage --- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- To use this module, add the following import to @xmonad.hs@: -- -- > import XMonad.Layout.LimitWindows -- @@ -56,7 +56,7 @@ -- actions. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip -- the hidden windows. @@ -75,7 +75,7 @@ limitWindows n = ModifiedLayout (LimitWindows FirstN n) -- | Only display @n@ windows around the focused window. This makes sense with --- layouts that arrange windows linearily, like 'XMonad.Layout.Layout.Accordion'. +-- layouts that arrange windows linearily, like "XMonad.Layout.Accordion". limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a limitSlice n = ModifiedLayout (LimitWindows Slice n) diff --git a/XMonad/Layout/MagicFocus.hs b/XMonad/Layout/MagicFocus.hs --- a/XMonad/Layout/MagicFocus.hs +++ b/XMonad/Layout/MagicFocus.hs @@ -34,7 +34,7 @@ import qualified Data.Map as M -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MagicFocus -- @@ -45,9 +45,9 @@ -- > main = xmonad def { layoutHook = myLayout, -- > handleEventHook = promoteWarp } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Create a new layout which automagically puts the focused window -- in the master area. diff --git a/XMonad/Layout/Magnifier.hs b/XMonad/Layout/Magnifier.hs --- a/XMonad/Layout/Magnifier.hs +++ b/XMonad/Layout/Magnifier.hs @@ -26,12 +26,15 @@ -- * General combinators magnify, + magnifyxy, -- * Magnify Everything magnifier, magnifierOff, magnifiercz, magnifierczOff, + magnifierxy, + magnifierxyOff, maxMagnifierOff, maximizeVertical, @@ -39,6 +42,8 @@ magnifier', magnifiercz', magnifierczOff', + magnifierxy', + magnifierxyOff', -- * Messages and Types MagnifyMsg (..), @@ -54,7 +59,7 @@ import XMonad.StackSet -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Magnifier -- @@ -66,19 +71,19 @@ -- -- By default 'magnifier' increases the focused window's size by @1.5@. -- --- You can also use @'magnifiercz' 1.2@ to use a custom level of --- magnification. You can even make the focused window smaller for a --- pop in effect. There's also the possibility of starting out not --- magnifying anything at all ('magnifierOff'); see below for ways to --- toggle this on while in use. +-- You can also use @'magnifiercz' 1.2@ or @'magnifierxy' 1 1000@ to use +-- a custom level of magnification. You can even make the focused window +-- smaller for a pop in effect. There's also the possibility of starting +-- out not magnifying anything at all ('magnifierOff'); see below for +-- ways to toggle this on while in use. -- -- The most general combinator available is 'magnify'—all of the other -- functions in this module are essentially just creative applications -- of it. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Magnifier supports some commands, see 'MagnifyMsg'. To use them add -- something like this to your key bindings: @@ -101,7 +106,7 @@ -- like @Mag.Toggle@, @Mag.magnifier@, and so on. -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Add magnification capabilities to a certain layout. -- @@ -116,9 +121,23 @@ -- (@True@) or off (@False@) -> l a -- ^ Input layout -> ModifiedLayout Magnifier l a -magnify cz mt start = ModifiedLayout $ - Mag 1 (fromRational cz, fromRational cz) (bool Off On start) mt +magnify cz = magnifyxy cz cz +-- | Like 'magnify', but with the ability to specify different amounts +-- of horizontal and vertical magnification. +-- +-- >>> magnifyxy 1.3 1.6 (NoMaster 1) True +magnifyxy + :: Rational -- ^ Amount to magnify horizontally + -> Rational -- ^ Amount to magnify vertically + -> MagnifyThis -- ^ What to magnify + -> Bool -- ^ Whether magnification should start out on + -- (@True@) or off (@False@) + -> l a -- ^ Input layout + -> ModifiedLayout Magnifier l a +magnifyxy cx cy mt start = ModifiedLayout $ + Mag 1 (fromRational cx, fromRational cy) (bool Off On start) mt + -- | Increase the size of the window that has focus magnifier :: l a -> ModifiedLayout Magnifier l a magnifier = magnifiercz 1.5 @@ -137,6 +156,24 @@ magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a magnifiercz' cz = magnify cz (NoMaster 1) True +-- | Increase the size of the window that has focus by a custom zoom in +-- both directions. +magnifierxy :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a +magnifierxy cx cy = magnifyxy cx cy (AllWins 1) True + +-- | Like 'magnifierxy', but default to @Off@. +magnifierxyOff :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a +magnifierxyOff cx cy = magnifyxy cx cy (AllWins 1) False + +-- | Increase the size of the window that has focus by a custom zoom in +-- both directions, unless it is one of the master windows. +magnifierxy' :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a +magnifierxy' cx cy = magnifyxy cx cy (NoMaster 1) True + +-- | Like 'magnifierxy'', but defaults to @Off@. +magnifierxyOff' :: Rational -> Rational -> l a -> ModifiedLayout Magnifier l a +magnifierxyOff' cx cy = magnifyxy cx cy (NoMaster 1) False + -- | Magnifier that defaults to Off magnifierOff :: l a -> ModifiedLayout Magnifier l a magnifierOff = magnifierczOff 1.5 @@ -154,7 +191,8 @@ magnifierczOff' :: Rational -> l a -> ModifiedLayout Magnifier l a magnifierczOff' cz = magnify cz (NoMaster 1) False --- | A magnifier that greatly magnifies just the vertical direction +-- | A magnifier that greatly magnifies just the vertical direction; +-- defaults to @Off@. maximizeVertical :: l a -> ModifiedLayout Magnifier l a maximizeVertical = ModifiedLayout (Mag 1 (1, 1000) Off (AllWins 1)) diff --git a/XMonad/Layout/Master.hs b/XMonad/Layout/Master.hs --- a/XMonad/Layout/Master.hs +++ b/XMonad/Layout/Master.hs @@ -31,7 +31,7 @@ import Control.Arrow (first) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Master -- @@ -52,6 +52,7 @@ -- Grid manage the right half. -- -- For more detailed instructions on editing the layoutHook see +-- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Like 'XMonad.Layout.Tall', 'withMaster' supports the diff --git a/XMonad/Layout/Maximize.hs b/XMonad/Layout/Maximize.hs --- a/XMonad/Layout/Maximize.hs +++ b/XMonad/Layout/Maximize.hs @@ -31,7 +31,7 @@ import XMonad.Prelude ( partition ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Maximize -- @@ -46,9 +46,9 @@ -- > myLayout = maximizeWithPadding 10 (Tall 1 (3/100) (1/2)) ||| Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key-bindings, do something like: -- @@ -57,7 +57,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data Maximize a = Maximize Dimension (Maybe Window) deriving ( Read, Show ) maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window diff --git a/XMonad/Layout/MessageControl.hs b/XMonad/Layout/MessageControl.hs --- a/XMonad/Layout/MessageControl.hs +++ b/XMonad/Layout/MessageControl.hs @@ -35,7 +35,7 @@ import Control.Arrow (second) -- $usage --- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.MessageEscape -- diff --git a/XMonad/Layout/Minimize.hs b/XMonad/Layout/Minimize.hs --- a/XMonad/Layout/Minimize.hs +++ b/XMonad/Layout/Minimize.hs @@ -30,7 +30,7 @@ import qualified XMonad.Util.ExtensibleState as XS -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Minimize -- @@ -39,9 +39,9 @@ -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- The module is designed to work together with "XMonad.Layout.BoringWindows" so -- that minimized windows will be skipped over when switching the focused window with diff --git a/XMonad/Layout/Monitor.hs b/XMonad/Layout/Monitor.hs --- a/XMonad/Layout/Monitor.hs +++ b/XMonad/Layout/Monitor.hs @@ -40,7 +40,7 @@ import XMonad.Hooks.FadeInactive (setOpacity) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Monitor -- diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs --- a/XMonad/Layout/Mosaic.hs +++ b/XMonad/Layout/Mosaic.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Mosaic @@ -37,7 +41,7 @@ import Control.Arrow(second, first) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Mosaic -- @@ -58,9 +62,9 @@ -- -- > , ((modm, xK_r), sendMessage Reset) -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data Aspect = Taller @@ -179,16 +183,7 @@ normalize x = let s = sum x in map (/s) x data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty - -instance Foldable Tree where - foldMap _f Empty = mempty - foldMap f (Leaf x) = f x - foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r - -instance Functor Tree where - fmap f (Leaf x) = Leaf $ f x - fmap f (Branch l r) = Branch (fmap f l) (fmap f r) - fmap _ Empty = Empty + deriving (Functor, Show, Foldable) instance Semigroup (Tree a) where Empty <> x = x diff --git a/XMonad/Layout/MosaicAlt.hs b/XMonad/Layout/MosaicAlt.hs --- a/XMonad/Layout/MosaicAlt.hs +++ b/XMonad/Layout/MosaicAlt.hs @@ -38,7 +38,7 @@ import Data.Ratio -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MosaicAlt -- > import qualified Data.Map as M @@ -48,9 +48,9 @@ -- > myLayout = MosaicAlt M.empty ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In the key-bindings, do something like: -- @@ -63,7 +63,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data HandleWindowAlt = ShrinkWindowAlt Window diff --git a/XMonad/Layout/MouseResizableTile.hs b/XMonad/Layout/MouseResizableTile.hs --- a/XMonad/Layout/MouseResizableTile.hs +++ b/XMonad/Layout/MouseResizableTile.hs @@ -20,7 +20,7 @@ -- $usage mouseResizableTile, mouseResizableTileMirrored, - MRTMessage (ShrinkSlave, ExpandSlave), + MRTMessage (ShrinkSlave, ExpandSlave, SetMasterFraction, SetLeftSlaveFraction, SetRightSlaveFraction), -- * Parameters -- $mrtParameters @@ -41,7 +41,7 @@ import Graphics.X11 as X -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MouseResizableTile -- @@ -53,9 +53,9 @@ -- > main = xmonad def { layoutHook = myLayout } -- -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to add the following key bindings: -- @@ -64,7 +64,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- $mrtParameters -- The following functions are also labels for updating the @data@ (whose diff --git a/XMonad/Layout/MultiColumns.hs b/XMonad/Layout/MultiColumns.hs --- a/XMonad/Layout/MultiColumns.hs +++ b/XMonad/Layout/MultiColumns.hs @@ -29,7 +29,7 @@ import XMonad.Prelude -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MultiColumns -- @@ -56,9 +56,9 @@ -- columns, the screen is instead split equally among all columns. Therefore, -- if equal size among all columns are desired, set the size to -0.5. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Layout constructor. multiCol @@ -96,8 +96,8 @@ ,fmap incmastern (fromMessage m)] where resize Shrink = l { multiColSize = max (-0.5) $ s-ds } resize Expand = l { multiColSize = min 1 $ s+ds } - incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ tail r } - where newval = max 0 $ head r + x + incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ drop 1 r } + where newval = max 0 $ maybe 0 (x +) (listToMaybe r) r = drop a n n = multiColNWin l ds = multiColDeltaSize l diff --git a/XMonad/Layout/MultiDishes.hs b/XMonad/Layout/MultiDishes.hs --- a/XMonad/Layout/MultiDishes.hs +++ b/XMonad/Layout/MultiDishes.hs @@ -27,7 +27,7 @@ import XMonad.Prelude (ap) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.MultiDishes -- @@ -53,9 +53,9 @@ -- > |_______| -- > |___|___| -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read) instance LayoutClass MultiDishes a where diff --git a/XMonad/Layout/Named.hs b/XMonad/Layout/Named.hs --- a/XMonad/Layout/Named.hs +++ b/XMonad/Layout/Named.hs @@ -16,7 +16,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.Named +module XMonad.Layout.Named {-# DEPRECATED "Use XMonad.Layout.Renamed instead" #-} ( -- * Usage -- $usage named, @@ -27,7 +27,7 @@ import XMonad.Layout.Renamed -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Named -- @@ -37,16 +37,12 @@ -- > myLayout = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Note that this module has been deprecated and may be removed in a future -- release, please use "XMonad.Layout.Renamed" instead. - --- | (Deprecated) Rename a layout. -named :: String -> l a -> ModifiedLayout Rename l a -named s = renamed [Replace s] -- | (Deprecated) Remove the first word of the name. nameTail :: l a -> ModifiedLayout Rename l a diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -45,7 +45,7 @@ -- $usage --- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: +-- You can use this module with the following in your xmonad.hs file: -- -- > import XMonad.Layout.NoBorders -- @@ -54,9 +54,9 @@ -- -- > layoutHook = ... ||| noBorders Full ||| ... -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- todo, use an InvisibleList. data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show ) diff --git a/XMonad/Layout/NoFrillsDecoration.hs b/XMonad/Layout/NoFrillsDecoration.hs --- a/XMonad/Layout/NoFrillsDecoration.hs +++ b/XMonad/Layout/NoFrillsDecoration.hs @@ -31,7 +31,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.NoFrillsDecoration -- diff --git a/XMonad/Layout/OnHost.hs b/XMonad/Layout/OnHost.hs --- a/XMonad/Layout/OnHost.hs +++ b/XMonad/Layout/OnHost.hs @@ -34,7 +34,7 @@ import System.Posix.Env (getEnv) -- $usage --- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.OnHost -- diff --git a/XMonad/Layout/OneBig.hs b/XMonad/Layout/OneBig.hs --- a/XMonad/Layout/OneBig.hs +++ b/XMonad/Layout/OneBig.hs @@ -55,23 +55,25 @@ -- | Main layout function oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)] -oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] - ++ divideBottom bottomRect bottomWs - ++ divideRight rightRect rightWs - where ws = W.integrate stack - n = length ws - ht (Rectangle _ _ _ hh) = hh - wd (Rectangle _ _ ww _) = ww - h' = round (fromIntegral (ht rect)*cy) - w = wd rect - m = calcBottomWs n w h' - master = head ws - other = tail ws - bottomWs = take m other - rightWs = drop m other - masterRect = cmaster n m cx cy rect - bottomRect = cbottom cy rect - rightRect = cright cx cy rect +oneBigLayout (OneBig cx cy) rect stack = + let ws = W.integrate stack + n = length ws + in case ws of + [] -> [] + (master : other) -> [(master,masterRect)] + ++ divideBottom bottomRect bottomWs + ++ divideRight rightRect rightWs + where + ht (Rectangle _ _ _ hh) = hh + wd (Rectangle _ _ ww _) = ww + h' = round (fromIntegral (ht rect)*cy) + w = wd rect + m = calcBottomWs n w h' + bottomWs = take m other + rightWs = drop m other + masterRect = cmaster n m cx cy rect + bottomRect = cbottom cy rect + rightRect = cright cx cy rect -- | Calculate how many windows must be placed at bottom calcBottomWs :: Int -> Dimension -> Dimension -> Int diff --git a/XMonad/Layout/PerScreen.hs b/XMonad/Layout/PerScreen.hs --- a/XMonad/Layout/PerScreen.hs +++ b/XMonad/Layout/PerScreen.hs @@ -29,7 +29,7 @@ import XMonad.Prelude (fromMaybe) -- $usage --- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.PerScreen -- diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs --- a/XMonad/Layout/PerWorkspace.hs +++ b/XMonad/Layout/PerWorkspace.hs @@ -29,7 +29,7 @@ import XMonad.Prelude (fromMaybe) -- $usage --- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.PerWorkspace -- diff --git a/XMonad/Layout/PositionStoreFloat.hs b/XMonad/Layout/PositionStoreFloat.hs --- a/XMonad/Layout/PositionStoreFloat.hs +++ b/XMonad/Layout/PositionStoreFloat.hs @@ -33,7 +33,7 @@ import XMonad.Prelude (fromMaybe, isJust, nub, when) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.PositionStoreFloat -- > import XMonad.Layout.NoFrillsDecoration diff --git a/XMonad/Layout/Reflect.hs b/XMonad/Layout/Reflect.hs --- a/XMonad/Layout/Reflect.hs +++ b/XMonad/Layout/Reflect.hs @@ -32,7 +32,7 @@ import XMonad.Layout.MultiToggle -- $usage --- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module by importing it into your @xmonad.hs@ file: -- -- > import XMonad.Layout.Reflect -- diff --git a/XMonad/Layout/Renamed.hs b/XMonad/Layout/Renamed.hs --- a/XMonad/Layout/Renamed.hs +++ b/XMonad/Layout/Renamed.hs @@ -19,6 +19,7 @@ module XMonad.Layout.Renamed ( -- * Usage -- $usage renamed + , named , Rename(..) ) where import XMonad @@ -29,7 +30,7 @@ -- -- > import XMonad.Layout.Renamed -- --- to your @~\/.xmonad\/xmonad.hs@. +-- to your @xmonad.hs@. -- -- You can then use 'renamed' to modify the description of your -- layouts. For example: @@ -39,6 +40,10 @@ -- | Apply a list of 'Rename' values to a layout, from left to right. renamed :: [Rename a] -> l a -> ModifiedLayout Rename l a renamed = ModifiedLayout . Chain + +-- | Rename a layout. (Convenience alias for @renamed [Replace s]@.) +named :: String -> l a -> ModifiedLayout Rename l a +named s = renamed [Replace s] -- | The available renaming operations data Rename a = CutLeft Int -- ^ Remove a number of characters from the left diff --git a/XMonad/Layout/ResizableThreeColumns.hs b/XMonad/Layout/ResizableThreeColumns.hs --- a/XMonad/Layout/ResizableThreeColumns.hs +++ b/XMonad/Layout/ResizableThreeColumns.hs @@ -13,7 +13,7 @@ -- -- A layout similar to tall but with three columns. With 2560x1600 pixels this -- layout can be used for a huge main window and up to six reasonable sized --- resizable slave windows. +-- resizable stack windows. ----------------------------------------------------------------------------- module XMonad.Layout.ResizableThreeColumns ( @@ -31,7 +31,7 @@ import Data.Ratio -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ResizableThreeColumns -- @@ -45,7 +45,7 @@ -- 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. -- -- You may also want to add the following key bindings: @@ -53,11 +53,11 @@ -- > , ((modm, xK_a), sendMessage MirrorShrink) -- > , ((modm, xK_z), sendMessage MirrorExpand) -- --- The ResizableThreeColMid variant places the main window between the slave columns. --- --- For more detailed instructions on editing the layoutHook see: +-- The ResizableThreeColMid variant places the main window between the stack columns. -- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Arguments are nmaster, delta, fraction @@ -99,8 +99,13 @@ mresize s MirrorExpand = mresize' s (negate delta) mresize' s delt = let up = length $ W.up s - total = up + length (W.down s) + 1 - pos = if up == (nmaster-1) || up == (total-1) then up-1 else up + down = length $ W.down s + total = up + down + 1 + pos = if up == nmaster - 1 -- upper right + || up == total - 1 -- upper left + || up `elem` [down, down + 1] -- lower right + then up - 1 + else up mfrac' = modifymfrac (mfrac ++ repeat 1) delt pos in l { threeColSlaves = take total mfrac'} modifymfrac [] _ _ = [] @@ -128,23 +133,23 @@ | n <= nmaster+1 = splitVertically mf nmaster s1 ++ splitVertically (drop nmaster mf) (n-nmaster) s2 | otherwise = concat [ splitVertically mf nmaster r1 - , splitVertically (drop nmaster mf) nslave1 r2 - , splitVertically (drop (nmaster + nslave1) mf) nslave2 r3 + , splitVertically (drop nmaster mf) nstack1 r2 + , splitVertically (drop (nmaster + nstack1) mf) nstack2 r3 ] where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r - nslave = n - nmaster - nslave1 = ceiling (nslave % 2) - nslave2 = n - nmaster - nslave1 + nstack = n - nmaster + nstack1 = ceiling (nstack % 2) + nstack2 = nstack - nstack1 splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] splitVertically [] _ r = [r] splitVertically _ n r | n < 2 = [r] splitVertically (f:fx) n (Rectangle sx sy sw sh) = - let smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) + let smallh = min sh (floor $ fi (sh `div` fi n) * f) in Rectangle sx sy sw smallh : - splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) + splitVertically fx (n-1) (Rectangle sx (sy+fi smallh) sw (sh-smallh)) split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) split3HorizontallyBy middle f (Rectangle sx sy sw sh) = diff --git a/XMonad/Layout/ResizableTile.hs b/XMonad/Layout/ResizableTile.hs --- a/XMonad/Layout/ResizableTile.hs +++ b/XMonad/Layout/ResizableTile.hs @@ -27,7 +27,7 @@ import qualified Data.Map as M -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ResizableTile -- @@ -36,9 +36,9 @@ -- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to add the following key bindings: -- @@ -47,7 +47,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data MirrorResize = MirrorShrink | MirrorExpand instance Message MirrorResize diff --git a/XMonad/Layout/ResizeScreen.hs b/XMonad/Layout/ResizeScreen.hs --- a/XMonad/Layout/ResizeScreen.hs +++ b/XMonad/Layout/ResizeScreen.hs @@ -11,9 +11,9 @@ -- Portability : unportable -- -- A layout transformer to have a layout respect a given screen --- geometry. Mostly used with "Decoration" (the Horizontal and the --- Vertical version will react to SetTheme and change their dimension --- accordingly. +-- geometry. Mostly used with "XMonad.Layout.Decoration" (the +-- Horizontal and the Vertical version will react to SetTheme and +-- change their dimension accordingly. ----------------------------------------------------------------------------- module XMonad.Layout.ResizeScreen @@ -31,7 +31,7 @@ -- $usage -- You can use this module by importing it into your --- @~\/.xmonad\/xmonad.hs@ file: +-- @xmonad.hs@ file: -- -- > import XMonad.Layout.ResizeScreen -- @@ -39,9 +39,9 @@ -- -- > layoutHook = resizeHorizontal 40 Full -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeHorizontal i = ModifiedLayout (ResizeScreen L i) diff --git a/XMonad/Layout/Roledex.hs b/XMonad/Layout/Roledex.hs --- a/XMonad/Layout/Roledex.hs +++ b/XMonad/Layout/Roledex.hs @@ -27,7 +27,7 @@ import Data.Ratio -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Roledex -- @@ -36,9 +36,9 @@ -- > myLayout = Roledex ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- $screenshot -- <> diff --git a/XMonad/Layout/ShowWName.hs b/XMonad/Layout/ShowWName.hs --- a/XMonad/Layout/ShowWName.hs +++ b/XMonad/Layout/ShowWName.hs @@ -35,15 +35,15 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.ShowWName -- > myLayout = layoutHook def -- > main = xmonad def { layoutHook = showWName myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A layout modifier to show the workspace name when switching showWName :: l a -> ModifiedLayout ShowWName l a diff --git a/XMonad/Layout/SimpleDecoration.hs b/XMonad/Layout/SimpleDecoration.hs --- a/XMonad/Layout/SimpleDecoration.hs +++ b/XMonad/Layout/SimpleDecoration.hs @@ -32,7 +32,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.SimpleDecoration -- @@ -42,9 +42,9 @@ -- > myL = simpleDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. -- diff --git a/XMonad/Layout/SimpleFloat.hs b/XMonad/Layout/SimpleFloat.hs --- a/XMonad/Layout/SimpleFloat.hs +++ b/XMonad/Layout/SimpleFloat.hs @@ -33,7 +33,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.SimpleFloat -- @@ -42,9 +42,9 @@ -- > myLayout = simpleFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A simple floating layout where every window is placed according -- to the window's initial attributes. diff --git a/XMonad/Layout/Simplest.hs b/XMonad/Layout/Simplest.hs --- a/XMonad/Layout/Simplest.hs +++ b/XMonad/Layout/Simplest.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Simplest @@ -24,7 +26,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.Simplest -- @@ -33,10 +35,10 @@ -- > myLayout = Simplest ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data Simplest a = Simplest deriving (Show, Read) instance LayoutClass Simplest a where - pureLayout Simplest rec (S.Stack w l r) = zip (w : reverse l ++ r) (repeat rec) + pureLayout Simplest rec (S.Stack w l r) = map (, rec) (w : reverse l ++ r) diff --git a/XMonad/Layout/SimplestFloat.hs b/XMonad/Layout/SimplestFloat.hs --- a/XMonad/Layout/SimplestFloat.hs +++ b/XMonad/Layout/SimplestFloat.hs @@ -28,7 +28,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.SimplestFloat -- @@ -37,9 +37,9 @@ -- > myLayout = simplestFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | A simple floating layout where every window is placed according -- to the window's initial attributes. diff --git a/XMonad/Layout/SortedLayout.hs b/XMonad/Layout/SortedLayout.hs --- a/XMonad/Layout/SortedLayout.hs +++ b/XMonad/Layout/SortedLayout.hs @@ -33,7 +33,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.SortedLayout -- @@ -42,9 +42,9 @@ -- > myLayout = sorted [ClassName "Firefox", ClassName "URxvt"] Grid -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Modify a layout using a list of properties to sort its windows. diff --git a/XMonad/Layout/Spacing.hs b/XMonad/Layout/Spacing.hs --- a/XMonad/Layout/Spacing.hs +++ b/XMonad/Layout/Spacing.hs @@ -41,12 +41,6 @@ -- * Modify Borders , Border (..) , borderMap, borderIncrementBy - - -- * Backwards Compatibility - , SpacingWithEdge - , SmartSpacing, SmartSpacingWithEdge - , ModifySpacing (..) - , setSpacing, incSpacing ) where import XMonad @@ -57,7 +51,7 @@ -- $usage --- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ +-- You can use this module by importing it into your @xmonad.hs@ -- file: -- -- > import XMonad.Layout.Spacing @@ -220,9 +214,6 @@ = Just $ s { windowBorder = f wb } | Just (ModifyWindowBorderEnabled f) <- fromMessage m = Just $ s { windowBorderEnabled = f wbe } - | Just (ModifySpacing f) <- fromMessage m - = Just $ let f' = borderMap (fromIntegral . f . fromIntegral) - in s { screenBorder = f' sb, windowBorder = f' wb } | otherwise = Nothing @@ -365,26 +356,7 @@ ----------------------------------------------------------------------------- -- Backwards Compatibility: ----------------------------------------------------------------------------- -{-# DEPRECATED SpacingWithEdge, SmartSpacing, SmartSpacingWithEdge "Use Spacing instead." #-} -{-# DEPRECATED ModifySpacing "Use SpacingModifier instead, perhaps with sendMessages." #-} -{-# DEPRECATED setSpacing "Use setScreenWindowSpacing instead." #-} -{-# DEPRECATED incSpacing "Use incScreenWindowSpacing instead." #-} --- | A type synonym for the 'Spacing' 'LayoutModifier'. -type SpacingWithEdge = Spacing - --- | A type synonym for the 'Spacing' 'LayoutModifier'. -type SmartSpacing = Spacing - --- | A type synonym for the 'Spacing' 'LayoutModifier'. -type SmartSpacingWithEdge = Spacing - --- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of --- the screen spacing and window spacing. See 'SpacingModifier'. -newtype ModifySpacing = ModifySpacing (Int -> Int) - -instance Message ModifySpacing - -- | Surround all windows by a certain number of pixels of blank space. See -- 'spacingRaw'. spacing :: Int -> l a -> ModifiedLayout Spacing l a @@ -410,11 +382,3 @@ smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True where i' = fromIntegral i - --- | See 'setScreenWindowSpacing'. -setSpacing :: Int -> X () -setSpacing = setScreenWindowSpacing . fromIntegral - --- | See 'incScreenWindowSpacing'. -incSpacing :: Int -> X () -incSpacing = incScreenWindowSpacing . fromIntegral diff --git a/XMonad/Layout/Spiral.hs b/XMonad/Layout/Spiral.hs --- a/XMonad/Layout/Spiral.hs +++ b/XMonad/Layout/Spiral.hs @@ -31,7 +31,7 @@ import XMonad.StackSet ( integrate ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Spiral -- @@ -40,12 +40,12 @@ -- > myLayout = spiral (6/7) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". fibs :: [Integer] -fibs = 1 : 1 : zipWith (+) fibs (tail fibs) +fibs = 1 : 1 : zipWith (+) fibs (drop 1 fibs) mkRatios :: [Integer] -> [Rational] mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs) @@ -82,7 +82,7 @@ instance LayoutClass SpiralWithDir a where pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects where ws = integrate stack - ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs + ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ drop 1 fibs rects = divideRects (zip ratios dirs) sc dirs = dropWhile (/= dir) $ case rot of CW -> cycle [East .. North] diff --git a/XMonad/Layout/Square.hs b/XMonad/Layout/Square.hs --- a/XMonad/Layout/Square.hs +++ b/XMonad/Layout/Square.hs @@ -29,7 +29,7 @@ import XMonad.StackSet ( integrate ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- You can use this module with the following in your @xmonad.hs@ file: -- -- > import XMonad.Layout.Square -- @@ -41,7 +41,7 @@ -- > [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data Square a = Square deriving ( Read, Show ) diff --git a/XMonad/Layout/StackTile.hs b/XMonad/Layout/StackTile.hs --- a/XMonad/Layout/StackTile.hs +++ b/XMonad/Layout/StackTile.hs @@ -27,7 +27,7 @@ import XMonad.Prelude -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.StackTile -- @@ -36,9 +36,9 @@ -- > myLayout = StackTile 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read) diff --git a/XMonad/Layout/StateFull.hs b/XMonad/Layout/StateFull.hs --- a/XMonad/Layout/StateFull.hs +++ b/XMonad/Layout/StateFull.hs @@ -20,19 +20,18 @@ -- behaviour of a child layout that has not been given the focused window. -------------------------------------------------------------------------------- -module XMonad.Layout.StateFull ( +module XMonad.Layout.StateFull {-# DEPRECATED "Use X.L.TrackFloating." #-} ( -- * Usage -- $Usage pattern StateFull, StateFull, - FocusTracking(..), - focusTracking + FocusTracking, + F.focusTracking ) where -import XMonad hiding ((<&&>)) -import XMonad.Prelude (fromMaybe, (<|>)) -import qualified XMonad.StackSet as W -import XMonad.Util.Stack (findZ) +import XMonad +import XMonad.Layout.LayoutModifier +import qualified XMonad.Layout.FocusTracking as F -- $Usage -- @@ -50,43 +49,14 @@ -- > main = xmonad def -- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) } --- | The @FocusTracking@ data type for which the @LayoutClass@ instance is --- provided. -data FocusTracking l a = FocusTracking (Maybe a) (l a) - deriving (Show, Read) - --- | Transform a layout into one that remembers and uses its last focus. -focusTracking :: l a -> FocusTracking l a -focusTracking = FocusTracking Nothing +-- | The @FocusTracking@ type for which the @LayoutClass@ instance is provided. +type FocusTracking = ModifiedLayout F.FocusTracking -- | A type synonym to match the @StateFull@ pattern synonym. type StateFull = FocusTracking Full -- | A pattern synonym for the primary use case of the @FocusTracking@ -- transformer; using @Full@. -pattern StateFull :: FocusTracking Full a -pattern StateFull = FocusTracking Nothing Full - -instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where - - description (FocusTracking _ child) - | chDesc == "Full" = "StateFull" - | ' ' `elem` chDesc = "FocusTracking (" ++ chDesc ++ ")" - | otherwise = "FocusTracking " ++ chDesc - where chDesc = description child - - runLayout (W.Workspace i (FocusTracking mOldFoc childL) mSt) sr = do - - mRealFoc <- gets (W.peek . windowset) - let mGivenFoc = W.focus <$> mSt - passedMSt = if mRealFoc == mGivenFoc then mSt - else (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt - - (wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr - let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL' - else Just $ FocusTracking mGivenFoc (fromMaybe childL mChildL') - - return (wrs, newFT) +pattern StateFull :: StateFull a +pattern StateFull = ModifiedLayout (F.FocusTracking Nothing) Full - handleMessage (FocusTracking mf childLayout) m = - (fmap . fmap) (FocusTracking mf) (handleMessage childLayout m) diff --git a/XMonad/Layout/Stoppable.hs b/XMonad/Layout/Stoppable.hs --- a/XMonad/Layout/Stoppable.hs +++ b/XMonad/Layout/Stoppable.hs @@ -58,7 +58,7 @@ import System.Posix.Signals -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Layout.Stoppable @@ -75,9 +75,9 @@ -- layoutHook you have to provide manageHook from -- "XMonad.Util.RemoteWindows" module. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". signalWindow :: Signal -> Window -> X () signalWindow s w = do diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -4,6 +4,7 @@ {-# LANGUAGE ParallelListComp #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- @@ -46,8 +47,6 @@ ) where -import XMonad.Layout.Circle () -- so haddock can find the link - import XMonad.Layout.Decoration(Decoration, DefaultShrinker) import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, redoLayout), @@ -114,7 +113,7 @@ -- -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.SubLayouts -- > import XMonad.Layout.WindowNavigation @@ -163,10 +162,9 @@ -- could not be used in the keybinding instead? It avoids having to explicitly -- pass the conf. -- --- For more detailed instructions, see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" --- "XMonad.Doc.Extending#Adding_key_bindings" +-- For more detailed instructions, see +-- +-- and "XMonad.Doc.Extending#Editing_the_layout_hook". -- | The main layout modifier arguments: -- @@ -184,11 +182,11 @@ -- [@outerLayout@] The layout that determines the rectangles given to each -- group. -- --- Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed --- with: +-- Ex. The second group is 'Tall', the third is 'XMonad.Layout.CircleEx.circle', +-- all others are tabbed with: -- -- > myLayout = addTabs shrinkText def --- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle) +-- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| circle) -- > $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a subLayout nextLayout sl = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) @@ -348,7 +346,7 @@ return $ Just $ Sublayout (I ((sm,w):ms)) defl sls | Just (Broadcast sm) <- fromMessage m = do - ms' <- fmap (zip (repeat sm) . W.integrate') currentStack + ms' <- fmap (map (sm,) . W.integrate') currentStack return $ if null ms' then Nothing else Just $ Sublayout (I $ ms' ++ ms) defl sls @@ -409,7 +407,7 @@ catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window)) catchLayoutMess x = do let m' = x `asTypeOf` (undefined :: LayoutMessages) - ms' <- zip (repeat $ SomeMessage m') . W.integrate' + ms' <- map (SomeMessage m',) . W.integrate' <$> currentStack return $ do guard $ not $ null ms' Just $ Sublayout (I $ ms' ++ ms) defl sls diff --git a/XMonad/Layout/TabBarDecoration.hs b/XMonad/Layout/TabBarDecoration.hs --- a/XMonad/Layout/TabBarDecoration.hs +++ b/XMonad/Layout/TabBarDecoration.hs @@ -31,7 +31,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.TabBarDecoration -- @@ -39,9 +39,9 @@ -- -- > main = xmonad def { layoutHook = simpleTabBar $ layoutHook def} -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- 'tabBar' will give you the possibility of setting a custom shrinker -- and a custom theme. diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs --- a/XMonad/Layout/Tabbed.hs +++ b/XMonad/Layout/Tabbed.hs @@ -43,7 +43,7 @@ import XMonad.Util.Types (Direction2D(..)) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.Tabbed -- @@ -67,9 +67,9 @@ -- on the workspace. To have it always shown, use one of the layouts or -- modifiers ending in @Always@. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You can also edit the default configuration options. -- diff --git a/XMonad/Layout/TallMastersCombo.hs b/XMonad/Layout/TallMastersCombo.hs --- a/XMonad/Layout/TallMastersCombo.hs +++ b/XMonad/Layout/TallMastersCombo.hs @@ -1,5 +1,9 @@ -- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} -{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards #-} + --------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TallMastersCombo @@ -16,7 +20,7 @@ -- a main master, which is the original master window; -- a sub master, the first window of the second pane. -- This combinator can be nested, and has a good support for using --- 'XMonad.Layout.Tabbed' as a sublayout. +-- "XMonad.Layout.Tabbed" as a sublayout. -- ----------------------------------------------------------------------------- @@ -42,16 +46,17 @@ ) where import XMonad hiding (focus, (|||)) -import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust) -import XMonad.StackSet (Workspace(..),integrate',Stack(..)) -import qualified XMonad.StackSet as W import qualified XMonad.Layout as LL -import XMonad.Layout.Simplest (Simplest(..)) import XMonad.Layout.Decoration +import XMonad.Layout.Simplest (Simplest (..)) +import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe) +import XMonad.StackSet (Stack (..), Workspace (..), integrate') +import qualified XMonad.StackSet as W +import XMonad.Util.Stack (zipperFocusedAtFirstOf) --------------------------------------------------------------------------------- -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.TallMastersCombo -- @@ -244,14 +249,14 @@ return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 (not vsp) nmaster delta frac layout1 layout2) True | Just SwapSubMaster <- fromMessage m = -- first get the submaster window - let subMaster = if null w2 then Nothing else Just $ head w2 + let subMaster = listToMaybe w2 in case subMaster of Just mw -> do windows $ W.modify' $ swapWindow mw return Nothing Nothing -> return Nothing | Just FocusSubMaster <- fromMessage m = -- first get the submaster window - let subMaster = if null w2 then Nothing else Just $ head w2 + let subMaster = listToMaybe w2 in case subMaster of Just mw -> do windows $ W.modify' $ focusWindow mw return Nothing @@ -302,19 +307,6 @@ mlayout2 <- handleMessage layout2 m return $ mergeSubLayouts mlayout1 mlayout2 i False - - --- code from CombineTwo --- given two sets of zs and xs takes the first z from zs that also belongs to xs --- and turns xs into a stack with z being current element. Acts as --- StackSet.differentiate if zs and xs don't intersect -differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) -differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z - , up = reverse $ takeWhile (/=z) xs - , down = tail $ dropWhile (/=z) xs } - | otherwise = differentiate zs xs -differentiate [] xs = W.differentiate xs - -- | Swap a given window with the focused window. swapWindow :: (Eq a) => a -> Stack a -> Stack a swapWindow w (Stack foc upLst downLst) @@ -388,9 +380,9 @@ Nothing -> f snum = length slst (slst1, slst2) = splitAt nmaster slst - s0 = differentiate f' slst - s1' = differentiate f' slst1 - s2' = differentiate f' slst2 + s0 = zipperFocusedAtFirstOf f' slst + s1' = zipperFocusedAtFirstOf f' slst1 + s2' = zipperFocusedAtFirstOf f' slst2 (s1,s2,frac') | nmaster == 0 = (Nothing,s0,0) | nmaster >= snum = (s0,Nothing,1) | otherwise = (s1',s2',frac) diff --git a/XMonad/Layout/ThreeColumns.hs b/XMonad/Layout/ThreeColumns.hs --- a/XMonad/Layout/ThreeColumns.hs +++ b/XMonad/Layout/ThreeColumns.hs @@ -32,7 +32,7 @@ import Data.Ratio -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ThreeColumns -- @@ -51,9 +51,9 @@ -- -- The ThreeColMid variant places the main window between the stack columns. -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- $screenshot diff --git a/XMonad/Layout/ToggleLayouts.hs b/XMonad/Layout/ToggleLayouts.hs --- a/XMonad/Layout/ToggleLayouts.hs +++ b/XMonad/Layout/ToggleLayouts.hs @@ -25,7 +25,7 @@ import XMonad.StackSet (Workspace (..)) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ToggleLayouts -- @@ -34,9 +34,9 @@ -- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- To toggle between layouts add a key binding like -- @@ -48,7 +48,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show) data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show) diff --git a/XMonad/Layout/TrackFloating.hs b/XMonad/Layout/TrackFloating.hs --- a/XMonad/Layout/TrackFloating.hs +++ b/XMonad/Layout/TrackFloating.hs @@ -2,7 +2,7 @@ {- | Module : XMonad.Layout.TrackFloating -Description : Track focus in the tiled layer. +Description : Let focused tiles track focused floats Copyright : (c) 2010 & 2013 Adam Vogt 2011 Willem Vanlint License : BSD-style (see xmonad/LICENSE) @@ -11,14 +11,9 @@ Stability : unstable Portability : unportable -Layout modifier that tracks focus in the tiled layer while the floating layer -or another sublayout is in use. This is particularly helpful for tiled layouts -where the focus determines what is visible. It can also be used to improve the -behaviour of a child layout that has not been given the focused window. +Provides layout modifier 'UseTransientFor': when a float has focus and is +@WM_TRANSIENT_FOR@ a tile, run the underlying layout as if that tile had focus. -The relevant bugs are Issue 4 and 306: -, - -} module XMonad.Layout.TrackFloating (-- * Usage @@ -37,31 +32,15 @@ import XMonad.Prelude import XMonad import XMonad.Layout.LayoutModifier +import XMonad.Layout.FocusTracking import XMonad.Util.Stack (findZ) import qualified XMonad.StackSet as W import qualified Data.Traversable as T -newtype TrackFloating a = TrackFloating (Maybe Window) - deriving (Read,Show) - - -instance LayoutModifier TrackFloating Window where - modifyLayoutWithUpdate (TrackFloating mw) ws@W.Workspace{ W.stack = ms } r - = do - xCur <- gets (W.peek . W.view (W.tag ws) . windowset) - let isF = xCur /= (W.focus <$> ms) - -- use the remembered focus point when true focus differs from - -- what this (sub)layout is given, which happens e.g. when true - -- focus is in floating layer or when another sublayout has focus - newStack | isF = (mw >>= \w -> findZ (w==) ms) <|> ms - | otherwise = ms - newState | isF = mw - | otherwise = xCur - ran <- runLayout ws{ W.stack = newStack } r - return (ran, guard (newState /= mw) >> Just (TrackFloating newState)) - +{-# DEPRECATED TrackFloating "Use X.L.FocusTracking.FocusTracking." #-} +type TrackFloating = FocusTracking {- | When focus is on the tiled layer, the underlying layout is run with focus @@ -128,8 +107,9 @@ * the remembered focus hasn't since been killed -} +{-# DEPRECATED trackFloating "Use X.L.FocusTracking.focusTracking." #-} trackFloating :: l a -> ModifiedLayout TrackFloating l a -trackFloating = ModifiedLayout (TrackFloating Nothing) +trackFloating = focusTracking {- $layoutModifier It also corrects focus issues for full-like layouts inside other layout diff --git a/XMonad/Layout/TwoPane.hs b/XMonad/Layout/TwoPane.hs --- a/XMonad/Layout/TwoPane.hs +++ b/XMonad/Layout/TwoPane.hs @@ -27,7 +27,7 @@ import XMonad.StackSet ( focus, up, down) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.TwoPane -- @@ -36,9 +36,9 @@ -- > myLayout = TwoPane (3/100) (1/2) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data TwoPane a = TwoPane Rational Rational @@ -56,8 +56,8 @@ handleMessage (TwoPane delta split) x = return $ case fromMessage x of - Just Shrink -> Just (TwoPane delta (split - delta)) - Just Expand -> Just (TwoPane delta (split + delta)) + Just Shrink -> Just (TwoPane delta (max 0 (split - delta))) + Just Expand -> Just (TwoPane delta (min 1 (split + delta))) _ -> Nothing description _ = "TwoPane" diff --git a/XMonad/Layout/TwoPanePersistent.hs b/XMonad/Layout/TwoPanePersistent.hs --- a/XMonad/Layout/TwoPanePersistent.hs +++ b/XMonad/Layout/TwoPanePersistent.hs @@ -28,7 +28,7 @@ import XMonad hiding (focus) -- $usage --- Import the module in @~\/.xmonad\/xmonad.hs@: +-- Import the module in @xmonad.hs@: -- -- > import XMonad.Layout.TwoPanePersistent -- @@ -58,8 +58,8 @@ pureMessage (TwoPanePersistent w delta split) x = case fromMessage x of - Just Shrink -> Just (TwoPanePersistent w delta (split - delta)) - Just Expand -> Just (TwoPanePersistent w delta (split + delta)) + Just Shrink -> Just (TwoPanePersistent w delta (max 0 (split - delta))) + Just Expand -> Just (TwoPanePersistent w delta (min 1 (split + delta))) _ -> Nothing description _ = "TwoPanePersistent" diff --git a/XMonad/Layout/VoidBorders.hs b/XMonad/Layout/VoidBorders.hs --- a/XMonad/Layout/VoidBorders.hs +++ b/XMonad/Layout/VoidBorders.hs @@ -35,7 +35,7 @@ import XMonad.StackSet (integrate) -- $usage --- You can use this module with the following in your ~\/.xmonad/xmonad.hs +-- You can use this module with the following in your @xmonad.hs@ -- file: -- -- > import XMonad.Layout.VoidBorders @@ -46,9 +46,9 @@ -- -- > layoutHook = ... ||| voidBorders Full ||| normalBorders Tall ... -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". data VoidBorders a = VoidBorders deriving (Read, Show) diff --git a/XMonad/Layout/WindowArranger.hs b/XMonad/Layout/WindowArranger.hs --- a/XMonad/Layout/WindowArranger.hs +++ b/XMonad/Layout/WindowArranger.hs @@ -35,7 +35,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.WindowArranger -- > myLayout = layoutHook def @@ -45,9 +45,9 @@ -- -- > main = xmonad def { layoutHook = windowArrangeAll myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- You may also want to define some key binding to move or resize -- windows. These are good defaults: @@ -68,7 +68,7 @@ -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1)) -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | A layout modifier to float the windows in a workspace windowArrange :: l a -> ModifiedLayout WindowArranger l a diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs --- a/XMonad/Layout/WindowNavigation.hs +++ b/XMonad/Layout/WindowNavigation.hs @@ -35,7 +35,7 @@ import XMonad.Util.XUtils -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.WindowNavigation -- @@ -45,9 +45,9 @@ -- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the 'layoutHook' see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the 'layoutHook' see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- In keybindings: -- @@ -62,7 +62,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show) @@ -75,10 +75,10 @@ -- | 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. diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs --- a/XMonad/Layout/WindowSwitcherDecoration.hs +++ b/XMonad/Layout/WindowSwitcherDecoration.hs @@ -36,7 +36,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Layout.WindowSwitcherDecoration -- > import XMonad.Layout.DraggingVisualizer diff --git a/XMonad/Layout/WorkspaceDir.hs b/XMonad/Layout/WorkspaceDir.hs --- a/XMonad/Layout/WorkspaceDir.hs +++ b/XMonad/Layout/WorkspaceDir.hs @@ -41,7 +41,7 @@ import XMonad.StackSet ( tag, currentTag ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Layout.WorkspaceDir -- @@ -51,9 +51,9 @@ -- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- WorkspaceDir provides also a prompt. To use it you need to import -- "XMonad.Prompt" and add something like this to your key bindings: @@ -67,7 +67,7 @@ -- -- For detailed instruction on editing the key binding see: -- --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . newtype Chdir = Chdir String instance Message Chdir diff --git a/XMonad/Layout/ZoomRow.hs b/XMonad/Layout/ZoomRow.hs --- a/XMonad/Layout/ZoomRow.hs +++ b/XMonad/Layout/ZoomRow.hs @@ -49,7 +49,7 @@ -- and decreased, and a window can be set to use the whole available -- space whenever it has focus. -- --- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: +-- You can use this module by including the following in your @xmonad.hs@: -- -- > import XMonad.Layout.ZoomRow -- @@ -69,8 +69,9 @@ -- > -- (Un)Maximize the focused window -- > , ((modMask , xK_f ), sendMessage ToggleZoomFull) -- --- For more information on editing your layout hook and key bindings, --- see "XMonad.Doc.Extending". +-- For more information on editing your layoutHook and key bindings, +-- see +-- and "XMonad.Doc.Extending". -- * Creation functions diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs --- a/XMonad/Prelude.hs +++ b/XMonad/Prelude.hs @@ -1,6 +1,9 @@ +{-# OPTIONS_GHC -Wno-dodgy-imports #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Prelude @@ -24,6 +27,7 @@ notEmpty, safeGetWindowAttributes, mkAbsolutePath, + findM, -- * Keys keyToString, @@ -35,6 +39,14 @@ multimediaKeys, functionKeys, WindowScreen, + + -- * Infinite streams + Stream(..), + (+~), + cycleS, + takeS, + toList, + fromList, ) where import Foreign (alloca, peek) @@ -44,10 +56,10 @@ import Control.Monad as Exports import Data.Bool as Exports import Data.Char as Exports -import Data.Foldable as Exports +import Data.Foldable as Exports hiding (toList) import Data.Function as Exports -import Data.Functor as Exports -import Data.List as Exports +import Data.Functor as Exports hiding (unzip) +import Data.List as Exports hiding ((!?)) import Data.Maybe as Exports import Data.Monoid as Exports import Data.Traversable as Exports @@ -55,14 +67,15 @@ import qualified Data.Map.Strict as Map import Control.Arrow ((&&&), first) +import Control.Exception (SomeException, handle) import Data.Bifunctor (bimap) import Data.Bits import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Tuple (swap) +import GHC.Exts (IsList(..)) import GHC.Stack import System.Directory (getHomeDirectory) import System.Environment (getEnv) -import Control.Exception (SomeException, handle) import qualified XMonad.StackSet as W -- | Short for 'fromIntegral'. @@ -89,6 +102,21 @@ (.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b (.:) = (.) . (.) +-- | Like 'find', but takes a monadic function instead; retains the +-- short-circuiting behaviour of the non-monadic version. +-- +-- For example, +-- +-- > findM (\a -> putStr (show a <> " ") >> pure False) [1..10] +-- +-- would print "1 2 3 4 5 6 7 8 9 10" and return @Nothing@, while +-- +-- > findM (\a -> putStr (show a <> " ") >> pure True) [1..10] +-- +-- would print @"1"@ and return @Just 1@. +findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) +findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing) + -- | 'Data.List.NonEmpty.fromList' with a better error message. Useful to -- silence GHC's Pattern match(es) are non-exhaustive warning in places where -- the programmer knows it's always non-empty, but it's infeasible to express @@ -97,7 +125,7 @@ notEmpty [] = error "unexpected empty list" notEmpty (x:xs) = x :| xs --- | A safe version of 'Graphics.X11.Extras.getWindowAttributes'. +-- | A safe version of 'Graphics.X11.Xlib.Extras.getWindowAttributes'. safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes) safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p -> xGetWindowAttributes dpy w p >>= \case @@ -199,7 +227,7 @@ allSpecialKeys :: [(String, KeySym)] allSpecialKeys = functionKeys <> specialKeys <> multimediaKeys --- | A list pairing function key descriptor strings (e.g. @\"\"@) +-- | A list pairing function key descriptor strings (e.g. @\"\\"@) -- with the associated KeySyms. functionKeys :: [(String, KeySym)] functionKeys = [ ('F' : show n, k) @@ -449,3 +477,36 @@ -- | The specialized 'W.Screen' derived from 'WindowSet'. type WindowScreen -- FIXME move to core = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail + +-- | An infinite stream type +data Stream a = !a :~ Stream a +infixr 5 :~ + +instance Functor Stream where + fmap :: (a -> b) -> Stream a -> Stream b + fmap f = go + where go (x :~ xs) = f x :~ go xs + +instance IsList (Stream a) where + type (Item (Stream a)) = a + + fromList :: [a] -> Stream a + fromList (x : xs) = x :~ fromList xs + fromList [] = errorWithoutStackTrace "XMonad.Prelude.Stream.fromList: Can't create stream out of finite list." + + toList :: Stream a -> [a] + toList (x :~ xs) = x : toList xs + +-- | Absorb a list into an infinite stream. +(+~) :: [a] -> Stream a -> Stream a +xs +~ s = foldr (:~) s xs +infixr 5 +~ + +-- | Absorb a non-empty list into an infinite stream. +cycleS :: NonEmpty a -> Stream a +cycleS (x :| xs) = s where s = x :~ xs +~ s + +-- | @takeS n stream@ returns the first @n@ elements of @stream@; if @n < 0@, +-- this returns the empty list. +takeS :: Int -> Stream a -> [a] +takeS n = take n . toList diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -7,6 +7,7 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt @@ -61,6 +62,7 @@ , defaultColor, modifyColor, setColor , resetColor, setBorderColor , modifyPrompter, setPrompter, resetPrompter + , selectedCompletion, setCurrentCompletions, getCurrentCompletions , moveWord, moveWord', killWord, killWord' , changeWord, deleteString , moveHistory, setSuccess, setDone, setModeDone @@ -98,7 +100,7 @@ ) where import XMonad hiding (cleanMask, config) -import XMonad.Prelude hiding (toList) +import XMonad.Prelude hiding (toList, fromList) import qualified XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.Types @@ -112,11 +114,13 @@ import Data.Bifunctor (bimap) import Data.Bits import Data.IORef +import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import Data.Set (fromList, toList) import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Posix.Files +import Data.List.NonEmpty (nonEmpty) -- $usage -- For usage examples see "XMonad.Prompt.Shell", @@ -183,7 +187,8 @@ -- history entries to remember , promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) -- ^ Mapping from key combinations to actions - , completionKey :: (KeyMask, KeySym) -- ^ Key that should trigger completion + , completionKey :: (KeyMask, KeySym) -- ^ Key to trigger forward completion + , prevCompletionKey :: (KeyMask, KeySym) -- ^ Key to trigger backward completion , changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes) , defaultText :: String -- ^ The text by default in the prompt line , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, @@ -285,14 +290,14 @@ | Bottom -- | Prompt will be placed in the center horizontally and -- in the certain place of screen vertically. If it's in the upper - -- part of the screen, completion window will be placed below(like - -- in 'Top') and otherwise above(like in 'Bottom') + -- part of the screen, completion window will be placed below (like + -- in 'Top') and otherwise above (like in 'Bottom') | CenteredAt { xpCenterY :: Rational -- ^ Rational between 0 and 1, giving -- y coordinate of center of the prompt relative to the screen height. , xpWidth :: Rational -- ^ Rational between 0 and 1, giving - -- width of the prompt relatave to the screen width. + -- width of the prompt relative to the screen width. } deriving (Show,Read) @@ -329,7 +334,8 @@ , borderColor = border def , promptBorderWidth = 1 , promptKeymap = defaultXPKeymap - , completionKey = (0,xK_Tab) + , completionKey = (0, xK_Tab) + , prevCompletionKey = (shiftMask, xK_Tab) , changeModeKey = xK_grave , position = Bottom , height = 18 @@ -439,7 +445,7 @@ setInput :: String -> XP () setInput = modify . setCommand --- | Returns the current input string. Intented for use in custom keymaps +-- | Returns the current input string. Intended for use in custom keymaps -- where 'get' or similar can't be used to retrieve it. getInput :: XP String getInput = gets command @@ -533,11 +539,11 @@ -- The argument supplied to the action to execute is always the current highlighted item, -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. mkXPromptWithModes :: [XPType] -> XPConfig -> X () -mkXPromptWithModes modes conf = do - let defaultMode = head modes - modeStack = W.Stack { W.focus = defaultMode -- Current mode +mkXPromptWithModes [] _ = pure () +mkXPromptWithModes (defaultMode : modes) conf = do + let modeStack = W.Stack { W.focus = defaultMode -- Current mode , W.up = [] - , W.down = tail modes -- Other modes + , W.down = modes -- Other modes } om = XPMultipleModes modeStack st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om @@ -624,6 +630,10 @@ type KeyStroke = (KeySym, String) +-- | Check whether the given key stroke is a modifier. +isModifier :: KeyStroke -> Bool +isModifier (_, keyString) = null keyString + -- | Main event "loop". Gives priority to events from the state's event buffer. eventLoop :: (KeyStroke -> Event -> XP ()) -> XP Bool @@ -642,11 +652,11 @@ 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 + (l : ls) -> do + modify $ \s -> s { eventBuffer = ls } + return l handle (keysym,keystr) event - stopAction >>= flip unless (eventLoop handle stopAction) + stopAction >>= \stop -> unless stop (eventLoop handle stopAction) -- | Default event loop stop condition. evDefaultStop :: XP Bool @@ -688,34 +698,39 @@ -- | Prompt event handler for the main loop. Dispatches to input, completion -- and mode switching handlers. handleMain :: KeyStroke -> Event -> XP () -handleMain stroke@(keysym,_) KeyEvent{ev_event_type = t, ev_state = m} = do - (compKey,modeKey) <- gets $ (completionKey &&& changeModeKey) . config - keymask <- gets cleanMask <*> pure m - -- haven't subscribed to keyRelease, so just in case - when (t == keyPress) $ - if (keymask,keysym) == compKey - then getCurrentCompletions >>= handleCompletionMain - else do - setCurrentCompletions Nothing - if keysym == modeKey - then modify setNextMode >> updateWindows - else handleInputMain keymask stroke -handleMain stroke event = handleOther stroke event - --- | Prompt input handler for the main loop. -handleInputMain :: KeyMask -> KeyStroke -> XP () -handleInputMain keymask (keysym,keystr) = do - keymap <- gets (promptKeymap . config) - case M.lookup (keymask,keysym) keymap of - -- 'null keystr' i.e. when only a modifier was pressed +handleMain stroke@(keysym, keystr) = \case + KeyEvent{ev_event_type = t, ev_state = m} -> do + (prevCompKey, (compKey, modeKey)) <- gets $ + (prevCompletionKey &&& completionKey &&& changeModeKey) . config + keymask <- gets cleanMask <*> pure m + -- haven't subscribed to keyRelease, so just in case + when (t == keyPress) $ if + | (keymask, keysym) == compKey -> + getCurrentCompletions >>= handleCompletionMain Next + | (keymask, keysym) == prevCompKey -> + getCurrentCompletions >>= handleCompletionMain Prev + | otherwise -> do + keymap <- gets (promptKeymap . config) + let mbAction = M.lookup (keymask, keysym) keymap + -- Either run when we can insert a valid character, or the + -- pressed key has an action associated to it. + unless (isModifier stroke && isNothing mbAction) $ do + setCurrentCompletions Nothing + if keysym == modeKey + then modify setNextMode >> updateWindows + else handleInput keymask mbAction + event -> handleOther stroke event + where + -- Prompt input handler for the main loop. + handleInput :: KeyMask -> Maybe (XP ()) -> XP () + handleInput keymask = \case Just action -> action >> updateWindows - Nothing -> unless (null keystr) $ - when (keymask .&. controlMask == 0) $ do - insertString $ utf8Decode keystr - updateWindows - updateHighlightedCompl - complete <- tryAutoComplete - when complete $ setSuccess True >> setDone True + Nothing -> when (keymask .&. controlMask == 0) $ do + insertString $ utf8Decode keystr + updateWindows + updateHighlightedCompl + complete <- tryAutoComplete + when complete acceptSelection -- There are two options to store the completion list during the main loop: -- * Use the State monad, with 'Nothing' as the initial state. @@ -725,17 +740,18 @@ -- -- | Prompt completion handler for the main loop. Given 'Nothing', generate the -- current completion list. With the current list, trigger a completion. -handleCompletionMain :: Maybe [String] -> XP () -handleCompletionMain Nothing = do - cs <- getCompletions - when (length cs > 1) $ - modify $ \s -> s { showComplWin = True } - setCurrentCompletions $ Just cs - handleCompletion cs -handleCompletionMain (Just cs) = handleCompletion cs +handleCompletionMain :: Direction1D -> Maybe [String] -> XP () +handleCompletionMain dir compls = case compls of + Just cs -> handleCompletion dir cs + Nothing -> do + cs <- getCompletions + when (length cs > 1) $ + modify $ \s -> s { showComplWin = True } + setCurrentCompletions $ Just cs + handleCompletion dir cs -handleCompletion :: [String] -> XP () -handleCompletion cs = do +handleCompletion :: Direction1D -> [String] -> XP () +handleCompletion dir cs = do alwaysHlight <- gets $ alwaysHighlight . config st <- get @@ -775,8 +791,10 @@ | -- We only have one suggestion, so we need to be a little -- bit smart in order to avoid a loop. - length cs == 1 = - if command st == hlCompl then put st else replaceCompletion (head cs) + Just (ch :| []) <- nonEmpty cs = + if command st == hlCompl + then put st + else replaceCompletion ch -- The current suggestion matches the command, so advance -- to the next completion and try again. @@ -790,7 +808,7 @@ | otherwise = replaceCompletion prevCompl where hlCompl :: String = fromMaybe (command st) $ highlightedItem st l - complIndex' :: (Int, Int) = nextComplIndex st + complIndex' :: (Int, Int) = computeComplIndex dir st nextHlCompl :: Maybe String = highlightedItem st{ complIndex = complIndex' } cs isSuffixOfCmd :: Bool = hlCompl `isSuffixOf` command st @@ -831,10 +849,10 @@ -> KeyMask -> KeyStroke -> XP () -handleInputSubmap defaultAction keymap keymask (keysym,keystr) = +handleInputSubmap defaultAction keymap keymask stroke@(keysym, _) = case M.lookup (keymask,keysym) keymap of Just action -> action >> updateWindows - Nothing -> unless (null keystr) $ defaultAction >> updateWindows + Nothing -> unless (isModifier stroke) $ defaultAction >> updateWindows -- | Initiate a prompt input buffer event loop. Input is sent to a buffer and -- bypasses the prompt. The provided function is given the existing buffer and @@ -888,8 +906,8 @@ -> KeyStroke -> Event -> XP () -handleInputBuffer f keymask (keysym,keystr) event = - unless (null keystr || keymask .&. controlMask /= 0) $ do +handleInputBuffer f keymask stroke@(keysym, keystr) event = + unless (isModifier stroke || keymask .&. controlMask /= 0) $ do (evB,inB) <- gets (eventBuffer &&& inputBuffer) let keystr' = utf8Decode keystr let (cont,keep) = f inB keystr' @@ -905,18 +923,24 @@ bufferOne :: String -> String -> (Bool,Bool) bufferOne xs x = (null xs && null x,True) --- | Return the @(column, row)@ of the next highlight, or @(0, 0)@ if +-- | Return the @(column, row)@ of the desired highlight, or @(0, 0)@ if -- there is no prompt window or a wrap-around occurs. -nextComplIndex :: XPState -> (Int, Int) -nextComplIndex st = case complWinDim st of +computeComplIndex :: Direction1D -> XPState -> (Int, Int) +computeComplIndex dir st = case complWinDim st of Nothing -> (0, 0) -- no window dimensions (just destroyed or not created) Just ComplWindowDim{ cwCols, cwRows } -> - let (currentcol, currentrow) = complIndex st - (colm, rowm) = - ((currentcol + 1) `mod` length cwCols, (currentrow + 1) `mod` length cwRows) - in if rowm == currentrow + 1 - then (currentcol, currentrow + 1) -- We are not in the last row, so go down - else (colm, rowm) -- otherwise advance to the next column + if rowm == currentrow + direction + then (currentcol, rowm) -- We are not in the last row, so advance the row + else (colm, rowm) -- otherwise advance to the respective column + where + (currentcol, currentrow) = complIndex st + (colm, rowm) = + ( (currentcol + direction) `mod` length cwCols + , (currentrow + direction) `mod` length cwRows + ) + direction = case dir of + Next -> 1 + Prev -> -1 tryAutoComplete :: XP Bool tryAutoComplete = do @@ -968,8 +992,8 @@ , (xK_bracketleft, quit) ] ++ map (first $ (,) 0) - [ (xK_Return, setSuccess True >> setDone True) - , (xK_KP_Enter, setSuccess True >> setDone True) + [ (xK_Return, acceptSelection) + , (xK_KP_Enter, acceptSelection) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) @@ -1009,6 +1033,7 @@ , (xK_g, quit) , (xK_bracketleft, quit) , (xK_t, transposeChars) + , (xK_m, acceptSelection) ] ++ map (first $ (,) mod1Mask) -- meta key + [ (xK_BackSpace, killWord' p Prev) @@ -1021,8 +1046,8 @@ ] ++ map (first $ (,) 0) -- - [ (xK_Return, setSuccess True >> setDone True) - , (xK_KP_Enter, setSuccess True >> setDone True) + [ (xK_Return, acceptSelection) + , (xK_KP_Enter, acceptSelection) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) @@ -1058,9 +1083,12 @@ -- alternates. -> M.Map (KeyMask,KeySym) (XP ()) vimLikeXPKeymap' fromColor promptF pasteFilter notWord = M.fromList $ + map (first $ (,) controlMask) -- control + + [ (xK_m, acceptSelection) + ] ++ map (first $ (,) 0) - [ (xK_Return, setSuccess True >> setDone True) - , (xK_KP_Enter, setSuccess True >> setDone True) + [ (xK_Return, acceptSelection) + , (xK_KP_Enter, acceptSelection) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) @@ -1111,6 +1139,8 @@ , (xK_c, promptSubmap (setModeDone True) changeVimXPKeymap >> setModeDone True ) + , (xK_Return, acceptSelection) + , (xK_KP_Enter, acceptSelection) ] ++ map (first $ (,) shiftMask) [ (xK_dollar, endOfLine >> moveCursor Prev) @@ -1166,6 +1196,10 @@ -- KeyPress and State +-- | Accept the current selection and exit. +acceptSelection :: StateT XPState IO () +acceptSelection = setSuccess True >> setDone True + -- | Quit. quit :: XP () quit = flushString >> setSuccess False >> setDone True >> setModeDone True @@ -1291,7 +1325,7 @@ c oc oo | oo >= length oc && d == Prev = take (oo - 1) oc | oo < length oc && d == Prev = take (oo - 1) f ++ ss - | oo < length oc && d == Next = f ++ tail ss + | oo < length oc && d == Next = f ++ drop 1 ss | otherwise = oc where (f,ss) = splitAt oo oc @@ -1372,11 +1406,11 @@ -- starting cursor character is not considered, and the cursor is placed over -- the matching character. toHeadChar :: Direction1D -> String -> XP () -toHeadChar d s = unless (null s) $ do +toHeadChar _ "" = pure () +toHeadChar d (c : _) = do cmd <- gets command off <- gets offset - let c = head s - off' = (if d == Prev then negate . fst else snd) + let off' = (if d == Prev then negate . fst else snd) . join (***) (maybe 0 (+1) . elemIndex c) . (reverse *** drop 1) $ splitAt off cmd @@ -1440,9 +1474,7 @@ redrawWindows emptyAction compls = do d <- gets dpy drawWin - case compls of - [] -> emptyAction - l -> redrawComplWin l + maybe emptyAction redrawComplWin (nonEmpty compls) io $ sync d False where -- | Draw the main prompt window. @@ -1461,14 +1493,14 @@ io $ freePixmap dpy pm -- | Redraw the completion window, if necessary. -redrawComplWin :: [String] -> XP () +redrawComplWin :: NonEmpty String -> XP () redrawComplWin compl = do XPS{ showComplWin, complWinDim, complWin } <- get nwi <- getComplWinDim compl let recreate = do destroyComplWin w <- createComplWin nwi drawComplWin w compl - if compl /= [] && showComplWin + if showComplWin then io (readIORef complWin) >>= \case Just w -> case complWinDim of Just wi -> if nwi == wi -- complWinDim did not change @@ -1499,7 +1531,7 @@ (preCursor, cursor, postCursor) = if offset >= length com then (str, " ","") -- add a space: it will be our cursor ;-) else let (a, b) = splitAt offset com - in (prt ++ a, [head b], tail b) + in (prt ++ a, take 1 b, drop 1 b) -- vertical and horizontal text alignment (asc, desc) <- io $ textExtentsXMF fontS str -- font ascent and descent @@ -1542,7 +1574,7 @@ -- | Given the completions that we would like to show, calculate the -- required dimensions for the completion windows. -getComplWinDim :: [String] -> XP ComplWindowDim +getComplWinDim :: NonEmpty String -> XP ComplWindowDim getComplWinDim compl = do XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get let -- Height of a single completion row @@ -1583,7 +1615,7 @@ -- Get font ascent and descent. Coherence condition: we will print -- everything using the same font. - (asc, desc) <- io $ textExtentsXMF fs $ head compl + (asc, desc) <- io $ textExtentsXMF fs $ NE.head compl let yp = fi $ (ht + fi (asc - desc)) `div` 2 -- y position of the first row yRows = take (fi rows) [yp, yp + fi ht ..] -- y positions of all rows @@ -1593,7 +1625,7 @@ pure $ ComplWindowDim x y winWidth rowHeight xCols yRows -- | Draw the completion window. -drawComplWin :: Window -> [String] -> XP () +drawComplWin :: Window -> NonEmpty String -> XP () drawComplWin w entries = do XPS{ config, color, dpy, gcon } <- get let scr = defaultScreenOfDisplay dpy @@ -1616,7 +1648,7 @@ -> GC -> String -- ^ Default foreground color -> String -- ^ Default background color - -> [String] -- ^ Entries to be printed... + -> NonEmpty String -- ^ Entries to be printed... -> ComplWindowDim -- ^ ...into a window of this size -> XP () printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do @@ -1638,7 +1670,7 @@ where -- | Create the completion matrix to be printed. complMat :: [[String]] - = chunksOf (length cwRows) (take (length cwCols * length cwRows) entries) + = chunksOf (length cwRows) (take (length cwCols * length cwRows) (NE.toList entries)) -- | Find the column and row indexes in which a string appears. -- If the string is not in the matrix, the indices default to @(0, 0)@. @@ -1756,7 +1788,7 @@ | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2') | otherwise = (s1, s2) where (s1, s2 ) = break isSpace s - (s1',s2') = breakAtSpace $ tail s2 + (s1',s2') = breakAtSpace $ drop 1 s2 -- | 'historyCompletion' provides a canned completion function much like -- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work @@ -1784,7 +1816,8 @@ -- immediately next to each other. deleteAllDuplicates, deleteConsecutive :: [String] -> [String] deleteAllDuplicates = nub -deleteConsecutive = map head . group +deleteConsecutive = map (NE.head . notEmpty) . group +-- The elements of group will always have at least one element. newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String))) diff --git a/XMonad/Prompt/AppendFile.hs b/XMonad/Prompt/AppendFile.hs --- a/XMonad/Prompt/AppendFile.hs +++ b/XMonad/Prompt/AppendFile.hs @@ -37,7 +37,7 @@ -- $usage -- -- You can use this module by importing it, along with --- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +-- "XMonad.Prompt", into your @xmonad.hs@ file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.AppendFile @@ -69,7 +69,7 @@ -- the file too. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . newtype AppendFile = AppendFile FilePath diff --git a/XMonad/Prompt/DirExec.hs b/XMonad/Prompt/DirExec.hs --- a/XMonad/Prompt/DirExec.hs +++ b/XMonad/Prompt/DirExec.hs @@ -35,7 +35,7 @@ econst = const . return -- $usage --- 1. In your @~\/.xmonad\/xmonad.hs@: +-- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt.DirExec -- @@ -63,7 +63,7 @@ -- terminal -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . newtype DirExec = DirExec String diff --git a/XMonad/Prompt/Email.hs b/XMonad/Prompt/Email.hs --- a/XMonad/Prompt/Email.hs +++ b/XMonad/Prompt/Email.hs @@ -31,7 +31,7 @@ -- $usage -- -- You can use this module by importing it, along with --- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +-- "XMonad.Prompt", into your @xmonad.hs@ file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Email @@ -50,7 +50,7 @@ -- characters and then hit \'tab\'. -- -- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | Prompt the user for a recipient, subject, and body, and send an diff --git a/XMonad/Prompt/FuzzyMatch.hs b/XMonad/Prompt/FuzzyMatch.hs --- a/XMonad/Prompt/FuzzyMatch.hs +++ b/XMonad/Prompt/FuzzyMatch.hs @@ -32,21 +32,21 @@ -- subsequence is a valid completion; matching is case insensitive. This means -- that the sequence of typed characters can be obtained from the completion by -- deleting an appropriate subset of its characters. Example: "spr" matches --- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the --- latter: "S.......P.r..........". +-- \"FastSPR\" but also \"SuccinctParallelTrees\" because it's a subsequence of +-- the latter: "S.......P.r..........". -- -- While this type of inclusiveness is helpful most of the time, it sometimes -- also produces surprising matches. 'fuzzySort' helps sorting matches by -- relevance, using a simple heuristic for measuring relevance. The matches are -- sorted primarily by the length of the substring that contains the query -- characters and secondarily the starting position of the match. So, if the --- search string is "spr" and the matches are "FastSPR", "FasterSPR", and --- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR", --- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr" --- within a substring of length 3 ("SPR") while the shortest substring of --- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length --- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at --- position 5 while the match in "FasterSPR" starts at position 7. +-- search string is "spr" and the matches are \"FastSPR\", \"FasterSPR\", and +-- \"SuccinctParallelTrees\", then the order is \"FastSPR\", \"FasterSPR\", +-- \"SuccinctParallelTrees\" because both \"FastSPR\" and \"FasterSPR\" contain +-- "spr" within a substring of length 3 (\"SPR\") while the shortest substring +-- of \"SuccinctParallelTrees\" that matches "spr" is \"SuccinctPar\", which has +-- length 11. \"FastSPR\" is ranked before \"FasterSPR\" because its match +-- starts at position 5 while the match in \"FasterSPR\" starts at position 7. -- -- To use these functions in an XPrompt, for example, for windowPrompt: -- @@ -63,7 +63,7 @@ -- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows) -- -- For detailed instructions on editing the key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- | 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. diff --git a/XMonad/Prompt/Input.hs b/XMonad/Prompt/Input.hs --- a/XMonad/Prompt/Input.hs +++ b/XMonad/Prompt/Input.hs @@ -56,7 +56,7 @@ -- create an autocompleting version, like this: -- -- > firingPrompt' = inputPromptWithCompl def "Fire" --- > (mkComplFunFromList employees) ?+ fireEmployee +-- > (mkComplFunFromList def employees) ?+ fireEmployee -- -- Now all he has to do is add a keybinding to @firingPrompt@ (or -- @firingPrompt'@), such as @@ -70,7 +70,7 @@ -- invoked. -- -- (For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings".) +-- .) -- -- "XMonad.Prompt.Input" is also intended to ease the process of -- developing other modules which require user input. For an example diff --git a/XMonad/Prompt/Layout.hs b/XMonad/Prompt/Layout.hs --- a/XMonad/Prompt/Layout.hs +++ b/XMonad/Prompt/Layout.hs @@ -26,7 +26,7 @@ import XMonad.StackSet ( workspaces, layout ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Layout @@ -34,7 +34,7 @@ -- > , ((modm .|. shiftMask, xK_m ), layoutPrompt def) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- -- WARNING: This prompt won't display all possible layouts, because the -- code to enable this was rejected from xmonad core. It only displays diff --git a/XMonad/Prompt/Man.hs b/XMonad/Prompt/Man.hs --- a/XMonad/Prompt/Man.hs +++ b/XMonad/Prompt/Man.hs @@ -39,7 +39,7 @@ import qualified Control.Exception as E -- $usage --- 1. In your @~\/.xmonad\/xmonad.hs@: +-- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Man @@ -49,7 +49,7 @@ -- > , ((modm, xK_F1), manPrompt def) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data Man = Man @@ -88,7 +88,7 @@ -- | Run a command using shell and return its output. -- --- XXX Merge into 'XMonad.Util.Run'? +-- XXX Merge into "XMonad.Util.Run"? -- -- (Ask \"gurus\" whether @evaluate (length ...)@ approach is -- better\/more idiomatic.) diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs --- a/XMonad/Prompt/OrgMode.hs +++ b/XMonad/Prompt/OrgMode.hs @@ -3,8 +3,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE ViewPatterns #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.OrgMode @@ -23,8 +25,8 @@ -- -- 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. +-- refile to some existing heading, and use the system's clipboard +-- (really: the primary selection) as the contents of the note. -- -- A blog post highlighting some features of this module can be found -- . @@ -36,6 +38,8 @@ -- * Prompts orgPrompt, -- :: XPConfig -> String -> FilePath -> X () + orgPromptRefile, -- :: XPConfig -> [String] -> String -> FilePath -> X () + orgPromptRefileTo, -- :: XPConfig -> String -> String -> FilePath -> X () orgPromptPrimary, -- :: XPConfig -> String -> FilePath -> X () -- * Types @@ -56,13 +60,22 @@ import XMonad.Prelude -import XMonad (X, io) -import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt) +import XMonad (X, io, whenJust) +import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPromptWithReturn, mkComplFunFromList, ComplFunction) import XMonad.Util.Parser import XMonad.Util.XSelection (getSelection) +import XMonad.Util.Run -import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian) -import System.IO (IOMode (AppendMode), hPutStrLn, withFile) +import Control.DeepSeq (deepseq) +import qualified Data.List.NonEmpty as NE (head) +import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian) +#if MIN_VERSION_time(1, 9, 0) +import Data.Time.Format.ISO8601 (iso8601Show) +#else +import Data.Time.Format (defaultTimeLocale, formatTime, iso8601DateFormat) +#endif +import GHC.Natural (Natural) +import System.IO (IOMode (AppendMode, ReadMode), hClose, hGetContents, openFile, withFile) {- $usage @@ -108,8 +121,8 @@ Monday and you schedule something for Monday, you will actually schedule it for the /next/ Monday (the one in seven days). -The time is specified in the @HH:MM@ format. The minutes may be -omitted, in which case we assume a full hour is specified. +The time is specified in the @HH:MM@ or @HHMM@ format. The minutes may +be omitted, in which case we assume a full hour is specified. A few examples are probably in order. Suppose we have bound the key above, pressed it, and are now confronted with a prompt: @@ -151,6 +164,20 @@ return to whatever you were doing before. See the 'orgPromptPrimary' prompt for that. +Finally, 'orgPromptRefile' and 'orgPromptRefileTo' provide support to +automatically + +the generated item under a heading of choice. For example, binding + +> orgPromptRefile def "TODO" "todos.org" + +to a key will first pop up an ordinary prompt that works exactly like +'orgPrompt', and then query the user for an already existing heading +(with completions) as provided by the @~/todos.org@ file. If that +prompt is cancelled, the heading will appear in the org file as normal +(i.e., at the end of the file); otherwise, it gets refiled under the +selected heading. + -} {- TODO @@ -173,6 +200,9 @@ , orgFile :: FilePath } +mkOrgCfg :: ClipboardSupport -> String -> FilePath -> X OrgMode +mkOrgCfg clp header fp = OrgMode clp header <$> mkAbsolutePath fp + -- | Whether we should use a clipboard and which one to use. data ClipboardSupport = PrimarySelection @@ -199,7 +229,7 @@ -- a single @*@ -> FilePath -- ^ Path to @.org@ file, e.g. @home\/me\/todos.org@ -> X () -orgPrompt xpc = mkOrgPrompt xpc .: OrgMode NoClpSupport +orgPrompt xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg NoClpSupport -- | Like 'orgPrompt', but additionally make use of the primary -- selection. If it is a URL, then use an org-style link @@ -209,12 +239,78 @@ -- The prompt will display a little @+ PS@ in the window -- after the type of note. orgPromptPrimary :: XPConfig -> String -> FilePath -> X () -orgPromptPrimary xpc = mkOrgPrompt xpc .: OrgMode PrimarySelection +orgPromptPrimary xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg PrimarySelection --- | Create the actual prompt. -mkOrgPrompt :: XPConfig -> OrgMode -> X () +-- | Internal type in order to generate a nice prompt in +-- 'orgPromptRefile' and 'orgPromptRefileTo'. +data RefilePrompt = Refile +instance XPrompt RefilePrompt where + showXPrompt :: RefilePrompt -> String + showXPrompt Refile = "Refile note to: " + +-- | Like 'orgPrompt' (which see for the other arguments), but offer to +-- refile the entered note afterwards. +-- +-- Note that refiling is done by shelling out to Emacs, hence an @emacs@ +-- binary must be in @$PATH@. One may customise this by following the +-- instructions in "XMonad.Util.Run#g:EDSL"; more specifically, by +-- changing the 'XMonad.Util.Run.emacs' field of +-- 'XMonad.Util.Run.ProcessConfig'. +orgPromptRefile :: XPConfig -> String -> FilePath -> X () +orgPromptRefile xpc str fp = do + orgCfg <- mkOrgCfg NoClpSupport str fp + + -- NOTE: Ideally we would just use System.IO.readFile' here + -- (especially because it also reads everything strictly), but this is + -- only available starting in base 4.15.x. + fileContents <- io $ do + handle <- openFile (orgFile orgCfg) ReadMode + contents <- hGetContents handle + contents <$ (contents `deepseq` hClose handle) + + -- Save the entry as soon as possible. + notCancelled <- mkOrgPrompt xpc orgCfg + when notCancelled $ + -- If the user didn't cancel, try to parse the org file and offer to + -- refile the entry if possible. + whenJust (runParser pOrgFile fileContents) $ \headings -> + mkXPromptWithReturn Refile xpc (completeHeadings headings) pure >>= \case + Nothing -> pure () + Just parent -> refile parent (orgFile orgCfg) + where + completeHeadings :: [Heading] -> ComplFunction + completeHeadings = mkComplFunFromList xpc . map headingText + +-- | Like 'orgPromptRefile', but with a fixed heading for refiling; no +-- prompt will appear to query for a target. +-- +-- Heading names may omit tags, but generally need to be prefixed by the +-- correct todo keywords; e.g., +-- +-- > orgPromptRefileTo def "PROJECT Work" "TODO" "~/todos.org" +-- +-- Will refile the created note @"TODO "@ to the @"PROJECT Work"@ +-- heading, even with the actual name is @"PROJECT Work +-- :work:other_tags:"@. Just entering @"Work"@ will not work, as Emacs +-- doesn't recognise @"PROJECT"@ as an Org keyword by default (i.e. when +-- started in batch-mode). +orgPromptRefileTo + :: XPConfig + -> String -- ^ Heading to refile the entry under. + -> String + -> FilePath + -> X () +orgPromptRefileTo xpc refileHeading str fp = do + orgCfg <- mkOrgCfg NoClpSupport str fp + notCancelled <- mkOrgPrompt xpc orgCfg + when notCancelled $ refile refileHeading (orgFile orgCfg) + +-- | Create the actual prompt. Returns 'False' when the input was +-- cancelled by the user (by, for example, pressing @Esc@ or @C-g@) and +-- 'True' otherwise. +mkOrgPrompt :: XPConfig -> OrgMode -> X Bool mkOrgPrompt xpc oc@OrgMode{ todoHeader, orgFile, clpSupport } = - mkXPrompt oc xpc (const (pure [])) appendNote + isJust <$> mkXPromptWithReturn oc xpc (const (pure [])) appendNote where -- | Parse the user input, create an @org-mode@ note out of that and -- try to append it to the given file. @@ -228,14 +324,32 @@ then Header sel else Body $ "\n " <> sel - -- Expand path if applicable - fp <- mkAbsolutePath orgFile - - withFile fp AppendMode . flip hPutStrLn + withFile orgFile AppendMode . flip hPutStrLn <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput $ input ------------------------------------------------------------------------ +-- Refiling + +-- | Let Emacs do the refiling, as this seems—and I know how this +-- sounds—more robust than trying to do it ad-hoc in this module. +refile :: String -> FilePath -> X () +refile (asString -> parent) (asString -> fp) = + proc $ inEmacs + >-> asBatch + >-> eval (progn [ "find-file" <> fp + , "end-of-buffer" + , "org-refile nil nil" + <> list [ parent + , fp + , "nil" + , saveExcursion ["org-find-exact-headline-in-buffer" + <> parent] + ] + , "save-buffer" + ]) + +------------------------------------------------------------------------ -- Time -- | A 'Time' is a 'Date' with the possibility of having a specified @@ -274,7 +388,11 @@ mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"] where time :: String = maybe "" ((' ' :) . show) tod +#if MIN_VERSION_time(1, 9, 0) + isoDay :: String = iso8601Show day +#else isoDay :: String = formatTime defaultTimeLocale (iso8601DateFormat Nothing) day +#endif -- | Pretty print a 'Date' and an optional time to reflect the actual -- date. @@ -375,7 +493,7 @@ otherPrio -> " [#" <> show otherPrio <> "] " ------------------------------------------------------------------------ --- Parsing +-- Note parsing -- | Parse the given string into a 'Note'. pInput :: String -> Maybe Note @@ -408,29 +526,38 @@ where go :: String -> Parser String go consumed = do - str <- munch (/= head ptn) + str <- munch (/= NE.head (notEmpty ptn)) word <- munch1 (/= ' ') bool go pure (word == ptn) $ consumed <> str <> word -- | Parse a 'Priority'. pPriority :: Parser Priority -pPriority = pLast (pure NoPriority) $ +pPriority = option NoPriority $ " " *> skipSpaces *> choice - [ "#" *> ("A" <|> "a") $> A - , "#" *> ("B" <|> "b") $> B - , "#" *> ("C" <|> "c") $> C + [ "#" *> foldCase "a" $> A + , "#" *> foldCase "b" $> B + , "#" *> foldCase "c" $> C ] -- | Try to parse a 'Time'. pTimeOfDay :: Parser (Maybe TimeOfDay) -pTimeOfDay = pLast (pure Nothing) $ - skipSpaces *> choice - [ Just <$> (TimeOfDay <$> pHour <* string ":" <*> pMinute) -- HH:MM - , Just <$> (TimeOfDay <$> pHour <*> pure 0 ) -- HH +pTimeOfDay = option Nothing $ + skipSpaces >> Just <$> choice + [ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM + , pHHMM -- HHMM + , TimeOfDay <$> pHour <*> pure 0 -- HH ] where - pMinute :: Parser Int = pNumBetween 1 60 - pHour :: Parser Int = pNumBetween 1 24 + pHHMM :: Parser TimeOfDay + pHHMM = do + let getTwo = count 2 (satisfy isDigit) + hh <- read <$> getTwo + guard (hh >= 0 && hh <= 23) + mm <- read <$> getTwo + guard (mm >= 0 && mm <= 59) + pure $ TimeOfDay hh mm + pHour :: Parser Int = pNumBetween 0 23 + pMinute :: Parser Int = pNumBetween 0 59 -- | Parse a 'Date'. pDate :: Parser Date @@ -470,12 +597,12 @@ ]) <*> optional (skipSpaces *> num >>= \i -> guard (i >= 25) $> i) - -- | Parse a prefix and drop a potential suffix up to the next (space + -- 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 (/= ' ') + pPrefix :: String -> String -> a -> Parser a + pPrefix start (map toLower -> leftover) ret = do + void (foldCase start) + l <- map toLower <$> munch (/= ' ') guard (l `isPrefixOf` leftover) pure ret @@ -485,8 +612,38 @@ n <- num n <$ guard (n >= lo && n <= hi) --- | 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 +-- Parse the given string case insensitively. +foldCase :: String -> Parser String +foldCase = traverse (\c -> char (toLower c) <|> char (toUpper c)) + +------------------------------------------------------------------------ +-- File parsing + +data Heading = Heading + { level :: Natural + -- ^ Level of the Org heading; i.e., the number of leading stars. + , headingText :: String + -- ^ The heading text without its level. + } + +-- | Naïvely parse an Org file. At this point, only the headings are +-- parsed into a non-nested list (ignoring parent-child relations); no +-- further analysis is done on the individual lines themselves. +pOrgFile :: Parser [Heading] +pOrgFile = many pHeading + +pHeading :: Parser Heading +pHeading = skipSpaces *> do + level <- genericLength <$> munch1 (== '*') <* " " + headingText <- pLine + void $ many (pLine >>= \line -> guard (isNotHeading line) $> line) -- skip body + pure Heading{..} + +pLine :: Parser String +pLine = munch (/= '\n') <* "\n" + +isNotHeading :: String -> Bool +isNotHeading str = case break (/= '*') str of + ("", _) -> True + (_ , ' ' : _) -> False + _ -> True diff --git a/XMonad/Prompt/Pass.hs b/XMonad/Prompt/Pass.hs --- a/XMonad/Prompt/Pass.hs +++ b/XMonad/Prompt/Pass.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Pass @@ -16,13 +17,16 @@ -- completion system provided by "XMonad.Prompt". Specifically, we -- provide -- --- - two functions to lookup passwords in the password-store: +-- - various functions to lookup passwords in the password-store: -- --- - 'passPrompt' copies the password directly to the clipboard. +-- + 'passPrompt' copies the password directly to the clipboard. -- --- - 'passTypePrompt' uses @xdotool@ to type the password --- directly. +-- + 'passOTPPrompt' copies a one-time-password to the clipboard +-- (this uses ). -- +-- + 'passTypePrompt' and 'passOTPTypePrompt' work like the above, +-- respectively, but use @xdotool@ to type out the password. +-- -- - 'passGeneratePrompt' generates a password for a given password -- label that the user inputs. -- @@ -64,26 +68,30 @@ , passGenerateAndCopyPrompt , passGenerateAndCopyPrompt' - -- * Misc + -- * One-time-passwords , passOTPPrompt + , passOTPTypePrompt ) where import System.Directory (getHomeDirectory) -import System.FilePath (combine, dropExtension, takeExtension) +import System.FilePath (dropExtension, ()) import System.Posix.Env (getEnv) -import XMonad.Core -import XMonad.Prompt ( XPrompt - , showXPrompt - , commandToComplete - , nextCompletion - , getNextCompletion - , XPConfig - , mkXPrompt - , searchPredicate) +import XMonad +import XMonad.Prelude +import XMonad.Prompt + ( XPConfig, + XPrompt, + commandToComplete, + getNextCompletion, + mkXPrompt, + nextCompletion, + searchPredicate, + showXPrompt, + ) import XMonad.Util.Run (runProcessWithInput) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt.Pass -- @@ -113,16 +121,14 @@ -- -- For detailed instructions on: -- --- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". +-- - editing your key bindings, see . -- -- - how to setup the password store, see -- or @man 1 pass@. -- -type Predicate = String -> String -> Bool - -getPassCompl :: [String] -> Predicate -> String -> IO [String] -getPassCompl compls p s = return $ filter (p s) compls +--------------------------------------------------------------------------------- +-- Prompt type PromptLabel = String @@ -133,28 +139,6 @@ commandToComplete _ c = c nextCompletion _ = getNextCompletion --- | Default password store folder in @$HOME/.password-store@. --- -passwordStoreFolderDefault :: String -> String -passwordStoreFolderDefault home = combine home ".password-store" - --- | Compute the password store's location. --- Use the @$PASSWORD_STORE_DIR@ environment variable to set the password store. --- If empty, return the password store located in user's home. --- -passwordStoreFolder :: IO String -passwordStoreFolder = - getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir - where computePasswordStoreDir Nothing = fmap passwordStoreFolderDefault getHomeDirectory - computePasswordStoreDir (Just storeDir) = return storeDir - --- | A pass prompt factory. --- -mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () -mkPassPrompt promptLabel passwordFunction xpconfig = do - passwords <- io (passwordStoreFolder >>= getPasswords) - mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction - -- | A prompt to retrieve a password from a given entry. -- passPrompt :: XPConfig -> X () @@ -171,6 +155,13 @@ passOTPPrompt :: XPConfig -> X () passOTPPrompt = mkPassPrompt "Select OTP" selectOTP +-- | A prompt to retrieve a OTP from a given entry. Note that you will +-- need to use the +-- extension for this to work. +-- +passOTPTypePrompt :: XPConfig -> X () +passOTPTypePrompt = mkPassPrompt "Select OTP" selectOTPType + -- | A prompt to generate a password for a given entry. -- This can be used to override an already stored entry. -- (Beware that no confirmation is asked) @@ -219,63 +210,104 @@ passEditPrompt' :: String -> XPConfig -> X () passEditPrompt' s = mkPassPrompt s editPassword +-- | A pass prompt factory. +-- +mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () +mkPassPrompt promptLabel passwordFunction xpconfig = do + passwords <- io (passwordStoreFolder >>= getPasswords) + mkXPrompt (Pass promptLabel) + xpconfig + (getPassCompl passwords $ searchPredicate xpconfig) + passwordFunction + where + getPassCompl :: [String] -> (String -> String -> Bool) -> String -> IO [String] + getPassCompl compls p s = return $ filter (p s) compls + + -- Compute the password store's location. Use the @$PASSWORD_STORE_DIR@ + -- environment variable to set the password store. If empty, return the + -- password store located in user's home. + passwordStoreFolder :: IO String + passwordStoreFolder = + getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir + where + -- Default password store folder in @$HOME/.password-store@. + computePasswordStoreDir :: Maybe String -> IO String + computePasswordStoreDir = \case + Nothing -> getHomeDirectory <&> ( ".password-store") + Just storeDir -> return storeDir + + -- Retrieve the list of passwords from the password store @passwordStoreDir@. + getPasswords :: FilePath -> IO [String] + getPasswords passwordStoreDir = do + files <- runProcessWithInput "find" [ + "-L", -- Traverse symlinks + passwordStoreDir, + "-type", "f", + "-name", "*.gpg", + "-printf", "%P\n"] [] + return . map dropExtension $ lines files + +--------------------------------------------------------------------------------- +-- Selecting a password + -- | Select a password. -- selectPassword :: String -> X () -selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\"" +selectPassword = spawn . pass "--clip" --- | Select an OTP. +-- | Select a one-time-password and copy it to the clipboard. -- selectOTP :: String -> X () -selectOTP passLabel = spawn $ "pass otp --clip \"" ++ escapeQuote passLabel ++ "\"" +selectOTP = spawn . pass "otp --clip" +-- | Select a one-time-password and type it out. +-- +selectOTPType :: String -> X () +selectOTPType = spawn . typeString . pass "otp" + -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- generatePassword :: String -> X () -generatePassword passLabel = spawn $ "pass generate --force \"" ++ escapeQuote passLabel ++ "\" 30" +generatePassword passLabel = spawn $ pass "generate --force" passLabel ++ " 30" -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- After generating the password, it is copied to the clipboard. -- generateAndCopyPassword :: String -> X () -generateAndCopyPassword passLabel = spawn $ "pass generate --force -c \"" ++ escapeQuote passLabel ++ "\" 30" +generateAndCopyPassword passLabel = spawn $ pass "generate --force -c" passLabel ++ " 30" -- | Remove a password stored for a given entry. -- removePassword :: String -> X () -removePassword passLabel = spawn $ "pass rm --force \"" ++ escapeQuote passLabel ++ "\"" +removePassword = spawn . pass "rm --force" -- | Edit a password stored for a given entry. -- editPassword :: String -> X () -editPassword passLabel = spawn $ "pass edit \"" ++ escapeQuote passLabel ++ "\"" +editPassword = spawn . pass "edit" -- | Type a password stored for a given entry using xdotool. -- typePassword :: String -> X () -typePassword passLabel = spawn $ "pass \"" ++ escapeQuote passLabel - ++ "\"|head -n1|tr -d '\n'|xdotool type --clearmodifiers --file -" - -escapeQuote :: String -> String -escapeQuote = concatMap escape - where escape :: Char -> String - escape '"' = "\\\"" - escape x = [x] +typePassword = spawn . typeString . pass "" --- | Retrieve the list of passwords from the password store 'passwordStoreDir' +-- | Type the given string with @xdotool@. -- -getPasswords :: FilePath -> IO [String] -getPasswords passwordStoreDir = do - files <- runProcessWithInput "find" [ - "-L", -- Traverse symlinks - passwordStoreDir, - "-type", "f", - "-name", "*.gpg", - "-printf", "%P\n"] [] - return . map removeGpgExtension $ lines files +-- >>> typeString (pass "" "arXiv") +-- "pass \"arXiv\" | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -" +typeString :: String -> String +typeString cmd = cmd ++ " | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -" -removeGpgExtension :: String -> String -removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file - | otherwise = file +-- | Generate a pass prompt. +-- +-- >>> pass "otp" "\\n'git'\"hub\"" +-- "pass otp \"\\\\n'git'\\\"hub\\\"\"" +pass :: String -> String -> String +pass cmd label = concat ["pass ", cmd, " \"", concatMap escape label, "\""] + where + escape :: Char -> String + escape '"' = "\\\"" + escape '\\' = "\\\\" + escape x = [x] diff --git a/XMonad/Prompt/RunOrRaise.hs b/XMonad/Prompt/RunOrRaise.hs --- a/XMonad/Prompt/RunOrRaise.hs +++ b/XMonad/Prompt/RunOrRaise.hs @@ -22,7 +22,7 @@ ) where import XMonad hiding (config) -import XMonad.Prelude (isNothing, isSuffixOf, liftA2) +import XMonad.Prelude import XMonad.Prompt import XMonad.Prompt.Shell import XMonad.Actions.WindowGo (runOrRaise) @@ -35,7 +35,7 @@ econst = const . return {- $usage -1. In your @~\/.xmonad\/xmonad.hs@: +1. In your @xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.RunOrRaise @@ -45,7 +45,8 @@ > , ((modm .|. controlMask, xK_x), runOrRaisePrompt def) For detailed instruction on editing the key binding see -"XMonad.Doc.Extending#Editing_key_bindings". -} +. +-} data RunOrRaisePrompt = RRP instance XPrompt RunOrRaisePrompt where diff --git a/XMonad/Prompt/Shell.hs b/XMonad/Prompt/Shell.hs --- a/XMonad/Prompt/Shell.hs +++ b/XMonad/Prompt/Shell.hs @@ -52,7 +52,7 @@ econst = const . return {- $usage -1. In your @~\/.xmonad\/xmonad.hs@: +1. In your @xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.Shell @@ -62,7 +62,8 @@ > , ((modm .|. controlMask, xK_x), shellPrompt def) For detailed instruction on editing the key binding see -"XMonad.Doc.Extending#Editing_key_bindings". -} +. +-} data Shell = Shell type Predicate = String -> String -> Bool @@ -196,7 +197,7 @@ p <- getEnv "PATH" `E.catch` econst [] let ds = filter (/= "") $ split ':' p es <- forM ds $ \d -> getDirectoryContents d `E.catch` econst [] - return . uniqSort . filter ((/= '.') . head) . concat $ es + return . uniqSort . filter (not . ("." `isPrefixOf`)) . concat $ es split :: Eq a => a -> [a] -> [[a]] split _ [] = [] diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs --- a/XMonad/Prompt/Ssh.hs +++ b/XMonad/Prompt/Ssh.hs @@ -33,7 +33,7 @@ econst = const . return -- $usage --- 1. In your @~\/.xmonad\/xmonad.hs@: +-- 1. In your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Ssh @@ -43,10 +43,10 @@ -- > , ((modm .|. controlMask, xK_s), sshPrompt def) -- -- Keep in mind, that if you want to use the completion you have to --- disable the "HashKnownHosts" option in your ssh_config +-- disable the \"HashKnownHosts\" option in your ssh_config -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data Ssh = Ssh diff --git a/XMonad/Prompt/Theme.hs b/XMonad/Prompt/Theme.hs --- a/XMonad/Prompt/Theme.hs +++ b/XMonad/Prompt/Theme.hs @@ -29,7 +29,7 @@ -- $usage -- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: +-- @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Theme @@ -39,7 +39,7 @@ -- > , ((modm .|. controlMask, xK_t), themePrompt def) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . data ThemePrompt = ThemePrompt diff --git a/XMonad/Prompt/Unicode.hs b/XMonad/Prompt/Unicode.hs --- a/XMonad/Prompt/Unicode.hs +++ b/XMonad/Prompt/Unicode.hs @@ -52,7 +52,7 @@ {- $usage You can use this module by importing it, along with -"XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +"XMonad.Prompt", into your @xmonad.hs@ file: > import XMonad.Prompt > import XMonad.Prompt.Unicode @@ -60,6 +60,11 @@ and adding an appropriate keybinding, for example: > , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def) + +A path to a @UnicodeData.txt@ file or equivalent must be provided. This file +should be available through your package manager; search for @unicode-data@. +If no package is found, one may opt to download this file directly from +[unicode.org](http://www.unicode.org/Public/UNIDATA/UnicodeData.txt). More flexibility is given by the @mkUnicodePrompt@ function, which takes a command and a list of arguments to pass as its first two arguments. See diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs --- a/XMonad/Prompt/Window.hs +++ b/XMonad/Prompt/Window.hs @@ -26,11 +26,6 @@ allApplications, wsWindows, XWindowMap, - - -- * Deprecated - windowPromptGoto, - windowPromptBring, - windowPromptBringCopy, ) where import XMonad.Prelude (forM) @@ -49,7 +44,7 @@ -- where you left your XChat. It also offers helpers to build the -- subset of windows which is used for the prompt completion. -- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Window @@ -70,7 +65,7 @@ -- keystrokes to the selected client. -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . -- Describe actions that can applied on the selected window data WindowPrompt = Goto | Bring | BringCopy | BringToMaster | WithWindow String (Window -> X()) @@ -111,15 +106,6 @@ bringAction = winAction bringWindow bringCopyAction = winAction bringCopyWindow bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s) - --- | Deprecated. Use windowPrompt instead. -{-# DEPRECATED windowPromptGoto "Use windowPrompt instead." #-} -{-# DEPRECATED windowPromptBring "Use windowPrompt instead." #-} -{-# DEPRECATED windowPromptBringCopy "Use windowPrompt instead." #-} -windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () -windowPromptGoto c = windowPrompt c Goto windowMap -windowPromptBring c = windowPrompt c Bring windowMap -windowPromptBringCopy c = windowPrompt c BringCopy windowMap -- | A helper to get the map of all windows. allWindows :: XWindowMap diff --git a/XMonad/Prompt/Workspace.hs b/XMonad/Prompt/Workspace.hs --- a/XMonad/Prompt/Workspace.hs +++ b/XMonad/Prompt/Workspace.hs @@ -28,7 +28,7 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex ) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Workspace @@ -36,7 +36,7 @@ -- > , ((modm .|. shiftMask, xK_m ), workspacePrompt def (windows . W.shift)) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . newtype Wor = Wor String diff --git a/XMonad/Prompt/XMonad.hs b/XMonad/Prompt/XMonad.hs --- a/XMonad/Prompt/XMonad.hs +++ b/XMonad/Prompt/XMonad.hs @@ -28,7 +28,7 @@ import XMonad.Prelude (fromMaybe) -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.XMonad @@ -38,7 +38,7 @@ -- > , ((modm .|. controlMask, xK_x), xmonadPrompt def) -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- . newtype XMonad = XMonad String diff --git a/XMonad/Prompt/Zsh.hs b/XMonad/Prompt/Zsh.hs --- a/XMonad/Prompt/Zsh.hs +++ b/XMonad/Prompt/Zsh.hs @@ -28,7 +28,7 @@ {- $usage 1. Grab the @capture.zsh@ script to capture zsh completions from -2. In your @~\/.xmonad\/xmonad.hs@: +2. In your @xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.Zsh @@ -38,7 +38,7 @@ > , ((modm .|. controlMask, xK_x), zshPrompt def "/path/to/capture.zsh") For detailed instruction on editing the key binding see -"XMonad.Doc.Extending#Editing_key_bindings". -} +. -} data Zsh = Zsh diff --git a/XMonad/Util/ActionCycle.hs b/XMonad/Util/ActionCycle.hs --- a/XMonad/Util/ActionCycle.hs +++ b/XMonad/Util/ActionCycle.hs @@ -33,7 +33,7 @@ -- $usage --- You can use this module to implement cycling key-bindings by importing 'XMonad.Util.ActionCycle' +-- You can use this module to implement cycling key-bindings by importing "XMonad.Util.ActionCycle" -- -- > import XMonad.Util.ActionCycle -- diff --git a/XMonad/Util/CustomKeys.hs b/XMonad/Util/CustomKeys.hs --- a/XMonad/Util/CustomKeys.hs +++ b/XMonad/Util/CustomKeys.hs @@ -25,7 +25,7 @@ -- $usage -- --- In @~\/.xmonad\/xmonad.hs@ add: +-- In @xmonad.hs@ add: -- -- > import XMonad.Util.CustomKeys -- diff --git a/XMonad/Util/DebugWindow.hs b/XMonad/Util/DebugWindow.hs --- a/XMonad/Util/DebugWindow.hs +++ b/XMonad/Util/DebugWindow.hs @@ -57,9 +57,7 @@ \s -> if null s then Nothing else let (w'',s'') = break (== '\NUL') s - s' = if null s'' - then s'' - else tail s'' + s' = drop 1 s'' in Just (w'',s') t <- catchX' (wrap <$> getEWMHTitle "VISIBLE" w) $ catchX' (wrap <$> getEWMHTitle "" w) $ @@ -107,8 +105,7 @@ getEWMHTitle :: String -> Window -> X String getEWMHTitle sub w = do a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME" - (Just t) <- withDisplay $ \d -> io $ getWindowProperty32 d a w - return $ map (toEnum . fromEnum) t + getDecodedStringProp w a -- should always be UTF8_STRING but rules are made to be broken getICCCMTitle :: Window -> X String getICCCMTitle w = getDecodedStringProp w wM_NAME @@ -116,7 +113,7 @@ getDecodedStringProp :: Window -> Atom -> X String getDecodedStringProp w a = do t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a - [s] <- catchX' (tryUTF8 t) $ + [s] <- catchX' (tryUTF8 t) $ -- shouldn't happen but some apps do it catchX' (tryCompound t) $ io ((:[]) <$> peekCString t') return s @@ -125,7 +122,7 @@ tryUTF8 (TextProperty s enc _ _) = do uTF8_STRING <- getAtom "UTF8_STRING" when (enc /= uTF8_STRING) $ error "String is not UTF8_STRING" - map decodeString . splitNul <$> io (peekCString s) + map decodeString . splitNul <$> io (peekCAString s) tryCompound :: TextProperty -> X [String] tryCompound t@(TextProperty _ enc _ _) = do @@ -203,7 +200,7 @@ 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 @@ -215,10 +212,10 @@ 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. + -- 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') + go (a:as) t = simplify "_NET_WM_STATE_" a >>= \t' -> go as (t ++ ' ':t') diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.EZConfig @@ -23,6 +25,7 @@ -- * Adding or removing keybindings additionalKeys, additionalKeysP, + remapKeysP, removeKeys, removeKeysP, additionalMouseBindings, removeMouseBindings, @@ -49,11 +52,13 @@ import XMonad.Util.Parser import Control.Arrow (first, (&&&)) +import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import Data.Ord (comparing) +import Data.List.NonEmpty (nonEmpty) -- $usage --- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@: +-- To use this module, first import it into your @xmonad.hs@: -- -- > import XMonad.Util.EZConfig -- @@ -90,6 +95,7 @@ additionalKeys :: XConfig a -> [((KeyMask, KeySym), X ())] -> XConfig a additionalKeys conf keyList = conf { keys = M.union (M.fromList keyList) . keys conf } +infixl 4 `additionalKeys` -- | Like 'additionalKeys', except using short @String@ key -- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as @@ -104,8 +110,44 @@ additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l additionalKeysP conf keyList = conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) } +infixl 4 `additionalKeysP` -- | +-- Remap keybindings from one binding to another. More precisely, the +-- input list contains pairs of the form @(TO, FROM)@, and maps the +-- action bound to @FROM@ to the key @TO@. For example, the following +-- would bind @"M-m"@ to what's bound to @"M-c"@ (which is to close the +-- focused window, in this case): +-- +-- > main :: IO () +-- > main = xmonad $ def `remapKeysP` [("M-m", "M-c")] +-- +-- NOTE: Submaps are not transparent, and thus these keys can't be +-- accessed in this way: more explicitly, the @FROM@ string may **not** +-- be a submap. However, the @TO@ can be a submap without problems. +-- This means that +-- +-- > xmonad $ def `remapKeysP` [("M-m", "M-c a")] +-- +-- is illegal (and indeed will just disregard the binding altogether), +-- while +-- +-- > xmonad $ def `remapKeysP` [("M-c a", "M-m")] +-- +-- is totally fine. +remapKeysP :: XConfig l -> [(String, String)] -> XConfig l +remapKeysP conf keyList = + conf { keys = \cnf -> mkKeymap cnf (keyList' cnf) <> keys conf cnf } + where + keyList' :: XConfig Layout -> [(String, X ())] + keyList' cnf = + mapMaybe (traverse (\s -> case readKeySequence cnf s of + Just (ks :| []) -> keys conf cnf M.!? ks + _ -> Nothing)) + keyList +infixl 4 `remapKeysP` + +-- | -- Remove standard keybindings you're not using. Example use: -- -- > main = xmonad $ def { terminal = "urxvt" } @@ -113,6 +155,7 @@ removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a removeKeys conf keyList = conf { keys = \cnf -> foldr M.delete (keys conf cnf) keyList } +infixl 4 `removeKeys` -- | Like 'removeKeys', except using short @String@ key descriptors -- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the @@ -123,17 +166,20 @@ removeKeysP :: XConfig l -> [String] -> XConfig l removeKeysP conf keyList = - conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) } + conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (map (, return ()) keyList) } +infixl 4 `removeKeysP` -- | Like 'additionalKeys', but for mouse bindings. additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a additionalMouseBindings conf mouseBindingsList = conf { mouseBindings = M.union (M.fromList mouseBindingsList) . mouseBindings conf } +infixl 4 `additionalMouseBindings` -- | Like 'removeKeys', but for mouse bindings. removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a removeMouseBindings conf mouseBindingList = conf { mouseBindings = \cnf -> foldr M.delete (mouseBindings conf cnf) mouseBindingList } +infixl 4 `removeMouseBindings` -------------------------------------------------------------- @@ -383,35 +429,40 @@ -- | Given a list of pairs of parsed key sequences and actions, -- group them into submaps in the appropriate way. -mkNamedSubmaps :: [([(KeyMask, KeySym)], NamedAction)] -> [((KeyMask, KeySym), NamedAction)] +mkNamedSubmaps :: [(NonEmpty (KeyMask, KeySym), NamedAction)] -> [((KeyMask, KeySym), NamedAction)] mkNamedSubmaps = mkSubmaps' submapName -mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())] +mkSubmaps :: [ (NonEmpty (KeyMask, KeySym), X ()) ] -> [((KeyMask, KeySym), X ())] mkSubmaps = mkSubmaps' $ submap . M.fromList -mkSubmaps' :: (Ord a) => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)] +mkSubmaps' :: forall a b. (Ord a) => ([(a, b)] -> b) -> [(NonEmpty a, b)] -> [(a, b)] mkSubmaps' subm binds = map combine gathered - where gathered = groupBy fstKey - . sortBy (comparing fst) - $ binds - combine [([k],act)] = (k,act) - combine ks = (head . fst . head $ ks, - subm . mkSubmaps' subm $ map (first tail) ks) - fstKey = (==) `on` (head . fst) + where + gathered :: [[(NonEmpty a, b)]] + gathered = groupBy fstKey . sortBy (comparing fst) $ binds + combine :: [(NonEmpty a, b)] -> (a, b) + combine [(k :| [], act)] = (k, act) + combine ks = ( NE.head . fst . NE.head . notEmpty $ ks + , subm . mkSubmaps' subm $ map (first (notEmpty . NE.drop 1)) ks + ) + + fstKey :: (NonEmpty a, b) -> (NonEmpty a, b) -> Bool + fstKey = (==) `on` (NE.head . fst) + -- | Given a configuration record and a list of (key sequence -- description, action) pairs, parse the key sequences into lists of -- @(KeyMask,KeySym)@ pairs. Key sequences which fail to parse will -- be ignored. -readKeymap :: XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)] +readKeymap :: XConfig l -> [(String, t)] -> [(NonEmpty (KeyMask, KeySym), t)] readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c)) where maybeKeys (Nothing,_) = Nothing maybeKeys (Just k, act) = Just (k, act) -- | Parse a sequence of keys, returning Nothing if there is -- a parse failure (no parse, or ambiguous parse). -readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)] -readKeySequence c = runParser (parseKeySequence c <* eof) +readKeySequence :: XConfig l -> String -> Maybe (NonEmpty (KeyMask, KeySym)) +readKeySequence c = nonEmpty <=< runParser (parseKeySequence c <* eof) -- | Parse a sequence of key combinations separated by spaces, e.g. -- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2). @@ -437,7 +488,7 @@ return $ indexMod (read [n] - 1) where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] --- | Parse an unmodified basic key, like @\"x\"@, @\"\"@, etc. +-- | Parse an unmodified basic key, like @\"x\"@, @\"\\"@, etc. parseKey :: Parser KeySym parseKey = parseSpecial <> parseRegular @@ -501,8 +552,8 @@ doKeymapCheck conf km = (bad,dups) where ks = map ((readKeySequence conf &&& id) . fst) km bad = nub . map snd . filter (isNothing . fst) $ ks - dups = map (snd . head) - . filter ((>1) . length) + dups = map (snd . NE.head) + . mapMaybe nonEmpty . groupBy ((==) `on` fst) . sortBy (comparing fst) . map (first fromJust) diff --git a/XMonad/Util/ExclusiveScratchpads.hs b/XMonad/Util/ExclusiveScratchpads.hs --- a/XMonad/Util/ExclusiveScratchpads.hs +++ b/XMonad/Util/ExclusiveScratchpads.hs @@ -15,7 +15,9 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.ExclusiveScratchpads ( +module XMonad.Util.ExclusiveScratchpads + {-# DEPRECATED "Use the exclusive scratchpad functionality of \"XMonad.Util.NamedScratchpad\" insead." #-} + ( -- * Usage -- $usage mkXScratchpads, @@ -37,13 +39,14 @@ customFloating ) where -import XMonad.Prelude (appEndo, filterM, liftA2, (<=<)) +import XMonad.Prelude import XMonad import XMonad.Actions.Minimize import XMonad.Actions.TagWindows (addTag,delTag) import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty) import qualified XMonad.StackSet as W +import qualified Data.List.NonEmpty as NE -- $usage -- @@ -51,7 +54,7 @@ -- "XMonad.Layout.Minimize", please refer to the documentation of these modules for more -- information on how to configure them. -- --- To use this module, put the following in your @~\/.xmonad\/xmonad.hs@: +-- To use this module, put the following in your @xmonad.hs@: -- -- > import XMonad.Utils.ExclusiveScratchpads -- > import XMonad.ManageHook (title,appName) @@ -71,11 +74,12 @@ -- -- > scratchpads = exclusiveSps ++ regularSps -- --- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook"), eg.: +-- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook" or +-- ); e.g., -- -- > manageHook = myManageHook <> xScratchpadsManageHook scratchpads -- --- And finally add some keybindings (see "XMonad.Doc.Extending#Editing_key_bindings"): +-- And finally add some keybindings (see ): -- -- > , ((modMask, xK_h), scratchpadAction scratchpads "htop") -- > , ((modMask, xK_c), scratchpadAction scratchpads "xclock") @@ -171,8 +175,8 @@ let ys = filterM (flip runQuery w . query) xs unlessX (null <$> ys) $ do - mh <- head . map hook <$> ys -- ys /= [], so `head` is fine - n <- head . map name <$> ys -- same + mh <- NE.head . notEmpty . map hook <$> ys -- ys /= [], so `head` is fine + n <- NE.head . notEmpty . map name <$> ys -- same (windows . appEndo <=< runQuery mh) w hideOthers xs n diff --git a/XMonad/Util/Font.hs b/XMonad/Util/Font.hs --- a/XMonad/Util/Font.hs +++ b/XMonad/Util/Font.hs @@ -123,12 +123,15 @@ if xftPrefix `isPrefixOf` s then do dpy <- asks display let fonts = case wordsBy (== ',') (drop (length xftPrefix) s) of - [] -> "xft:monospace" :| [] -- NE.singleton only in base 4.15 + [] -> fallback :| [] -- NE.singleton only in base 4.15 (x : xs) -> x :| xs - Xft <$> io (traverse (openFont dpy) fonts) + fb <- io $ openFont dpy fallback + fmap Xft . io $ traverse (\f -> E.catch (openFont dpy f) (econst $ pure fb)) + fonts else Utf8 <$> initUtf8Font s where xftPrefix = "xft:" + fallback = "xft:monospace" openFont dpy str = xftFontOpen dpy (defaultScreenOfDisplay dpy) str wordsBy p str = case dropWhile p str of "" -> [] diff --git a/XMonad/Util/History.hs b/XMonad/Util/History.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/History.hs @@ -0,0 +1,128 @@ +{-# LANGUAGE NamedFieldPuns, DeriveTraversable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.History +-- Description : Track history in /O(log n)/ time. +-- Copyright : (c) 2022 L. S. Leary +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : @LSLeary (on github) +-- Stability : unstable +-- Portability : unportable +-- +-- Provides 'History', a variation on a LIFO stack with a uniqueness property. +-- In order to achieve the desired asymptotics, the data type is implemented as +-- an ordered Map. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.History ( + History, + origin, + event, + erase, + recall, + ledger, + transcribe, + ) where + +-- base +import Data.Function (on) +import Text.Read + ( Read(readPrec, readListPrec), Lexeme(Ident) + , parens, prec, lexP, step, readListPrecDefault + ) + +-- containers +import Data.IntMap (IntMap) +import qualified Data.IntMap.Strict as I +import Data.Map (Map) +import qualified Data.Map.Strict as M + + +-- | A history of unique @k@-events with @a@-annotations. +-- +-- @History k a@ can be considered a (LIFO) stack of @(k, a)@ values with the +-- property that each @k@ is unique. From this point of view, 'event' pushes +-- and 'ledger' pops/peeks all. +-- +-- The naive implementation has /O(n)/ 'event' and 'erase' due to the +-- uniqueness condition, but we can still use it as a denotation: +-- +-- > mu :: History k a -> [(k, a)] +-- +-- As an opaque data type with strict operations, @History k a@ values are all +-- finite expressions in the core interface: 'origin', 'erase' and 'event'. +-- Hence we define @mu@ by structural induction on these three cases. +-- +data History k a = History + { annals :: !(IntMap (k, a)) + , recorded :: !(Map k Int) + } deriving (Functor, Foldable, Traversable) + +instance (Eq k, Eq a) => Eq (History k a) where (==) = (==) `on` ledger +instance (Ord k, Ord a) => Ord (History k a) where compare = compare `on` ledger + +instance (Show k, Show a) => Show (History k a) where + showsPrec d h + = showParen (d > app_prec) + $ showString "transcribe " + . showsPrec (app_prec+1) (ledger h) + where app_prec = 10 + +instance (Read k, Read a, Ord k) => Read (History k a) where + readPrec = parens . prec app_prec $ do + Ident "transcribe" <- lexP + l <- step readPrec + pure (transcribe l) + where app_prec = 10 + readListPrec = readListPrecDefault + + +-- | /O(1)/. A history of nothing. +-- +-- > mu origin := [] +-- +origin :: History k a +origin = History I.empty M.empty + +-- | /O(log n)/. A new event makes history; its predecessor forgotten. +-- +-- > mu (event k a h) := (k, a) : mu (erase k h) +-- +event :: Ord k => k -> a -> History k a -> History k a +event k a History{annals,recorded} = History + { annals = I.insert ik (k, a) . maybe id I.delete mseen $ annals + , recorded = recorded' + } + where + ik = maybe 0 (\((i, _), _) -> pred i) (I.minViewWithKey annals) + (mseen, recorded') = M.insertLookupWithKey (\_ x _ -> x) k ik recorded + +-- | /O(log n)/. Erase an event from history. +-- +-- > mu (erase k h) := filter ((k /=) . fst) (mu h) +-- +erase :: Ord k => k -> History k a -> History k a +erase k History{annals,recorded} = History + { annals = maybe id I.delete mseen annals + , recorded = recorded' + } + where (mseen, recorded') = M.updateLookupWithKey (\_ _ -> Nothing) k recorded + + +-- | /O(log n)/. Recall an event. +recall :: Ord k => k -> History k a -> Maybe a +recall k History{annals,recorded} = do + ik <- M.lookup k recorded + (_, a) <- I.lookup ik annals + pure a + +-- | /O(n)/. Read history, starting with the modern day. @ledger@ is @mu@. +ledger :: History k a -> [(k, a)] +ledger = I.elems . annals + +-- | /O(n * log n)/. Transcribe a ledger. +transcribe :: Ord k => [(k, a)] -> History k a +transcribe = foldr (uncurry event) origin diff --git a/XMonad/Util/Image.hs b/XMonad/Util/Image.hs --- a/XMonad/Util/Image.hs +++ b/XMonad/Util/Image.hs @@ -22,7 +22,8 @@ ) where import XMonad -import XMonad.Util.Font (stringToPixel,fi) +import XMonad.Prelude +import XMonad.Util.Font (stringToPixel) -- | Placement of the icon in the title bar data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner @@ -42,7 +43,7 @@ -- | Gets the ('width', 'height') of an image imageDims :: [[Bool]] -> (Int, Int) -imageDims img = (length (head img), length img) +imageDims img = (length (fromMaybe [] (listToMaybe img)), length img) -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing -- the image given its 'Placement' diff --git a/XMonad/Util/Loggers.hs b/XMonad/Util/Loggers.hs --- a/XMonad/Util/Loggers.hs +++ b/XMonad/Util/Loggers.hs @@ -35,13 +35,16 @@ -- $xmonad , logCurrent, logLayout , logTitle, logTitles, logTitles' + , logClassname, logClassnames, logClassnames' , logConst, logDefault, (.|) -- * XMonad: Screen-specific Loggers -- $xmonad-screen , logCurrentOnScreen, logLayoutOnScreen - , logTitleOnScreen, logWhenActive + , logTitleOnScreen, logClassnameOnScreen, logWhenActive , logTitlesOnScreen, logTitlesOnScreen' + , logClassnamesOnScreen, logClassnamesOnScreen' , TitlesFormat(..) + , ClassnamesFormat(..) -- * Formatting Utilities -- $format , onLogger @@ -58,7 +61,7 @@ import XMonad.Hooks.StatusBar.PP import XMonad.Hooks.UrgencyHook (readUrgents) import XMonad.Util.Font (Align (..)) -import XMonad.Util.NamedWindows (getName) +import XMonad.Util.NamedWindows (getName, getNameWMClass) import Control.Exception as E import XMonad.Prelude (find, fromMaybe, isPrefixOf, isSuffixOf, WindowScreen) @@ -71,7 +74,7 @@ econst = const . return -- $usage --- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@: +-- Use this module by importing it into your @xmonad.hs@: -- -- > import XMonad.Util.Loggers -- @@ -175,9 +178,13 @@ -- example you can loggerize the number of windows on each workspace, or -- titles on other workspaces, or the id of the previously focused workspace.... +-- | Internal function to get a wrapped title string from a window +fetchWindowTitle :: Window -> X String +fetchWindowTitle = fmap show . getName + -- | Get the title (name) of the focused window. logTitle :: Logger -logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek +logTitle = logWindowInfoFocusedWindow fetchWindowTitle -- | Get the titles of all windows on the visible workspace of the given -- screen and format them according to the given functions. @@ -199,41 +206,24 @@ -> (String -> String) -- ^ Formatting for the unfocused window -> Logger logTitlesOnScreen sid formatFoc formatUnfoc = - logTitlesOnScreen' sid TitlesFormat{ focusedFormat = formatFoc - , unfocusedFormat = formatUnfoc - , urgentFormat = formatUnfoc - } + logWindowInfoOnScreen fetchWindowTitle sid formatFoc formatUnfoc formatUnfoc -- | Like 'logTitlesOnScreen' but with support for urgent windows. To -- be used with "XMonad.Hooks.UrgencyHook". logTitlesOnScreen' :: ScreenId -> TitlesFormat -> Logger logTitlesOnScreen' sid (TitlesFormat formatFoc formatUnfoc formatUrg) = - (`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 logger wins winNames + logWindowInfoOnScreen fetchWindowTitle sid formatFoc formatUnfoc formatUrg -- | Like 'logTitlesOnScreen', but directly use the "focused" screen -- (the one with the currently focused workspace). logTitles :: (String -> String) -> (String -> String) -> Logger -logTitles formatFoc formatUnfoc = do - sid <- gets $ W.screen . W.current . windowset - logTitlesOnScreen sid formatFoc formatUnfoc +logTitles formatFoc formatUnfoc = + logWindowInfoFocusedScreen fetchWindowTitle formatFoc formatUnfoc formatUnfoc -- | Variant of 'logTitles', but with support for urgent windows. logTitles' :: TitlesFormat -> Logger -logTitles' formatter = - gets (W.screen . W.current . windowset) >>= (`logTitlesOnScreen'` formatter) +logTitles' (TitlesFormat formatFoc formatUnfoc formatUrg) = + logWindowInfoFocusedScreen fetchWindowTitle formatFoc formatUnfoc formatUrg -- | Formatting applied to the titles of certain windows. data TitlesFormat = TitlesFormat @@ -246,11 +236,114 @@ -- 'logTitlesOnScreen''. instance Default TitlesFormat where def = TitlesFormat - { focusedFormat = wrap "[" "]" . xmobarRaw . shorten 30 . xmobarStrip - , unfocusedFormat = xmobarRaw . shorten 30 . xmobarStrip - , urgentFormat = wrap "!" "!" . xmobarRaw . shorten 30 . xmobarStrip + { focusedFormat = xmobarFocusedFormat + , unfocusedFormat = xmobarWsFormat + , urgentFormat = xmobarUrgentFormat } +-- | Internal function to get a wrapped classname string from a window +fetchWindowClassname :: Window -> X String +fetchWindowClassname = fmap show . getNameWMClass + +-- | Get the classname of the focused window. +logClassname :: Logger +logClassname = logWindowInfoFocusedWindow fetchWindowClassname + +-- | Get the classnames of all windows on the visible workspace of the given +-- screen and format them according to the given functions. +logClassnamesOnScreen + :: ScreenId -- ^ Screen to log the classnames on + -> (String -> String) -- ^ Formatting for the focused window + -> (String -> String) -- ^ Formatting for the unfocused window + -> Logger +logClassnamesOnScreen sid formatFoc formatUnfoc = + logWindowInfoOnScreen fetchWindowClassname sid formatFoc formatUnfoc formatUnfoc + +-- | Like 'logClassnamesOnScreen' but with support for urgent windows. To +-- be used with "XMonad.Hooks.UrgencyHook". +logClassnamesOnScreen' :: ScreenId -> ClassnamesFormat -> Logger +logClassnamesOnScreen' sid (ClassnamesFormat formatFoc formatUnfoc formatUrg) = + logWindowInfoOnScreen fetchWindowClassname sid formatFoc formatUnfoc formatUrg + +-- | Like 'logClassnamesOnScreen', but directly use the "focused" screen +-- (the one with the currently focused workspace). +logClassnames :: (String -> String) -> (String -> String) -> Logger +logClassnames formatFoc formatUnfoc = + logWindowInfoFocusedScreen fetchWindowClassname formatFoc formatUnfoc formatUnfoc + +-- | Variant of 'logClassnames', but with support for urgent windows. +logClassnames' :: ClassnamesFormat -> Logger +logClassnames' (ClassnamesFormat formatFoc formatUnfoc formatUrg) = + logWindowInfoFocusedScreen fetchWindowClassname formatFoc formatUnfoc formatUrg + +-- | Formatting applied to the classnames of certain windows. +data ClassnamesFormat = ClassnamesFormat + { focusedFormatClassname :: String -> String -- ^ Focused formatting. + , unfocusedFormatClassname :: String -> String -- ^ Unfocused formatting. + , urgentFormatClassname :: String -> String -- ^ Formatting when urgent. + } + +-- | How to format these classnames by default when using 'logClassnames'' and +-- 'logClassnamesOnScreen''. +instance Default ClassnamesFormat where + def = ClassnamesFormat + { focusedFormatClassname = xmobarFocusedFormat + , unfocusedFormatClassname = xmobarWsFormat + , urgentFormatClassname = xmobarUrgentFormat + } + +-- | Internal function to get the specified window information for all windows on +-- the visible workspace of the given screen and format them according to the +-- given functions. +logWindowInfoOnScreen + :: (Window -> X String) + -> ScreenId + -> (String -> String) + -> (String -> String) + -> (String -> String) + -> Logger +logWindowInfoOnScreen getWindowInfo sid formatFoc formatUnfoc formatUrg = + (`withScreen` sid) $ \screen -> do + let focWin = fmap W.focus . W.stack . W.workspace $ screen + urgWins <- readUrgents + logWindowInfoOnScreenWorker getWindowInfo screen $ \win name -> + if | Just win == focWin -> formatFoc name + | win `elem` urgWins -> formatUrg name + | otherwise -> formatUnfoc name + +-- | Internal helper function for 'logWindowInfoOnScreen'. +logWindowInfoOnScreenWorker + :: (Window -> X String) + -> WindowScreen + -> (Window -> String -> String) + -> Logger +logWindowInfoOnScreenWorker getWindowInfo screen logger = do + let wins = maybe [] W.integrate . W.stack . W.workspace $ screen + winNames <- traverse getWindowInfo wins + pure . Just . unwords $ zipWith logger wins winNames + +-- | Internal. Like 'logWindowInfoOnScreen', but directly use the "focused" screen +-- (the one with the currently focused workspace). +logWindowInfoFocusedScreen + :: (Window -> X String) + -> (String -> String) + -> (String -> String) + -> (String -> String) + -> Logger +logWindowInfoFocusedScreen getWindowInfo formatFoc formatUnfoc formatUrg = do + sid <- gets $ W.screen . W.current . windowset + logWindowInfoOnScreen getWindowInfo sid formatFoc formatUnfoc formatUrg + +-- | Internal function to get the specified information for the currently focused window +logWindowInfoFocusedWindow :: (Window -> X String) -> Logger +logWindowInfoFocusedWindow getWindowInfo = withWindowSet $ traverse getWindowInfo . W.peek + +-- | Internal formatting helpers +xmobarWsFormat, xmobarFocusedFormat, xmobarUrgentFormat :: String -> String +xmobarWsFormat = xmobarRaw . shorten 30 . xmobarStrip +xmobarFocusedFormat = wrap "[" "]" . xmobarWsFormat +xmobarUrgentFormat = wrap "!" "!" . xmobarWsFormat + -- | Get the name of the current layout. logLayout :: Logger logLayout = withWindowSet $ return . Just . ld @@ -297,9 +390,18 @@ -- | Get the title (name) of the focused window, on the given screen. logTitleOnScreen :: ScreenId -> Logger -logTitleOnScreen = +logTitleOnScreen = logWindowInfoFocusedWindowOnScreen fetchWindowTitle + +-- | Get the classname of the focused window, on the given screen. +logClassnameOnScreen :: ScreenId -> Logger +logClassnameOnScreen = logWindowInfoFocusedWindowOnScreen fetchWindowClassname + +-- | Internal function to get the specified information for the focused window, +-- on the given screen. +logWindowInfoFocusedWindowOnScreen :: (Window -> X String) -> ScreenId -> Logger +logWindowInfoFocusedWindowOnScreen getWindowInfo = withScreen - $ traverse (fmap show . getName) + $ traverse getWindowInfo . (W.focus <$>) . W.stack . W.workspace diff --git a/XMonad/Util/Loggers/NamedScratchpad.hs b/XMonad/Util/Loggers/NamedScratchpad.hs --- a/XMonad/Util/Loggers/NamedScratchpad.hs +++ b/XMonad/Util/Loggers/NamedScratchpad.hs @@ -9,7 +9,7 @@ -- Stability : unstable -- Portability : unportable -- --- 'XMonad.Util.Loggers' for 'XMonad.Util.NamedScratchpad' +-- "XMonad.Util.Loggers" for "XMonad.Util.NamedScratchpad" -- ----------------------------------------------------------------------------- @@ -50,7 +50,7 @@ -- (This is difficult to change; "minimizing" by moving it back to 'NSP' -- is even harder.) -- I hide the 'NamedScratchpad's from the taskbar and use this to track --- them instead (see 'XMonad.Util.NoTaskbar'). +-- them instead (see "XMonad.Util.NoTaskbar"). -- The extension data for tracking NSP windows newtype NSPTrack = NSPTrack [Maybe Window] diff --git a/XMonad/Util/NamedActions.hs b/XMonad/Util/NamedActions.hs --- a/XMonad/Util/NamedActions.hs +++ b/XMonad/Util/NamedActions.hs @@ -205,7 +205,7 @@ addDescrKeys' (k,f) ks conf = let shk l = f $ [(k,f $ ks l)] ^++^ ks l keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)] - in conf { keys = keylist } + in conf { keys = keylist <> keys conf } -- | A version of the default keys from the default configuration, but with -- 'NamedAction' instead of @X ()@ diff --git a/XMonad/Util/NamedScratchpad.hs b/XMonad/Util/NamedScratchpad.hs --- a/XMonad/Util/NamedScratchpad.hs +++ b/XMonad/Util/NamedScratchpad.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedScratchpad @@ -30,37 +31,48 @@ allNamedScratchpadAction, namedScratchpadManageHook, nsHideOnFocusLoss, + nsSingleScratchpadPerWorkspace, -- * Dynamic Scratchpads -- $dynamic-scratchpads dynamicNSPAction, toggleDynamicNSP, + -- * Exclusive Scratchpads + -- $exclusive-scratchpads + addExclusives, + -- ** Keyboard related + resetFocusedNSP, + -- ** Mouse related + setNoexclusive, + resizeNoexclusive, + floatMoveNoexclusive, + -- * Deprecations namedScratchpadFilterOutWorkspace, namedScratchpadFilterOutWorkspacePP, ) where -import Data.Coerce (coerce) import Data.Map.Strict (Map, (!?)) import XMonad import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) import XMonad.Actions.SpawnOn (spawnHere) +import XMonad.Actions.TagWindows (addTag, delTag) import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Hooks.RefocusLast (withRecentsIn) import XMonad.Hooks.StatusBar.PP (PP, ppSort) -import XMonad.Prelude (filterM, unless, when) +import XMonad.Prelude (appEndo, filterM, findM, foldl', for_, liftA2, unless, void, when, (<=<)) -import qualified Data.Map.Strict as Map import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -- $usage -- Allows to have several floating scratchpads running different applications. --- Bind a key to 'namedScratchpadSpawnAction'. +-- Bind a key to 'namedScratchpadAction'. -- Pressing it will spawn configured application, or bring it to the current -- workspace if it already exists. -- Pressing the key with the application on the current workspace will @@ -101,7 +113,7 @@ -- > , manageHook = namedScratchpadManageHook scratchpads -- -- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings" +-- -- -- For some applications (like displaying your workspaces in a status bar) it -- is convenient to filter out the @NSP@ workspace when looking at all @@ -111,6 +123,25 @@ -- the list of workspaces from EWMH. See the documentation of these functions -- for examples. -- +-- If you want to explore this module further, scratchpads can come in +-- many forms and flavours: +-- +-- + \"Regular\" scratchpads: they can be predefined and +-- summoned/banished with a key press. These are the scratchpads +-- that you have seen above. +-- +-- + [Dynamic scratchpads](#g:dynamic-scratchpads), which allow you to +-- dynamically declare existing windows as scratchpads. These can +-- be treated as a separate type of scratchpad. +-- +-- + [Exclusive](#g:exclusive-scratchpads) scratchpads, which can be +-- seen as a property of already existing scratchpads. Marking +-- scratchpads as exclusive will not allow them to be shown on the +-- same workspace; the scratchpad being brought up will hide the +-- others. +-- +-- See the relevant sections in the documentation for more information. +-- -- Further, there is also a @logHook@ that you can use to hide -- scratchpads when they lose focus; this is functionality akin to what -- some dropdown terminals provide. See the documentation of @@ -124,23 +155,51 @@ , 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) +-- | The NSP state. +data NSPState = NSPState + { nspExclusives :: !(Map String NamedScratchpads) + -- ^ Associates the name of a scratchpad to some list of scratchpads + -- that should be mutually exclusive to it. + , nspScratchpads :: !(Map String NamedScratchpad) + -- ^ Associates a name to an entire scratchpad. + } instance ExtensionClass NSPState where initialValue :: NSPState - initialValue = NSPState mempty + initialValue = NSPState mempty 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. +-- | Try to: +-- +-- (i) Fill the 'nspScratchpads' portion of the 'NSPState' with the +-- given list of scratchpads. In case that particular map of the +-- state is already non-empty, don't do anything and return that +-- state. +-- +-- (ii) Replace possibly dummy scratchpads in @nspExclusives@ with +-- proper values. For convenience, the user may specify +-- exclusive scratchpads by name in the startup hook. However, +-- we don't necessarily have all information then to immediately +-- turn these into proper NamedScratchpads. As such, we thinly +-- wrap the names into an NSP skeleton, to be filled in later. +-- This function, to be executed _before_ +-- 'someNamedScratchpadAction' is the (latest) point where that +-- happens. fillNSPState :: NamedScratchpads -> X NSPState fillNSPState nsps = do - nsp@(NSPState xs) <- XS.get - let nspState = NSPState . Map.fromList $ zip (map name nsps) nsps - if null xs - then nspState <$ XS.put nspState - else pure nsp + nsp@(NSPState exs scratches) <- XS.get + if null scratches + then let nspState = NSPState (fillOut exs) nspScratches + in nspState <$ XS.put nspState + else pure nsp + where + -- @fillNSPState@ only runs once, so the complexity here is probably + -- not a big deal. + nspScratches :: Map String NamedScratchpad + nspScratches = Map.fromList $ zip (map name nsps) nsps + fillOut :: Map String [NamedScratchpad] -> Map String [NamedScratchpad] + fillOut exs = foldl' (\nspMap n -> Map.map (replaceWith n) nspMap) exs nsps + replaceWith :: NamedScratchpad -> [NamedScratchpad] -> [NamedScratchpad] + replaceWith n = map (\x -> if name x == name n then n else x) -- | Manage hook that makes the window non-floating nonFloating :: ManageHook @@ -154,6 +213,11 @@ customFloating :: W.RationalRect -> ManageHook customFloating = doRectFloat +-- | @isNSP win nsps@ checks whether the window @win@ is any scratchpad +-- in @nsps@. +isNSP :: Window -> NamedScratchpads -> X Bool +isNSP w = fmap or . traverse ((`runQuery` w) . query) + -- | Named scratchpads configuration type NamedScratchpads = [NamedScratchpad] @@ -221,15 +285,58 @@ -- > -- enable hiding for all of @myScratchpads@ -- > } nsHideOnFocusLoss :: NamedScratchpads -> X () -nsHideOnFocusLoss scratches = withWindowSet $ \winSet -> do +nsHideOnFocusLoss scratches = + nsHideOnCondition $ \ lastFocus _curFoc _ws hideScratch -> + whenX (isNSP lastFocus scratches) $ + hideScratch lastFocus + +-- | A @logHook@ to have only one active scratchpad on a workspace. This can +-- be useful when working with multiple floating scratchpads which would +-- otherwise be stacked. Note that this also requires you to use the +-- 'XMonad.Hooks.RefocusLast.refocusLastLogHook'. +-- +-- ==== __Example__ +-- +-- > import XMonad.Hooks.RefocusLast (refocusLastLogHook) +-- > import XMonad.Util.NamedScratchpad +-- > +-- > main = xmonad $ def +-- > { logHook = refocusLastLogHook +-- > >> nsHideOnNewScratchpad myScratchpads +-- > -- enable hiding for all of @myScratchpads@ +-- > } +nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X () +nsSingleScratchpadPerWorkspace scratches = + nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do + allScratchesButCurrent <- + filterM (liftA2 (<||>) (pure . (/= curFocus)) (`isNSP` scratches)) + (W.index winSet) + whenX (isNSP curFocus scratches) $ + for_ allScratchesButCurrent hideScratch + +-- | Hide scratchpads according to some condition. See 'nsHideOnFocusLoss' and +-- 'nsSingleScratchpadPerWorkspace' for usage examples. +nsHideOnCondition + :: ( Window -- Last focus. + -> Window -- Current focus. + -> WindowSet -- Current windowset. + -> (Window -> X ()) -- A function to hide the named scratchpad. + -> X ()) + -> X () +nsHideOnCondition cond = withWindowSet $ \winSet -> do let cur = W.currentTag winSet - withRecentsIn cur () $ \lastFocus _ -> - when (lastFocus `elem` W.index winSet && cur /= scratchpadWorkspaceTag) $ - whenX (isNS lastFocus) $ - shiftToNSP (W.workspaces winSet) ($ lastFocus) - where - isNS :: Window -> X Bool - isNS w = or <$> traverse ((`runQuery` w) . query) scratches + withRecentsIn cur () $ \lastFocus curFocus -> do + let hideScratch :: Window -> X () + hideScratch win = shiftToNSP (W.workspaces winSet) ($ win) + isWorthy = + -- Check for the window being on the current workspace; if there + -- is no history (i.e., curFocus ≡ lastFocus), don't do anything + -- because the potential scratchpad is definitely focused. + lastFocus `elem` W.index winSet && lastFocus /= curFocus + -- Don't do anything on the NSP workspace, lest the world explodes. + && cur /= scratchpadWorkspaceTag + when isWorthy $ + cond lastFocus curFocus winSet hideScratch -- | Execute some action on a named scratchpad. -- @@ -241,19 +348,23 @@ -> String -> X () someNamedScratchpadAction f runApp _ns scratchpadName = do - NSPState scratchpadConfig <- fillNSPState _ns -- See Note [Filling NSPState] - case scratchpadConfig !? scratchpadName of + NSPState{ nspScratchpads } <- fillNSPState _ns -- See Note [Filling NSPState] + case nspScratchpads !? scratchpadName of Just conf -> withWindowSet $ \winSet -> do - let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ winSet) + let focusedWspWindows = W.index winSet allWindows = W.allWindows winSet matchingOnCurrent <- filterM (runQuery (query conf)) focusedWspWindows matchingOnAll <- filterM (runQuery (query conf)) allWindows case NE.nonEmpty matchingOnCurrent of -- no matching window on the current workspace -> scratchpad not running or in background - Nothing -> case NE.nonEmpty matchingOnAll of - Nothing -> runApp conf - Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins + Nothing -> do + -- summon the scratchpad + case NE.nonEmpty matchingOnAll of + Nothing -> runApp conf + Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins + -- check for exclusive scratchpads to hide + hideUnwanted (name conf) -- matching window running on current workspace -> window should be shifted to scratchpad workspace Just wins -> shiftToNSP (W.workspaces winSet) (`f` wins) @@ -284,7 +395,7 @@ namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration -> ManageHook namedScratchpadManageHook nsps = do - ns <- Map.elems . coerce <$> liftX (fillNSPState nsps) + ns <- Map.elems . nspScratchpads <$> liftX (fillNSPState nsps) composeAll $ fmap (\c -> query c --> hook c) ns -- | Shift some windows to the scratchpad workspace according to the @@ -339,11 +450,12 @@ -- | Make a window a dynamic scratchpad addDynamicNSP :: String -> Window -> X () -addDynamicNSP s w = XS.modify @NSPState . coerce $ Map.insert s (mkDynamicNSP s w) +addDynamicNSP s w = XS.modify $ \(NSPState exs ws) -> + NSPState exs (Map.insert s (mkDynamicNSP s w) ws) -- | Make a window stop being a dynamic scratchpad removeDynamicNSP :: String -> X () -removeDynamicNSP s = XS.modify @NSPState . coerce $ Map.delete @_ @NamedScratchpad s +removeDynamicNSP s = XS.modify $ \(NSPState exs ws) -> NSPState exs (Map.delete s ws) -- | Toggle the visibility of a dynamic scratchpad. dynamicNSPAction :: String -> X () @@ -353,12 +465,139 @@ -- 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 + NSPState{ nspScratchpads } <- XS.get + case nspScratchpads !? s of Nothing -> addDynamicNSP s w Just nsp -> ifM (runQuery (query nsp) w) (removeDynamicNSP s) (addDynamicNSP s w) + +----------------------------------------------------------------------- +-- Exclusive scratchpads + +-- $exclusive-scratchpads +-- +-- Exclusive scratchpads allow you to hide certain scratchpads in +-- relation to others. There can be multiple groups of pairwise +-- exclusive scratchpads; whenever one such scratchpad gets called, it +-- will hide all other scratchpads on the focused workspace that are in +-- this group. +-- +-- For example, having defined "Calc", "Mail", and "Term" scratchpads, +-- you can use 'addExclusives' to make some of them dislike each other: +-- +-- > myExclusives = addExclusives +-- > [ ["Calc", "Mail"] +-- > , ["Mail", "Term"] +-- > ] +-- +-- You now have to add @myExclusives@ to you startupHook: +-- +-- > main :: IO +-- > main = xmonad . … . $ def +-- > { … +-- > , startupHook = myStartupHook >> myExclusives +-- > } +-- +-- This will hide the "Mail" scratchpad whenever the "Calc" scratchpad +-- is brought up, and vice-versa. Likewise, "Mail" and "Term" behave in +-- this way, but "Calc" and "Term" may peacefully coexist. +-- +-- If you move a scratchpad it still gets hidden when you fetch a +-- scratchpad of the same family. To change that behaviour—and make +-- windows not exclusive anymore when they get resized or moved—add +-- these mouse bindings (see +-- "XMonad.Doc.Extending#Editing_mouse_bindings"): +-- +-- > , ((mod4Mask, button1), floatMoveNoexclusive) +-- > , ((mod4Mask, button3), resizeNoexclusive) +-- +-- To reset a moved scratchpad to the original position that you set +-- with its hook, focus is and then call 'resetFocusedNSP'. For +-- example, if you want to extend @M-\@ to reset the placement +-- when a scratchpad is in focus but keep the default behaviour for +-- tiled windows, set these key bindings: +-- +-- > , ((modMask, xK_Return), windows W.swapMaster >> resetFocusedNSP) + +-- | Make some scratchpads exclusive. +addExclusives :: [[String]] -> X () +addExclusives exs = do + NSPState _ ws <- XS.get + -- Re-initialise `ws' to nothing, so we can react to changes in case + -- of a restart. See 'fillNSPState' for more details on filling. + XS.put (NSPState (foldl' (go []) mempty exs) mempty) + unless (null ws) $ + void (fillNSPState (Map.elems ws)) + where + -- Ignoring that this is specialised to NSPs, it works something like + -- >>> foldl' (go []) mempty [[1, 2], [3, 4], [1, 3]] + -- fromList [(1, [3, 2]), (2, [1]), (3, [1, 4]), (4, [3])] + go _ m [] = m + go ms m (n : ns) = go (n : ms) (Map.insertWith (<>) n (mkNSP (ms <> ns)) m) ns + mkNSP = map (\n -> NS n mempty (pure False) mempty) + +-- | @setNoexclusive w@ makes the window @w@ lose its exclusivity +-- features. +setNoexclusive :: Window -> X () +setNoexclusive w = do + NSPState _ ws <- XS.get + whenX (isNSP w (Map.elems ws)) $ + addTag "_NSP_NOEXCLUSIVE" w + +-- | If the focused window is a scratchpad, the scratchpad gets reset to +-- the original placement specified with the hook and becomes exclusive +-- again. +resetFocusedNSP :: X () +resetFocusedNSP = do + NSPState _ (Map.elems -> ws) <- XS.get + withFocused $ \w -> do + mbWin <- findM ((`runQuery` w) . query) ws + whenJust mbWin $ \win -> do + (windows . appEndo <=< runQuery (hook win)) w + hideUnwanted (name win) + delTag "_NSP_NOEXCLUSIVE" w + +-- | @hideUnwanted nspWindow@ hides all windows that @nspWindow@ does +-- not like; i.e., windows that are in some kind of exclusivity contract +-- with it. +-- +-- A consistency assumption for this is that @nspWindow@ must be the +-- currently focused window. For this to take effect, @nspWindow@ must +-- not have set the @_NSP_NOEXCLUSIVE@ property, neither must any +-- exclusive window we'd like to hide. +hideUnwanted :: String -> X () +hideUnwanted nspWindow = withWindowSet $ \winSet -> do + NSPState{ nspExclusives } <- XS.get + whenJust (nspExclusives !? nspWindow) $ \unwanted -> + withFocused $ \w -> whenX (runQuery notIgnored w) $ do + for_ (W.index winSet) $ \win -> + whenX (runQuery (isUnwanted unwanted) win) $ + shiftToNSP (W.workspaces winSet) ($ win) + where + notIgnored :: Query Bool + notIgnored = notElem "_NSP_NOEXCLUSIVE" . words <$> stringProperty "_XMONAD_TAGS" + + isUnwanted :: [NamedScratchpad] -> Query Bool + isUnwanted = (notIgnored <&&>) . foldr (\nsp qs -> qs <||> query nsp) (pure False) + +-- | Float and drag the window; make it lose its exclusivity status in +-- the process. +floatMoveNoexclusive :: Window -- ^ Window which should be moved + -> X () +floatMoveNoexclusive = mouseHelper mouseMoveWindow + +-- | Resize window and make it lose its exclusivity status in the +-- process. +resizeNoexclusive :: Window -- ^ Window which should be resized + -> X () +resizeNoexclusive = mouseHelper mouseResizeWindow + +mouseHelper :: (Window -> X a) -> Window -> X () +mouseHelper f w = setNoexclusive w + >> focus w + >> f w + >> windows W.shiftMaster ------------------------------------------------------------------------ -- Deprecations diff --git a/XMonad/Util/Parser.hs b/XMonad/Util/Parser.hs --- a/XMonad/Util/Parser.hs +++ b/XMonad/Util/Parser.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.Parser @@ -36,6 +37,7 @@ runParser, -- * Primitive Parsers + pfail, eof, num, char, @@ -43,10 +45,17 @@ skipSpaces, get, look, + gather, -- * Combining Parsers satisfy, choice, + count, + between, + option, + optionally, + skipMany, + skipMany1, many1, sepBy, sepBy1, @@ -54,7 +63,11 @@ endBy1, munch, munch1, - pfail + chainr, + chainr1, + chainl, + chainl1, + manyTill, ) where import XMonad.Prelude @@ -85,7 +98,7 @@ > pLongerSequence = ReadP.char '<' *> ReadP.string "f" <* ReadP.char '>' > pCombination = pLangle ReadP.+++ pLongerSequence -Parsing the string @""@ will return +Parsing the string @"\"@ will return >>> ReadP.readP_to_S pCombination "" [("<","f>"),("f","")] @@ -123,18 +136,22 @@ -- produces any result at all, then right parser is not used. (<>) :: Parser a -> Parser a -> Parser a (<>) = coerce ((<++) @a) + {-# INLINE (<>) #-} instance Monoid (Parser a) where -- | A parser that always fails. mempty :: Parser a mempty = Parser empty + {-# INLINE mempty #-} instance Alternative Parser where empty :: Parser a empty = mempty + {-# INLINE empty #-} (<|>) :: Parser a -> Parser a -> Parser a (<|>) = (<>) + {-# INLINE (<|>) #-} -- | When @-XOverloadedStrings@ is on, treat a string @s@ as the parser -- @'string' s@, when appropriate. This allows one to write things like @@ -142,89 +159,199 @@ instance a ~ String => IsString (Parser a) where fromString :: String -> Parser a fromString = string + {-# INLINE fromString #-} -- | Run a parser on a given string. runParser :: Parser a -> String -> Maybe a runParser (Parser p) = fmap fst . listToMaybe . ReadP.readP_to_S p +{-# INLINE runParser #-} -- | Always fails pfail :: Parser a pfail = empty +{-# INLINE pfail #-} -- | Consume and return the next character. Fails if there is no input -- left. get :: Parser Char get = coerce ReadP.get +{-# INLINE get #-} -- | Look-ahead: return the part of the input that is left, without -- consuming it. look :: Parser String look = coerce ReadP.look +{-# INLINE look #-} +-- | Transform a parser into one that does the same, but in addition +-- returns the exact characters read. +-- +-- >>> runParser ( string "* " $> True) "* hi" +-- Just True +-- >>> runParser (gather $ string "* " $> True) "* hi" +-- Just ("* ",True) +gather :: forall a. Parser a -> Parser (String, a) +gather = coerce (ReadP.gather @a) +{-# INLINE gather #-} + -- | Succeeds if and only if we are at the end of input. eof :: Parser () eof = coerce ReadP.eof +{-# INLINE eof #-} --- | Parse an integral number number. +-- | Parse an integral number. num :: (Read a, Integral a) => Parser a num = read <$> munch1 isDigit -{-# SPECIALISE num :: Parser Word #-} -{-# SPECIALISE num :: Parser Int #-} -{-# SPECIALISE num :: Parser Integer #-} +{-# INLINE num #-} -- | Parse and return the specified character. char :: Char -> Parser Char char = coerce ReadP.char +{-# INLINE char #-} -- | Parse and return the specified string. string :: String -> Parser String string = coerce ReadP.string +{-# INLINE string #-} -- | Skip all whitespace. skipSpaces :: Parser () skipSpaces = coerce ReadP.skipSpaces +{-# INLINE skipSpaces #-} -- | Consume and return the next character if it satisfies the specified -- predicate. satisfy :: (Char -> Bool) -> Parser Char satisfy = coerce ReadP.satisfy +{-# INLINE satisfy #-} -- | Combine all parsers in the given list in a left-biased way. choice :: [Parser a] -> Parser a choice = foldl' (<>) mempty +{-# INLINE choice #-} +-- | @count n p@ parses @n@ occurrences of @p@ in sequence and returns a +-- list of results. +count :: Int -> Parser a -> Parser [a] +count = replicateM +{-# INLINE count #-} + +-- | @between open close p@ parses @open@, followed by @p@ and finally +-- @close@. Only the value of @p@ is returned. +between :: Parser open -> Parser close -> Parser a -> Parser a +between open close p = open *> p <* close +{-# INLINE between #-} + +-- | @option def p@ will try to parse @p@ and, if it fails, simply +-- return @def@ without consuming any input. +option :: a -> Parser a -> Parser a +option def p = p <|> pure def +{-# INLINE option #-} + +-- | @optionally p@ optionally parses @p@ and always returns @()@. +optionally :: Parser a -> Parser () +optionally p = void p <|> pure () +{-# INLINE optionally #-} + +-- | Like 'many', but discard the result. +skipMany :: Parser a -> Parser () +skipMany = void . many +{-# INLINE skipMany #-} + +-- | Like 'many1', but discard the result. +skipMany1 :: Parser a -> Parser () +skipMany1 p = p *> skipMany p +{-# INLINE skipMany1 #-} + -- | Parse the first zero or more characters satisfying the predicate. -- Always succeeds; returns an empty string if the predicate returns -- @False@ on the first character of input. munch :: (Char -> Bool) -> Parser String munch = coerce ReadP.munch +{-# INLINE munch #-} -- | Parse the first one or more characters satisfying the predicate. -- Fails if none, else succeeds exactly once having consumed all the -- characters. munch1 :: (Char -> Bool) -> Parser String munch1 = coerce ReadP.munch1 +{-# INLINE munch1 #-} -- | @endBy p sep@ parses zero or more occurrences of @p@, separated and -- ended by @sep@. endBy :: Parser a -> Parser sep -> Parser [a] endBy p sep = many (p <* sep) +{-# INLINE endBy #-} -- | @endBy p sep@ parses one or more occurrences of @p@, separated and -- ended by @sep@. endBy1 :: Parser a -> Parser sep -> Parser [a] endBy1 p sep = many1 (p <* sep) +{-# INLINE endBy1 #-} -- | Parse one or more occurrences of the given parser. many1 :: Parser a -> Parser [a] -many1 p = liftA2 (:) p (many p) +many1 = some +{-# INLINE many1 #-} -- | @sepBy p sep@ parses zero or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. sepBy :: Parser a -> Parser sep -> Parser [a] sepBy p sep = sepBy1 p sep <> pure [] +{-# INLINE sepBy #-} -- | @sepBy1 p sep@ parses one or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. sepBy1 :: Parser a -> Parser sep -> Parser [a] sepBy1 p sep = liftA2 (:) p (many (sep *> p)) +{-# INLINE sepBy1 #-} + +-- | @chainr p op x@ parses zero or more occurrences of @p@, separated +-- by @op@. Returns a value produced by a /right/ associative +-- application of all functions returned by @op@. If there are no +-- occurrences of @p@, @x@ is returned. +chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a +chainr p op x = option x (chainr1 p op) +{-# INLINE chainr #-} + +-- | Like 'chainr', but parses one or more occurrences of @p@. +chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a +chainr1 p op = scan + where + scan :: Parser a + scan = p >>= rest + + rest :: a -> Parser a + rest x = option x $ do f <- op + f x <$> scan +{-# INLINE chainr1 #-} + +-- | @chainl p op x@ parses zero or more occurrences of @p@, separated +-- by @op@. Returns a value produced by a /left/ associative +-- application of all functions returned by @op@. If there are no +-- occurrences of @p@, @x@ is returned. +chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a +chainl p op x = option x (chainl1 p op) +{-# INLINE chainl #-} + +-- | Like 'chainl', but parses one or more occurrences of @p@. +chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a +chainl1 p op = scan + where + scan :: Parser a + scan = p >>= rest + + rest :: a -> Parser a + rest x = option x $ do f <- op + y <- p + rest (f x y) +{-# INLINE chainl1 #-} + +-- | @manyTill p end@ parses zero or more occurrences of @p@, until +-- @end@ succeeds. Returns a list of values returned by @p@. +manyTill :: forall a end. Parser a -> Parser end -> Parser [a] +manyTill p end = scan + where + scan :: Parser [a] + scan = end $> [] <|> liftA2 (:) p scan +{-# INLINE manyTill #-} diff --git a/XMonad/Util/Paste.hs b/XMonad/Util/Paste.hs --- a/XMonad/Util/Paste.hs +++ b/XMonad/Util/Paste.hs @@ -35,7 +35,7 @@ {- $usage -Import this module into your xmonad.hs as usual: +Import this module into your @xmonad.hs@ as usual: > import XMonad.Util.Paste diff --git a/XMonad/Util/PureX.hs b/XMonad/Util/PureX.hs --- a/XMonad/Util/PureX.hs +++ b/XMonad/Util/PureX.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-} +{-# LANGUAGE DerivingVia, GeneralizedNewtypeDeriving, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | @@ -53,7 +53,7 @@ -- xmonad import XMonad -import XMonad.Prelude (Any (..), liftA2, WindowScreen) +import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Actions.FocusNth @@ -110,12 +110,7 @@ -- | The @PureX@ newtype over @ReaderT XConf (State XState) a@. newtype PureX a = PureX (ReaderT XConf (State XState) a) deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState) - -instance Semigroup a => Semigroup (PureX a) where - (<>) = liftA2 (<>) - -instance Monoid a => Monoid (PureX a) where - mempty = return mempty + deriving (Semigroup, Monoid) via Ap PureX a -- | The @XLike@ typeclass over monads reading @XConf@ values and tracking -- @XState@ state. diff --git a/XMonad/Util/RemoteWindows.hs b/XMonad/Util/RemoteWindows.hs --- a/XMonad/Util/RemoteWindows.hs +++ b/XMonad/Util/RemoteWindows.hs @@ -44,7 +44,7 @@ import System.Posix.Env -- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad -- > import XMonad.Util.RemoteWindows diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs --- a/XMonad/Util/Run.hs +++ b/XMonad/Util/Run.hs @@ -49,6 +49,7 @@ spawnExternalProcess, proc, getInput, + toInput, -- ** Programs inEditor, @@ -59,9 +60,12 @@ -- ** General Combinators (>->), (>-$), + (>&&>), + (>||>), inWorkingDir, - execute, eval, + execute, + executeNoQuote, setXClass, asString, @@ -75,6 +79,9 @@ require, progn, quote, + findFile, + list, + saveExcursion, -- * Re-exports hPutStr, @@ -107,9 +114,7 @@ - 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". + "XMonad.Util.Dmenu", or "XMonad.Prompt.Shell". - For an example usage of 'runProcessWithInputAndWait' see "XMonad.Util.Dzen". @@ -300,6 +305,10 @@ which would be quite bothersome to type indeed! +A blog post going into some more detail and also explaining how to +integrate this new language with the "XMonad.Util.NamedScratchpad" +module is available +. -} ----------------------------------------------------------------------- @@ -354,10 +363,32 @@ (>-$) xi xs = xi >-> fmap mkDList xs infixr 3 >-$ +-- | @a >&&> b@ glues the different inputs @a@ and @b@ by means of @&&@. +-- For example, +-- +-- @ +-- pure "do something" >&&> pure "do another thing" +-- @ +-- +-- would result in @do something && do another thing@ being executed by a +-- shell. +(>&&>) :: X Input -> X Input -> X Input +a >&&> b = a <> toInput " && " <> b +infixr 2 >&&> + +-- | Like '(>&&>)', but with @||@. +(>||>) :: X Input -> X Input -> X Input +a >||> b = a <> toInput " || " <> b +infixr 2 >||> + -- | Spawn a completed input. proc :: X Input -> X () proc xi = spawn =<< getInput xi +-- | Create an effectful 'Input' from a 'String'. +toInput :: String -> X Input +toInput = pure . mkDList + -- | Get the completed input string. getInput :: X Input -> X String getInput xi = xi <&> ($ "") @@ -373,13 +404,20 @@ -- | Execute the argument. Current /thing/ must support a @-e@ option. -- For programs such as Emacs, 'eval' may be the safer option; while -- @emacsclient@ supports @-e@, the @emacs@ executable itself does not. +-- +-- Note that this function always wraps its argument in single quotes; +-- see 'executeNoQuote' for an alternative. execute :: String -> X Input -execute this = pure ((" -e " <> this) <>) +execute this = pure ((" -e " <> tryQuote this) <>) +-- | Like 'execute', but doesn't wrap its argument in single quotes. +executeNoQuote :: String -> X Input +executeNoQuote this = pure ((" -e " <> this) <>) + -- | Eval(uate) the argument. Current /thing/ must support a @--eval@ -- option. eval :: String -> X Input -eval this = pure ((" --eval " <> this) <>) +eval this = pure ((" --eval " <> tryQuote this) <>) -- | Use 'emacs'. inEmacs :: X Input @@ -413,6 +451,9 @@ termInDir :: X Input termInDir = inTerm >-> inWorkingDir +----------------------------------------------------------------------- +-- Emacs + -- | Transform the given input into an elisp function; i.e., surround it -- with parentheses. -- @@ -428,14 +469,14 @@ 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: +-- | Wrap the given commands in a @progn@. The given commands need not +-- be wrapped in parentheses (but can); this will be done by the +-- function. For example: -- -- >>> progn [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"] --- " '( progn (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2) )' " +-- "(progn (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))" progn :: [String] -> String -progn cmds = elispFun $ "progn " <> unwords (map inParens cmds) +progn = inParens . ("progn " <>) . unwords . map inParens -- | Require a package. -- @@ -451,6 +492,27 @@ quote :: String -> String quote = inParens . ("quote " <>) +-- | Call @find-file@. +-- +-- >>> findFile "/path/to/file" +-- "(find-file \"/path/to/file\" )" +findFile :: String -> String +findFile = inParens . ("find-file" <>) . asString + +-- | Make a list of the given inputs. +-- +-- >>> list ["foo", "bar", "baz", "qux"] +-- "(list foo bar baz qux)" +list :: [String] -> String +list = inParens . ("list " <>) . unwords + +-- | Like 'progn', but with @save-excursion@. +-- +-- >>> saveExcursion [require "this-lib", "function-from-this-lib arg", "(other-function arg2)"] +-- "(save-excursion (require (quote this-lib)) (function-from-this-lib arg) (other-function arg2))" +saveExcursion :: [String] -> String +saveExcursion = inParens . ("save-excursion " <>) . unwords . map inParens + ----------------------------------------------------------------------- -- Batch mode @@ -493,3 +555,8 @@ inParens s = case s of '(' : _ -> s _ -> "(" <> s <> ")" + +tryQuote :: String -> String +tryQuote s = case dropWhile (== ' ') s of + '\'' : _ -> s + _ -> "'" <> s <> "'" diff --git a/XMonad/Util/Scratchpad.hs b/XMonad/Util/Scratchpad.hs --- a/XMonad/Util/Scratchpad.hs +++ b/XMonad/Util/Scratchpad.hs @@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.Scratchpad ( +module XMonad.Util.Scratchpad {-# DEPRECATED "Use XMonad.Util.NamedScratchpad instead" #-} ( -- * Usage -- $usage scratchpadSpawnAction diff --git a/XMonad/Util/SpawnNamedPipe.hs b/XMonad/Util/SpawnNamedPipe.hs --- a/XMonad/Util/SpawnNamedPipe.hs +++ b/XMonad/Util/SpawnNamedPipe.hs @@ -9,7 +9,7 @@ -- Stability : unstable -- Portability : not portable -- --- A module for spawning a pipe whose "Handle" lives in the Xmonad state. +-- A module for spawning a pipe whose 'Handle' lives in the Xmonad state. -- ----------------------------------------------------------------------------- @@ -55,10 +55,10 @@ instance ExtensionClass NamedPipes where initialValue = NamedPipes Map.empty --- | When 'spawnNamedPipe' is executed with a command "String" and a name --- "String" respectively. The command string is spawned with 'spawnPipe' (as --- long as the name chosen hasn't been used already) and the "Handle" returned --- is saved in Xmonad's state associated with the name "String". +-- | When 'spawnNamedPipe' is executed with a command 'String' and a name +-- 'String' respectively. The command string is spawned with 'spawnPipe' (as +-- long as the name chosen hasn't been used already) and the 'Handle' returned +-- is saved in Xmonad's state associated with the name 'String'. spawnNamedPipe :: String -> String -> X () spawnNamedPipe cmd name = do b <- XS.gets (Map.member name . pipeMap) @@ -66,7 +66,7 @@ h <- spawnPipe cmd XS.modify (NamedPipes . Map.insert name h . pipeMap) --- | Attempts to retrieve a "Handle" to a pipe previously stored in Xmonad's +-- | Attempts to retrieve a 'Handle' to a pipe previously stored in Xmonad's -- state associated with the given string via a call to 'spawnNamedPipe'. If the -- given string doesn't exist in the map stored in Xmonad's state Nothing is -- returned. diff --git a/XMonad/Util/SpawnOnce.hs b/XMonad/Util/SpawnOnce.hs --- a/XMonad/Util/SpawnOnce.hs +++ b/XMonad/Util/SpawnOnce.hs @@ -11,7 +11,7 @@ -- -- A module for spawning a command once, and only once. Useful to start -- status bars and make session settings inside startupHook. See also --- 'XMonad.Util.SessionStart' for a different and more flexible way to +-- "XMonad.Util.SessionStart" for a different and more flexible way to -- run commands only on first startup. -- ----------------------------------------------------------------------------- @@ -53,7 +53,7 @@ -- $spawnon -- These functions combine 'spawnOnce' with their relatives in --- 'XMonad.Actions.SpawnOn'. You must add 'manageSpawn' to your +-- "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. diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs --- a/XMonad/Util/Stack.hs +++ b/XMonad/Util/Stack.hs @@ -27,6 +27,7 @@ , toIndex , fromTags , toTags + , zipperFocusedAtFirstOf -- * 'Zipper' manipulation functions -- ** Insertion, movement @@ -123,6 +124,18 @@ toTags (Just s) = map Left (reverse . W.up $ s) ++ [Right . W.focus $ s] ++ map Left (W.down s) +-- | @differentiate zs xs@ takes the first @z@ from @z2 that also belongs to +-- @xs@ and turns @xs@ into a stack with @z@ being the current element. Acts +-- as 'XMonad.StackSet.differentiate' if @zs@ and @xs@ don't intersect. +zipperFocusedAtFirstOf :: Eq q => [q] -> [q] -> Zipper q +zipperFocusedAtFirstOf [] xs = W.differentiate xs +zipperFocusedAtFirstOf (z : zs) xs + | z `elem` xs = Just $ + W.Stack { W.focus = z + , W.up = reverse $ takeWhile (/= z) xs + , W.down = drop 1 $ dropWhile (/= z) xs + } + | otherwise = zipperFocusedAtFirstOf zs xs -- * Zipper functions @@ -162,20 +175,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) (tail (reverse down) ++ [f]) [] +focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (drop 1 (reverse down) ++ [f]) [] -- | Move the focus to the next element focusDownZ :: Zipper a -> Zipper a focusDownZ Nothing = Nothing focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down focusDownZ (Just s) | null $ W.up s = Just s -focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (tail (reverse up) ++ [f]) +focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (drop 1 (reverse up) ++ [f]) -- | Move the focus to the first element focusMasterZ :: Zipper a -> Zipper a focusMasterZ Nothing = Nothing focusMasterZ (Just (W.Stack f up down)) | not $ null up - = Just $ W.Stack (last up) [] (tail (reverse up) ++ [f] ++ down) + = Just $ W.Stack (last up) [] (drop 1 (reverse up) ++ [f] ++ down) focusMasterZ (Just s) = Just s -- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to diff --git a/XMonad/Util/Timer.hs b/XMonad/Util/Timer.hs --- a/XMonad/Util/Timer.hs +++ b/XMonad/Util/Timer.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Timer @@ -20,13 +21,14 @@ , TimerId ) where -import XMonad import Control.Concurrent import Data.Unique +import XMonad +import XMonad.Prelude (listToMaybe) -- $usage -- This module can be used to setup a timer to handle deferred events. --- See 'XMonad.Layout.ShowWName' for an usage example. +-- See "XMonad.Layout.ShowWName" for an usage example. type TimerId = Int @@ -53,7 +55,6 @@ handleTimer ti ClientMessageEvent{ev_message_type = mt, ev_data = dt} action = do d <- asks display a <- io $ internAtom d "XMONAD_TIMER" False - if mt == a && dt /= [] && fromIntegral (head dt) == ti - then action - else return Nothing + if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action + | otherwise -> return Nothing handleTimer _ _ _ = return Nothing diff --git a/XMonad/Util/Ungrab.hs b/XMonad/Util/Ungrab.hs --- a/XMonad/Util/Ungrab.hs +++ b/XMonad/Util/Ungrab.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Ungrab @@ -13,12 +14,15 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.Ungrab +module XMonad.Util.Ungrab {-# DEPRECATED "Use XMonad.Operations.unGrab instead" #-} ( -- * Usage: -- $usage unGrab ) where +#if MIN_VERSION_xmonad(0, 17, 9) +import XMonad.Operations (unGrab) +#else import Graphics.X11.Xlib (sync) import Graphics.X11.Xlib.Extras (currentTime) import Graphics.X11.Xlib.Misc (ungrabKeyboard, ungrabPointer) @@ -43,3 +47,4 @@ -- | Release xmonad's keyboard grab, so other grabbers can do their thing. unGrab :: X () unGrab = withDisplay $ \d -> io (ungrabKeyboard d currentTime >> ungrabPointer d currentTime >> sync d False) +#endif diff --git a/XMonad/Util/WindowProperties.hs b/XMonad/Util/WindowProperties.hs --- a/XMonad/Util/WindowProperties.hs +++ b/XMonad/Util/WindowProperties.hs @@ -46,7 +46,7 @@ | Or Property Property | Not Property | Const Bool - | Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows' + | Tagged String -- ^ Tagged via "XMonad.Actions.TagWindows" deriving (Read, Show) infixr 9 `And` infixr 8 `Or` diff --git a/XMonad/Util/WindowState.hs b/XMonad/Util/WindowState.hs --- a/XMonad/Util/WindowState.hs +++ b/XMonad/Util/WindowState.hs @@ -33,22 +33,22 @@ -- -- This module have advantage over "XMonad.Actions.TagWindows" in that it -- hides from you implementation details and provides simple type-safe --- interface. Main datatype is "StateQuery", which is simple wrapper around --- "Query", which is instance of MonadState, with 'put' and 'get' are --- functions to acess data, stored in "Window". +-- interface. Main datatype is 'StateQuery', which is simple wrapper around +-- 'Query', which is instance of MonadState, with 'put' and 'get' are +-- functions to acess data, stored in 'Window'. -- -- To save some data in window you probably want to do following: -- > (runStateQuery (put $ Just value) win) :: X () -- To retrive it, you can use -- > (runStateQuery get win) :: X (Maybe YourValueType) --- "Query" can be promoted to "StateQuery" simply by constructor, +-- 'Query' can be promoted to 'StateQuery' simply by constructor, -- and reverse is 'getQuery'. -- -- For example, I use it to have all X applications @russian@ or @dvorak@ -- layout, but emacs have only @us@, to not screw keybindings. Use your -- imagination! --- | Wrapper around "Query" with phanom type @s@, representing state, saved in +-- | Wrapper around 'Query' with phantom type @s@, representing state, saved in -- window. newtype StateQuery s a = StateQuery { getQuery :: Query a @@ -57,11 +57,11 @@ packIntoQuery :: (Window -> X a) -> Query a packIntoQuery = Query . ReaderT --- | Apply "StateQuery" to "Window". +-- | Apply 'StateQuery' to 'Window'. runStateQuery :: StateQuery s a -> Window -> X a runStateQuery = runQuery . getQuery --- | Lifted to "Query" version of 'catchX' +-- | Lifted to 'Query' version of 'catchX' catchQuery :: Query a -> Query (Maybe a) catchQuery q = packIntoQuery $ \win -> userCode $ runQuery q win diff --git a/tests/OrgMode.hs b/tests/OrgMode.hs --- a/tests/OrgMode.hs +++ b/tests/OrgMode.hs @@ -150,6 +150,7 @@ hourGen :: Gen String hourGen = oneof [ pure " " <<>> (pad <$> hourInt) <<>> pure ":" <<>> (pad <$> minuteInt) + , pure " " <<>> (pad <$> hourInt) <<>> (pad <$> minuteInt) , pure "" ] where diff --git a/tests/Selective.hs b/tests/Selective.hs --- a/tests/Selective.hs +++ b/tests/Selective.hs @@ -34,14 +34,14 @@ prop_select_increasing :: Selection l -> Stack Int -> Bool prop_select_increasing sel (stk :: Stack Int) = let res = integrate $ select sel stk - in and . zipWith (<) res $ tail res + in and . zipWith (<) res $ drop 1 res -- selection has the form [0..l] ++ [m..n] -- relies on the Arbitrary instance for Stack Int generating stacks like [0..k] prop_select_two_consec :: Selection l -> Stack Int -> Bool prop_select_two_consec sel (stk :: Stack Int) = let wins = integrate $ select sel stk - in (length . filter not . zipWith ((==) . (+1)) wins $ tail wins) <= 1 + in (length . filter not . zipWith ((==) . (+1)) wins $ drop 1 wins) <= 1 -- update preserves invariants on selections prop_update_nm :: Selection l -> Stack Int -> Bool diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -1,5 +1,5 @@ name: xmonad-contrib -version: 0.17.1 +version: 0.18.0 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_* homepage: https://xmonad.org/ @@ -38,7 +38,7 @@ 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.7 || == 9.0.2 || == 9.2.2 +tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1 source-repository head type: git @@ -55,8 +55,8 @@ library build-depends: base >= 4.11 && < 5, - bytestring >= 0.10 && < 0.12, - containers >= 0.5 && < 0.7, + bytestring >= 0.10 && < 0.13, + containers >= 0.5 && < 0.8, directory, filepath, time >= 1.8 && < 1.13, @@ -65,21 +65,21 @@ mtl >= 1 && < 3, unix, X11 >= 1.10 && < 1.11, - xmonad >= 0.16.99999 && < 0.18, + xmonad >= 0.16.99999 && < 0.19, utf8-string, deepseq default-language: Haskell2010 cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0 - -DXMONAD_CONTRIB_VERSION_MINOR=17 - -DXMONAD_CONTRIB_VERSION_PATCH=1 + -DXMONAD_CONTRIB_VERSION_MINOR=18 + -DXMONAD_CONTRIB_VERSION_PATCH=0 ghc-options: -Wall -Wno-unused-do-bind if flag(pedantic) ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports -- Keep this in sync with the oldest version in 'tested-with' - if impl(ghc > 8.4.4) + if impl(ghc > 8.6.5) -- don't treat unused-imports warning as errors, they may be necessary -- for compatibility with older versions of base (or other deps) ghc-options: -Wwarn=unused-imports @@ -118,6 +118,7 @@ XMonad.Actions.LinkWorkspaces XMonad.Actions.MessageFeedback XMonad.Actions.Minimize + XMonad.Actions.MostRecentlyUsed XMonad.Actions.MouseGestures XMonad.Actions.MouseResize XMonad.Actions.Navigation2D @@ -132,6 +133,7 @@ XMonad.Actions.Promote XMonad.Actions.RandomBackground XMonad.Actions.RepeatAction + XMonad.Actions.Repeatable XMonad.Actions.RotSlaves XMonad.Actions.RotateSome XMonad.Actions.Search @@ -145,6 +147,7 @@ XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.TiledWindowDragging + XMonad.Actions.ToggleFullFloat XMonad.Actions.TopicSpace XMonad.Actions.TreeSelect XMonad.Actions.UpdateFocus @@ -190,18 +193,17 @@ XMonad.Hooks.FadeWindows XMonad.Hooks.FloatNext XMonad.Hooks.Focus - XMonad.Hooks.ICCCMFocus XMonad.Hooks.InsertPosition XMonad.Hooks.ManageDebug XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.Minimize XMonad.Hooks.Modal + XMonad.Hooks.OnPropertyChange XMonad.Hooks.Place XMonad.Hooks.PositionStoreHooks XMonad.Hooks.RefocusLast XMonad.Hooks.Rescreen - XMonad.Hooks.RestoreMinimized XMonad.Hooks.ScreenCorners XMonad.Hooks.Script XMonad.Hooks.ServerMode @@ -226,14 +228,25 @@ XMonad.Layout.BorderResize XMonad.Layout.BoringWindows XMonad.Layout.ButtonDecoration + XMonad.Layout.CenterMainFluid XMonad.Layout.CenteredIfSingle XMonad.Layout.CenteredMaster XMonad.Layout.Circle + XMonad.Layout.CircleEx XMonad.Layout.Column XMonad.Layout.Combo XMonad.Layout.ComboP XMonad.Layout.Cross XMonad.Layout.Decoration + XMonad.Layout.DecorationEx + XMonad.Layout.DecorationEx.Common + XMonad.Layout.DecorationEx.Engine + XMonad.Layout.DecorationEx.Geometry + XMonad.Layout.DecorationEx.Widgets + XMonad.Layout.DecorationEx.LayoutModifier + XMonad.Layout.DecorationEx.TextEngine + XMonad.Layout.DecorationEx.DwmGeometry + XMonad.Layout.DecorationEx.TabbedGeometry XMonad.Layout.DecorationAddons XMonad.Layout.DecorationMadness XMonad.Layout.Dishes @@ -244,6 +257,7 @@ XMonad.Layout.DwmStyle XMonad.Layout.FixedAspectRatio XMonad.Layout.FixedColumn + XMonad.Layout.FocusTracking XMonad.Layout.Fullscreen XMonad.Layout.Gaps XMonad.Layout.Grid @@ -260,7 +274,6 @@ XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder - XMonad.Layout.LayoutBuilderP XMonad.Layout.LayoutCombinators XMonad.Layout.LayoutHints XMonad.Layout.LayoutModifier @@ -362,6 +375,7 @@ XMonad.Util.Font XMonad.Util.Grab XMonad.Util.Hacks + XMonad.Util.History XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.Loggers @@ -417,6 +431,7 @@ XMonad.Actions.FocusNth XMonad.Actions.GridSelect XMonad.Actions.PhysicalScreens + XMonad.Actions.Repeatable XMonad.Actions.RotateSome XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces @@ -462,7 +477,7 @@ build-depends: base , QuickCheck >= 2 , X11 >= 1.10 && < 1.11 - , bytestring >= 0.10 && < 0.12 + , bytestring >= 0.10 && < 0.13 , containers , directory , time >= 1.8 && < 1.13 @@ -473,7 +488,7 @@ , unix , utf8-string , deepseq - , xmonad >= 0.16.9999 && < 0.18 + , xmonad >= 0.16.9999 && < 0.19 cpp-options: -DTESTING ghc-options: -Wall -Wno-unused-do-bind default-language: Haskell2010 @@ -482,7 +497,10 @@ 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) + if impl(ghc > 8.6.5) -- don't treat unused-imports warning as errors, they may be necessary -- for compatibility with older versions of base (or other deps) ghc-options: -Wwarn=unused-imports + + if impl(ghc > 9.8) + ghc-options: -Wno-x-partial