xmonad-contrib 0.13 → 0.14
raw patch · 63 files changed
+3661/−660 lines, 63 filesdep +semigroupsdep ~X11dep ~basedep ~xmonadnew-uploader
Dependencies added: semigroups
Dependency ranges changed: X11, base, xmonad
Files
- CHANGES.md +358/−6
- README.md +10/−9
- XMonad/Actions/Commands.hs +11/−3
- XMonad/Actions/CycleWorkspaceByScreen.hs +102/−0
- XMonad/Actions/DynamicWorkspaceOrder.hs +17/−0
- XMonad/Actions/GridSelect.hs +12/−10
- XMonad/Actions/MessageFeedback.hs +230/−53
- XMonad/Actions/Minimize.hs +144/−0
- XMonad/Actions/Navigation2D.hs +107/−26
- XMonad/Actions/PhysicalScreens.hs +76/−41
- XMonad/Actions/SpawnOn.hs +36/−3
- XMonad/Actions/SwapPromote.hs +407/−0
- XMonad/Actions/WindowMenu.hs +1/−1
- XMonad/Config/Azerty.hs +9/−3
- XMonad/Config/Bluetile.hs +2/−1
- XMonad/Config/Example.hs +78/−0
- XMonad/Config/Gnome.hs +1/−1
- XMonad/Hooks/DynamicLog.hs +63/−9
- XMonad/Hooks/EwmhDesktops.hs +11/−16
- XMonad/Hooks/FadeWindows.hs +5/−1
- XMonad/Hooks/Minimize.hs +3/−3
- XMonad/Hooks/RestoreMinimized.hs +2/−10
- XMonad/Hooks/WallpaperSetter.hs +5/−1
- XMonad/Hooks/WorkspaceHistory.hs +47/−18
- XMonad/Layout/BinaryColumn.hs +139/−0
- XMonad/Layout/BinarySpacePartition.hs +1/−0
- XMonad/Layout/ComboP.hs +12/−0
- XMonad/Layout/DecorationAddons.hs +1/−1
- XMonad/Layout/Fullscreen.hs +14/−2
- XMonad/Layout/Gaps.hs +60/−12
- XMonad/Layout/Grid.hs +1/−1
- XMonad/Layout/Groups.hs +53/−21
- XMonad/Layout/ImageButtonDecoration.hs +1/−1
- XMonad/Layout/LayoutHints.hs +6/−0
- XMonad/Layout/Magnifier.hs +28/−26
- XMonad/Layout/Minimize.hs +13/−83
- XMonad/Layout/Mosaic.hs +5/−1
- XMonad/Layout/MultiColumns.hs +7/−3
- XMonad/Layout/MultiDishes.hs +92/−0
- XMonad/Layout/MultiToggle.hs +2/−1
- XMonad/Layout/MultiToggle/TabBarDecoration.hs +47/−0
- XMonad/Layout/NoBorders.hs +199/−65
- XMonad/Layout/Spacing.hs +338/−79
- XMonad/Layout/StateFull.hs +94/−0
- XMonad/Layout/ThreeColumns.hs +2/−2
- XMonad/Prompt.hs +5/−2
- XMonad/Prompt/AppendFile.hs +22/−4
- XMonad/Prompt/FuzzyMatch.hs +104/−0
- XMonad/Prompt/Pass.hs +41/−24
- XMonad/Prompt/Unicode.hs +66/−40
- XMonad/Prompt/Window.hs +53/−13
- XMonad/Util/Dmenu.hs +14/−9
- XMonad/Util/Dzen.hs +53/−0
- XMonad/Util/EZConfig.hs +5/−1
- XMonad/Util/Minimize.hs +37/−0
- XMonad/Util/Rectangle.hs +214/−0
- XMonad/Util/SessionStart.hs +64/−0
- XMonad/Util/SpawnOnce.hs +29/−8
- XMonad/Util/Stack.hs +30/−1
- XMonad/Util/Themes.hs +18/−0
- XMonad/Util/WindowProperties.hs +6/−2
- XMonad/Util/WorkspaceCompare.hs +12/−20
- xmonad-contrib.cabal +36/−23
CHANGES.md view
@@ -1,5 +1,363 @@ # Change Log / Release Notes +## 0.14++### Breaking Changes++ * `XMonad.Layout.Spacing`++ Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed+ of four sides each with its own border width. The screen and window borders+ are now separate and can be independently toggled on/off. The screen border+ examines the window/rectangle list resulting from 'runLayout' rather than+ the stack, which makes it compatible with layouts such as the builtin+ `Full`. The child layout will always be called with the screen border. If+ only a single window is displayed (and `smartBorder` enabled), it will be+ expanded into the original layout rectangle. Windows that are displayed but+ not part of the stack, such as those created by 'XMonad.Layout.Decoration',+ will be shifted out of the way, but not scaled (not possible for windows+ created by XMonad). This isn't perfect, so you might want to disable+ `Spacing` on such layouts.++ * `XMonad.Util.SpawnOnce`++ - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks+ to shift spawned windows to a specific workspace.++ * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier++ * `XMonad.Actions.GridSelect`++ - Added field `gs_bordercolor` to `GSConfig` to specify border color.++ * `XMonad.Layout.Minimize`++ Though the interface it offers is quite similar, this module has been+ almost completely rewritten. The new `XMonad.Actions.Minimize` contains+ several functions that allow interaction with minimization window state.+ If you are using this module, you must upgrade your configuration to import+ `X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of+ sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has+ been completely deprecated, and its functions have no effect.++ * `XMonad.Prompt.Unicode`++ - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a+ filepath to the `UnicodeData.txt` file containing unicode data.++ * `XMonad.Actions.PhysicalScreens`++ `getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter+ of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default+ value are:++ - `def`(same as verticalScreenOrderer) will keep previous behavior+ - `verticalScreenOrderer`+ - `horizontalScreenOrderer`++ One can build his custom ScreenOrderer using:+ - `screenComparatorById` (allow to order by Xinerama id)+ - `screenComparatorByRectangle` (allow to order by screen coordonate)+ - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)++ * `XMonad.Util.WorkspaceCompare`++ `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in+ `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)++ * `XMonad.Hooks.EwmhDesktops`++ - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific+ remapping of all visible windows to the active workspace (#216).+ - Handle workspace renames that might be occuring in the custom function+ that is provided to ewmhDesktopsLogHookCustom.++ * `XMonad.Hooks.DynamicLog`++ - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and+ `xmobarRaw`.++ * `XMonad.Layout.NoBorders`++ The layout now maintains a list of windows that never have borders, and a+ list of windows that always have borders. Use `BorderMessage` to manage+ these lists and the accompanying event hook (`borderEventHook`) to remove+ destroyed windows from them. Also provides the `hasBorder` manage hook.++ Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and+ `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`. See+ the documentation for more information.++ The type signature of `hiddens` was changed to accept a new `Rectangle`+ parameter representing the bounds of the parent layout, placed after the+ `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`+ will need to update their configuration. For example, replace "`hiddens amb+ wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make+ use of the new parameter with "`hiddens amb wset lr mst wrs =`".++ * `XMonad.Actions.MessageFeedback`++ - Follow the naming conventions of `XMonad.Operations`. Functions returning+ `X ()` are named regularly (previously these ended in underscore) while+ those returning `X Bool` are suffixed with an uppercase 'B'.+ - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and+ `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`+ (renamed from `send`).+ - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of+ type `SomeMessage -> X Bool`, which means you are no longer constrained+ to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.+ - The `send*Messages*` family of funtions allows for sequencing arbitrary+ sets of messages with minimal refresh. It makes little sense for these+ functions to support custom message dispatchers.+ - Remain backwards compatible. Maintain deprecated aliases of all renamed+ functions:+ - `send` -> `sendMessageWithNoRefreshToCurrentB`+ - `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB`+ - `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent`+ - `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB`+ - `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent`+ - `tryMessage` -> `tryMessageWithNoRefreshToCurrentB`+ - `tryMessage_` -> `tryMessageWithNoRefreshToCurrent`++### New Modules++ * `XMonad.Layout.MultiToggle.TabBarDecoration`++ Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to+ dynamically toggle `XMonad.Layout.TabBarDecoration`.++ * `XMonad.Layout.StateFull`++ Provides `StateFull`: a stateful form of `Full` that does not misbehave when+ floats are focused, and the `FocusTracking` layout transformer by means of+ which `StateFull` is implemented. `FocusTracking` simply holds onto the last+ true focus it was given and continues to use it as the focus for the+ transformed layout until it sees another. It can be used to improve the+ behaviour of a child layout that has not been given the focused window.++ * `XMonad.Actions.SwapPromote`++ Module for tracking master window history per workspace, and associated+ functions for manipulating the stack using such history.++ * `XMonad.Actions.CycleWorkspaceByScreen`++ A new module that allows cycling through previously viewed workspaces in the+ order they were viewed most recently on the screen where cycling is taking+ place.++ Also provides the `repeatableAction` helper function which can be used to+ build actions that can be repeated while a modifier key is held down.++ * `XMonad.Prompt.FuzzyMatch`++ Provides a predicate `fuzzyMatch` that is much more lenient in matching+ completions in `XMonad.Prompt` than the default prefix match. Also provides+ a function `fuzzySort` that allows sorting the fuzzy matches by "how well"+ they match.++ * `XMonad.Utils.SessionStart`++ A new module that allows to query if this is the first time xmonad is+ started of the session, or a xmonad restart.++ Currently needs manual setting of the session start flag. This could be+ automated when this moves to the core repository.++ * `XMonad.Layout.MultiDishes`++ A new layout based on Dishes, however it accepts additional configuration+ to allow multiple windows within a single stack.++ * `XMonad.Util.Rectangle`++ A new module for handling pixel rectangles.++ * `XMonad.Layout.BinaryColumn`++ A new module which provides a simple grid layout, halving the window+ sizes of each window after master.++ This is similar to Column, but splits the window in a way+ that maintains window sizes upon adding & removing windows as well as the+ option to specify a minimum window size.++### Bug Fixes and Minor Changes++ * `XMonad.Layout.Grid`++ Fix as per issue #223; Grid will no longer calculate more columns than there+ are windows.++ * `XMonad.Hooks.FadeWindows`++ Added support for GHC version 8.4.x by adding a Semigroup instance for+ Monoids++ * `XMonad.Hooks.WallpaperSetter`++ Added support for GHC version 8.4.x by adding a Semigroup instance for+ Monoids++ * `XMonad.Hooks.Mosaic`++ Added support for GHC version 8.4.x by adding a Semigroup instance for+ Monoids++ * `XMonad.Actions.Navigation2D`++ Added `sideNavigation` and a parameterised variant, providing a navigation+ strategy with fewer quirks for tiled layouts using X.L.Spacing.++ * `XMonad.Layout.Fullscreen`++ The fullscreen layouts will now not render any window that is totally+ obscured by fullscreen windows.++ * `XMonad.Layout.Gaps`++ Extended the sendMessage interface with `ModifyGaps` to allow arbitrary+ modifications to the `GapSpec`.++ * `XMonad.Layout.Groups`++ Added a new `ModifyX` message type that allows the modifying+ function to return values in the `X` monad.++ * `XMonad.Actions.Navigation2D`++ Generalised (and hence deprecated) hybridNavigation to hybridOf.++ * `XMonad.Layout.LayoutHints`++ Preserve the window order of the modified layout, except for the focused+ window that is placed on top. This fixes an issue where the border of the+ focused window in certain situations could be rendered below borders of+ unfocused windows. It also has a lower risk of interfering with the+ modified layout.++ * `XMonad.Layout.MultiColumns`++ The focused window is placed above the other windows if they would be made to+ overlap due to a layout modifier. (As long as it preserves the window order.)++ * `XMonad.Actions.GridSelect`++ - The vertical centring of text in each cell has been improved.++ * `XMonad.Actions.SpawnOn`++ - Bind windows spawns by child processes of the original window to the same+ workspace as the original window.++ * `XMonad.Util.WindowProperties`++ - Added the ability to test if a window has a tag from+ `XMonad.Actions.TagWindows`++ * `XMonad.Layout.Magnifier`++ - Handle `IncMasterN` messages.++ * `XMonad.Util.EZConfig`++ - Can now parse Latin1 keys, to better accommodate users with+ non-US keyboards.++ * `XMonad.Actions.Submap`++ Establish pointer grab to avoid freezing X, when button press occurs after+ submap key press. And terminate submap at button press in the same way,+ as we do for wrong key press.++ * `XMonad.Hooks.SetWMName`++ Add function `getWMName`.++ * `XMonad.Hooks.ManageHelpers`++ Make type of ManageHook combinators more general.++ * `XMonad.Prompt`++ Export `insertString`.++ * `XMonad.Prompt.Window`++ - New function: `windowMultiPrompt` for using `mkXPromptWithModes`+ with window prompts.++ * `XMonad.Hooks.WorkspaceHistory`++ - Now supports per screen history.++ * `XMonad.Layout.ComboP`++ - New `PartitionWins` message to re-partition all windows into the+ configured sub-layouts. Useful when window properties have+ changed and you want to re-sort windows into the appropriate+ sub-layout.++ * `XMonad.Actions.Minimize`++ - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform+ actions with both the last and first minimized windows easily.++ * `XMonad.Config.Gnome`++ - Update logout key combination (modm+shift+Q) to work with modern++ * `XMonad.Prompt.Pass`++ - New function `passTypePrompt` which uses `xdotool` to type in a password+ from the store, bypassing the clipboard.+ - Now handles password labels with spaces and special characters inside+ them.++ * `XMonad.Prompt.Unicode`++ - Persist unicode data cache across XMonad instances due to+ `ExtensibleState` now used instead of `unsafePerformIO`.+ - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the+ Unicode character via `xdotool` instead of copying it to the paste buffer.+ - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`+ acts as a generic function to pass the selected Unicode character to any+ program.++ * `XMonad.Prompt.AppendFile`++ - New function `appendFilePrompt'` which allows for transformation of the+ string passed by a user before writing to a file.++ * `XMonad.Hooks.DynamicLog`++ - Added a new function `dzenWithFlags` which allows specifying the arguments+ passed to `dzen2` invocation. The behaviour of current `dzen` function is+ unchanged.++ * `XMonad.Util.Dzen`++ - Now provides functions `fgColor` and `bgColor` to specify foreground and+ background color, `align` and `slaveAlign` to set text alignment, and+ `lineCount` to enable a second (slave) window that displays lines beyond+ the initial (title) one.++ * `XMonad.Hooks.DynamicLog`++ - Added optional `ppVisibleNoWindows` to differentiate between empty+ and non-empty visible workspaces in pretty printing.++ * `XMonad.Actions.DynamicWorkspaceOrder`++ - Added `updateName` and `removeName` to better control ordering when+ workspace names are changed or workspaces are removed.++ * `XMonad.Config.Azerty`++ * Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY+ keyboards, which are slightly different from the French ones in the top+ row.+ ## 0.13 (February 10, 2017) ### Breaking Changes@@ -67,12 +425,6 @@ * `XMonad.Actions.UpdatePointer` - Fix bug when cursor gets stuck in one of the corners.-- * `XMonad.Actions.Submap`-- Establish pointer grab to avoid freezing X, when button press occurs after- submap key press. And terminate submap at button press in the same way,- as we do for wrong key press. * `XMonad.Actions.DynamicProjects`
README.md view
@@ -1,14 +1,15 @@ # xmonad-contrib: Third Party Extensions to the xmonad Window Manager [](https://travis-ci.org/xmonad/xmonad-contrib)+[](https://www.codetriage.com/xmonad/xmonad-contrib) You need the ghc compiler and xmonad window manager installed in order to use these extensions. For installation and configuration instructions, please see the-[xmonad website] [xmonad], the documents included with the-[xmonad source distribution] [xmonad-git], and the-[online haddock documentation] [xmonad-docs].+[xmonad website][xmonad], the documents included with the+[xmonad source distribution][xmonad-git], and the+[online haddock documentation][xmonad-docs]. ## Getting or Updating XMonadContrib @@ -17,7 +18,7 @@ * Git version: <https://github.com/xmonad/xmonad-contrib> (To use git xmonad-contrib you must also use the-[git version of xmonad] [xmonad-git].)+[git version of xmonad][xmonad-git].) ## Contributing @@ -28,15 +29,15 @@ XMonad.Layout.Grid -For further details, see the [documentation] [developing] for the-`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].+For further details, see the [documentation][developing] for the+`XMonad.Doc.Developing` module, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md) and the [xmonad website][xmonad]. ## License Code submitted to the contrib repo is licensed under the same license as xmonad itself, with copyright held by the authors.-+ [xmonad]: http://xmonad.org [xmonad-git]: https://github.com/xmonad/xmonad-[xmonad-docs]: http://www.xmonad.org/xmonad-docs-[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html+[xmonad-docs]: http://hackage.haskell.org/package/xmonad+[developing]: http://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Doc-Developing.html
XMonad/Actions/Commands.hs view
@@ -19,6 +19,7 @@ -- $usage commandMap, runCommand,+ runCommandConfig, runCommand', workspaceCommands, screenCommands,@@ -103,11 +104,18 @@ ] -- | Given a list of command\/action pairs, prompt the user to choose a--- command and return the corresponding action.+-- command using dmenu and return the corresponding action. runCommand :: [(String, X ())] -> X ()-runCommand cl = do+runCommand = runCommandConfig dmenu+++-- | Given a list of command\/action pairs, prompt the user to choose a+-- command using dmenu-compatible launcher and return the corresponding action.+-- See X.U.Dmenu for compatible launchers.+runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()+runCommandConfig f cl = do let m = commandMap cl- choice <- dmenu (M.keys m)+ choice <- f (M.keys m) fromMaybe (return ()) (M.lookup choice m) -- | Given the name of a command from 'defaultCommands', return the
+ XMonad/Actions/CycleWorkspaceByScreen.hs view
@@ -0,0 +1,102 @@++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.CycleWorkspaceByScreen+-- Copyright : (c) 2017 Ivan Malison+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : IvanMalison@gmail.com+-- Stability : unstable+-- Portability : unportable+--+-- Cycle through previously viewed workspaces in the order they were viewed most+-- recently on the screen where cycling is taking place.+--+-----------------------------------------------------------------------------++module XMonad.Actions.CycleWorkspaceByScreen (+ -- * Usage+ -- $usage+ cycleWorkspaceOnScreen+ , cycleWorkspaceOnCurrentScreen+ , handleKeyEvent+ , repeatableAction+ ) where++import Control.Monad+import Data.IORef+import Data.List+import Data.Maybe++import Graphics.X11.Xlib.Extras++import XMonad+import XMonad.Hooks.WorkspaceHistory+import qualified XMonad.StackSet as W++-- $usage+-- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory+--+-- To use, add something like the following to your keybindings+-- , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)++repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()+repeatableAction mods pressHandler = do+ XConf {theRoot = root, display = d} <- ask+ let getNextEvent = io $ allocaXEvent $ \p ->+ do+ maskEvent d (keyPressMask .|. keyReleaseMask) p+ KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p+ s <- io $ keycodeToKeysym d c 0+ return (t, s)+ handleEvent (t, s)+ | t == keyRelease && s `elem` mods = return ()+ | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent++ io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime+ getNextEvent >>= handleEvent+ io $ ungrabKeyboard d currentTime++handleKeyEvent :: EventType+ -> KeySym+ -> X ()+ -> EventType+ -> KeySym+ -> Maybe (X ())+handleKeyEvent eventType key action = helper+ where+ helper et k+ | et == eventType && k == key = Just action+ | otherwise = Nothing+++runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X ()+runFirst matchers eventType key =+ fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers++cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()+cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do+ startingHistory <- workspaceHistoryByScreen+ currentWSIndex <- io $ newIORef 1+ let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory+ getAndIncrementWS increment = do+ current <- readIORef currentWSIndex+ modifyIORef+ currentWSIndex+ ((`mod` (length cycleWorkspaces)) . (+ increment))+ return $ cycleWorkspaces !! current+ focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)++ focusIncrement 1 -- Do the first workspace cycle+ repeatableAction mods $+ runFirst+ [ handleKeyEvent keyPress nextKey $ focusIncrement 1+ , handleKeyEvent keyPress prevKey $ focusIncrement (-1)+ ]+ return ()++cycleWorkspaceOnCurrentScreen+ :: [KeySym] -> KeySym -> KeySym -> X ()+cycleWorkspaceOnCurrentScreen mods n p =+ withWindowSet $ \ws ->+ cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p
XMonad/Actions/DynamicWorkspaceOrder.hs view
@@ -23,6 +23,8 @@ getWsCompareByOrder , getSortByOrder , swapWith+ , updateName+ , removeName , moveTo , moveToGreedy@@ -151,6 +153,21 @@ let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2] XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) windows id -- force a status bar update++-- | Update the name of a workspace in the stored order.+updateName :: WorkspaceId -> WorkspaceId -> X ()+updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId++-- | Remove a workspace from the stored order.+removeName :: WorkspaceId -> X ()+removeName = XS.modify . withWSO . M.delete++-- | Update a key in a Map.+changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a+changeKey oldKey newKey oldMap =+ case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of+ (Nothing, _) -> oldMap+ (Just val, newMap) -> M.insert newKey val newMap -- | View the next workspace of the given type in the given direction, -- where \"next\" is determined using the dynamic workspace order.
XMonad/Actions/GridSelect.hs view
@@ -205,7 +205,8 @@ gs_navigate :: TwoD a (Maybe a), gs_rearranger :: Rearranger a, gs_originFractX :: Double,- gs_originFractY :: Double+ gs_originFractY :: Double,+ gs_bordercolor :: String } -- | That is 'fromClassName' if you are selecting a 'Window', or@@ -322,15 +323,15 @@ findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) -drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()-drawWinBox win font (fg,bg) ch cw text x y cp =+drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()+drawWinBox win font (fg,bg) bc ch cw text x y cp = withDisplay $ \dpy -> do gc <- liftIO $ createGC dpy win bordergc <- liftIO $ createGC dpy win liftIO $ do Just fgcolor <- initColor dpy fg Just bgcolor <- initColor dpy bg- Just bordercolor <- initColor dpy borderColor+ Just bordercolor <- initColor dpy bc setForeground dpy gc fgcolor setBackground dpy gc bgcolor setForeground dpy bordergc bordercolor@@ -340,7 +341,10 @@ (\n -> do size <- liftIO $ textWidthXMF dpy font n return $ size > (fromInteger (cw-(2*cp)))) text- printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext+ -- calculate the offset to vertically centre the text based on the ascender and descender+ (asc,desc) <- liftIO $ textExtentsXMF font stext+ let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc+ printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext liftIO $ freeGC dpy gc liftIO $ freeGC dpy bordergc @@ -378,6 +382,7 @@ colors <- colorizer element (pos == curpos) drawWinBox win font colors+ (gs_bordercolor gsconfig) cellheight cellwidth text@@ -390,7 +395,7 @@ stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop | t == buttonRelease = do s @ TwoDState { td_paneX = px, td_paneY = py,- td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get+ td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get let gridX = (fi x - (px - cw) `div` 2) `div` cw gridY = (fi y - (py - ch) `div` 2) `div` ch case lookup (gridX,gridY) (td_elementmap s) of@@ -714,10 +719,7 @@ -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2)--borderColor :: String-borderColor = "white"+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" -- | Brings selected window to the current workspace. bringSelected :: GSConfig Window -> X ()
XMonad/Actions/MessageFeedback.hs view
@@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MessageFeedback--- Copyright : (c) Quentin Moser <moserq@gmail.com>+-- Copyright : (c) -- Quentin Moser <moserq@gmail.com>+-- 2018 Yclept Nemo -- License : BSD3 -- -- Maintainer : orphaned@@ -13,87 +14,263 @@ -- this facility. ----------------------------------------------------------------------------- -module XMonad.Actions.MessageFeedback (- -- * Usage- -- $usage+module XMonad.Actions.MessageFeedback+ ( -- * Usage+ -- $usage - send- , tryMessage- , tryMessage_- , tryInOrder- , tryInOrder_- , sm- , sendSM- , sendSM_- ) where+ -- * Messaging variants -import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )-import XMonad.StackSet ( current, workspace, layout, tag )-import XMonad.Operations ( updateLayout )+ -- ** 'SomeMessage'+ sendSomeMessageB, sendSomeMessage+ , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh+ , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent -import Control.Monad.State ( gets )-import Data.Maybe ( isJust )-import Control.Applicative ((<$>))+ -- ** 'Message'+ , sendMessageB+ , sendMessageWithNoRefreshB+ , sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent + -- * Utility Functions++ -- ** Send All+ , sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages++ -- ** Send Until+ , tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent+ , tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent++ -- ** Aliases+ , sm++ -- * Backwards Compatibility+ -- $backwardsCompatibility+ , send, sendSM, sendSM_+ , tryInOrder, tryInOrder_+ , tryMessage, tryMessage_+ ) where++import XMonad ( Window )+import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )+import XMonad.StackSet ( Workspace, current, workspace, layout, tag )+import XMonad.Operations ( updateLayout, refresh, windows )++import Data.Maybe ( isJust )+import Control.Monad ( when, void )+import Control.Monad.State ( gets )+import Control.Applicative ( (<$>), liftA2 )+ -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.MessageFeedback ----- You can then use this module's functions wherever an action is expected.+-- You can then use this module's functions wherever an action is expected. All+-- feedback variants are supported: --+-- * message to any workspace with no refresh+-- * message to current workspace with no refresh+-- * message to current workspace with refresh+--+-- Except "message to any workspace with refresh" which makes little sense.+-- -- Note that most functions in this module have a return type of @X Bool@--- whereas configuration options will expect a @X ()@ action.--- For example, the key binding+-- whereas configuration options will expect a @X ()@ action. For example, the+-- key binding: -- -- > -- Shrink the master area of a tiled layout, or move the focused window -- > -- to the left in a WindowArranger-based layout--- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))+-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50)) ----- is mis-typed. For this reason, this module provides alternatives (ending with--- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.--- For example, to correct the previous example:+-- is mis-typed. For this reason, this module provides alternatives (not ending+-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than+-- 'sendMessageB') that discard their boolean result and return an @X ()@. For+-- example, to correct the previous example: ----- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))+-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50)) --+-- This module also provides 'SomeMessage' variants of each 'Message' function+-- for when the messages are of differing types (but still instances of+-- 'Message'). First box each message using 'SomeMessage' or the convenience+-- alias 'sm'. Then, for example, to send each message:+--+-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]+--+-- This is /not/ equivalent to the following example, which will not refresh+-- the workspace unless the last message is handled:+--+-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB --- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the--- message was handled by the layout, False otherwise.-send :: Message a => a -> X Bool-send = sendSM . sm+-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use+-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,+-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'+-- for efficiency this is pretty much an exact copy of the+-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.+sendSomeMessageB :: SomeMessage -> X Bool+sendSomeMessageB m = do+ w <- workspace . current <$> gets windowset+ ml <- handleMessage (layout w) m `catchX` return Nothing+ whenJust ml $ \l ->+ windows $ \ws -> ws { current = (current ws)+ { workspace = (workspace $ current ws)+ { layout = l }}}+ return $ isJust ml --- | Sends the first message, and if it was not handled, sends the second.--- Returns True if either message was handled, False otherwise.-tryMessage :: (Message a, Message b) => a -> b -> X Bool-tryMessage m1 m2 = do b <- send m1- if b then return True else send m2+-- | Variant of 'sendSomeMessageB' that discards the result.+sendSomeMessage :: SomeMessage -> X ()+sendSomeMessage = void . sendSomeMessageB -tryMessage_ :: (Message a, Message b) => a -> b -> X ()-tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts+-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns+-- @True@ if the message was handled, @False@ otherwise.+sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool+sendSomeMessageWithNoRefreshB m w+ = handleMessage (layout w) m `catchX` return Nothing+ >>= liftA2 (>>) (updateLayout $ tag w) (return . isJust) --- | Tries sending every message of the list in order until one of them--- is handled. Returns True if one of the messages was handled, False otherwise.-tryInOrder :: [SomeMessage] -> X Bool-tryInOrder [] = return False-tryInOrder (m:ms) = do b <- sendSM m- if b then return True else tryInOrder ms+-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.+sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()+sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m -tryInOrder_ :: [SomeMessage] -> X ()-tryInOrder_ ms = tryInOrder ms >> return ()+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the+-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see+-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was+-- handled, @False@ otherwise. This function is somewhat of a cross between+-- 'XMonad.Operations.sendMessage' (sends to the current layout) and+-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).+sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool+sendSomeMessageWithNoRefreshToCurrentB m+ = (gets $ workspace . current . windowset)+ >>= sendSomeMessageWithNoRefreshB m +-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the+-- result.+sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()+sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB --- | Convenience shorthand for 'XMonad.Core.SomeMessage'.++-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'+-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message+-- was handled, @False@ otherwise.+sendMessageB :: Message a => a -> X Bool+sendMessageB = sendSomeMessageB . SomeMessage++-- | Variant of 'sendSomeMessageWithNoRefreshB' which like+-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than+-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.+sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool+sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage++-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts+-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was+-- handled, @False@ otherwise.+sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool+sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage++-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.+sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()+sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB+++-- | Send each 'SomeMessage' to the current layout without refresh (using+-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any+-- message was handled, refresh. If you want to sequence a series of messages+-- that would have otherwise used 'XMonad.Operations.sendMessage' while+-- minimizing refreshes, use this.+sendSomeMessagesB :: [SomeMessage] -> X [Bool]+sendSomeMessagesB m+ = mapM sendSomeMessageWithNoRefreshToCurrentB m+ >>= liftA2 (>>) (flip when refresh . or) return++-- | Variant of 'sendSomeMessagesB' that discards the results.+sendSomeMessages :: [SomeMessage] -> X ()+sendSomeMessages = void . sendSomeMessagesB++-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than+-- 'SomeMessage'. Use this if all the messages are of the same type.+sendMessagesB :: Message a => [a] -> X [Bool]+sendMessagesB = sendSomeMessagesB . map SomeMessage++-- | Variant of 'sendMessagesB' that discards the results.+sendMessages :: Message a => [a] -> X ()+sendMessages = void . sendMessagesB+++-- | Apply the dispatch function in order to each message of the list until one+-- is handled. Returns @True@ if so, @False@ otherwise.+tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool+tryInOrderB _ [] = return False+tryInOrderB f (m:ms) = do b <- f m+ if b then return True else tryInOrderB f ms++-- | Variant of 'tryInOrderB' that sends messages to the current layout without+-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.+tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool+tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB++-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.+tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()+tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB++-- | Apply the dispatch function to the first message, and if it was not+-- handled, apply it to the second. Returns @True@ if either message was+-- handled, @False@ otherwise.+tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool+tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]++-- | Variant of 'tryMessageB' that sends messages to the current layout without+-- refresh using 'sendMessageWithNoRefreshToCurrentB'.+tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool+tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB++-- | Variant of 'tryMessage' that discards the results.+tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()+tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m+++-- | Convenience shorthand for 'SomeMessage'. sm :: Message a => a -> SomeMessage sm = SomeMessage +--------------------------------------------------------------------------------+-- 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." #-} -sendSM :: SomeMessage -> X Bool-sendSM m = do w <- workspace . current <$> gets windowset- ml' <- handleMessage (layout w) m `catchX` return Nothing- updateLayout (tag w) ml'- return $ isJust ml'+-- $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_ m = sendSM m >> return ()+sendSM_ = sendSomeMessageWithNoRefreshToCurrent++-- | See 'tryInOrderWithNoRefreshToCurrentB'.+tryInOrder :: [SomeMessage] -> X Bool+tryInOrder = tryInOrderWithNoRefreshToCurrentB++-- | See 'tryInOrderWithNoRefreshToCurrent'.+tryInOrder_ :: [SomeMessage] -> X ()+tryInOrder_ = tryInOrderWithNoRefreshToCurrent++-- | See 'tryMessageWithNoRefreshToCurrentB'.+tryMessage :: (Message a, Message b) => a -> b -> X Bool+tryMessage = tryMessageWithNoRefreshToCurrentB++-- | See 'tryMessageWithNoRefreshToCurrent'.+tryMessage_ :: (Message a, Message b) => a -> b -> X ()+tryMessage_ = tryMessageWithNoRefreshToCurrent
+ XMonad/Actions/Minimize.hs view
@@ -0,0 +1,144 @@+----------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.Minimize+-- Copyright : (c) Bogdan Sinitsyn (2016)+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>+-- Stability : unstable+-- Portability : not portable+--+-- Adds actions for minimizing and maximizing windows+--+-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your+-- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from+-- this module+--+-- Possible keybindings:+--+-- > , ((modm, xK_m ), withFocused minimizeWindow)+-- > , ((modm .|. shiftMask, xK_m ), withLastMinimized maximizeWindowAndFocus)+--+-----------------------------------------------------------------------------++module XMonad.Actions.Minimize+ ( -- * Usage+ -- $usage+ minimizeWindow+ , maximizeWindow+ , maximizeWindowAndFocus+ , withLastMinimized+ , withLastMinimized'+ , withFirstMinimized+ , withFirstMinimized'+ , withMinimized+ ) where++import XMonad+import qualified XMonad.StackSet as W++import qualified XMonad.Layout.BoringWindows as BW+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Minimize+import XMonad.Util.WindowProperties (getProp32)++import Foreign.C.Types (CLong)+import Control.Applicative((<$>))+import Control.Monad (join)+import Data.Maybe (fromMaybe, listToMaybe)+import qualified Data.List as L+import qualified Data.Map as M++-- $usage+-- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows":+-- > import XMonad.Actions.Minimize+-- > import XMonad.Layout.Minimize+-- > import qualified XMonad.Layout.BoringWindows as BW+--+-- Then apply 'minimize' and 'boringWindows' to your layout hook and use some+-- actions from this module:+-- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever }+-- Example keybindings:+-- > , ((modm, xK_m ), withFocused minimizeWindow )+-- > , ((modm .|. shiftMask, xK_m ), withLastMinimized maximizeWindow)++setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()+setMinimizedState win st f = do+ setWMState win st+ withDisplay $ \dpy -> do+ wm_state <- getAtom "_NET_WM_STATE"+ hidden <- fromIntegral <$> getAtom "_NET_WM_STATE_HIDDEN"+ wstate <- fromMaybe [] <$> getProp32 wm_state win+ io $ changeProperty32 dpy win wm_state aTOM propModeReplace (f hidden wstate)++setMinimized :: Window -> X ()+setMinimized win = setMinimizedState win iconicState (:)++setNotMinimized :: Window -> X ()+setNotMinimized win = setMinimizedState win normalState L.delete++-- It does not just set minimizedStack to newWindows because it should save+-- order in which elements were added (newer first)+modified :: (RectMap -> RectMap) -> X Bool+modified f = XS.modified $+ \Minimized { rectMap = oldRectMap, minimizedStack = oldStack } ->+ let newRectMap = f oldRectMap+ newWindows = M.keys newRectMap+ in Minimized { rectMap = newRectMap+ , minimizedStack = (newWindows L.\\ oldStack)+ +++ (oldStack `L.intersect` newWindows)+ }+++-- | Minimize a window+minimizeWindow :: Window -> X ()+minimizeWindow w = withWindowSet $ \ws ->+ whenX (modified $ M.insert w (M.lookup w $ W.floating ws)) $ do+ setMinimized w+ windows $ W.sink w+ BW.focusDown+++-- | Maximize window and apply a function to maximized window and 'WindowSet'+maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X ()+maximizeWindowAndChangeWSet f w = do+ mrect <- XS.gets (join . M.lookup w . rectMap)+ whenX (modified $ M.delete w) $ do+ setNotMinimized w+ broadcastMessage BW.UpdateBoring+ windows $ f w . maybe id (W.float w) mrect++-- | Just maximize a window without focusing+maximizeWindow :: Window -> X ()+maximizeWindow = maximizeWindowAndChangeWSet $ const id++-- | Maximize a window and then focus it+maximizeWindowAndFocus :: Window -> X ()+maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow++-- | Perform an action with first minimized window on current workspace+-- or do nothing if there is no minimized windows on current workspace+withFirstMinimized :: (Window -> X ()) -> X ()+withFirstMinimized action = withFirstMinimized' (flip whenJust action)++-- | Like withFirstMinimized but the provided action is always invoked with a+-- 'Maybe Window', that will be nothing if there is no first minimized window.+withFirstMinimized' :: (Maybe Window -> X ()) -> X ()+withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)++-- | Perform an action with last minimized window on current workspace+-- or do nothing if there is no minimized windows on current workspace+withLastMinimized :: (Window -> X ()) -> X ()+withLastMinimized action = withLastMinimized' (flip whenJust action)++-- | Like withLastMinimized but the provided action is always invoked with a+-- 'Maybe Window', that will be nothing if there is no last minimized window.+withLastMinimized' :: (Maybe Window -> X ()) -> X ()+withLastMinimized' action = withMinimized (action . listToMaybe)++withMinimized :: ([Window] -> X a) -> X a+withMinimized action = do+ minimized <- XS.gets minimizedStack+ currentStack <- withWindowSet $ return . W.index+ action $ minimized `L.intersect` currentStack
@@ -43,6 +43,9 @@ , Navigation2D , lineNavigation , centerNavigation+ , sideNavigation+ , sideNavigationWithBias+ , hybridOf , hybridNavigation , fullScreenRect , singleWindowRect@@ -59,6 +62,7 @@ import qualified Data.List as L import qualified Data.Map as M import Data.Maybe+import Data.Ord (comparing) import XMonad hiding (Screen) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS@@ -70,16 +74,17 @@ -- Navigation2D provides directional navigation (go left, right, up, down) for -- windows and screens. It treats floating and tiled windows as two separate -- layers and provides mechanisms to navigate within each layer and to switch--- between layers. Navigation2D provides two different navigation strategies--- (see <#Technical_Discussion> for details): /Line navigation/ feels rather--- natural but may make it impossible to navigate to a given window from the--- current window, particularly in the floating layer. /Center navigation/--- feels less natural in certain situations but ensures that all windows can be--- reached without the need to involve the mouse. A third option is to use--- /Hybrid navigation/, which automatically chooses between the two whenever--- navigation is attempted. Navigation2D allows different navigation strategies--- to be used in the two layers and allows customization of the navigation strategy--- for the tiled layer based on the layout currently in effect.+-- between layers. Navigation2D provides three different navigation strategies+-- (see <#Technical_Discussion> for details): /Line navigation/ and+-- /Side navigation/ feel rather natural but may make it impossible to navigate+-- to a given window from the current window, particularly in the floating+-- layer. /Center navigation/ feels less natural in certain situations but+-- ensures that all windows can be reached without the need to involve the+-- mouse. Another option is to use a /Hybrid/ of the three strategies,+-- automatically choosing whichever first provides a suitable target window.+-- Navigation2D allows different navigation strategies to be used in the two+-- layers and allows customization of the navigation strategy for the tiled+-- layer based on the layout currently in effect. -- -- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@: --@@ -96,11 +101,11 @@ -- -- Alternatively, you can use navigation2DP: ----- > main = xmonad $ navigation2D def--- > ("<Up>", "<Left>", "<Down>", "<Right>")--- > [("M-", windowGo ),--- > ("M-S-", windowSwap)]--- > False+-- > main = xmonad $ navigation2DP def+-- > ("<Up>", "<Left>", "<Down>", "<Right>")+-- > [("M-", windowGo ),+-- > ("M-S-", windowSwap)]+-- > False -- > $ def -- -- That's it. If instead you'd like more control, you can combine@@ -318,12 +323,46 @@ centerNavigation :: Navigation2D centerNavigation = N 2 doCenterNavigation --- | Hybrid navigation. This attempts Line navigation, then falls back on Center--- navigation if it does not find any suitable target windows. This is useful since--- Line navigation tends to fail on gaps, but provides more intuitive motions--- when it succeeds—provided there are no floating windows.+-- | Side navigation. Consider navigating to the right this time. The strategy+-- is to take the line segment forming the right boundary of the current window,+-- and push it to the right until it intersects with at least one other window.+-- Of those windows, one with a point that is the closest to the centre of the+-- line (+1) is selected. This is probably the most intuitive strategy for the+-- tiled layer when using XMonad.Layout.Spacing.+sideNavigation :: Navigation2D+sideNavigation = N 1 (doSideNavigationWithBias 1)++-- | Side navigation with bias. Consider a case where the screen is divided+-- up into three vertical panes; the side panes occupied by one window each and+-- the central pane split across the middle by two windows. By the criteria+-- of side navigation, the two central windows are equally good choices when+-- navigating inwards from one of the side panes. Hence in order to be+-- equitable, symmetric and pleasant to use, different windows are chosen when+-- navigating from different sides. In particular, the lower is chosen when+-- going left and the higher when going right, causing L, L, R, R, L, L, etc to+-- cycle through the four windows clockwise. This is implemented by using a bias+-- of 1. /Bias/ is how many pixels off centre the vertical split can be before+-- this behaviour is lost and the same window chosen every time. A negative bias+-- swaps the preferred window for each direction. A bias of zero disables the+-- behaviour.+sideNavigationWithBias :: Int -> Navigation2D+sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)++-- | Hybrid of two modes of navigation, preferring the motions of the first.+-- Use this if you want to fall back on a second strategy whenever the first+-- does not find a candidate window. E.g.+-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the+-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable+-- you to take advantage of some of the latter strategy's more interesting+-- motions in the tiled layer.+hybridOf :: Navigation2D -> Navigation2D -> Navigation2D+hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2+ where+ applyToBoth f g a b c = f a b c <|> g a b c++{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-} hybridNavigation :: Navigation2D-hybridNavigation = N 2 doHybridNavigation+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,@@ -767,12 +806,54 @@ -- or it has the same distance but comes later -- in the window stack --- | Implements Hybrid navigation. This attempts Line navigation first,--- then falls back on Center navigation if it finds no suitable target window.-doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a-doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation- where- applyToBoth f g h a b c = f (g a b c) (h a b c)+-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and+-- y1 <= y2, and make the assumption valid by initialising SideRects with the+-- property and carefully preserving it over any individual transformation.+data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }+ deriving Show++-- Conversion from Rectangle format to SideRect.+toSR :: Rectangle -> SideRect+toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)++-- Implements side navigation with bias.+doSideNavigationWithBias ::+ Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a+doSideNavigationWithBias bias dir (cur, rect)+ = fmap fst . listToMaybe+ . L.sortBy (comparing dist) . foldr acClosest []+ . filter (`toRightOf` (cur, transform rect))+ . map (fmap transform)+ where+ -- Getting the center of the current window so we can make it the new origin.+ cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)+ (x0, y0) = cOf . toSR $ rect++ -- Translate the given SideRect by (-x0, -y0).+ translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)++ -- Rotate the given SideRect 90 degrees counter-clockwise about the origin.+ rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)++ -- Apply the above function until d becomes synonymous with R (wolog).+ rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]+ in foldr (const $ (.) rHalfPiCC) id l++ transform = rotateToR dir . translate . toSR++ -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't+ -- below or above c, i.e. iff:+ -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)+ toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)++ -- Greedily accumulate the windows tied for the leftmost left side.+ acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l+ | x1 r > x1 r' = l+ acClosest (w, r) _ = (w, r) : []++ -- Given a (_, SideRect), calculate how far it is from the y=bias line.+ dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0+ | otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias) -- | Swaps the current window with the window given as argument swap :: Window -> WindowSet -> WindowSet
XMonad/Actions/PhysicalScreens.hs view
@@ -21,6 +21,12 @@ , sendToScreen , onNextNeighbour , onPrevNeighbour+ , horizontalScreenOrderer+ , verticalScreenOrderer+ , ScreenComparator(ScreenComparator)+ , getScreenIdAndRectangle+ , screenComparatorById+ , screenComparatorByRectangle ) where import XMonad@@ -36,17 +42,20 @@ rather than their @ScreenID@ s, which are arbitrarily determined by your X server and graphics hardware. -Screens are ordered by the upper-left-most corner, from top-to-bottom+You can specify how to order the screen by giving a ScreenComparator.+To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.+The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom and then left-to-right. Example usage in your @~\/.xmonad\/xmonad.hs@ file: > import XMonad.Actions.PhysicalScreens+> import Data.Default -> , ((modMask, xK_a), onPrevNeighbour W.view)-> , ((modMask, xK_o), onNextNeighbour W.view)-> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)-> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)+> , ((modMask, xK_a), onPrevNeighbour def W.view)+> , ((modMask, xK_o), onNextNeighbour def W.view)+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift) > -- > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3@@ -54,7 +63,7 @@ > -- > [((modm .|. mask, key), f sc) > | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]-> , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]+> , (f, mask) <- [(viewScreen, 0), (sendToScreen def, shiftMask)]] For detailed instructions on editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".@@ -63,52 +72,78 @@ -- | The type of the index of a screen by location newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) +getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)+getScreenIdAndRectangle screen = (W.screen screen, rect) where+ rect = screenRect $ W.screenDetail screen+ -- | Translate a physical screen index to a "ScreenId"-getScreen :: PhysicalScreen -> X (Maybe ScreenId)-getScreen (P i) = do w <- gets windowset- let screens = W.current w : W.visible w- if i<0 || i >= length screens- then return Nothing- else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens- in return $ Just $ W.screen $ ss !! i+getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)+getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset+ let screens = W.current w : W.visible w+ if i<0 || i >= length screens+ then return Nothing+ else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens+ in return $ Just $ W.screen $ ss !! i -- | Switch to a given physical screen-viewScreen :: PhysicalScreen -> X ()-viewScreen p = do i <- getScreen p- whenJust i $ \s -> do- w <- screenWorkspace s- whenJust w $ windows . W.view+viewScreen :: ScreenComparator -> PhysicalScreen -> X ()+viewScreen sc p = do i <- getScreen sc p+ whenJust i $ \s -> do+ w <- screenWorkspace s+ whenJust w $ windows . W.view -- | Send the active window to a given physical screen-sendToScreen :: PhysicalScreen -> X ()-sendToScreen p = do i <- getScreen p- whenJust i $ \s -> do- w <- screenWorkspace s- whenJust w $ windows . W.shift+sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()+sendToScreen sc p = do i <- getScreen sc p+ whenJust i $ \s -> do+ w <- screenWorkspace s+ whenJust w $ windows . W.shift --- | Compare two screens by their top-left corners, ordering--- | top-to-bottom and then left-to-right.-cmpScreen :: Rectangle -> Rectangle -> Ordering-cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)+-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id+newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering) +-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom+instance Default ScreenComparator where+ def= verticalScreenOrderer +-- | Compare screen only by their coordonate+screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator+screenComparatorByRectangle rectComparator = ScreenComparator comparator where+ comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2++-- | Compare screen only by their Xinerama id+screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator+screenComparatorById idComparator = ScreenComparator comparator where+ comparator (id1, _) (id2, _) = idComparator id1 id2++-- | orders screens by the upper-left-most corner, from top-to-bottom+verticalScreenOrderer :: ScreenComparator+verticalScreenOrderer = screenComparatorByRectangle comparator where+ comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2)++-- | orders screens by the upper-left-most corner, from left-to-right+horizontalScreenOrderer :: ScreenComparator+horizontalScreenOrderer = screenComparatorByRectangle comparator where+ comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2)+ -- | Get ScreenId for neighbours of the current screen based on position offset.-getNeighbour :: Int -> X ScreenId-getNeighbour d = do w <- gets windowset- let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w- curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss- pos = (curPos + d) `mod` length ss- return $ ss !! pos+getNeighbour :: ScreenComparator -> Int -> X ScreenId+getNeighbour (ScreenComparator cmpScreen) d =+ do w <- gets windowset+ let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w+ curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss+ pos = (curPos + d) `mod` length ss+ return $ ss !! pos -neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()-neighbourWindows d f = do s <- getNeighbour d- w <- screenWorkspace s- whenJust w $ windows . f+neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()+neighbourWindows sc d f = do s <- getNeighbour sc d+ w <- screenWorkspace s+ whenJust w $ windows . f -- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.-onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()-onNextNeighbour = neighbourWindows 1+onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()+onNextNeighbour sc = neighbourWindows sc 1 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.-onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()-onPrevNeighbour = neighbourWindows (-1)+onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()+onPrevNeighbour sc = neighbourWindows sc (-1)
XMonad/Actions/SpawnOn.hs view
@@ -28,8 +28,14 @@ shellPromptOn ) where +import Control.Exception (tryJust)+import Control.Monad (guard) import Data.List (isInfixOf)+import Data.Maybe (isJust)+import System.IO.Error (isDoesNotExistError)+import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID)+import Text.Printf (printf) import XMonad import qualified XMonad.StackSet as W@@ -68,6 +74,25 @@ initialValue = Spawner [] +getPPIDOf :: ProcessID -> Maybe ProcessID+getPPIDOf pid =+ case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger pid of+ Left _ -> Nothing+ Right contents -> case lines contents of+ [] -> Nothing+ first : _ -> case words first of+ _ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int)+ _ -> Nothing++getPPIDChain :: ProcessID -> [ProcessID]+getPPIDChain pid' = ppid_chain pid' []+ where ppid_chain pid acc =+ if pid == 0+ then acc+ else case getPPIDOf pid of+ Nothing -> acc+ Just ppid -> ppid_chain ppid (ppid : acc)+ -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner f = XS.modify (Spawner . f . pidsRef)@@ -83,9 +108,17 @@ manageSpawnWithGC garbageCollect = do Spawner pids <- liftX XS.get mp <- pid- case flip lookup pids =<< mp of- Nothing -> idHook- Just mh -> do+ let ppid_chain = case mp of+ Just winpid -> winpid : getPPIDChain winpid+ Nothing -> []+ known_window_handlers = [ mh+ | ppid <- ppid_chain+ , let mpid = lookup ppid pids+ , isJust mpid+ , let (Just mh) = mpid ]+ case known_window_handlers of+ [] -> idHook+ (mh:_) -> do whenJust mp $ \p -> liftX $ do ps <- XS.gets pidsRef XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
+ XMonad/Actions/SwapPromote.hs view
@@ -0,0 +1,407 @@+{-# LANGUAGE DeriveDataTypeable #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.SwapPromote+-- Copyright : (c) 2018 Yclept Nemo+-- License : BSD-style (see LICENSE)+--+-- Maintainer :+-- Stability : unstable+-- Portability : unportable+--+-- Module for tracking master window history per workspace, and associated+-- functions for manipulating the stack using such history.+--+-----------------------------------------------------------------------------+++module XMonad.Actions.SwapPromote+ ( -- * Usage+ -- $usage+ MasterHistory (..)+ -- * State Accessors+ , getMasterHistoryMap+ , getMasterHistoryFromTag+ , getMasterHistoryCurrent+ , getMasterHistoryFromWindow+ , modifyMasterHistoryFromTag+ , modifyMasterHistoryCurrent+ -- * Log Hook+ , masterHistoryHook+ -- * Log Hook Building Blocks+ , masterHistoryHook'+ , updateMasterHistory+ -- * Actions+ , swapPromote+ , swapPromote'+ , swapIn+ , swapIn'+ , swapHybrid+ , swapHybrid'+ -- * Action Building Blocks+ , swapApply+ , swapPromoteStack+ , swapInStack+ , swapHybridStack+ -- * List Utilities+ , cycleN+ , split+ , split'+ , merge+ , merge'+ -- * Stack Utilities+ , stackSplit+ , stackMerge+ ) where+++import XMonad+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS++import qualified Data.Map as M+import qualified Data.Set as S+import Data.List+import Data.Maybe+import Control.Arrow+import Control.Applicative ((<$>),(<*>))+import Control.Monad+++-- $usage+-- Given your configuration file, import this module:+--+-- > import XMonad.Actions.SwapPromote+--+-- First add 'masterHistoryHook' to your 'logHook' to track master windows per+-- workspace:+--+-- > myLogHook = otherHook >> masterHistoryHook+--+-- Then replace xmonad's default promote keybinding with 'swapPromote'':+--+-- > , ((mod1Mask, xK_Return), swapPromote' False)+--+-- Depending on your xmonad configuration or window actions the master history+-- may be empty. If this is the case you can still chain another promotion+-- function:+--+-- > import XMonad.Actions.DwmPromote+-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)+--+-- To be clear, this is only called when the lack of master history hindered+-- the swap and not other conditions, such as having a only a single window.+--+-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus+-- position - effectively "swapping" new windows into focus without moving the+-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows+-- while swapping windows into the focused master. This works well on layouts+-- with large masters. Both come with chainable variants, see 'swapIn'' and+-- 'swapHybrid''.+--+-- So far floating windows have been treated no differently than tiled windows+-- even though their positions are independent of the stack. Often, yanking+-- floating windows in and out of the workspace will obliterate the stack+-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is+-- toggled so frequenty and always replaces the master window. That's why the+-- swap functions accept a boolean argument; when @True@ non-focused floating+-- windows will be ignored.+--+-- All together:+--+-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)+++-- | Mapping from workspace tag to master history list. The current master is+-- the head of the list, the previous master the second element, and so on.+-- Without history, the list is empty.+newtype MasterHistory = MasterHistory+ { getMasterHistory :: M.Map WorkspaceId [Window]+ } deriving (Read,Show,Typeable)++instance ExtensionClass MasterHistory where+ initialValue = MasterHistory M.empty++-- | Return the master history map from the state.+getMasterHistoryMap :: X (M.Map WorkspaceId [Window])+getMasterHistoryMap = XS.gets getMasterHistory++-- | Return the master history list of a given tag. The master history list may+-- be empty. An invalid tag will also result in an empty list.+getMasterHistoryFromTag :: WorkspaceId -> X [Window]+getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap++-- | Return the master history list of the current workspace.+getMasterHistoryCurrent :: X [Window]+getMasterHistoryCurrent = gets (W.currentTag . windowset)+ >>= getMasterHistoryFromTag++-- | Return the master history list of the workspace containing the given+-- window. Return an empty list if the window is not in the stackset.+getMasterHistoryFromWindow :: Window -> X [Window]+getMasterHistoryFromWindow w = gets (W.findTag w . windowset)+ >>= maybe (return []) getMasterHistoryFromTag++-- | Modify the master history list of a given workspace, or the empty list of+-- no such workspace is mapped. The result is then re-inserted into the master+-- history map.+modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()+modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->+ let l = M.findWithDefault [] t m+ in MasterHistory $ M.insert t (f l) m++-- | Modify the master history list of the current workspace. While the current+-- workspace is guaranteed to exist; its master history may not. For more+-- information see 'modifyMasterHistoryFromTag'.+modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()+modifyMasterHistoryCurrent f = gets (W.currentTag . windowset)+ >>= flip modifyMasterHistoryFromTag f++-- | A 'logHook' to update the master history mapping. Non-existent workspaces+-- are removed, and the master history list for the current workspaces is+-- updated. See 'masterHistoryHook''.+masterHistoryHook :: X ()+masterHistoryHook = masterHistoryHook' True updateMasterHistory++-- | Backend for 'masterHistoryHook'.+masterHistoryHook' :: Bool+ -- ^ If @True@, remove non-existent workspaces.+ -> ([Window] -> [Window] -> [Window])+ -- ^ Function used to update the master history list of+ -- the current workspace. First argument is the master+ -- history, second is the integrated stack. See+ -- 'updateMasterHistory' for more details.+ -> X ()+masterHistoryHook' removeWorkspaces historyModifier = do+ wset <- gets windowset+ let W.Workspace wid _ mst = W.workspace . W.current $ wset+ tags = map W.tag $ W.workspaces wset+ st = W.integrate' mst+ XS.modify $ \(MasterHistory mm) ->+ let mm' = if removeWorkspaces+ then restrictKeys mm $ S.fromList tags+ else mm+ ms = M.findWithDefault [] wid mm'+ ms' = historyModifier ms st+ in MasterHistory $ M.insert wid ms' mm'++-- | Less efficient version of 'M.restrictKeys'. Given broader eventual+-- adoption, replace this with 'M.restrictKeys'.+restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a+restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m++-- | Given the current master history list and an integrated stack, return the+-- new master history list. The current master is either moved (if it exists+-- within the history) or added to the head of the list, and all missing (i.e.+-- closed) windows are removed.+updateMasterHistory :: [Window] -- ^ The master history list.+ -> [Window] -- ^ The integrated stack.+ -> [Window]+updateMasterHistory _ [] = []+updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws++-- | Wrap 'swapPromoteStack'; see also 'swapApply'.+swapPromote :: Bool -> X Bool+swapPromote = flip swapApply swapPromoteStack++-- | Like 'swapPromote'' but discard the result.+swapPromote' :: Bool -> X ()+swapPromote' = void . swapPromote++-- | Wrap 'swapInStack'; see also 'swapApply'.+swapIn :: Bool -> X Bool+swapIn = flip swapApply swapInStack++-- | Like 'swapIn'' but discard the result.+swapIn' :: Bool -> X ()+swapIn' = void . swapIn++-- | Wrap 'swapHybridStack'; see also 'swapApply'.+swapHybrid :: Bool -> X Bool+swapHybrid = flip swapApply swapHybridStack++-- | Like 'swapHybrid'' but discard the result.+swapHybrid' :: Bool -> X ()+swapHybrid' = void . swapHybrid++-- | Apply the given master history stack modifier to the current stack. If+-- given @True@, all non-focused floating windows will be ignored. Return+-- @True@ if insufficient history; if so use 'whenX' to sequence a backup+-- promotion function.+swapApply :: Bool+ -> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))+ -> X Bool+swapApply ignoreFloats swapFunction = do+ fl <- gets $ W.floating . windowset+ st <- gets $ W.stack . W.workspace . W.current . windowset+ ch <- getMasterHistoryCurrent+ let swapApply' s1 =+ let fl' = if ignoreFloats then M.keysSet fl else S.empty+ ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)+ fh = filter ff ch+ pm = listToMaybe . drop 1 $ fh+ (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)+ (b,s3) = swapFunction pm s2+ s4 = stackMerge s3 r+ mh = let w = head . W.integrate $ s3+ in const $ w : delete w ch+ in (b,Just s4,mh)+ (x,y,z) = maybe (False,Nothing,id) swapApply' st+ -- Any floating master windows will be added to the history when 'windows'+ -- calls the log hook.+ modifyMasterHistoryCurrent z+ windows $ W.modify Nothing . const $ y+ return x++-- | If the focused window is the master window and there is no previous+-- master, do nothing. Otherwise swap the master with the previous master. If+-- the focused window is not the master window, swap it with the master window.+-- In either case focus follows the original window, i.e. the focused window+-- does not change, only its position.+--+-- The first argument is the previous master (which may not exist), the second+-- a window stack. Return @True@ if the master history hindered the swap; the+-- history is either empty or out-of-sync. Though the latter shouldn't happen+-- this function never changes the stack under such circumstances.+swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)+swapPromoteStack _ st@(W.Stack _x [] []) = (False,st)+swapPromoteStack Nothing st@(W.Stack _x [] _r) = (True,st)+swapPromoteStack (Just pm) (W.Stack x [] r) =+ let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r+ st' = W.Stack x l' r'+ b = null l'+ in (b,st')+swapPromoteStack _ (W.Stack x l r) =+ let r' = (++ r) . cycleN 1 . reverse $ l+ st' = W.Stack x [] r'+ in (False,st')++-- | Perform the same swap as 'swapPromoteStack'. However the new window+-- receives the focus; it appears to "swap into" the position of the original+-- window. Under this model focus follows stack position and the zipper does+-- not move.+--+-- See 'swapPromoteStack' for more details regarding the parameters.+swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)+swapInStack _ st@(W.Stack _x [] []) = (False,st)+swapInStack Nothing st@(W.Stack _x [] _r) = (True,st)+swapInStack (Just pm) (W.Stack x [] r) =+ let (x',r') = case span (/= pm) r of+ (__,[]) -> (x,r)+ (sl,sr) -> (pm,sl ++ x : drop 1 sr)+ st' = W.Stack x' [] r'+ b = x' == x+ in (b,st')+swapInStack _ (W.Stack x l r) =+ let l' = init l ++ [x]+ x' = last l+ st' = W.Stack x' l' r+ in (False,st')++-- | If the focused window is the master window, use 'swapInStack'. Otherwise use+-- 'swapPromoteStack'.+--+-- See 'swapPromoteStack' for more details regarding the parameters.+swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)+swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st+swapHybridStack m st = swapPromoteStack m st++-- | Cycle a list by the given count. If positive, cycle to the left. If+-- negative, cycle to the right:+--+-- >>> cycleN 2 [1,2,3,4,5]+-- [3,4,5,1,2]+-- >>> cycleN (-2) [1,2,3,4,5]+-- [4,5,1,2,3]+cycleN :: Int -> [a] -> [a]+cycleN n ls =+ let l = length ls+ in take l $ drop (n `mod` l) $ cycle ls++-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.+split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])+split p l =+ let (_,ys,ns) = split' p 0 l+ in (ys,ns)++-- | Given a predicate, an initial index and a list, return a tuple containing:+--+-- * List length.+-- * Indexed list of elements which satisfy the predicate. An indexed element+-- is a tuple containing the element index (offset by the initial index) and+-- the element.+-- * List of elements which do not satisfy the predicate.+--+-- The initial index and length of the list simplify chaining calls to this+-- function, such as for zippers of lists.+split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])+split' p i l =+ let accumulate e (c,ys,ns) = if p (snd e)+ then (c+1,e:ys,ns)+ else (c+1,ys,e:ns)+ (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l+ in (c',ys',snd . unzip $ ns')++-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the+-- unindexed list with elements from the leftover indexed list appended.+merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]+merge il ul =+ let (_,il',ul') = merge' 0 il ul+ in ul' ++ map snd il'++-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see+-- 'split''). Given a virtual index, an indexed list and an unindexed list,+-- return a tuple containing:+--+-- * Virtual index /after/ the unindexed list+-- * Remainder of the indexed list+-- * Merged unindexed list+--+-- If the indexed list is empty, this functions consumes the entire unindexed+-- list. If the unindexed list is empty, this function consumes only adjacent+-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing+-- unindexed elements and so once @(10,"ten")@ is consumed this function+-- concludes.+--+-- The indexed list is assumed to have been created by 'split'' and not checked+-- for correctness. Indices are assumed to be ascending, i.e.+-- > [(1,"one"),(2,"two"),(4,"four")]+--+-- The initial and final virtual indices simplify chaining calls to the this+-- function, as as for zippers of lists. Positive values shift the unindexed+-- list towards the tail, as if preceded by that many elements.+merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])+merge' i il@((j,a):ps) ul@(b:bs) = if j <= i+ then let (x,y,z) = merge' (i+1) ps ul+ in (x,y,a:z)+ else let (x,y,z) = merge' (i+1) il bs+ in (x,y,b:z)+merge' i [] (b:bs) =+ let (x,y,z) = merge' (i+1) [] bs+ in (x,y,b:z)+merge' i il@((j,a):ps) [] = if j <= i+ then let (x,y,z) = merge' (i+1) ps []+ in (x,y,a:z)+ else (i,il,[])+merge' i [] [] =+ (i,[],[])++-- | Remove all elements of the set from the stack. Skip the currently focused+-- member. Return an indexed list of excluded elements and the modified stack.+-- Use 'stackMerge' to re-insert the elements using this list.+stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)+stackSplit (W.Stack x l r) s =+ let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)+ (_,fr,tr) = split' (`S.member` s) (c+1) r+ in (fl++fr,W.Stack x (reverse tl) tr)++-- | Inverse of 'stackSplit'. Given a list of elements and their original+-- indices, re-insert the elements into these same positions within the stack.+-- Skip the currently focused member. Works best if the stack's length hasn't+-- changed, though if shorter any leftover elements will be tacked on.+stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b+stackMerge (W.Stack x l r) il =+ let (i,il1,l') = merge' 0 il (reverse l)+ (_,il2,r') = merge' (i+1) il1 r+ in W.Stack x (reverse l') (r' ++ map snd il2)
XMonad/Actions/WindowMenu.hs view
@@ -28,7 +28,7 @@ import qualified XMonad.StackSet as W import XMonad.Actions.GridSelect import XMonad.Layout.Maximize-import XMonad.Layout.Minimize+import XMonad.Actions.Minimize import XMonad.Util.XUtils (fi) -- $usage
XMonad/Config/Azerty.hs view
@@ -17,7 +17,7 @@ module XMonad.Config.Azerty ( -- * Usage -- $usage- azertyConfig, azertyKeys+ azertyConfig, azertyKeys, belgianConfig, belgianKeys ) where import XMonad@@ -40,11 +40,17 @@ azertyConfig = def { keys = azertyKeys <+> keys def } -azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $+belgianConfig = def { keys = belgianKeys <+> keys def }++azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]++belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]++azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $ [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] ++ [((m .|. modm, k), windows $ f i)- | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],+ | (i, k) <- zip (workspaces conf) topRow, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] ++ -- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
XMonad/Config/Bluetile.hs view
@@ -44,6 +44,7 @@ import XMonad.Actions.BluetileCommands import XMonad.Actions.CycleWS+import XMonad.Actions.Minimize import XMonad.Actions.WindowMenu import XMonad.Hooks.CurrentWorkspaceOnTop@@ -143,7 +144,7 @@ -- Minimizing , ((modMask', xK_m ), withFocused minimizeWindow)- , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin)+ , ((modMask' .|. shiftMask, xK_m ), withLastMinimized maximizeWindow) ] ++ -- mod-[1..9] ++ [0] %! Switch to workspace N
+ XMonad/Config/Example.hs view
@@ -0,0 +1,78 @@+--------------------------------------------------------------------------------+-- | Example.hs+--+-- Example configuration file for xmonad using the latest recommended+-- features (e.g., 'desktopConfig').+module Main (main) where++--------------------------------------------------------------------------------+import System.Exit+import XMonad+import XMonad.Config.Desktop+import XMonad.Hooks.DynamicLog+import XMonad.Hooks.ManageHelpers+import XMonad.Layout.BinarySpacePartition (emptyBSP)+import XMonad.Layout.NoBorders (noBorders)+import XMonad.Layout.ResizableTile (ResizableTall(..))+import XMonad.Layout.ToggleLayouts (ToggleLayout(..), toggleLayouts)+import XMonad.Prompt+import XMonad.Prompt.ConfirmPrompt+import XMonad.Prompt.Shell+import XMonad.Util.EZConfig++--------------------------------------------------------------------------------+main = do+ spawn "xmobar" -- Start a task bar such as xmobar.++ -- Start xmonad using the main desktop configuration with a few+ -- simple overrides:+ xmonad $ desktopConfig+ { modMask = mod4Mask -- Use the "Win" key for the mod key+ , manageHook = myManageHook <+> manageHook desktopConfig+ , layoutHook = desktopLayoutModifiers $ myLayouts+ , logHook = dynamicLogString def >>= xmonadPropLog+ }++ `additionalKeysP` -- Add some extra key bindings:+ [ ("M-S-q", confirmPrompt myXPConfig "exit" (io exitSuccess))+ , ("M-p", shellPrompt myXPConfig)+ , ("M-<Esc>", sendMessage (Toggle "Full"))+ ]++--------------------------------------------------------------------------------+-- | Customize layouts.+--+-- This layout configuration uses two primary layouts, 'ResizableTall'+-- and 'BinarySpacePartition'. You can also use the 'M-<Esc>' key+-- binding defined above to toggle between the current layout and a+-- full screen layout.+myLayouts = toggleLayouts (noBorders Full) others+ where+ others = ResizableTall 1 (1.5/100) (3/5) [] ||| emptyBSP++--------------------------------------------------------------------------------+-- | Customize the way 'XMonad.Prompt' looks and behaves. It's a+-- great replacement for dzen.+myXPConfig = def+ { position = Top+ , alwaysHighlight = True+ , promptBorderWidth = 0+ , font = "xft:monospace:size=9"+ }++--------------------------------------------------------------------------------+-- | Manipulate windows as they are created. The list given to+-- @composeOne@ is processed from top to bottom. The first matching+-- rule wins.+--+-- Use the `xprop' tool to get the info you need for these matches.+-- For className, use the second value that xprop gives you.+myManageHook = composeOne+ [ className =? "Pidgin" -?> doFloat+ , className =? "XCalc" -?> doFloat+ , className =? "mpv" -?> doFloat+ , isDialog -?> doCenterFloat++ -- Move transient windows to their parent:+ , transience+ ]
XMonad/Config/Gnome.hs view
@@ -47,7 +47,7 @@ gnomeKeys (XConfig {modMask = modm}) = M.fromList $ [ ((modm, xK_p), gnomeRun)- , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]+ , ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ] -- | Launch the "Run Application" dialog. gnome-panel must be running for this -- to work.
XMonad/Hooks/DynamicLog.hs view
@@ -24,6 +24,7 @@ -- * Drop-in loggers dzen,+ dzenWithFlags, xmobar, statusBar, dynamicLog,@@ -42,8 +43,8 @@ -- * Formatting utilities wrap, pad, trim, shorten,- xmobarColor, xmobarStrip,- xmobarStripTags,+ xmobarColor, xmobarAction, xmobarRaw,+ xmobarStrip, xmobarStripTags, dzenColor, dzenEscape, dzenStrip, -- * Internal formatting functions@@ -61,7 +62,7 @@ import Control.Monad (liftM2, msum) import Data.Char ( isSpace, ord ) import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)-import Data.Maybe ( isJust, catMaybes, mapMaybe )+import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe ) import Data.Ord ( comparing ) import qualified Data.Map as M import qualified XMonad.StackSet as S@@ -150,14 +151,17 @@ ------------------------------------------------------------------------ --- | Run xmonad with a dzen status bar set to some nice defaults.+-- | Run xmonad with a dzen status bar with specified dzen+-- command line arguments. ----- > main = xmonad =<< dzen myConfig+-- > main = xmonad =<< dzenWithFlags flags myConfig -- > -- > myConfig = def { ... }+-- >+-- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d" ----- The intent is that the above config file should provide a nice--- status bar with minimal effort.+-- This function can be used to customize the arguments passed to dzen2.+-- e.g changing the default width and height of dzen2. -- -- If you wish to customize the status bar format at all, you'll have to -- use the 'statusBar' function instead.@@ -166,9 +170,30 @@ -- handle screen placement for dzen, and enables 'mod-b' for toggling -- the menu bar. --+-- You should use this function only when the default 'dzen' function does not+-- serve your purpose.+--+dzenWithFlags :: LayoutClass l Window+ => String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))+dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf++-- | Run xmonad with a dzen status bar set to some nice defaults.+--+-- > main = xmonad =<< dzen myConfig+-- >+-- > myConfig = def { ... }+--+-- The intent is that the above config file should provide a nice+-- status bar with minimal effort.+--+-- The binding uses the XMonad.Hooks.ManageDocks module to automatically+-- handle screen placement for dzen, and enables 'mod-b' for toggling+-- the menu bar. Please refer to 'dzenWithFlags' function for further+-- documentation.+-- dzen :: LayoutClass l Window => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))-dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf+dzen conf = dzenWithFlags flags conf where fg = "'#a8a3f7'" -- n.b quoting bg = "'#3f3c6d'"@@ -295,7 +320,8 @@ fmt w = printer pp (S.tag w) where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent | S.tag w == this = ppCurrent- | S.tag w `elem` visibles = ppVisible+ | S.tag w `elem` visibles && isJust (S.stack w) = ppVisible+ | S.tag w `elem` visibles = liftM2 fromMaybe ppVisible ppVisibleNoWindows | isJust (S.stack w) = ppHidden | otherwise = ppHiddenNoWindows @@ -392,6 +418,31 @@ xmobarColor fg bg = wrap t "</fc>" where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"] +-- | Encapsulate text with an action. The text will be displayed, and the+-- action executed when the displayed text is clicked. Illegal input is not+-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new+-- syntax wherein the command is surrounded by backticks.+xmobarAction :: String+ -- ^ Command. Use of backticks (`) will cause a parse error.+ -> String+ -- ^ Buttons 1-5, such as "145". Other characters will cause a+ -- parse error.+ -> String+ -- ^ Displayed/wrapped text.+ -> String+xmobarAction command button = wrap l r+ where+ l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"+ r = "</action>"++-- | Encapsulate arbitrary text for display only, i.e. untrusted content if+-- wrapped (perhaps from window titles) will be displayed only, with all tags+-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not+-- to shorten the result.+xmobarRaw :: String -> String+xmobarRaw "" = ""+xmobarRaw s = concat ["<raw=", show $ length s, ":", s, "/>"]+ -- ??? add an xmobarEscape function? -- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and@@ -435,6 +486,8 @@ -- contain windows , ppHiddenNoWindows :: WorkspaceId -> String -- ^ how to print tags of empty hidden workspaces+ , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)+ -- ^ how to print tags of empty visible workspaces , ppUrgent :: WorkspaceId -> String -- ^ format to be applied to tags of urgent workspaces. , ppSep :: String@@ -487,6 +540,7 @@ , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const ""+ , ppVisibleNoWindows= Nothing , ppUrgent = id , ppSep = " : " , ppWsSep = " "
XMonad/Hooks/EwmhDesktops.hs view
@@ -25,6 +25,7 @@ ) where import Codec.Binary.UTF8.String (encode)+import Control.Applicative((<$>)) import Data.List import Data.Maybe import Data.Monoid@@ -87,29 +88,19 @@ let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws setClientList wins - -- Current desktop- case (elemIndex (W.currentTag s) $ map W.tag ws) of- Nothing -> return ()- Just curr -> do- setCurrentDesktop curr+ -- Remap the current workspace to handle any renames that f might be doing.+ let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])+ maybeCurrent = join (flip elemIndex (map W.tag ws) <$> maybeCurrent') - -- Per window Desktop- -- To make gnome-panel accept our xinerama stuff, we display- -- all visible windows on the current desktop.- forM_ (W.current s : W.visible s) $ \x ->- forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do- setWindowDesktop win curr+ fromMaybe (return ()) $ setCurrentDesktop <$> maybeCurrent - forM_ (W.hidden s) $ \w ->- case elemIndex (W.tag w) (map W.tag ws) of- Nothing -> return ()- Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do- setWindowDesktop win wn+ sequence_ $ zipWith setWorkspaceWindowDesktops [0..] ws setActiveWindow return () + -- | -- Intercepts messages from pagers and similar applications and reacts on them. -- Currently supports:@@ -229,6 +220,10 @@ io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) a' <- getAtom "_NET_CLIENT_LIST_STACKING" io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)++setWorkspaceWindowDesktops :: (Integral a) => a -> WindowSpace -> X()+setWorkspaceWindowDesktops index workspace =+ mapM_ (flip setWindowDesktop index) (W.integrate' $ W.stack workspace) setWindowDesktop :: (Integral a) => Window -> a -> X () setWindowDesktop win i = withDisplay $ \dpy -> do
XMonad/Hooks/FadeWindows.hs view
@@ -61,7 +61,8 @@ ,asks) import Control.Monad.State (gets) import qualified Data.Map as M-import Data.Monoid+import Data.Monoid hiding ((<>))+import Data.Semigroup import Graphics.X11.Xlib.Extras (Event(..)) @@ -133,6 +134,9 @@ mempty = OEmpty r `mappend` OEmpty = r _ `mappend` r = r++instance Semigroup Opacity where+ (<>) = mappend -- | A FadeHook is similar to a ManageHook, but records window opacity. type FadeHook = Query Opacity
XMonad/Hooks/Minimize.hs view
@@ -23,7 +23,7 @@ import Control.Monad(when) import XMonad-import XMonad.Layout.Minimize+import XMonad.Actions.Minimize -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -43,10 +43,10 @@ a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cs <- getAtom "WM_CHANGE_STATE" - when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)+ when (mt == a_aw) $ maximizeWindow w when (mt == a_cs) $ do let message = fromIntegral . head $ dt- when (message == normalState) $ sendMessage (RestoreMinimizedWin w)+ when (message == normalState) $ maximizeWindow w when (message == iconicState) $ minimizeWindow w return (All True)
XMonad/Hooks/RestoreMinimized.hs view
@@ -1,4 +1,4 @@-----------------------------------------------------------------------------+----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.RestoreMinimized -- Copyright : (c) Jan Vornberger 2009@@ -15,6 +15,7 @@ ----------------------------------------------------------------------------- module XMonad.Hooks.RestoreMinimized+ {-# DEPRECATED "Use XMonad.Hooks.Minimize instead, this module has no effect" #-} ( -- * Usage -- $usage RestoreMinimized (..)@@ -22,10 +23,8 @@ ) where import Data.Monoid-import Control.Monad(when) import XMonad-import XMonad.Layout.Minimize -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -39,11 +38,4 @@ data RestoreMinimized = RestoreMinimized deriving ( Show, Read ) restoreMinimizedEventHook :: Event -> X All-restoreMinimizedEventHook (ClientMessageEvent {ev_window = w,- ev_message_type = mt}) = do- a_aw <- getAtom "_NET_ACTIVE_WINDOW"- a_cs <- getAtom "WM_CHANGE_STATE"- when (mt == a_aw || mt == a_cs) $ do- sendMessage (RestoreMinimizedWin w)- return (All True) restoreMinimizedEventHook _ = return (All True)
XMonad/Hooks/WallpaperSetter.hs view
@@ -41,7 +41,8 @@ import Control.Monad import Control.Applicative import Data.Maybe-import Data.Monoid+import Data.Monoid hiding ((<>))+import Data.Semigroup -- $usage -- This module requires imagemagick and feh to be installed, as these are utilized@@ -85,6 +86,9 @@ mempty = WallpaperList [] mappend (WallpaperList w1) (WallpaperList w2) = WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)++instance Semigroup WallpaperList where+ (<>) = mappend -- | Complete wallpaper configuration passed to the hook data WallpaperConf = WallpaperConf {
XMonad/Hooks/WorkspaceHistory.hs view
@@ -14,20 +14,25 @@ -- ----------------------------------------------------------------------------- -module XMonad.Hooks.WorkspaceHistory- ( -- * Usage+module XMonad.Hooks.WorkspaceHistory (+ -- * Usage -- $usage- -- * Hooking- workspaceHistoryHook-+ workspaceHistoryHook -- * Querying- , workspaceHistory+ , workspaceHistory+ , workspaceHistoryByScreen+ , workspaceHistoryWithScreen+ -- * Handling edits+ , workspaceHistoryTransaction+ ) where - ) where+import Control.Applicative+import Prelude import XMonad-import XMonad.StackSet (currentTag)+import XMonad.StackSet hiding (filter, delete)+import Data.List import qualified XMonad.Util.ExtensibleState as XS -- $usage@@ -46,10 +51,10 @@ -- -- To make use of the collected data, a query function is provided. -data WorkspaceHistory =- WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order.- }- deriving (Typeable, Read, Show)+data WorkspaceHistory = WorkspaceHistory+ { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in+ -- reverse-chronological order.+ } deriving (Typeable, Read, Show) instance ExtensionClass WorkspaceHistory where initialValue = WorkspaceHistory []@@ -58,17 +63,41 @@ -- | A 'logHook' that keeps track of the order in which workspaces have -- been viewed. workspaceHistoryHook :: X ()-workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst)+workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen) +workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]+workspaceHistoryWithScreen = XS.gets history++workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]+workspaceHistoryByScreen =+ map (\wss -> (fst $ head wss, map snd wss)) .+ groupBy (\a b -> fst a == fst b) .+ sortBy (\a b -> compare (fst a) $ fst b)<$>+ workspaceHistoryWithScreen+ -- | A list of workspace tags in the order they have been viewed, with the -- most recent first. No duplicates are present, but not all workspaces are -- guaranteed to appear, and there may be workspaces that no longer exist. workspaceHistory :: X [WorkspaceId]-workspaceHistory = XS.gets history+workspaceHistory = nub . map snd <$> XS.gets history +workspaceHistoryTransaction :: X () -> X ()+workspaceHistoryTransaction action = do+ startingHistory <- XS.gets history+ action+ new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset+ XS.put new --- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not+-- | Update the last visible workspace on each monitor if needed -- already there, or move it to the front if it is.-makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory-makeFirst w v = let (xs, ys) = break (w ==) $ history v- in v { history = w : (xs ++ drop 1 ys) }+updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory+updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =+ WorkspaceHistory { history = doUpdate cur $ foldl updateLastForScreen (history wh) $ vis ++ [cur] }+ where+ firstOnScreen sid = find ((== sid) . fst)+ doUpdate Screen {workspace = Workspace { tag = wid }, screen = sid} curr =+ let newEntry = (sid, wid) in newEntry:delete newEntry curr+ updateLastForScreen curr Screen {workspace = Workspace { tag = wid }, screen = sid} =+ let newEntry = (sid, wid)+ alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr+ in if alreadyCurrent then curr else newEntry:delete newEntry curr
+ XMonad/Layout/BinaryColumn.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.BinaryColumn+-- Copyright : (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Campbell Barton <ideasman42@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- Provides Column layout that places all windows in one column.+-- Each window is half the height of the previous,+-- except for the last pair of windows.+--+-- Note: Originally based on 'XMonad.Layout.Column' with changes:+--+-- * Adding/removing windows doesn't resize all other windows.+-- (last window pair exception).+-- * Minimum window height option.+--+-----------------------------------------------------------------------------++module XMonad.Layout.BinaryColumn (+ -- * Usage+ -- $usage+ BinaryColumn (..)+ ) where+import XMonad+import qualified XMonad.StackSet+import qualified Data.List++-- $usage+-- This module defines layout named BinaryColumn.+-- It places all windows in one column.+-- Windows heights are calculated to prevent window resizing whenever+-- a window is added or removed.+-- This is done by keeping the last two windows in the stack the same height.+--+-- You can use this module by adding following in your @xmonad.hs@:+--+-- > import XMonad.Layout.BinaryColumn+--+-- Then add layouts to your layoutHook:+--+-- > myLayoutHook = BinaryColumn 1.0 32 ||| ...+--+-- The first value causes the master window to take exactly half of the screen,+-- the second ensures that windows are no less than 32 pixels tall.+--+-- Shrink/Expand can be used to adjust the first value by increments of 0.1.+--+-- * 2.0 uses all space for the master window+-- (minus the space for windows which get their fixed height).+-- * 0.0 gives an evenly spaced grid.+-- Negative values reverse the sizes so the last+-- window in the stack becomes larger.+--++data BinaryColumn a = BinaryColumn Float Int+ deriving (Read, Show)++instance XMonad.LayoutClass BinaryColumn a where+ pureLayout = columnLayout+ pureMessage = columnMessage++columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)+columnMessage (BinaryColumn q min_size) m = fmap resize (fromMessage m)+ where+ resize Shrink = BinaryColumn (max (-2.0) (q - 0.1)) min_size+ resize Expand = BinaryColumn (min 2.0 (q + 0.1)) min_size++columnLayout :: BinaryColumn a+ -> XMonad.Rectangle+ -> XMonad.StackSet.Stack a+ -> [(a, XMonad.Rectangle)]+columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects+ where+ ws = XMonad.StackSet.integrate stack+ n = length ws+ scale_abs = abs scale+ heights_noflip =+ let+ -- Regular case: check for min size.+ f n size div False = let+ n_fl = (fromIntegral n)+ n_prev_fl = (fromIntegral (n + 1))+ div_test = min (div) (n_prev_fl)+ value_test = (toInteger (round ((fromIntegral size) / div_test)))+ value_max = size - (toInteger (min_size * n))+ (value, divide_next, no_room) =+ if value_test < value_max then+ (value_test, div, False)+ else+ (value_max, n_fl, True)+ size_next = size - value+ n_next = n - 1+ in value+ : f n_next size_next divide_next no_room+ -- Fallback case: when windows have reached min size+ -- simply create an even grid with the remaining space.+ f n size div True = let+ n_fl = (fromIntegral n)+ value_even = ((fromIntegral size) / div)+ value = (toInteger (round value_even))++ n_next = n - 1+ size_next = size - value+ divide_next = n_fl+ in value+ : f n_next size_next n_fl True+ -- Last item: included twice.+ f 0 size div no_room_prev =+ [size];+ in f+ n_init size_init divide_init False+ where+ n_init = n - 1+ size_init = (toInteger (rect_height rect))+ divide_init =+ if scale_abs == 0.0 then+ (fromIntegral n)+ else+ (1.0 / (0.5 * scale_abs))++ heights =+ if (scale < 0.0) then+ Data.List.reverse (take n heights_noflip)+ else+ heights_noflip++ ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]]+ rects = map (mkRect rect) $ zip heights ys++mkRect :: XMonad.Rectangle+ -> (Integer,XMonad.Position)+ -> XMonad.Rectangle+mkRect (XMonad.Rectangle xs ys ws _) (h, y) =+ XMonad.Rectangle xs (ys + fromIntegral y) ws (fromInteger h)
XMonad/Layout/BinarySpacePartition.hs view
@@ -20,6 +20,7 @@ -- * Usage -- $usage emptyBSP+ , BinarySpacePartition , Rotate(..) , Swap(..) , ResizeDirectional(..)
XMonad/Layout/ComboP.hs view
@@ -20,6 +20,7 @@ combineTwoP, CombineTwoP, SwapWindow(..),+ PartitionWins(..), Property(..) ) where @@ -71,6 +72,16 @@ deriving (Read, Show, Typeable) instance Message SwapWindow +data PartitionWins = PartitionWins -- ^ Reset the layout and+ -- partition all windows into the+ -- correct sub-layout. Useful for+ -- when window properties have+ -- changed and you want ComboP to+ -- update which layout a window+ -- belongs to.+ deriving (Read, Show, Typeable)+instance Message PartitionWins+ data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property deriving (Read, Show) @@ -100,6 +111,7 @@ (maybe l1 id ml1') (maybe l2 id ml2') prop) handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m+ | Just PartitionWins <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop | Just SwapWindow <- fromMessage m = swap us | Just (SwapWindowN 0) <- fromMessage m = swap us | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1
XMonad/Layout/DecorationAddons.hs view
@@ -24,7 +24,7 @@ import qualified XMonad.StackSet as W import XMonad.Layout.Decoration import XMonad.Actions.WindowMenu-import XMonad.Layout.Minimize+import XMonad.Actions.Minimize import XMonad.Layout.Maximize import XMonad.Hooks.ManageDocks import XMonad.Util.Font
XMonad/Layout/Fullscreen.hs view
@@ -109,7 +109,7 @@ pureModifier (FullscreenFull frect fulls) rect _ list = (map (flip (,) rect') visfulls ++ rest, Nothing) where visfulls = intersect fulls $ map fst list- rest = filter (flip notElem visfulls . fst) list+ rest = filter (not . (flip elem visfulls `orP` covers rect')) list rect' = scaleRationalRect rect frect instance LayoutModifier FullscreenFocus Window where@@ -122,7 +122,7 @@ pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list | f `elem` fulls = ((f, rect') : rest, Nothing) | otherwise = (list, Nothing)- where rest = filter ((/= f) . fst) list+ where rest = filter (not . ((== f) `orP` covers rect')) list rect' = scaleRationalRect rect frect pureModifier _ _ Nothing list = (list, Nothing) @@ -240,3 +240,15 @@ sendMessageWithNoRefresh FullscreenChanged cw idHook +-- | True iff one rectangle completely contains another.+covers :: Rectangle -> Rectangle -> Bool+(Rectangle x1 y1 w1 h1) `covers` (Rectangle x2 y2 w2 h2) =+ let fi = fromIntegral+ in x1 <= x2 &&+ y1 <= y2 &&+ x1 + fi w1 >= x2 + fi w2 &&+ y1 + fi h1 >= y2 + fi h2++-- | Applies a pair of predicates to a pair of operands, combining them with ||.+orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool+orP f g (x, y) = f x || g y
XMonad/Layout/Gaps.hs view
@@ -14,7 +14,9 @@ -- be used for tiling, along with support for toggling gaps on and -- off. ----- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for+-- Note 1: For gaps\/space around /windows/ see "XMonad.Layout.Spacing".+--+-- Note 2: "XMonad.Hooks.ManageDocks" is the preferred solution for -- leaving space for your dock-type applications (status bars, -- toolbars, docks, etc.), since it automatically sets up appropriate -- gaps, allows them to be toggled, etc. However, this module may@@ -29,8 +31,8 @@ -- * Usage -- $usage Direction2D(..), Gaps,- GapSpec, gaps, gaps', GapMessage(..)-+ GapSpec, gaps, gaps', GapMessage(..),+ weakModifyGaps, modifyGap, setGaps, setGap ) where import XMonad.Core@@ -55,10 +57,23 @@ -- You can additionally add some keybindings to toggle or modify the gaps, -- for example: ----- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps--- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap--- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap--- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap+-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps+-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap+-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap+-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap+-- > , ((modm .|. controlMask, xK_r), sendMessage $ ModifyGaps rotateGaps) -- rotate gaps 90 degrees clockwise+-- > , ((modm .|. controlMask, xK_h), sendMessage $ weakModifyGaps halveHor) -- halve the left and right-hand gaps+-- > , ((modm .|. controlMask, xK_d), sendMessage $ modifyGap (*2) L) -- double the left-hand gap+-- > , ((modm .|. controlMask, xK_s), sendMessage $ setGaps [(U,18), (R,23)]) -- reset the GapSpec+-- > , ((modm .|. controlMask, xK_b), sendMessage $ setGap 30 D) -- set the bottom gap to 30+-- > ]+-- > where rotateGaps gs = zip (map (rotate . fst) gs) (map snd gs)+-- > rotate U = R+-- > rotate R = D+-- > rotate D = L+-- > rotate L = U+-- > halveHor d i | d `elem` [L, R] = i `div` 2+-- > | otherwise = i -- -- If you want complete control over all gaps, you could include -- something like this in your keybindings, assuming in this case you@@ -93,6 +108,7 @@ | ToggleGap !Direction2D -- ^ Toggle a single gap. | IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels. | DecGap !Int !Direction2D -- ^ Decrease a gap.+ | ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily. deriving (Typeable) instance Message GapMessage@@ -106,11 +122,46 @@ | Just (ToggleGap d) <- fromMessage m = Just $ Gaps conf (toggleGap conf cur d) | Just (IncGap i d) <- fromMessage m- = Just $ Gaps (incGap conf d i) cur+ = Just $ Gaps (limit . continuation (+ i ) d $ conf) cur | Just (DecGap i d) <- fromMessage m- = Just $ Gaps (incGap conf d (-i)) cur+ = Just $ Gaps (limit . continuation (+(-i)) d $ conf) cur+ | Just (ModifyGaps f) <- fromMessage m+ = Just $ Gaps (limit . f $ conf) cur | otherwise = Nothing +-- | Modifies gaps weakly, for convenience.+weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage+weakModifyGaps = ModifyGaps . weakToStrong++-- | Arbitrarily modify a single gap with the given function.+modifyGap :: (Int -> Int) -> Direction2D -> GapMessage+modifyGap f d = ModifyGaps $ continuation f d++-- | Set the GapSpec.+setGaps :: GapSpec -> GapMessage+setGaps = ModifyGaps . const++-- | Set a gap to the given value.+setGap :: Int -> Direction2D -> GapMessage+setGap = modifyGap . const++-- | Imposes limits upon a GapSpec, ensuring gaps are at least 0. Not exposed.+limit :: GapSpec -> GapSpec+limit = weakToStrong $ \_ -> max 0++-- | Takes a weak gaps-modifying function f and returns a GapSpec modifying+-- function. Not exposed.+weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec+weakToStrong f gs = zip (map fst gs) (map (uncurry f) gs)++-- | Given f as a definition for the behaviour of a gaps modifying function in+-- one direction d, produces a continuation of the function to the other+-- directions using the identity. Not exposed.+continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec+continuation f d1 = weakToStrong h+ where h d2 | d2 == d1 = f+ | otherwise = id+ applyGaps :: Gaps a -> Rectangle -> Rectangle applyGaps gs r = foldr applyGap r (activeGaps gs) where@@ -130,9 +181,6 @@ toggleGap conf cur d | d `elem` cur = delete d cur | d `elem` (map fst conf) = d:cur | otherwise = cur--incGap :: GapSpec -> Direction2D -> Int -> GapSpec-incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs -- | Add togglable manual gaps to a layout. gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes.
XMonad/Layout/Grid.hs view
@@ -56,7 +56,7 @@ arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles where nwins = length st- ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)+ ncols = max 1 . min nwins . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio) mincs = max 1 $ nwins `div` ncols extrs = nwins - ncols * mincs chop :: Int -> Dimension -> [(Position, Dimension)]
XMonad/Layout/Groups.hs view
@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable- , UndecidableInstances, FlexibleInstances, MultiParamTypeClasses+ , UndecidableInstances, FlexibleInstances, LambdaCase, MultiParamTypeClasses , PatternGuards, Rank2Types, TypeSynonymInstances #-} -----------------------------------------------------------------------------@@ -25,6 +25,7 @@ -- * Messages , GroupsMessage(..) , ModifySpec+ , ModifySpecX -- ** Useful 'ModifySpec's , swapUp , swapDown@@ -99,7 +100,6 @@ group l l2 = Groups l l2 startingGroups (U 1 0) where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ - -- * Stuff with unique keys data Uniq = U Integer Integer@@ -187,6 +187,7 @@ -- to the layout. | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing -- of windows according to a 'ModifySpec'+ | ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad deriving Typeable instance Show GroupsMessage where@@ -206,6 +207,13 @@ in g { groups = fromMaybe defaultGroups . f . Just $ groups g , seed = seed' } +modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))+ -> Groups l l2 a -> X (Groups l l2 a)+modifyGroupsX f g = do+ let (seed', id:_) = gen (seed g)+ defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ+ g' <- f . Just $ groups g+ return g { groups = fromMaybe defaultGroups g', seed = seed' } -- ** Readaptation @@ -305,6 +313,9 @@ Just (Modify spec) -> case applySpec spec l of Just l' -> refocus l' >> return (Just l') Nothing -> return $ Just l+ Just (ModifyX spec) -> applySpecX spec l >>= \case+ Just l' -> refocus l' >> return (Just l')+ Nothing -> return $ Just l Just Refocus -> refocus l >> return (Just l) Just _ -> return Nothing Nothing -> handleMessage l $ SomeMessage (ToFocused sm)@@ -361,29 +372,50 @@ -> Zipper (Group l Window) -> Zipper (Group l Window) --- | Apply a ModifySpec.-applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)-applySpec f g = let (seed', id:ids) = gen $ seed g- g' = flip modifyGroups g $ f (ID id $ baseLayout g)- >>> toTags- >>> foldr reID ((ids, []), [])- >>> snd- >>> fromTags- in case groups g == groups g' of- True -> Nothing- False -> Just g' { seed = seed' }-- where reID eg ((id:ids, seen), egs)- = let myID = getID $ gLayout $ fromE eg- in case elem myID seen of- False -> ((id:ids, myID:seen), eg:egs)- True -> ((ids, seen), mapE_ (setID id) eg:egs)- where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z- reID _ (([], _), _) = undefined -- The list of ids is infinite+-- ** ModifierSpecX type +-- | This is the same as 'ModifySpec', but it allows the function to use+-- actions inside the 'X' monad. This is useful, for example, if the function+-- has to make decisions based on the results of a 'runQuery'.+type ModifySpecX = forall l. WithID l Window+ -> Zipper (Group l Window)+ -> X (Zipper (Group l Window)) +-- | Apply a ModifySpec.+applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)+applySpec f g =+ let (seed', id:ids) = gen $ seed g+ g' = flip modifyGroups g $ f (ID id $ baseLayout g)+ >>> toTags+ >>> foldr (reID g) ((ids, []), [])+ >>> snd+ >>> fromTags+ in case groups g == groups g' of+ True -> Nothing+ False -> Just g' { seed = seed' } +applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))+applySpecX f g = do+ let (seed', id:ids) = gen $ seed g+ g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)+ >>> fmap toTags+ >>> fmap (foldr (reID g) ((ids, []), []))+ >>> fmap snd+ >>> fmap fromTags+ return $ case groups g == groups g' of+ True -> Nothing+ False -> Just g' { seed = seed' } +reID :: Groups l l2 Window+ -> Either (Group l Window) (Group l Window)+ -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])+ -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])+reID _ _ (([], _), _) = undefined -- The list of ids is infinite+reID g eg ((id:ids, seen), egs) = case elem myID seen of+ False -> ((id:ids, myID:seen), eg:egs)+ True -> ((ids, seen), mapE_ (setID id) eg:egs)+ where myID = getID $ gLayout $ fromE eg+ setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z -- ** Misc. ModifySpecs
XMonad/Layout/ImageButtonDecoration.hs view
@@ -38,7 +38,7 @@ import XMonad.Util.Image import XMonad.Actions.WindowMenu-import XMonad.Layout.Minimize+import XMonad.Actions.Minimize import XMonad.Layout.Maximize -- $usage
XMonad/Layout/LayoutHints.hs view
@@ -44,6 +44,7 @@ import Data.Set (Set) import qualified Data.Set as Set+import Data.Maybe(fromJust) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -147,9 +148,14 @@ modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do (arrs,ol) <- runLayout ws r flip (,) ol+ . changeOrder (W.focus st : (filter (/= W.focus st) $ map fst arrs)) . head . reverse . sortBy (compare `on` (fitting . map snd)) . map (applyHints st r) . applyOrder r <$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs++changeOrder :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]+changeOrder w wr = zip w' $ map (fromJust . flip lookup wr) w'+ where w' = filter (`elem` map fst wr) w -- apply hints to first, grow adjacent windows applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)]
XMonad/Layout/Magnifier.hs view
@@ -83,63 +83,65 @@ -- | Increase the size of the window that has focus magnifier :: l a -> ModifiedLayout Magnifier l a-magnifier = ModifiedLayout (Mag (1.5,1.5) On All)+magnifier = ModifiedLayout (Mag 1 (1.5,1.5) On All) -- | Change the size of the window that has focus by a custom zoom magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a-magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All)+magnifiercz cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On All) --- | Increase the size of the window that has focus, unless if it is the--- master window.+-- | Increase the size of the window that has focus, unless if it is one of the+-- master windows. magnifier' :: l a -> ModifiedLayout Magnifier l a-magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster)+magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster) -- | Magnifier that defaults to Off magnifierOff :: l a -> ModifiedLayout Magnifier l a-magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All)+magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All) -- | Increase the size of the window that has focus by a custom zoom,--- unless if it is the master window.+-- unless if it is one of the the master windows. magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a-magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster)+magnifiercz' cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On NoMaster) -- | A magnifier that greatly magnifies just the vertical direction maximizeVertical :: l a -> ModifiedLayout Magnifier l a-maximizeVertical = ModifiedLayout (Mag (1,1000) Off All)+maximizeVertical = ModifiedLayout (Mag 1 (1,1000) Off All) data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable ) instance Message MagnifyMsg -data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show)+data Magnifier a = Mag !Int (Double,Double) Toggle MagnifyMaster deriving (Read, Show) data Toggle = On | Off deriving (Read, Show) data MagnifyMaster = All | NoMaster deriving (Read, Show) instance LayoutModifier Magnifier Window where- redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs- redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs+ redoLayout (Mag _ z On All ) r (Just s) wrs = applyMagnifier z r s wrs+ redoLayout (Mag n z On NoMaster) r (Just s) wrs = unlessMaster n (applyMagnifier z) r s wrs redoLayout _ _ _ wrs = return (wrs, Nothing) - handleMess (Mag z On t) m- | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1 ) On t)- | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On t)- | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z ) Off t)- | Just Toggle <- fromMessage m = return . Just $ (Mag (z ) Off t)+ handleMess (Mag n z On t) m+ | Just MagnifyMore <- fromMessage m = return . Just $ Mag n (z `addto` 0.1 ) On t+ | Just MagnifyLess <- fromMessage m = return . Just $ Mag n (z `addto` (-0.1)) On t+ | Just ToggleOff <- fromMessage m = return . Just $ Mag n z Off t+ | Just Toggle <- fromMessage m = return . Just $ Mag n z Off t+ | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z On t where addto (x,y) i = (x+i,y+i)- handleMess (Mag z Off t) m- | Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t)- | Just Toggle <- fromMessage m = return . Just $ (Mag z On t)+ handleMess (Mag n z Off t) m+ | Just ToggleOn <- fromMessage m = return . Just $ Mag n z On t+ | Just Toggle <- fromMessage m = return . Just $ Mag n z On t+ | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z Off t handleMess _ _ = return Nothing - modifierDescription (Mag _ On All ) = "Magnifier"- modifierDescription (Mag _ On NoMaster) = "Magnifier NoMaster"- modifierDescription (Mag _ Off _ ) = "Magnifier (off)"+ modifierDescription (Mag _ _ On All ) = "Magnifier"+ modifierDescription (Mag _ _ On NoMaster) = "Magnifier NoMaster"+ modifierDescription (Mag _ _ Off _ ) = "Magnifier (off)" type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) -unlessMaster :: NewLayout a -> NewLayout a-unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)- else mainmod r s wrs+unlessMaster :: Int -> NewLayout a -> NewLayout a+unlessMaster n mainmod r s wrs = if null (drop (n-1) (up s)) then return (wrs, Nothing)+ else mainmod r s wrs applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a)
XMonad/Layout/Minimize.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Minimize@@ -18,20 +18,14 @@ -- * Usage -- $usage minimize,- minimizeWindow,- MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin),- Minimize, ) where import XMonad import qualified XMonad.StackSet as W+import XMonad.Util.Minimize (Minimized(..)) import XMonad.Layout.LayoutModifier import XMonad.Layout.BoringWindows as BW-import XMonad.Util.WindowProperties (getProp32)-import Data.List-import qualified Data.Map as M-import Data.Maybe-import Foreign.C.Types (CLong)+import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -47,97 +41,33 @@ -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" ----- In the key-bindings, do something like:------ > , ((modm, xK_m ), withFocused minimizeWindow)--- > , ((modm .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin)------ The first action will minimize the focused window, while the second one will restore--- the next minimized window.------ For detailed instruction on editing the key binding see:------ "XMonad.Doc.Extending#Editing_key_bindings".--- -- The module is designed to work together with "XMonad.Layout.BoringWindows" so -- that minimized windows will be skipped over when switching the focused window with -- the keyboard. Include 'BW.boringWindows' in your layout hook and see the -- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings. --+-- See "XMonad.Actions.Minimize" for possible actions for minimizing/restoring windows+-- -- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize -- and restore windows from your taskbar. -data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show )-minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window-minimize = ModifiedLayout $ Minimize [] M.empty+data Minimize a = Minimize deriving ( Read, Show )+minimize :: l Window -> ModifiedLayout Minimize l Window+minimize = ModifiedLayout Minimize -data MinimizeMsg = MinimizeWin Window- | RestoreMinimizedWin Window- | RestoreNextMinimizedWin- deriving (Typeable, Eq)-instance Message MinimizeMsg -minimizeWindow :: Window -> X ()-minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown--setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()-setMinimizedState win st f = do- setWMState win st- withDisplay $ \dpy -> do- wm_state <- getAtom "_NET_WM_STATE"- mini <- getAtom "_NET_WM_STATE_HIDDEN"- wstate <- fromMaybe [] `fmap` getProp32 wm_state win- let ptype = 4 -- The atom property type for changeProperty- fi_mini = fromIntegral mini- io $ changeProperty32 dpy win wm_state ptype propModeReplace (f fi_mini wstate)--setMinimized :: Window -> X ()-setMinimized win = setMinimizedState win iconicState (:)--setNotMinimized :: Window -> X ()-setNotMinimized win = setMinimizedState win normalState delete- instance LayoutModifier Minimize Window where modifierDescription _ = "Minimize" - modifyLayout (Minimize minimized _) wksp rect = do+ modifyLayout Minimize wksp rect = do+ minimized <- XS.gets minimizedStack let stack = W.stack wksp- filtStack = stack >>=W.filter (\w -> not (w `elem` minimized))+ filtStack = stack >>= W.filter (`notElem` minimized) runLayout (wksp {W.stack = filtStack}) rect - handleMess (Minimize minimized unfloated) m- | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do- setMinimized w- ws <- gets windowset- case M.lookup w (W.floating ws) of- Nothing -> return $ Just $ Minimize (w:minimized) unfloated- Just r -> do- modify (\s -> s { windowset = W.sink w ws})- return $ Just $ Minimize (w:minimized) (M.insert w r unfloated)- | Just (RestoreMinimizedWin w) <- fromMessage m = do- setNotMinimized w- case M.lookup w unfloated of- Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated- Just r -> do- ws <- gets windowset- modify (\s -> s { windowset = W.float w r ws})- return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated)- | Just RestoreNextMinimizedWin <- fromMessage m = do- ws <- gets windowset- if not (null minimized)- then case M.lookup (head minimized) unfloated of- Nothing -> do- let w = head minimized- setNotMinimized w- modify (\s -> s { windowset = W.focusWindow w ws})- return $ Just $ Minimize (tail minimized) unfloated- Just r -> do- let w = head minimized- setNotMinimized w- modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws})- return $ Just $ Minimize (tail minimized) (M.delete w unfloated)- else return Nothing+ handleMess Minimize m | Just BW.UpdateBoring <- fromMessage m = do+ minimized <- XS.gets minimizedStack ws <- gets (W.workspace . W.current . windowset) flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized return Nothing
XMonad/Layout/Mosaic.hs view
@@ -38,7 +38,8 @@ import Data.Foldable(Foldable,foldMap, sum) import Data.Function(on) import Data.List(sortBy)-import Data.Monoid(Monoid,mempty, mappend)+import Data.Monoid(Monoid,mempty, mappend, (<>))+import Data.Semigroup -- $usage@@ -201,6 +202,9 @@ mappend Empty x = x mappend x Empty = x mappend x y = Branch x y++instance Semigroup (Tree a) where+ (<>) = mappend makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree _ [] = Empty
XMonad/Layout/MultiColumns.hs view
@@ -77,10 +77,9 @@ } deriving (Show,Read,Eq) instance LayoutClass MultiCol a where- doLayout l r s = return (zip w rlist, resl)+ doLayout l r s = return (combine s rlist, resl) where rlist = doL (multiColNWin l') (multiColSize l') r wlen- w = W.integrate s- wlen = length w+ wlen = length $ W.integrate s -- Make sure the list of columns is big enough and update active column nw = multiColNWin l ++ repeat (multiColDefWin l) l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw@@ -90,6 +89,7 @@ resl = if l'==l then Nothing else Just l'+ combine (W.Stack foc left right) rs = zip (foc : reverse left ++ right) $ raiseFocused (length left) rs handleMessage l m = return $ msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)]@@ -104,6 +104,10 @@ a = multiColActive l description _ = "MultiCol" +raiseFocused :: Int -> [a] -> [a]+raiseFocused n xs = actual ++ before ++ after+ where (before,rest) = splitAt n xs+ (actual,after) = splitAt 1 rest -- | Get which column a window is in, starting at 0. getCol :: Int -> [Int] -> Int
+ XMonad/Layout/MultiDishes.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.MultiDishes+-- Copyright : (c) Jeremy Apthorp, Nathan Fairhurst+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Nathan Fairhurst <nathan.p3pictures@gmail.com>+-- Stability : unstable+-- Portability : portable+--+-- MultiDishes is a layout that stacks groups of extra windows underneath+-- the master windows.+--+-----------------------------------------------------------------------------++module XMonad.Layout.MultiDishes (+ -- * Usage+ -- $usage+ MultiDishes (..)+ ) where++import XMonad+import XMonad.StackSet (integrate)+import Control.Monad (ap)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.MultiDishes+--+-- Then edit your @layoutHook@ by adding the MultiDishes layout:+--+-- > myLayout = MultiDishes 2 3 (1/6) ||| Full ||| etc..+-- > main = xmonad def { layoutHook = myLayout }+--+-- This is based on the Layout Dishes, but accepts another parameter for+-- the maximum number of dishes allowed within a stack.+--+-- > MultiDishes x 1 y+-- is equivalent to +-- > Dishes x y+--+-- The stack with the fewest dishes is always on top, so 4 windows+-- with the layout `MultiDishes 1 2 (1/5)` would look like this:+--+-- > _________+-- > | |+-- > | M |+-- > |_______|+-- > |_______|+-- > |___|___|+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read)+instance LayoutClass MultiDishes a where+ pureLayout (MultiDishes nmaster dishesPerStack h) r =+ ap zip (multiDishes h r nmaster dishesPerStack . length) . integrate+ pureMessage (MultiDishes nmaster dishesPerStack h) m = fmap incmastern (fromMessage m)+ where incmastern (IncMasterN d) = MultiDishes (max 0 (nmaster+d)) dishesPerStack h++multiDishes :: Rational -> Rectangle -> Int -> Int -> Int -> [Rectangle]+multiDishes h s nmaster dishesPerStack n = if n <= nmaster+ then splitHorizontally n s+ else ws+ where+ (filledDishStackCount, remainder) =+ (n - nmaster) `quotRem` (max 1 dishesPerStack)++ (firstDepth, dishStackCount) =+ if remainder == 0 then+ (dishesPerStack, filledDishStackCount)+ else+ (remainder, filledDishStackCount + 1)++ (masterRect, dishesRect) =+ splitVerticallyBy (1 - (fromIntegral dishStackCount) * h) s++ dishStackRects =+ splitVertically dishStackCount dishesRect++ allDishRects = case dishStackRects of+ (firstStack:bottomDishStacks) ->+ splitHorizontally firstDepth firstStack ++ (bottomDishStacks >>= splitHorizontally dishesPerStack)+ [] -> []++ ws =+ splitHorizontally nmaster masterRect ++ allDishRects
XMonad/Layout/MultiToggle.hs view
@@ -90,7 +90,8 @@ -- > instance Transformer MIRROR Window where -- > transform _ x k = k (Mirror x) (\(Mirror x') -> x') ----- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the+-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable,+-- TypeSynonymInstances, MultiParamTypeClasses \#-}@ at the -- beginning of your file. -- | A class to identify custom transformers (and look up transforming
+ XMonad/Layout/MultiToggle/TabBarDecoration.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.MultiToggle.TabBarDecoration+-- Copyright : (c) 2018 Lucian Poston+-- License : BSD-style (see LICENSE)+--+-- Maintainer : <lucianposton@pm.me>+-- Stability : unstable+-- Portability : unportable+--+-- Provides a simple transformer for use with "XMonad.Layout.MultiToggle" to+-- dynamically toggle "XMonad.Layout.TabBarDecoration".+-----------------------------------------------------------------------------++module XMonad.Layout.MultiToggle.TabBarDecoration (+ SimpleTabBar(..)+) where++import XMonad.Layout.MultiToggle++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Layout.TabBarDecoration++-- $usage+-- To use this module with "XMonad.Layout.MultiToggle", add the @SIMPLETABBAR@+-- to your layout For example, from a basic layout like+--+-- > layout = tiled ||| Full+--+-- Add @SIMPLETABBAR@ by changing it this to+--+-- > layout = mkToggle (single SIMPLETABBAR) (tiled ||| Full)+--+-- You can now dynamically toggle the 'XMonad.Layout.TabBarDecoration'+-- transformation by adding a key binding such as @mod-x@ as follows.+--+-- > ...+-- > , ((modm, xK_x ), sendMessage $ Toggle SIMPLETABBAR)+-- > ...++-- | Transformer for "XMonad.Layout.TabBarDecoration".+data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq, Typeable)+instance Transformer SimpleTabBar Window where+ transform _ x k = k (simpleTabBar x) (\(ModifiedLayout _ (ModifiedLayout _ x')) -> x')
XMonad/Layout/NoBorders.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances, PatternGuards, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.NoBorders--- Copyright : (c) David Roundy <droundy@darcs.net>+-- Copyright : (c) -- David Roundy <droundy@darcs.net>+-- 2018 Yclept Nemo -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>@@ -18,26 +19,33 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.NoBorders (- -- * Usage- -- $usage- noBorders,- smartBorders,- withBorder,- lessBorders,- SetsAmbiguous(..),- Ambiguity(..),- With(..),- SmartBorder, WithBorder, ConfigurableBorder,+module XMonad.Layout.NoBorders ( -- * Usage+ -- $usage+ noBorders+ , smartBorders+ , withBorder+ , lessBorders+ , hasBorder+ , SetsAmbiguous(..)+ , Ambiguity(..)+ , With(..)+ , BorderMessage (..), borderEventHook+ , SmartBorder, WithBorder, ConfigurableBorder ) where -import XMonad-import XMonad.Layout.LayoutModifier-import qualified XMonad.StackSet as W-import Data.List-import qualified Data.Map as M-import Data.Function (on)+import XMonad+import XMonad.Layout.LayoutModifier+import qualified XMonad.StackSet as W+import qualified XMonad.Util.Rectangle as R +import Data.List+import Data.Monoid+import qualified Data.Map as M+import Data.Function (on)+import Control.Applicative ((<$>),(<*>),pure)+import Control.Monad (guard)++ -- $usage -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: --@@ -100,34 +108,94 @@ -- instances lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) => p -> l a -> ModifiedLayout (ConfigurableBorder p) l a-lessBorders amb = ModifiedLayout (ConfigurableBorder amb [])+lessBorders amb = ModifiedLayout (ConfigurableBorder amb [] [] []) -data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show)+-- | 'ManageHook' for sending 'HasBorder' messages:+--+-- > title =? "foo" --> hasBorder True+--+-- There is no equivalent for 'ResetBorder'.+hasBorder :: Bool -> ManageHook+hasBorder b = ask >>= \w -> liftX (broadcastMessage $ HasBorder b w) >> idHook +data BorderMessage+ = HasBorder Bool Window+ -- ^ If @True@, never remove the border from the specified window. If+ -- @False@, always remove the border from the specified window.+ | ResetBorder Window+ -- ^ Reset the effects of any 'HasBorder' messages on the specified+ -- window.+ deriving (Typeable)++instance Message BorderMessage++data ConfigurableBorder p w = ConfigurableBorder+ { _generateHidden :: p+ -- ^ Generates a list of windows without borders. Uses 'SetsAmbiguous'+ -- to filter the current layout.+ , alwaysHidden :: [w]+ -- ^ Windows that never have borders. This list is added to the result+ -- of 'generateHidden'.+ , neverHidden :: [w]+ -- ^ Windows that always have borders - i.e. ignored by this module.+ -- This list is subtraced from 'alwaysHidden' and so has higher+ -- precendence.+ , currentHidden :: [w]+ -- ^ The current set of windows without borders, i.e. the state.+ } deriving (Read, Show)++-- | Only necessary with 'BorderMessage' - remove non-existent windows from the+-- 'alwaysHidden' or 'neverHidden' lists.+borderEventHook :: Event -> X All+borderEventHook (DestroyWindowEvent { ev_window = w }) = do+ broadcastMessage $ ResetBorder w+ return $ All True+borderEventHook _ = return $ All True+ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where- unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s+ unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch - redoLayout (ConfigurableBorder p s) _ mst wrs = do- ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs))- asks (borderWidth . config) >>= setBorders (s \\ ws)- setBorders ws 0- return (wrs, Just $ ConfigurableBorder p ws)+ redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do+ let gh' wset = let lh = (hiddens gh wset lr mst wrs)+ in return $ (ah `union` lh) \\ nh+ ch' <- withWindowSet gh'+ asks (borderWidth . config) >>= setBorders (ch \\ ch')+ setBorders ch' 0+ return (wrs, Just $ cb { currentHidden = ch' }) + pureMess cb@(ConfigurableBorder gh ah nh ch) m+ | Just (HasBorder b w) <- fromMessage m =+ let consNewIf l True = if w `elem` l then Nothing else Just (w:l)+ consNewIf l False = Just l+ in (ConfigurableBorder gh) <$> consNewIf ah (not b)+ <*> consNewIf nh b+ <*> pure ch+ | Just (ResetBorder w) <- fromMessage m =+ let delete' e l = if e `elem` l then (True,delete e l) else (False,l)+ (da,ah') = delete' w ah+ (dn,nh') = delete' w nh+ in if da || dn+ then Just cb { alwaysHidden = ah', neverHidden = nh' }+ else Nothing+ | otherwise = Nothing+ -- | SetsAmbiguous allows custom actions to generate lists of windows that -- should not have borders drawn through 'ConfigurableBorder' -- -- To add your own (though perhaps those options would better belong as an--- aditional constructor to 'Ambiguity'), you can add the function as such:+-- additional constructor to 'Ambiguity'), you can add the following function.+-- Note that @lr@, the parameter representing the 'Rectangle' of the parent+-- layout, was added to 'hiddens' in 0.14. Update your instance accordingly. -- -- > data MyAmbiguity = MyAmbiguity deriving (Read, Show) -- -- > instance SetsAmbiguous MyAmbiguity where--- > hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat--- > where otherHiddens p = hiddens p wset mst wrs+-- > hiddens _ wset lr mst wrs = otherHiddens Screen \\ otherHiddens OnlyScreenFloat+-- > where otherHiddens p = hiddens p wset lr mst wrs -- -- The above example is redundant, because you can have the same result with: ----- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... )+-- > layoutHook = lessBorders (Combine Difference Screen OnlyScreenFloat) (Tall 1 0.5 0.03 ||| ... ) -- -- To get the same result as 'smartBorders': --@@ -136,32 +204,87 @@ -- This indirect method is required to keep the 'Read' and 'Show' for -- ConfigurableBorder so that xmonad can serialize state. class SetsAmbiguous p where- hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]+ hiddens :: p -> WindowSet -> Rectangle -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window] +-- Quick overview since the documentation lacks clarity:+-- * Overall stacking order =+-- tiled stacking order ++ floating stacking order+-- Where tiled windows are (obviously) stacked below floating windows.+-- * Tiled stacking order =+-- [(window, Rectangle] order+-- Given by 'XMonad.Core.LayoutClass' where earlier entries are stacked+-- higher.+-- * Floating stacking order =+-- focus order+-- Given by the workspace stack where a higher focus corresponds to a higher+-- stacking position.+--+-- Integrating a stack returns a list in order of [highest...lowest].+--+-- 'XMonad.Core.LayoutClass' is given a stack with all floating windows removed+-- and returns a list (in stack order) of only the visible tiled windows, while+-- the workspace stack contains all windows (visible/hidden, floating/tiled) in+-- focus order. The StackSet 'floating' field maps all floating windows across+-- all workspaces to relative rectangles - without the associated screen.+--+-- 'XMonad.Operations.windows' gets the windowset from the state, mutates it,+-- then updates the state before calling 'runLayout' with the new windowset -+-- excluding any floating windows. Aside from the filtering, the stack received+-- by the layout should be identical to the one received from 'withWindowSet'. instance SetsAmbiguous Ambiguity where- hiddens amb wset mst wrs+ hiddens amb wset lr mst wrs | Combine Union a b <- amb = on union next a b | Combine Difference a b <- amb = on (\\) next a b | Combine Intersection a b <- amb = on intersect next a b | otherwise = tiled ms ++ floating- where next p = hiddens p wset mst wrs- nonzerorect (Rectangle _ _ 0 0) = False- nonzerorect _ = True+ where next p = hiddens p wset lr mst wrs - screens =- [ scr | scr <- W.screens wset,- case amb of- Never -> True- _ -> not $ null $ integrate scr,- nonzerorect . screenRect $ W.screenDetail scr]- floating = [ w |- (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,- px <= 0, py <= 0,- wx + px >= 1, wy + py >= 1]+ screens = [ scr | scr <- W.screens wset+ , case amb of+ Never -> True+ _ -> not $ null $ integrate scr+ , not . R.empty . screenRect+ $ W.screenDetail scr+ ]++ -- This originally considered all floating windows across all+ -- workspaces. It seems more efficient to have each layout manage+ -- its own floating windows - and equally valid though untested+ -- against a multihead setup. In some cases the previous code would+ -- redundantly add then remove borders from already-borderless+ -- windows.+ floating = do+ let wz :: Integer -> (Window,Rectangle)+ -> (Integer,Window,Rectangle)+ wz i (w,wr) = (i,w,wr)+ -- For the following: in stacking order lowest -> highest.+ ts = reverse . zipWith wz [-1,-2..] $ wrs+ fs = zipWith wz [0..] $ do+ w <- reverse . W.index $ wset+ Just wr <- [M.lookup w (W.floating wset)]+ return (w,scaleRationalRect sr wr)+ sr = screenRect . W.screenDetail . W.current $ wset+ (i1,w1,wr1) <- fs+ guard $ case amb of+ OnlyLayoutFloatBelow ->+ let vu = do+ gr <- sr `R.difference` lr+ (i2,_w2,wr2) <- ts ++ fs+ guard $ i2 < i1+ [wr2 `R.intersects` gr]+ in lr == wr1 && (not . or) vu+ OnlyLayoutFloat ->+ lr == wr1+ _ ->+ wr1 `R.supersetOf` sr+ return w1+ ms = filter (`elem` W.integrate' mst) $ map fst wrs tiled [w] | Screen <- amb = [w]- | OnlyFloat <- amb = []+ | OnlyScreenFloat <- amb = []+ | OnlyLayoutFloat <- amb = []+ | OnlyLayoutFloatBelow <- amb = [] | OtherIndicated <- amb , let nonF = map integrate $ W.current wset : W.visible wset , length (concat nonF) > length wrs@@ -174,23 +297,34 @@ -- subsequent constructors add additional cases where borders are not drawn -- than their predecessors. These behaviors make most sense with with multiple -- screens: for single screens, 'Never' or 'smartBorders' makes more sense.-data Ambiguity = Combine With Ambiguity Ambiguity- -- ^ This constructor is used to combine the- -- borderless windows provided by the- -- SetsAmbiguous instances from two other- -- 'Ambiguity' data types.- | OnlyFloat -- ^ Only remove borders on floating windows that- -- cover the whole screen- | Never -- ^ Never remove borders when ambiguous:- -- this is the same as smartBorders- | EmptyScreen -- ^ Focus in an empty screens does not count as- -- ambiguous.- | OtherIndicated- -- ^ No borders on full when all other screens- -- have borders.- | Screen -- ^ Borders are never drawn on singleton screens.- -- With this one you really need another way such- -- as a statusbar to detect focus.+data Ambiguity+ = Combine With Ambiguity Ambiguity+ -- ^ This constructor is used to combine the borderless windows+ -- provided by the SetsAmbiguous instances from two other 'Ambiguity'+ -- data types.+ | OnlyScreenFloat+ -- ^ Only remove borders on floating windows that cover the whole+ -- screen.+ | OnlyLayoutFloatBelow+ -- ^ Like 'OnlyLayoutFloat', but only removes borders if no window+ -- stacked below remains visible. Considers all floating windows on the+ -- current screen and all visible tiled windows of the child layout. If+ -- any such window (that is stacked below) shows in any gap between the+ -- parent layout rectangle and the physical screen, the border will+ -- remain drawn.+ | OnlyLayoutFloat+ -- ^ Only remove borders on floating windows that exactly cover the+ -- parent layout rectangle.+ | Never+ -- ^ Never remove borders when ambiguous: this is the same as+ -- smartBorders.+ | EmptyScreen+ -- ^ Focus in an empty screen does not count as ambiguous.+ | OtherIndicated+ -- ^ No borders on full when all other screens have borders.+ | Screen+ -- ^ Borders are never drawn on singleton screens. With this one you+ -- really need another way such as a statusbar to detect focus. deriving (Read, Show) -- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two
XMonad/Layout/Spacing.hs view
@@ -1,129 +1,388 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}-{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Spacing--- Copyright : (c) Brent Yorgey+-- Copyright : (C) -- Brent Yorgey+-- 2018 Yclept Nemo -- License : BSD-style (see LICENSE) -- -- Maintainer : <byorgey@gmail.com> -- Stability : unstable--- Portability : portable+-- Portability : unportable -- -- Add a configurable amount of space around windows.+--+-- Note: For space\/gaps along edges of the /screen/ see "XMonad.Layout.Gaps". ----------------------------------------------------------------------------- -module XMonad.Layout.Spacing (- -- * Usage- -- $usage+module XMonad.Layout.Spacing+ ( -- * Usage+ -- $usage+ Border (..)+ , Spacing (..)+ , SpacingModifier (..)+ , spacingRaw+ , setSmartSpacing+ , setScreenSpacing, setScreenSpacingEnabled+ , setWindowSpacing, setWindowSpacingEnabled+ , toggleSmartSpacing+ , toggleScreenSpacingEnabled+ , toggleWindowSpacingEnabled+ , setScreenWindowSpacing+ , incWindowSpacing, incScreenSpacing+ , decWindowSpacing, decScreenSpacing+ , incScreenWindowSpacing, decScreenWindowSpacing+ , borderMap, borderIncrementBy+ -- * Backwards Compatibility+ -- $backwardsCompatibility+ , SpacingWithEdge+ , SmartSpacing, SmartSpacingWithEdge+ , ModifySpacing (..)+ , spacing, spacingWithEdge+ , smartSpacing, smartSpacingWithEdge+ , setSpacing, incSpacing+ ) where - spacing, Spacing,- spacingWithEdge, SpacingWithEdge,- smartSpacing, SmartSpacing,- smartSpacingWithEdge, SmartSpacingWithEdge,- ModifySpacing(..), setSpacing, incSpacing- ) where+import XMonad+import XMonad.StackSet as W+import qualified XMonad.Util.Rectangle as R+import XMonad.Layout.LayoutModifier+import XMonad.Actions.MessageFeedback -import Graphics.X11 (Rectangle(..))-import Control.Arrow (second)-import XMonad.Operations (sendMessage)-import XMonad.Core (X,runLayout,Message,fromMessage,Typeable)-import XMonad.StackSet (up, down, Workspace(..))-import XMonad.Util.Font (fi) -import XMonad.Layout.LayoutModifier- -- $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\/xmonad.hs@+-- file: -- -- > import XMonad.Layout.Spacing -- -- and modifying your layoutHook as follows (for example): ----- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2)--- > -- put a 2px space around every window---+-- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $+-- > layoutHook def --- | Surround all windows by a certain number of pixels of blank space.-spacing :: Int -> l a -> ModifiedLayout Spacing l a-spacing p = ModifiedLayout (Spacing p)+-- | Represent the borders of a rectangle.+data Border = Border+ { top :: Integer+ , bottom :: Integer+ , right :: Integer+ , left :: Integer+ } deriving (Show,Read) -data Spacing a = Spacing Int deriving (Show, Read)+-- | A 'LayoutModifier' providing customizable screen and window borders.+-- Borders are clamped to @[0,Infinity]@ before being applied.+data Spacing a = Spacing+ { smartBorder :: Bool+ -- ^ When @True@ borders are not applied if+ -- there fewer than two windows.+ , screenBorder :: Border+ -- ^ The screen border.+ , screenBorderEnabled :: Bool+ -- ^ Is the screen border enabled?+ , windowBorder :: Border+ -- ^ The window borders.+ , windowBorderEnabled :: Bool+ -- ^ Is the window border enabled?+ } deriving (Show,Read) --- | Message to dynamically modify (e.g. increase/decrease/set) the size of the window spacing-data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)-instance Message ModifySpacing+instance Eq a => LayoutModifier Spacing a where+ -- This is a bit of a chicken-and-egg problem - the visible window list has+ -- yet to be generated. Several workarounds to incorporate the screen+ -- border:+ -- 1. Call 'runLayout' twice, with/without the screen border. Since layouts+ -- run arbitrary X actions, this breaks an important underlying+ -- assumption. Also, doesn't really solve the chicken-egg problem.+ -- 2. Create the screen border after and if the child layout returns more+ -- than one window. Unfortunately this breaks the window ratios+ -- presented by the child layout, another important assumption.+ -- 3. Create the screen border before, and remove it after and if the child+ -- layout returns fewer than two visible windows. This is somewhat hacky+ -- but probably the best option. Could significantly modify the child+ -- layout if it would have returned more than one window given the space+ -- of the screen border, but this is the underlying chicken-egg problem,+ -- and some concession must be made:+ -- * no border -> multiple windows+ -- * border -> single window+ -- Also slightly breaks layouts that expect to present absolutely-sized+ -- windows; a single window will be scaled up by the border size.+ -- Overall these are trivial assumptions.+ --+ -- Note #1: the original code counted the windows of the 'Workspace' stack,+ -- and so generated incorrect results even for the builtin 'Full' layout.+ -- Even though most likely true, it isn't guaranteed that a layout will+ -- never return windows not in the stack, specifically that an empty stack+ -- will lead to 0 visible windows and a stack with a single window will+ -- lead to 0-1 visible windows (see 'XMonad.Layout.Decoration'). So as much+ -- as I would like to pass a rectangle without screen borders to the child+ -- layout when appropriate (per the original approach), I can't. Since the+ -- screen border is always present whether displayed or not, child layouts+ -- can't depend on an accurate layout rectangle.+ --+ -- Note #2: If there are fewer than two stack windows displayed, the stack+ -- window (if present) is scaled up while the non-stack windows are moved a+ -- border-dependent amount based on their quadrant. So a non-stack window+ -- in the top-left quadrant will be moved using only the border's top and+ -- left components. Originally I was going to use an edge-attachment+ -- algorithm, but this is much simpler and covers most cases. Edge+ -- attachment would have scaled non-stack windows, but most non-stack+ -- windows are created by XMonad and therefore cannot be scaled. I suggest+ -- this layout be disabled for any incompatible child layouts.+ modifyLayout (Spacing _b _sb False _wb _wbe) wsp lr =+ runLayout wsp lr+ modifyLayout (Spacing b sb _sbe _wb _wbe) wsp lr = do+ let sb1 = borderClampGTZero sb+ lr' = withBorder' sb1 2 lr+ sb2 = toBorder lr' lr+ (wrs,ml) <- runLayout wsp lr'+ let ff (w,wr) (i,ps) = if w `elem` (W.integrate' . W.stack $ wsp)+ then let wr' = withBorder' sb2 2 wr+ in (i+1,(w,wr'):ps)+ else let wr' = moveByQuadrant lr wr sb2+ in (i,(w,wr'):ps)+ (c,wrs') = foldr ff (0::Integer,[]) wrs+ return $ if c <= 1 && b+ then (wrs',ml)+ else (wrs,ml)+ where+ moveByQuadrant :: Rectangle -> Rectangle -> Border -> Rectangle+ moveByQuadrant rr mr@(Rectangle {rect_x = x, rect_y = y}) (Border bt bb br bl) =+ let (rcx,rcy) = R.center rr+ (mcx,mcy) = R.center mr+ dx = orderSelect (compare mcx rcx) (bl,0,negate br)+ dy = orderSelect (compare mcy rcy) (bt,0,negate bb)+ in mr { rect_x = x + fromIntegral dx, rect_y = y + fromIntegral dy } --- | Set spacing to given amount-setSpacing :: Int -> X ()-setSpacing n = sendMessage $ ModifySpacing $ const n+ -- This is run after 'modifyLayout' but receives the original stack, not+ -- one possibly modified by the child layout. Does not remove borders from+ -- windows not in the stack, i.e. decorations generated by+ -- 'XMonad.Layout.Decorations'.+ pureModifier (Spacing _b _sb _sbe _wb False) _lr _mst wrs =+ (wrs, Nothing)+ pureModifier (Spacing b _sb _sbe wb _wbe) _lr mst wrs =+ let wb' = borderClampGTZero wb+ ff p@(w,wr) (i,ps) = if w `elem` W.integrate' mst+ then let wr' = withBorder' wb' 2 wr+ in (i+1,(w,wr'):ps)+ else (i,p:ps)+ (c,wrs') = foldr ff (0::Integer,[]) wrs+ in if c <= 1 && b+ then (wrs, Nothing)+ else (wrs', Nothing) --- | Increase spacing by given amount-incSpacing :: Int -> X ()-incSpacing n = sendMessage $ ModifySpacing $ (+n)+ pureMess s@(Spacing b sb sbe wb wbe) m+ | Just (ModifySmartBorder f) <- fromMessage m+ = Just $ s { smartBorder = f b }+ | Just (ModifyScreenBorder f) <- fromMessage m+ = Just $ s { screenBorder = f sb }+ | Just (ModifyScreenBorderEnabled f) <- fromMessage m+ = Just $ s { screenBorderEnabled = f sbe }+ | Just (ModifyWindowBorder f) <- fromMessage m+ = Just $ s { windowBorder = f wb }+ | Just (ModifyWindowBorderEnabled f) <- fromMessage m+ = Just $ s { windowBorderEnabled = f wbe }+ | Just (ModifySpacing f) <- fromMessage m+ = Just $ let f' = borderMap (fromIntegral . f . fromIntegral)+ in s { screenBorder = f' sb, windowBorder = f' wb }+ | otherwise+ = Nothing -instance LayoutModifier Spacing a where+ modifierDescription Spacing {} =+ "Spacing" - pureModifier (Spacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing) - pureMess (Spacing px) m- | Just (ModifySpacing f) <- fromMessage m = Just $ Spacing $ max 0 $ f px- | otherwise = Nothing+-- | Generate the 'ModifiedLayout', exposing all initial state of 'Spacing'.+spacingRaw :: Bool -- ^ The 'smartBorder'.+ -> Border -- ^ The 'screenBorder'.+ -> Bool -- ^ The 'screenBorderEnabled'.+ -> Border -- ^ The 'windowBorder'.+ -> Bool -- ^ The 'windowBorderEnabled'.+ -> l a -> ModifiedLayout Spacing l a+spacingRaw b sb sbe wb wbe = ModifiedLayout (Spacing b sb sbe wb wbe) - modifierDescription (Spacing p) = "Spacing " ++ show p+-- | Messages to alter the state of 'Spacing' using the endomorphic function+-- arguments.+data SpacingModifier+ = ModifySmartBorder (Bool -> Bool)+ | ModifyScreenBorder (Border -> Border)+ | ModifyScreenBorderEnabled (Bool -> Bool)+ | ModifyWindowBorder (Border -> Border)+ | ModifyWindowBorderEnabled (Bool -> Bool)+ deriving (Typeable) --- | Surround all windows by a certain number of pixels of blank space, and--- additionally adds the same amount of spacing around the edge of the screen.-spacingWithEdge :: Int -> l a -> ModifiedLayout SpacingWithEdge l a-spacingWithEdge p = ModifiedLayout (SpacingWithEdge p)+instance Message SpacingModifier -data SpacingWithEdge a = SpacingWithEdge Int deriving (Show, Read)+-- | Set 'smartBorder' to the given 'Bool'.+setSmartSpacing :: Bool -> X ()+setSmartSpacing = sendMessage . ModifySmartBorder . const -instance LayoutModifier SpacingWithEdge a where+-- | Set 'screenBorder' to the given 'Border'.+setScreenSpacing :: Border -> X ()+setScreenSpacing = sendMessage . ModifyScreenBorder . const - pureModifier (SpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)+-- | Set 'screenBorderEnabled' to the given 'Bool'.+setScreenSpacingEnabled :: Bool -> X ()+setScreenSpacingEnabled = sendMessage . ModifyScreenBorderEnabled . const - pureMess (SpacingWithEdge px) m- | Just (ModifySpacing f) <- fromMessage m = Just $ SpacingWithEdge $ max 0 $ f px- | otherwise = Nothing+-- | Set 'windowBorder' to the given 'Border'.+setWindowSpacing :: Border -> X ()+setWindowSpacing = sendMessage . ModifyWindowBorder . const - modifyLayout (SpacingWithEdge p) w r = runLayout w (shrinkRect p r)+-- | Set 'windowBorderEnabled' to the given 'Bool'.+setWindowSpacingEnabled :: Bool -> X ()+setWindowSpacingEnabled = sendMessage . ModifyWindowBorderEnabled . const - modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p+-- | Toggle 'smartBorder'.+toggleSmartSpacing :: X ()+toggleSmartSpacing = sendMessage $ ModifySmartBorder not -shrinkRect :: Int -> Rectangle -> Rectangle-shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (fi $ max 1 $ fi w-2*p) (fi $ max 1 $ fi h-2*p)+-- | Toggle 'screenBorderEnabled'.+toggleScreenSpacingEnabled :: X ()+toggleScreenSpacingEnabled = sendMessage $ ModifyScreenBorderEnabled not --- | Surrounds all windows with blank space, except when the window is the only--- visible window on the current workspace.-smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a-smartSpacing p = ModifiedLayout (SmartSpacing p)+-- | Toggle 'windowBorderEnabled'.+toggleWindowSpacingEnabled :: X ()+toggleWindowSpacingEnabled = sendMessage $ ModifyWindowBorderEnabled not -data SmartSpacing a = SmartSpacing Int deriving (Show, Read)+-- | Set all borders to a uniform size; see 'setWindowSpacing' and+-- 'setScreenSpacing'.+setScreenWindowSpacing :: Integer -> X ()+setScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder]+ . flip id . const . uniformBorder -instance LayoutModifier SmartSpacing a where+-- | Increment the borders of 'windowBorder' using 'borderIncrementBy', which+-- preserves border ratios during clamping.+incWindowSpacing :: Integer -> X ()+incWindowSpacing = sendMessage . ModifyWindowBorder . borderIncrementBy - pureModifier _ _ _ [x] = ([x], Nothing)- pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)+-- | Increment the borders of 'screenBorder' using 'borderIncrementBy'.+incScreenSpacing :: Integer -> X ()+incScreenSpacing = sendMessage . ModifyScreenBorder . borderIncrementBy - modifierDescription (SmartSpacing p) = "SmartSpacing " ++ show p+-- | Inverse of 'incWindowSpacing', equivalent to applying 'negate'.+decWindowSpacing :: Integer -> X ()+decWindowSpacing = incWindowSpacing . negate --- | Surrounds all windows with blank space, and adds the same amount of spacing--- around the edge of the screen, except when the window is the only visible--- window on the current workspace.-smartSpacingWithEdge :: Int -> l a -> ModifiedLayout SmartSpacingWithEdge l a-smartSpacingWithEdge p = ModifiedLayout (SmartSpacingWithEdge p)+-- | Inverse of 'incScreenSpacing'.+decScreenSpacing :: Integer -> X ()+decScreenSpacing = incScreenSpacing . negate -data SmartSpacingWithEdge a = SmartSpacingWithEdge Int deriving (Show, Read)+-- | Increment both screen and window borders; see 'incWindowSpacing' and+-- 'incScreenSpacing'.+incScreenWindowSpacing :: Integer -> X ()+incScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder]+ . flip id . borderIncrementBy -instance LayoutModifier SmartSpacingWithEdge a where+-- | Inverse of 'incScreenWindowSpacing'.+decScreenWindowSpacing :: Integer -> X ()+decScreenWindowSpacing = incScreenWindowSpacing . negate - pureModifier _ _ _ [x] = ([x], Nothing)- pureModifier (SmartSpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)+-- | Construct a uniform 'Border'. That is, having equal individual borders.+uniformBorder :: Integer -> Border+uniformBorder i = Border i i i i - modifyLayout (SmartSpacingWithEdge p) w r- | maybe False (\s -> null (up s) && null (down s)) (stack w) = runLayout w r- | otherwise = runLayout w (shrinkRect p r)+-- | Map a function over a 'Border'. That is, over the four individual borders.+borderMap :: (Integer -> Integer) -> Border -> Border+borderMap f (Border t b r l) = Border (f t) (f b) (f r) (f l) - modifierDescription (SmartSpacingWithEdge p) = "SmartSpacingWithEdge " ++ show p+-- | Clamp borders to within @[0,Infinity]@.+borderClampGTZero :: Border -> Border+borderClampGTZero = borderMap (max 0)++-- | Change the border spacing by the provided amount, adjusted so that at+-- least one border field is @>=0@.+borderIncrementBy :: Integer -> Border -> Border+borderIncrementBy i (Border t b r l) =+ let bl = [t,b,r,l]+ o = maximum bl+ o' = max i $ negate o+ [t',b',r',l'] = map (+o') bl+ in Border t' b' r' l'++-- | Interface to 'XMonad.Util.Rectangle.withBorder'.+withBorder' :: Border -> Integer -> Rectangle -> Rectangle+withBorder' (Border t b r l) = R.withBorder t b r l++-- | Return the border necessary to derive the second rectangle from the first.+-- Since 'R.withBorder' may scale the borders to stay within rectangle bounds,+-- it is not an invertible operation, i.e. applying a negated border may not+-- return the original rectangle. Use this instead.+toBorder :: Rectangle -> Rectangle -> Border+toBorder r1 r2 =+ let R.PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = R.pixelsToCoordinates r1+ R.PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = R.pixelsToCoordinates r2+ l = r2_x1 - r1_x1+ r = r1_x2 - r2_x2+ t = r2_y1 - r1_y1+ b = r1_y2 - r2_y2+ in Border t b r l++-- | Given an ordering and a three-tuple, return the first tuple entry if 'LT',+-- second if 'EQ' and third if 'GT'.+orderSelect :: Ordering -> (a,a,a) -> a+orderSelect o (lt,eq,gt) = case o of+ LT -> lt+ EQ -> eq+ GT -> gt++-----------------------------------------------------------------------------+-- Backwards Compatibility:+-----------------------------------------------------------------------------+{-# DEPRECATED SpacingWithEdge, SmartSpacing, SmartSpacingWithEdge "Use Spacing instead." #-}+{-# DEPRECATED ModifySpacing "Use SpacingModifier instead, perhaps with sendMessages." #-}+{-# DEPRECATED spacing, spacingWithEdge, smartSpacing, smartSpacingWithEdge "Use spacingRaw instead." #-}+{-# DEPRECATED setSpacing "Use setScreenWindowSpacing instead." #-}+{-# DEPRECATED incSpacing "Use incScreenWindowSpacing instead." #-}++-- $backwardsCompatibility+-- The following functions and types exist solely for compatibility with+-- pre-0.14 releases.++-- | A type synonym for the 'Spacing' 'LayoutModifier'.+type SpacingWithEdge = Spacing++-- | A type synonym for the 'Spacing' 'LayoutModifier'.+type SmartSpacing = Spacing++-- | A type synonym for the 'Spacing' 'LayoutModifier'.+type SmartSpacingWithEdge = Spacing++-- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of+-- the screen spacing and window spacing. See 'SpacingModifier'.+data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)++instance Message ModifySpacing++-- | Surround all windows by a certain number of pixels of blank space. See+-- 'spacingRaw'.+spacing :: Int -> l a -> ModifiedLayout Spacing l a+spacing i = spacingRaw False (uniformBorder 0) False (uniformBorder i') True+ where i' = fromIntegral i++-- | Surround all windows by a certain number of pixels of blank space, and+-- additionally adds the same amount of spacing around the edge of the screen.+-- See 'spacingRaw'.+spacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a+spacingWithEdge i = spacingRaw False (uniformBorder i') True (uniformBorder i') True+ where i' = fromIntegral i++-- | Surrounds all windows with blank space, except when the window is the only+-- visible window on the current workspace. See 'spacingRaw'.+smartSpacing :: Int -> l a -> ModifiedLayout Spacing l a+smartSpacing i = spacingRaw True (uniformBorder 0) False (uniformBorder i') True+ where i' = fromIntegral i++-- | Surrounds all windows with blank space, and adds the same amount of+-- spacing around the edge of the screen, except when the window is the only+-- visible window on the current workspace. See 'spacingRaw'.+smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a+smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True+ where i' = fromIntegral i++-- | See 'setScreenWindowSpacing'.+setSpacing :: Int -> X ()+setSpacing = setScreenWindowSpacing . fromIntegral++-- | See 'incScreenWindowSpacing'.+incSpacing :: Int -> X ()+incSpacing = incScreenWindowSpacing . fromIntegral
+ XMonad/Layout/StateFull.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}++--------------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.StateFull+-- Description : The StateFull Layout & FocusTracking Layout Transformer+-- Copyright : (c) 2018 L. S. Leary+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : L. S. Leary+-- Stability : unstable+-- Portability : unportable+--+-- Provides StateFull: a stateful form of Full that does not misbehave when+-- floats are focused, and the FocusTracking layout transformer by means of+-- which StateFull is implemented. FocusTracking simply holds onto the last+-- true focus it was given and continues to use it as the focus for the+-- transformed layout until it sees another. It can be used to improve the+-- behaviour of a child layout that has not been given the focused window.+--------------------------------------------------------------------------------++module XMonad.Layout.StateFull (+ -- * Usage+ -- $Usage+ pattern StateFull,+ StateFull,+ FocusTracking(..),+ focusTracking+) where++import XMonad hiding ((<&&>))+import qualified XMonad.StackSet as W+import XMonad.Util.Stack (findZ)++import Data.Maybe (fromMaybe)+import Control.Applicative ((<|>),(<$>))+import Control.Monad (join)++-- $Usage+--+-- To use it, first you need to:+--+-- > import XMonad.Layout.StateFull+--+-- Then to toggle your tiled layout with @StateFull@, you can do:+--+-- > main = xmonad def { layoutHook = someTiledLayout ||| StateFull }+--+-- Or, some child layout that depends on focus information can be made to fall+-- back on the last focus it had:+--+-- > main = xmonad def+-- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) }++-- | The @FocusTracking@ 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++-- | A type synonym to match the @StateFull@ pattern synonym.+type StateFull = FocusTracking Full++-- | A pattern synonym for the primary use case of the @FocusTracking@+-- transformer; using @Full@.+pattern StateFull = FocusTracking Nothing Full++instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where++ description (FocusTracking _ child)+ | (chDesc == "Full") = "StateFull"+ | (' ' `elem` chDesc) = "FocusTracking (" ++ chDesc ++ ")"+ | otherwise = "FocusTracking " ++ chDesc+ where chDesc = description child++ runLayout (W.Workspace i (FocusTracking mOldFoc childL) mSt) sr = do++ mRealFoc <- gets (W.peek . windowset)+ let mGivenFoc = W.focus <$> mSt+ passedMSt = if mRealFoc == mGivenFoc then mSt+ else join (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt++ (wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr+ let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL'+ else Just $ FocusTracking mGivenFoc (fromMaybe childL mChildL')++ return (wrs, newFT)++ handleMessage (FocusTracking mf childLayout) m =+ (fmap . fmap) (FocusTracking mf) (handleMessage childLayout m)
XMonad/Layout/ThreeColumns.hs view
@@ -97,8 +97,8 @@ split3HorizontallyBy middle f (Rectangle sx sy sw sh) = if middle then ( Rectangle (sx + fromIntegral r3w) sy r1w sh- , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh- , Rectangle sx sy r3w sh )+ , Rectangle sx sy r3w sh+ , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh ) else ( Rectangle sx sy r1w sh , Rectangle (sx + fromIntegral r1w) sy r2w sh , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh )
XMonad/Prompt.hs view
@@ -35,7 +35,7 @@ , emacsLikeXPKeymap, emacsLikeXPKeymap' , quit , killBefore, killAfter, startOfLine, endOfLine- , pasteString, moveCursor+ , insertString, pasteString, moveCursor , setInput, getInput , moveWord, moveWord', killWord, killWord', deleteString , moveHistory, setSuccess, setDone@@ -126,7 +126,10 @@ } data XPConfig =- XPC { font :: String -- ^ Font; use the prefix @"xft:"@ for TrueType fonts+ XPC { font :: String -- ^ Font. For TrueType fonts, use something like+ -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font+ -- Description, i.e. something like+ -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@. , bgColor :: String -- ^ Background color , fgColor :: String -- ^ Font color , fgHLight :: String -- ^ Font color of a highlighted completion entry
XMonad/Prompt/AppendFile.hs view
@@ -23,6 +23,7 @@ -- $usage appendFilePrompt,+ appendFilePrompt', AppendFile, ) where @@ -55,6 +56,17 @@ -- -- (Put the spawn on the line after the prompt to append the time instead.) --+-- 'appendFilePrompt'' can be used to transform the string input in the prompt+-- before saving into the file. Previous example with date can be rewritten as:+--+-- > , ((modm .|. controlMask, xK_n), do+-- > date <- io $ liftM (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime+-- > appendFilePrompt' def (date ++) $ "/home/me/NOTES"+-- > )+--+-- A benefit is that if the prompt is cancelled the date is not output to+-- the file too.+-- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". @@ -66,11 +78,17 @@ -- | Given an XPrompt configuration and a file path, prompt the user -- for a line of text, and append it to the given file. appendFilePrompt :: XPConfig -> FilePath -> X ()-appendFilePrompt c fn = mkXPrompt (AppendFile fn)+appendFilePrompt c fn = appendFilePrompt' c id fn++-- | Given an XPrompt configuration, string transformation function+-- and a file path, prompt the user for a line of text, transform it+-- and append the result to the given file.+appendFilePrompt' :: XPConfig -> (String -> String) -> FilePath -> X ()+appendFilePrompt' c trans fn = mkXPrompt (AppendFile fn) c (const (return []))- (doAppend fn)+ (doAppend trans fn) -- | Append a string to a file.-doAppend :: FilePath -> String -> X ()-doAppend fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn+doAppend :: (String -> String) -> FilePath -> String -> X ()+doAppend trans fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn . trans
+ XMonad/Prompt/FuzzyMatch.hs view
@@ -0,0 +1,104 @@+--------------------------------------------------------------------------------+-- |+-- Module : XMonad.Prompt.FuzzyMatch+-- Copyright : (C) 2015 Norbert Zeh+-- License : GPL+--+-- Maintainer : Norbert Zeh <norbert.zeh@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- A module for fuzzy completion matching in prompts akin to emacs ido mode.+--+--------------------------------------------------------------------------------++module XMonad.Prompt.FuzzyMatch ( -- * Usage+ -- $usage+ fuzzyMatch+ , fuzzySort+ ) where++import Data.Char+import Data.Function+import Data.List++-- $usage+-- +-- This module offers two aspects of fuzzy matching of completions offered by+-- XMonad.Prompt.+--+-- 'fuzzyMatch' can be used as the searchPredicate in the XPConfig. The effect+-- is that any completion that contains the currently typed characters as a+-- subsequence is a valid completion; matching is case insensitive. This means+-- that the sequence of typed characters can be obtained from the completion by+-- deleting an appropriate subset of its characters. Example: "spr" matches+-- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the+-- latter: "S.......P.r..........".+--+-- While this type of inclusiveness is helpful most of the time, it sometimes+-- also produces surprising matches. 'fuzzySort' helps sorting matches by+-- relevance, using a simple heuristic for measuring relevance. The matches are+-- sorted primarily by the length of the substring that contains the query+-- characters and secondarily the starting position of the match. So, if the+-- search string is "spr" and the matches are "FastSPR", "FasterSPR", and+-- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR",+-- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr"+-- within a substring of length 3 ("SPR") while the shortest substring of+-- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length+-- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at+-- position 5 while the match in "FasterSPR" starts at position 7.+--+-- To use these functions in an XPrompt, for example, for windowPromptGoto:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Window ( windowPromptGoto )+-- > import XMonad.Prompt.FuzzyMatch+-- >+-- > myXPConfig = def { searchPredicate = fuzzyMatch+-- , sorter = fuzzySort+-- }+-- +-- then add this to your keys definition:+--+-- > , ((modm .|. shiftMask, xK_g), windowPromptGoto myXPConfig)+--+-- 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.+fuzzyMatch :: String -> String -> Bool+fuzzyMatch [] _ = True+fuzzyMatch _ [] = False+fuzzyMatch xxs@(x:xs) (y:ys) | toLower x == toLower y = fuzzyMatch xs ys+ | otherwise = fuzzyMatch xxs ys++-- | Sort the given set of strings by how well they match. Match quality is+-- measured first by the length of the substring containing the match and second+-- by the positions of the matching characters in the string.+fuzzySort :: String -> [String] -> [String]+fuzzySort q = map snd . sortBy (compare `on` fst) . map (rankMatch q)++rankMatch :: String -> String -> ((Int, Int), String)+rankMatch q s = (minimum $ rankMatches q s, s)++rankMatches :: String -> String -> [(Int, Int)]+rankMatches [] _ = [(0, 0)]+rankMatches q s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s++findShortestMatches :: String -> String -> [(Int, Int)]+findShortestMatches q s = foldl' extendMatches spans oss+ where (os:oss) = map (findOccurrences s) q+ spans = [(o, o) | o <- os]++findOccurrences :: String -> Char -> [Int]+findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]++extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)]+extendMatches spans xs = map last $ groupBy ((==) `on` snd) $ extendMatches' spans xs++extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)]+extendMatches' [] _ = []+extendMatches' _ [] = []+extendMatches' spans@((l, r):spans') xs@(x:xs') | r < x = (l, x) : extendMatches' spans' xs+ | otherwise = extendMatches' spans xs'
XMonad/Prompt/Pass.hs view
@@ -8,9 +8,10 @@ -- Stability : unstable -- Portability : unportable ----- This module provides 3 <XMonad.Prompt> to ease passwords manipulation (generate, read, remove):+-- This module provides 4 <XMonad.Prompt> to ease password manipulation (generate, read, remove): ----- - one to lookup passwords in the password-storage.+-- - two to lookup passwords in the password-store; one of which copies to the+-- clipboard, and the other uses @xdotool@ to type the password directly. -- -- - one to generate a password for a given password label that the user inputs. --@@ -18,28 +19,26 @@ -- -- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>. ----- The password store is setuped through an environment variable PASSWORD_STORE_DIR.--- If this is set, use the content of the variable.--- Otherwise, the password store is located on user's home @$HOME\/.password-store@.---+-- The password store is setup through an environment variable PASSWORD_STORE_DIR,+-- or @$HOME\/.password-store@ if it is unset. -- -- Source: ----- - The password storage implementation is <http://git.zx2c4.com/password-store the password-store cli>.+-- - The password store implementation is <http://git.zx2c4.com/password-store the password-store cli>. ----- - Inspired from <http://babushk.in/posts/combining-xmonad-and-pass.html>+-- - Inspired by <http://babushk.in/posts/combining-xmonad-and-pass.html> -- ----------------------------------------------------------------------------- module XMonad.Prompt.Pass (- -- * Usages- -- $usages+ -- * Usage+ -- $usage passPrompt , passGeneratePrompt , passRemovePrompt+ , passTypePrompt ) where -import Control.Monad (liftM) import XMonad.Core import XMonad.Prompt ( XPrompt , showXPrompt@@ -54,32 +53,32 @@ import System.Posix.Env (getEnv) import XMonad.Util.Run (runProcessWithInput) --- $usages+-- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt.Pass -- -- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt': ----- > , ((modMask x , xK_p) , passPrompt xpconfig)--- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig)--- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig)+-- > , ((modMask , xK_p) , passPrompt xpconfig)+-- > , ((modMask .|. controlMask, xK_p) , passGeneratePrompt xpconfig)+-- > , ((modMask .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig) -- -- For detailed instructions on: -- -- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". ----- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>+-- - how to setup the password store, see <http://git.zx2c4.com/password-store/about/> -- type Predicate = String -> String -> Bool getPassCompl :: [String] -> Predicate -> String -> IO [String]-getPassCompl compls p s = do return $ filter (p s) compls+getPassCompl compls p s = return $ filter (p s) compls type PromptLabel = String -data Pass = Pass PromptLabel+newtype Pass = Pass PromptLabel instance XPrompt Pass where showXPrompt (Pass prompt) = prompt ++ ": "@@ -98,7 +97,7 @@ passwordStoreFolder :: IO String passwordStoreFolder = getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir- where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory+ where computePasswordStoreDir Nothing = fmap passwordStoreFolderDefault getHomeDirectory computePasswordStoreDir (Just storeDir) = return storeDir -- | A pass prompt factory@@ -126,23 +125,41 @@ passRemovePrompt :: XPConfig -> X () passRemovePrompt = mkPassPrompt "Remove password" removePassword +-- | A prompt to type in a password for a given entry.+-- This doesn't touch the clipboard.+--+passTypePrompt :: XPConfig -> X ()+passTypePrompt = mkPassPrompt "Type password" typePassword+ -- | Select a password. -- selectPassword :: String -> X ()-selectPassword passLabel = spawn $ "pass --clip " ++ passLabel+selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\"" -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- generatePassword :: String -> X ()-generatePassword passLabel = spawn $ "pass generate --force " ++ passLabel ++ " 30"+generatePassword passLabel = spawn $ "pass generate --force \"" ++ escapeQuote passLabel ++ "\" 30" -- | Remove a password stored for a given entry. -- removePassword :: String -> X ()-removePassword passLabel = spawn $ "pass rm --force " ++ passLabel+removePassword passLabel = spawn $ "pass rm --force \"" ++ escapeQuote passLabel ++ "\"" --- | Retrieve the list of passwords from the password storage 'passwordStoreDir+-- | Type a password stored for a given entry using xdotool.+--+typePassword :: String -> X ()+typePassword passLabel = spawn $ "pass \"" ++ escapeQuote passLabel+ ++ "\"|head -n1|tr -d '\n'|xdotool type --clearmodifiers --file -"++escapeQuote :: String -> String+escapeQuote = concatMap escape+ where escape :: Char -> String+ escape '"' = ['\\', '\"']+ escape x = return x++-- | Retrieve the list of passwords from the password store 'passwordStoreDir getPasswords :: FilePath -> IO [String] getPasswords passwordStoreDir = do files <- runProcessWithInput "find" [@@ -150,7 +167,7 @@ "-type", "f", "-name", "*.gpg", "-printf", "%P\n"] []- return $ map removeGpgExtension $ lines files+ return . map removeGpgExtension $ lines files removeGpgExtension :: String -> String removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file
XMonad/Prompt/Unicode.hs view
@@ -1,6 +1,7 @@ {- | Module : XMonad.Prompt.Unicode Copyright : (c) 2016 Joachim Breitner+ 2017 Nick Hu License : BSD-style (see LICENSE) Maintainer : <mail@joachim-breitner.de>@@ -9,14 +10,18 @@ A prompt for searching unicode characters by name and inserting them into the clipboard. -Requires the file @\/usr\/share\/unicode\/UnicodeData.txt@ (shipped in the package-@unicode-data@ on Debian) and the @xsel@ tool.+The provided @unicodePrompt@ and @typeUnicodePrompt@ use @xsel@ and @xdotool@+respectively. -} +{-# LANGUAGE DeriveDataTypeable #-}+ module XMonad.Prompt.Unicode ( -- * Usage -- $usage- unicodePrompt+ unicodePrompt,+ typeUnicodePrompt,+ mkUnicodePrompt ) where import qualified Data.ByteString.Char8 as BS@@ -33,9 +38,23 @@ import Text.Printf import XMonad+import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.Run import XMonad.Prompt +data Unicode = Unicode+instance XPrompt Unicode where+ showXPrompt Unicode = "Unicode: "+ commandToComplete Unicode s = s+ nextCompletion Unicode = getNextCompletion++newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, BS.ByteString)] }+ deriving (Typeable, Read, Show)++instance ExtensionClass UnicodeData where+ initialValue = UnicodeData []+ extensionType = StateExtension+ {- $usage You can use this module by importing it, along with@@ -46,54 +65,61 @@ and adding an appropriate keybinding, for example: -> , ((modm .|. controlMask, xK_u), unicodePrompt def)+> , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def) +More flexibility is given by the @mkUnicodePrompt@ function, which takes a+command and a list of arguments to pass as its first two arguments. See+@unicodePrompt@ for details. -} -unicodeDataFilename :: String-unicodeDataFilename = "/usr/share/unicode/UnicodeData.txt"--entries :: [(Char, BS.ByteString)]-entries = unsafePerformIO $ do- datE <- tryIOError $ BS.readFile unicodeDataFilename- case datE of- Left e -> do- hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""- hPutStrLn stderr $ show e- hPutStrLn stderr $ "Do you have unicode-data installed?"- return []- Right dat -> return $ sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat-{-# NOINLINE entries #-}+populateEntries :: String -> X Bool+populateEntries unicodeDataFilename = do+ entries <- fmap getUnicodeData (XS.get :: X UnicodeData)+ if null entries+ then do+ datE <- liftIO . tryIOError $ BS.readFile unicodeDataFilename+ case datE of+ Left e -> liftIO $ do+ hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""+ hPrint stderr e+ hPutStrLn stderr "Do you have unicode-data installed?"+ return False+ Right dat -> do+ XS.put . UnicodeData . sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat+ return True+ else return True parseUnicodeData :: BS.ByteString -> [(Char, BS.ByteString)] parseUnicodeData = mapMaybe parseLine . BS.lines- where- parseLine l = do- field1 : field2 : _ <- return $ BS.split ';' l- [(c,"")] <- return $ readHex (BS.unpack field1)- return (chr c, field2)+ where parseLine l = do+ field1 : field2 : _ <- return $ BS.split ';' l+ [(c,"")] <- return . readHex $ BS.unpack field1+ return (chr c, field2) -searchUnicode :: String -> [(Char, String)]-searchUnicode s = map (second BS.unpack) $ filter go entries- where w = map BS.pack $ filter (all isAscii) $ filter ((> 1) . length) $ words $ map toUpper s+searchUnicode :: [(Char, BS.ByteString)] -> String -> [(Char, String)]+searchUnicode entries s = map (second BS.unpack) $ filter go entries+ where w = map BS.pack . filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s go (c,d) = all (`BS.isInfixOf` d) w --- | Prompt the user for a unicode character to be inserted into the paste buffer of the X server.-unicodePrompt :: XPConfig -> X ()-unicodePrompt config = mkXPrompt Unicode config unicodeCompl paste+mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()+mkUnicodePrompt prog args unicodeDataFilename config =+ whenX (populateEntries unicodeDataFilename) $ do+ entries <- fmap getUnicodeData (XS.get :: X UnicodeData)+ mkXPrompt Unicode config (unicodeCompl entries) paste where- unicodeCompl [] = return []- unicodeCompl s = do- return $ map (\(c,d) -> printf "%s %s" [c] d) $ take 20 $ searchUnicode s-+ unicodeCompl _ [] = return []+ unicodeCompl entries s = do+ let m = searchUnicode entries s+ return . map (\(c,d) -> printf "%s %s" [c] d) $ take 20 m paste [] = return () paste (c:_) = do- runProcessWithInput "xsel" ["-i"] [c]- return ()+ runProcessWithInput prog args [c]+ return () -data Unicode = Unicode-instance XPrompt Unicode where- showXPrompt Unicode = "Unicode: "- commandToComplete Unicode s = s- nextCompletion Unicode = getNextCompletion+-- | Prompt the user for a Unicode character to be inserted into the paste buffer of the X server.+unicodePrompt :: String -> XPConfig -> X ()+unicodePrompt = mkUnicodePrompt "xsel" ["-i"] +-- | Prompt the user for a Unicode character to be typed by @xdotool@.+typeUnicodePrompt :: String -> XPConfig -> X ()+typeUnicodePrompt = mkUnicodePrompt "xdotool" ["type", "--clearmodifiers", "--file", "-"]
XMonad/Prompt/Window.hs view
@@ -20,6 +20,7 @@ -- $usage WindowPrompt(..), windowPrompt,+ windowMultiPrompt, allWindows, wsWindows, XWindowMap,@@ -30,6 +31,7 @@ windowPromptBringCopy, ) where +import Control.Monad (forM) import qualified Data.Map as M import qualified XMonad.StackSet as W@@ -79,7 +81,36 @@ commandToComplete _ c = c nextCompletion _ = getNextCompletion +-- | Internal type used for the multiple mode prompt.+data WindowModePrompt =+ WindowModePrompt WindowPrompt (M.Map String Window) (String -> String -> Bool)++instance XPrompt WindowModePrompt where+ showXPrompt (WindowModePrompt action _ _) =+ showXPrompt action++ completionFunction (WindowModePrompt _ winmap predicate) =+ \s -> return . filter (predicate s) . map fst . M.toList $ winmap++ modeAction (WindowModePrompt action winmap _) buf auto = do+ let name = if null auto then buf else auto+ a = case action of+ Goto -> gotoAction winmap+ Bring -> bringAction winmap+ BringCopy -> bringCopyAction winmap+ BringToMaster -> bringToMaster winmap+ a name+ where+ winAction a m = flip whenJust (windows . a) . flip M.lookup m+ gotoAction = winAction W.focusWindow+ bringAction = winAction bringWindow+ bringCopyAction = winAction bringCopyWindow+ bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s)+ -- | Deprecated. Use windowPrompt instead.+{-# DEPRECATED windowPromptGoto "Use windowPrompt instead." #-}+{-# DEPRECATED windowPromptBring "Use windowPrompt instead." #-}+{-# DEPRECATED windowPromptBringCopy "Use windowPrompt instead." #-} windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () windowPromptGoto c = windowPrompt c Goto windowMap windowPromptBring c = windowPrompt c Bring windowMap@@ -106,22 +137,31 @@ -- selected window, according to WindowPrompt. windowPrompt :: XPConfig -> WindowPrompt -> XWindowMap -> X () windowPrompt c t winmap = do- a <- case t of- Goto -> fmap gotoAction winmap- Bring -> fmap bringAction winmap- BringCopy -> fmap bringCopyAction winmap- BringToMaster -> fmap bringToMaster winmap wm <- winmap- mkXPrompt t c (compList wm) a+ let mode = WindowModePrompt t wm (searchPredicate c)+ action = modeAction mode+ compList = completionFunction mode+ mkXPrompt t c compList (\s -> action s s) - where- winAction a m = flip whenJust (windows . a) . flip M.lookup m- gotoAction = winAction W.focusWindow- bringAction = winAction bringWindow- bringCopyAction = winAction bringCopyWindow- bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s)+-- | Like 'windowPrompt', but uses the multiple modes feature of+-- @Prompt@ (via 'mkXPromptWithModes').+--+-- Given a list of actions along with the windows they should work+-- with, display the appropriate prompt with the ability to switch+-- between them using the @changeModeKey@.+--+-- For example, to have a prompt that first shows you all windows, but+-- allows you to narrow the list down to just the windows on the+-- current workspace:+--+-- > windowMultiPrompt config [(Goto, allWindows), (Goto, wsWindows)]+windowMultiPrompt :: XPConfig -> [(WindowPrompt, XWindowMap)] -> X ()+windowMultiPrompt c modes = do+ modes' <- forM modes $ \(t, wm) -> do+ wm' <- wm+ return . XPT $ WindowModePrompt t wm' (searchPredicate c) - compList m s = return . filter (searchPredicate c s) . map fst . M.toList $ m+ mkXPromptWithModes modes' c -- | Brings a copy of the specified window into the current workspace. bringCopyWindow :: Window -> WindowSet -> WindowSet
@@ -24,6 +24,7 @@ import qualified XMonad.StackSet as W import qualified Data.Map as M import XMonad.Util.Run+import Control.Monad (liftM) -- $usage -- You can use this module with the following in your Config.hs file:@@ -41,28 +42,32 @@ -- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch> dmenuXinerama :: [String] -> X String dmenuXinerama opts = do- curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int- runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)+ curscreen <-+ (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int+ _ <-+ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) menuArgs "dmenu" ["-xs", show (curscreen+1)] opts -- | Run dmenu to select an option from a list.-dmenu :: [String] -> X String+dmenu :: MonadIO m => [String] -> m String dmenu opts = menu "dmenu" opts -- | like 'dmenu' but also takes the command to run.-menu :: String -> [String] -> X String+menu :: MonadIO m => String -> [String] -> m String menu menuCmd opts = menuArgs menuCmd [] opts -- | Like 'menu' but also takes a list of command line arguments.-menuArgs :: String -> [String] -> [String] -> X String-menuArgs menuCmd args opts = fmap (filter (/='\n')) $ runProcessWithInput menuCmd args (unlines opts)+menuArgs :: MonadIO m => String -> [String] -> [String] -> m String+menuArgs menuCmd args opts = liftM (filter (/='\n')) $+ runProcessWithInput menuCmd args (unlines opts) -- | Like 'dmenuMap' but also takes the command to run.-menuMap :: String -> M.Map String a -> X (Maybe a)+menuMap :: MonadIO m => String -> M.Map String a -> m (Maybe a) menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap -- | Like 'menuMap' but also takes a list of command line arguments.-menuMapArgs :: String -> [String] -> M.Map String a -> X (Maybe a)+menuMapArgs :: MonadIO m => String -> [String] -> M.Map String a ->+ m (Maybe a) menuMapArgs menuCmd args selectionMap = do selection <- menuFunction (M.keys selectionMap) return $ M.lookup selection selectionMap@@ -70,5 +75,5 @@ menuFunction = menuArgs menuCmd args -- | Run dmenu to select an entry from a map based on the key.-dmenuMap :: M.Map String a -> X (Maybe a)+dmenuMap :: MonadIO m => M.Map String a -> m (Maybe a) dmenuMap selectionMap = menuMap "dmenu" selectionMap
XMonad/Util/Dzen.hs view
@@ -25,6 +25,11 @@ x, y, addArgs,+ fgColor,+ bgColor,+ align,+ slaveAlign,+ lineCount, -- * Legacy interface dzen,@@ -41,6 +46,7 @@ import XMonad import XMonad.StackSet import XMonad.Util.Run (runProcessWithInputAndWait, seconds)+import XMonad.Util.Font (Align (..)) type DzenConfig = (Int, [String]) -> X (Int, [String]) @@ -116,6 +122,45 @@ y :: Int -> DzenConfig y n = addArgs ["-y", show n] +-- | Set the foreground color.+--+-- Please be advised that @fgColor@ and @bgColor@ also exist in "XMonad.Prompt".+-- If you use both modules, you might have to tell the compiler which one you mean:+--+-- > import XMonad.Prompt as P+-- > import XMonad.Util.Dzen as D+-- >+-- > dzenConfig (D.fgColor "#f0f0f0") "foobar"+fgColor :: String -> DzenConfig+fgColor c = addArgs ["-fg", c]++-- | Set the background color.+bgColor :: String -> DzenConfig+bgColor c = addArgs ["-bg", c]++-- | Set the alignment of the title (main) window content.+-- Note that @AlignRightOffset@ is treated as equal to @AlignRight@.+--+-- > import XMonad.Util.Font (Align(..))+-- >+-- > dzenConfig (align AlignLeft) "foobar"+align :: Align -> DzenConfig+align = align' "-ta"++-- | Set the alignment of the slave window content.+-- Using this option only makes sense if you also use the @lineCount@ parameter.+slaveAlign :: Align -> DzenConfig+slaveAlign = align' "-sa"++-- Set an alignment parameter+align' :: String -> Align -> DzenConfig+align' opt a = addArgs [opt, s] where+ s = case a of+ AlignCenter -> "c"+ AlignLeft -> "l"+ AlignRight -> "r"+ AlignRightOffset _ -> "r"+ -- | Specify the font. Check out xfontsel to get the format of the String -- right; if your dzen supports xft, then you can supply that here, too. font :: String -> DzenConfig@@ -159,6 +204,14 @@ v = visible ws mapping = map (\s -> (screen s, screenDetail s)) (c:v) maybeSD = lookup sc mapping++-- | Enable slave window and specify the number of lines.+--+-- Dzen can optionally draw a second window underneath the title window.+-- By default, this window is only displayed if the mouse enters the title window.+-- This option is only useful if the string you want to display contains more than one line.+lineCount :: Int -> DzenConfig+lineCount n = addArgs ["-l", show n] -- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds. -- Example usage:
XMonad/Util/EZConfig.hs view
@@ -427,7 +427,11 @@ -- | Parse a regular key name (represented by itself). parseRegular :: ReadP KeySym parseRegular = choice [ char s >> return k- | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde]+ | (s,k) <- zip ['!' .. '~' ] -- ASCII+ [xK_exclam .. xK_asciitilde]++ ++ zip ['\xa0' .. '\xff' ] -- Latin1+ [xK_nobreakspace .. xK_ydiaeresis] ] -- | Parse a special key name (one enclosed in angle brackets).
+ XMonad/Util/Minimize.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE DeriveDataTypeable #-}+----------------------------------------------------------------------------+-- |+-- Module : XMonad.Util.Minimize+-- Copyright : (c) Bogdan Sinitsyn (2016)+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : bogdan.sinitsyn@gmail.com+-- Stability : unstable+-- Portability : not portable+--+-- Stores some common utilities for modules used for window minimizing/maximizing+--+-----------------------------------------------------------------------------+module XMonad.Util.Minimize+ ( RectMap+ , Minimized(..)+ ) where++import XMonad+import qualified XMonad.StackSet as W++import qualified Data.Map as M++type RectMap = M.Map Window (Maybe W.RationalRect)++data Minimized = Minimized+ { rectMap :: RectMap+ , minimizedStack :: [Window]+ }+ deriving (Eq, Typeable, Read, Show)++instance ExtensionClass Minimized where+ initialValue = Minimized { rectMap = M.empty+ , minimizedStack = []+ }+ extensionType = PersistentExtension
+ XMonad/Util/Rectangle.hs view
@@ -0,0 +1,214 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Util.Rectangle+-- Copyright : (c) 2018 Yclept Nemo+-- License : BSD-style (see LICENSE)+--+-- Maintainer :+-- Stability : unstable+-- Portability : unportable+--+-- A module for handling pixel rectangles: 'Rectangle'.+--+-----------------------------------------------------------------------------+++module XMonad.Util.Rectangle+ ( -- * Usage+ -- $usage+ PointRectangle (..)+ , pixelsToIndices, pixelsToCoordinates+ , indicesToRectangle, coordinatesToRectangle+ , empty+ , intersects+ , supersetOf+ , difference+ , withBorder+ , center+ , toRatio+ ) where++import XMonad+import qualified XMonad.StackSet as W++import Data.Ratio+++-- $usage+-- > import XMonad.Util.Rectangle as R+-- > R.empty (Rectangle 0 0 1024 768)+++-- | Rectangle as two points. What those points mean depends on the conversion+-- function.+data PointRectangle a = PointRectangle+ { point_x1::a -- ^ Point nearest to the origin.+ , point_y1::a+ , point_x2::a -- ^ Point furthest from the origin.+ , point_y2::a+ } deriving (Eq,Read,Show)++-- | There are three possible ways to convert rectangles to pixels:+--+-- * Consider integers as "gaps" between pixels; pixels range from @(N,N+1)@,+-- exclusively: @(0,1)@, @(1,2)@, and so on. This leads to interval ambiguity:+-- whether an integer endpoint contains a pixel depends on which direction the+-- interval approaches the pixel. Consider the adjacent pixels @(0,1)@ and+-- @(1,2)@ where @1@ can refer to either pixel @(0,1)@ or pixel @(1,2)@.+--+-- * Consider integers to demarcate the start of each pixel; pixels range from+-- @[N,N+1)@: @[0,1)@, @[1,2)@, and so on - or equivalently: @(N,N+1]@. This is+-- the most flexible coordinate system, and the convention used by the+-- 'Rectangle' type.+--+-- * Consider integers to demarcate the center of each pixel; pixels range from+-- @[N,N+1]@, as though each real-valued coordinate had been rounded (either+-- down or up) to the nearest integers. So each pixel, from zero, is listed as:+-- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this+-- considers pixels as row/colum indices. While easiest to reason with,+-- indices are unable to represent zero-dimension rectangles.+--+-- Consider pixels as indices. Do not use this on empty rectangles.+pixelsToIndices :: Rectangle -> (PointRectangle Integer)+pixelsToIndices (Rectangle px py dx dy) =+ PointRectangle (fromIntegral px)+ (fromIntegral py)+ (fromIntegral px + fromIntegral dx - 1)+ (fromIntegral py + fromIntegral dy - 1)++-- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles.+pixelsToCoordinates :: Rectangle -> (PointRectangle Integer)+pixelsToCoordinates (Rectangle px py dx dy) =+ PointRectangle (fromIntegral px)+ (fromIntegral py)+ (fromIntegral px + fromIntegral dx)+ (fromIntegral py + fromIntegral dy)++-- | Invert 'pixelsToIndices'.+indicesToRectangle :: (PointRectangle Integer) -> Rectangle+indicesToRectangle (PointRectangle x1 y1 x2 y2) =+ Rectangle (fromIntegral x1)+ (fromIntegral y1)+ (fromIntegral $ x2 - x1 + 1)+ (fromIntegral $ y2 - y1 + 1)++-- | Invert 'pixelsToCoordinates'.+coordinatesToRectangle :: (PointRectangle Integer) -> Rectangle+coordinatesToRectangle (PointRectangle x1 y1 x2 y2) =+ Rectangle (fromIntegral x1)+ (fromIntegral y1)+ (fromIntegral $ x2 - x1)+ (fromIntegral $ y2 - y1)++-- | True if either the 'rect_width' or 'rect_height' fields are zero, i.e. the+-- rectangle has no area.+empty :: Rectangle -> Bool+empty (Rectangle _ _ _ 0) = True+empty (Rectangle _ _ 0 _) = True+empty (Rectangle _ _ _ _) = False++-- | True if the intersection of the set of points comprising each rectangle is+-- not the empty set. Therefore any rectangle containing the initial points of+-- an empty rectangle will never intersect that rectangle - including the same+-- empty rectangle.+intersects :: Rectangle -> Rectangle -> Bool+intersects r1 r2 | empty r1 || empty r2 = False+ | otherwise = r1_x1 < r2_x2+ && r1_x2 > r2_x1+ && r1_y1 < r2_y2+ && r1_y2 > r2_y1+ where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1+ PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2++-- | True if the first rectangle contains at least all the points of the second+-- rectangle. Any rectangle containing the initial points of an empty rectangle+-- will be a superset of that rectangle - including the same empty rectangle.+supersetOf :: Rectangle -> Rectangle -> Bool+supersetOf r1 r2 = r1_x1 <= r2_x1+ && r1_y1 <= r2_y1+ && r1_x2 >= r2_x2+ && r1_y2 >= r2_y2+ where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1+ PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2++-- | Return the smallest set of rectangles resulting from removing all the+-- points of the second rectangle from those of the first, i.e. @r1 - r2@, such+-- that @0 <= l <= 4@ where @l@ is the length of the resulting list.+difference :: Rectangle -> Rectangle -> [Rectangle]+difference r1 r2 | r1 `intersects` r2 = map coordinatesToRectangle $+ concat [rt,rr,rb,rl]+ | otherwise = [r1]+ where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1+ PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2+ -- top - assuming (0,0) is top-left+ rt = if r2_y1 > r1_y1 && r2_y1 < r1_y2+ then [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1]+ else []+ -- right+ rr = if r2_x2 > r1_x1 && r2_x2 < r1_x2+ then [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2]+ else []+ -- bottom+ rb = if r2_y2 > r1_y1 && r2_y2 < r1_y2+ then [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2]+ else []+ -- left+ rl = if r2_x1 > r1_x1 && r2_x1 < r1_x2+ then [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2)]+ else []++-- | Fit a 'Rectangle' within the given borders of itself. Given insufficient+-- space, borders are minimized while preserving the ratio of opposite borders.+-- Origin is top-left, and yes, negative borders are allowed.+withBorder :: Integer -- ^ Top border.+ -> Integer -- ^ Bottom border.+ -> Integer -- ^ Right border.+ -> Integer -- ^ Left border.+ -> Integer -- ^ Smallest allowable rectangle dimensions, i.e.+ -- width/height, with values @<0@ defaulting to @0@.+ -> Rectangle -> Rectangle+withBorder t b r l i (Rectangle x y w h) =+ let -- conversions+ w' = fromIntegral w+ h' = fromIntegral h+ -- minimum window dimensions+ i' = max i 0+ iw = min i' w'+ ih = min i' h'+ -- maximum border dimensions+ bh = w' - iw+ bv = h' - ih+ -- scaled border ratios+ rh = if l + r <= 0+ then 1+ else min 1 $ bh % (l + r)+ rv = if t + b <= 0+ then 1+ else min 1 $ bv % (t + b)+ -- scaled border pixels+ t' = truncate $ rv * fromIntegral t+ b' = truncate $ rv * fromIntegral b+ r' = truncate $ rh * fromIntegral r+ l' = truncate $ rh * fromIntegral l+ in Rectangle (x + l')+ (y + t')+ (w - r' - fromIntegral l')+ (h - b' - fromIntegral t')++-- | Calculate the center - @(x,y)@ - as if the 'Rectangle' were bounded.+center :: Rectangle -> (Ratio Integer,Ratio Integer)+center (Rectangle x y w h) = (cx,cy)+ where cx = fromIntegral x + (fromIntegral w) % 2+ cy = fromIntegral y + (fromIntegral h) % 2++-- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip+-- conversion may not result in the original value. The first 'Rectangle' is+-- scaled to the second:+--+-- >>> (Rectangle 2 2 6 6) `toRatio` (Rectangle 0 0 10 10)+-- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5)+toRatio :: Rectangle -> Rectangle -> W.RationalRect+toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) =+ let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2]+ [w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]+ in W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)
+ XMonad/Util/SessionStart.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveDataTypeable #-}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Util.SessionStart+-- Copyright : (c) Markus Ongyerth 2017+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : markus@ongy.net+-- Stability : unstable+-- Portability : not portable+--+-- A module for detectiong session startup. Useful to start+-- status bars, compositors and session initialization.+-- This is a more general approach than spawnOnce and allows spawnOn etc.+-----------------------------------------------------------------------------++module XMonad.Util.SessionStart+ ( doOnce+ , isSessionStart+ , setSessionStarted+ )+where++import Control.Monad (when)+import Control.Applicative ((<$>))++import XMonad+import qualified XMonad.Util.ExtensibleState as XS++-- ---------------------------------------------------------------------+-- $usage+--+-- Add 'setSessionStarted' at the end of the 'startupHook' to set the+-- flag.+--+-- To do something only when the session is started up, use +-- 'isSessionStart' to query or wrap it in 'doOnce' to only do it when+-- the flag isn't set.+-- ---------------------------------------------------------------------++data SessionStart = SessionStart { unSessionStart :: Bool }+ deriving (Read, Show, Typeable)++instance ExtensionClass SessionStart where+ initialValue = SessionStart True+ extensionType = PersistentExtension++-- | Use this to only do a part of your hook on session start+doOnce :: X () -> X ()+doOnce act = do+ startup <- isSessionStart+ when startup act++-- | Query if the current startup is the session start+isSessionStart :: X Bool+isSessionStart = unSessionStart <$> XS.get++-- This should become a noop/be deprecated when merged into master, and+-- the flag should be set when the state file is loaded.+-- | This currently has to be added to the end of the startup hook to+-- set the flag.+setSessionStarted :: X ()+setSessionStarted = XS.put $ SessionStart False
XMonad/Util/SpawnOnce.hs view
@@ -15,9 +15,10 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.SpawnOnce (spawnOnce) where+module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where import XMonad+import XMonad.Actions.SpawnOn import Data.Set as Set import qualified XMonad.Util.ExtensibleState as XS import Control.Monad@@ -29,11 +30,31 @@ initialValue = SpawnOnce Set.empty extensionType = PersistentExtension --- | The first time 'spawnOnce' is executed on a particular command, that--- command is executed. Subsequent invocations for a command do nothing.-spawnOnce :: String -> X ()-spawnOnce xs = do- b <- XS.gets (Set.member xs . unspawnOnce)+doOnce :: (String -> X ()) -> String -> X ()+doOnce f s = do+ b <- XS.gets (Set.member s . unspawnOnce) when (not b) $ do- spawn xs- XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)+ f s+ XS.modify (SpawnOnce . Set.insert s . unspawnOnce)+++-- | The first time 'spawnOnce' is executed on a particular command,+-- that command is executed. Subsequent invocations for a command do+-- nothing.+spawnOnce :: String -> X ()+spawnOnce cmd = doOnce spawn cmd++-- | Like spawnOnce but launches the application on the given workspace.+spawnOnOnce :: WorkspaceId -> String -> X ()+spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd++-- | Lanch the given application n times on the specified+-- workspace. Subsequent attempts to spawn this application will be+-- ignored.+spawnNOnOnce :: Int -> WorkspaceId -> String -> X ()+spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd++-- | Spawn the application once and apply the manage hook. Subsequent+-- attempts to spawn this application will be ignored.+spawnAndDoOnce :: ManageHook -> String -> X ()+spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd
XMonad/Util/Stack.hs view
@@ -38,6 +38,8 @@ , focusUpZ , focusDownZ , focusMasterZ+ , findS+ , findZ -- ** Extraction , getFocusZ , getIZ@@ -73,10 +75,13 @@ , mapE_ , mapEM , mapEM_+ , reverseS+ , reverseZ ) where import qualified XMonad.StackSet as W-import Control.Monad (liftM)+import Control.Applicative ((<|>),(<$>),(<$))+import Control.Monad (guard,liftM) import Data.List (sortBy) @@ -175,6 +180,22 @@ = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down) focusMasterZ (Just s) = Just s +-- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to+-- @Nothing@.+findS :: Eq a => (a -> Bool) -> W.Stack a -> Maybe (W.Stack a)+findS p st = st <$ (guard . p . W.focus) st <|> findUp st <|> findDown st+ where findDown = reverseZ . findUp . reverseS+ findUp s | u:ups <- W.up s = (if p u then Just else findUp)+ $ W.Stack u ups (W.focus s : W.down s)+ | otherwise = Nothing++-- | Refocus a @Zipper a@ on an element satisfying the predicate, or fail to+-- @Nothing@. Never returns @Just Nothing@, so the second layer of @Maybe@ is+-- actually redundant.+findZ :: Eq a => (a -> Bool) -> Zipper a -> Maybe (Zipper a)+findZ _ Nothing = Nothing+findZ p (Just st) = Just <$> findS p st+ -- ** Extraction -- | Get the focused element@@ -338,3 +359,11 @@ -- | Tag the element with 'Right' if the property is true, 'Left' otherwise tagBy :: (a -> Bool) -> a -> Either a a tagBy p a = if p a then Right a else Left a++-- | Reverse a @Stack a@; O(1).+reverseS :: W.Stack a -> W.Stack a+reverseS (W.Stack foc ups downs) = W.Stack foc downs ups++-- | Reverse a @Zipper a@; O(1).+reverseZ :: Zipper a -> Zipper a+reverseZ = (reverseS <$>)
XMonad/Util/Themes.hs view
@@ -20,6 +20,7 @@ , xmonadTheme , smallClean , robertTheme+ , darkTheme , deiflTheme , oxymor00nTheme , donaldTheme@@ -90,6 +91,7 @@ listOfThemes :: [ThemeInfo] listOfThemes = [ xmonadTheme , smallClean+ , darkTheme , deiflTheme , oxymor00nTheme , robertTheme@@ -160,6 +162,22 @@ , inactiveTextColor = "#d5d3a7" , fontName = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859" , decoHeight = 16+ }+ }++-- | Dark Theme, by Lucian Poston.+darkTheme :: ThemeInfo+darkTheme =+ newTheme { themeName = "darkTheme"+ , themeAuthor = "Lucian Poston"+ , themeDescription = "Dark Theme"+ , theme = def { inactiveBorderColor = "#202030"+ , activeBorderColor = "#a0a0d0"+ , inactiveColor = "#000000"+ , activeColor = "#000000"+ , inactiveTextColor = "#607070"+ , activeTextColor = "#a0d0d0"+ , decoHeight = 15 } }
XMonad/Util/WindowProperties.hs view
@@ -21,10 +21,12 @@ -- $helpers getProp32, getProp32s) where++import Control.Monad+import Foreign.C.Types (CLong) import XMonad+import XMonad.Actions.TagWindows (hasTag) import qualified XMonad.StackSet as W-import Foreign.C.Types (CLong)-import Control.Monad -- $edsl -- Allows to specify window properties, such as title, classname or@@ -43,6 +45,7 @@ | Or Property Property | Not Property | Const Bool+ | Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows' deriving (Read, Show) infixr 9 `And` infixr 8 `Or`@@ -78,6 +81,7 @@ propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2 propertyToQuery (Not p) = not `fmap` propertyToQuery p propertyToQuery (Const b) = return b+propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w) -- $helpers
XMonad/Util/WorkspaceCompare.hs view
@@ -25,10 +25,10 @@ import XMonad import qualified XMonad.StackSet as S import Data.List-import Data.Monoid-import Data.Ord import Data.Maybe-import Data.Function+import Data.Monoid (mconcat)+import XMonad.Actions.PhysicalScreens (ScreenComparator(ScreenComparator), getScreenIdAndRectangle, screenComparatorById)+import Data.Function (on) type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering type WorkspaceSort = [WindowSpace] -> [WindowSpace]@@ -64,28 +64,22 @@ -- and screen id. It produces the same ordering as -- 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'. getXineramaWsCompare :: X WorkspaceCompare-getXineramaWsCompare = getXineramaWsCompare' False+getXineramaWsCompare = getXineramaPhysicalWsCompare $ screenComparatorById compare -- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens.-getXineramaPhysicalWsCompare :: X WorkspaceCompare-getXineramaPhysicalWsCompare = getXineramaWsCompare' True--getXineramaWsCompare' :: Bool -> X WorkspaceCompare-getXineramaWsCompare' phy = do+getXineramaPhysicalWsCompare :: ScreenComparator -> X WorkspaceCompare+getXineramaPhysicalWsCompare (ScreenComparator sc) = do w <- gets windowset return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of- (True, True) -> cmpPosition phy w a b+ (True, True) -> compareUsingScreen w a b (False, False) -> compare a b (True, False) -> LT (False, True) -> GT where onScreen w = S.current w : S.visible w isOnScreen a w = a `elem` map (S.tag . S.workspace) (onScreen w)- tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s- cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b- cmpPosition True w a b = comparing (rect.(tagToSid $ onScreen w)) a b- where rect i = let (Rectangle x y _ _) = screens !! fromIntegral i in (y,x)- screens = map (screenRect . S.screenDetail) $ sortBy (comparing S.screen) $ S.current w : S.visible w+ tagToScreen s x = fromJust $ find ((== x) . S.tag . S.workspace) s+ compareUsingScreen w = sc `on` getScreenIdAndRectangle . tagToScreen (onScreen w) -- | Create a workspace sorting function from a workspace comparison -- function.@@ -109,8 +103,6 @@ -- sorted by tag. getSortByXineramaRule :: X WorkspaceSort getSortByXineramaRule = mkWsSort getXineramaWsCompare---- | Like 'getSortByXineramaRule', but uses physical locations for screens.-getSortByXineramaPhysicalRule :: X WorkspaceSort-getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare-+-- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens.+getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort+getSortByXineramaPhysicalRule sc = mkWsSort $ getXineramaPhysicalWsCompare sc
xmonad-contrib.cabal view
@@ -1,5 +1,5 @@ name: xmonad-contrib-version: 0.13+version: 0.14 homepage: http://xmonad.org/ synopsis: Third party extensions for xmonad description:@@ -31,11 +31,12 @@ tests/SwapWorkspaces.hs tests/XPrompt.hs XMonad/Config/dmwit.xmobarrc+ XMonad/Config/Example.hs cabal-version: >= 1.6 build-type: Simple bug-reports: https://github.com/xmonad/xmonad-contrib/issues -tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3 source-repository head type: git@@ -63,9 +64,10 @@ random, mtl >= 1 && < 3, unix,- X11>=1.6.1 && < 1.9,- xmonad>=0.13 && < 0.14,- utf8-string+ X11>=1.6.1 && < 1.10,+ xmonad>=0.14 && < 0.15,+ utf8-string,+ semigroups if flag(use_xft) build-depends: X11-xft >= 0.2@@ -80,25 +82,22 @@ if impl(ghc >= 6.12.1) ghc-options: -fno-warn-unused-do-bind - exposed-modules: XMonad.Doc- XMonad.Doc.Configuring- XMonad.Doc.Extending- XMonad.Doc.Developing- XMonad.Actions.AfterDrag+ exposed-modules: XMonad.Actions.AfterDrag XMonad.Actions.BluetileCommands XMonad.Actions.Commands XMonad.Actions.ConstrainedResize XMonad.Actions.CopyWindow XMonad.Actions.CycleRecentWS XMonad.Actions.CycleSelectedLayouts- XMonad.Actions.CycleWindows XMonad.Actions.CycleWS+ XMonad.Actions.CycleWindows+ XMonad.Actions.CycleWorkspaceByScreen XMonad.Actions.DeManage XMonad.Actions.DwmPromote- XMonad.Actions.DynamicWorkspaces+ XMonad.Actions.DynamicProjects XMonad.Actions.DynamicWorkspaceGroups XMonad.Actions.DynamicWorkspaceOrder- XMonad.Actions.DynamicProjects+ XMonad.Actions.DynamicWorkspaces XMonad.Actions.FindEmptyWorkspace XMonad.Actions.FlexibleManipulate XMonad.Actions.FlexibleResize@@ -107,9 +106,11 @@ XMonad.Actions.FocusNth XMonad.Actions.GridSelect XMonad.Actions.GroupNavigation+ XMonad.Actions.KeyRemap XMonad.Actions.Launcher XMonad.Actions.LinkWorkspaces XMonad.Actions.MessageFeedback+ XMonad.Actions.Minimize XMonad.Actions.MouseGestures XMonad.Actions.MouseResize XMonad.Actions.Navigation2D@@ -120,7 +121,6 @@ XMonad.Actions.Plane XMonad.Actions.Promote XMonad.Actions.RandomBackground- XMonad.Actions.KeyRemap XMonad.Actions.RotSlaves XMonad.Actions.Search XMonad.Actions.ShowText@@ -129,6 +129,7 @@ XMonad.Actions.SpawnOn XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces+ XMonad.Actions.SwapPromote XMonad.Actions.TagWindows XMonad.Actions.TopicSpace XMonad.Actions.TreeSelect@@ -140,13 +141,13 @@ XMonad.Actions.WindowMenu XMonad.Actions.WindowNavigation XMonad.Actions.WithAll+ XMonad.Actions.Workscreen XMonad.Actions.WorkspaceCursors XMonad.Actions.WorkspaceNames- XMonad.Actions.Workscreen XMonad.Config.Arossato XMonad.Config.Azerty- XMonad.Config.Bluetile XMonad.Config.Bepo+ XMonad.Config.Bluetile XMonad.Config.Desktop XMonad.Config.Dmwit XMonad.Config.Droundy@@ -156,14 +157,18 @@ XMonad.Config.Prime XMonad.Config.Sjanssen XMonad.Config.Xfce+ XMonad.Doc+ XMonad.Doc.Configuring+ XMonad.Doc.Developing+ XMonad.Doc.Extending XMonad.Hooks.CurrentWorkspaceOnTop XMonad.Hooks.DebugEvents XMonad.Hooks.DebugKeyEvents+ XMonad.Hooks.DebugStack XMonad.Hooks.DynamicBars XMonad.Hooks.DynamicHooks XMonad.Hooks.DynamicLog XMonad.Hooks.DynamicProperty- XMonad.Hooks.DebugStack XMonad.Hooks.EwmhDesktops XMonad.Hooks.FadeInactive XMonad.Hooks.FadeWindows@@ -190,6 +195,7 @@ XMonad.Layout.Accordion XMonad.Layout.AutoMaster XMonad.Layout.AvoidFloats+ XMonad.Layout.BinaryColumn XMonad.Layout.BinarySpacePartition XMonad.Layout.BorderResize XMonad.Layout.BoringWindows@@ -204,8 +210,9 @@ XMonad.Layout.DecorationAddons XMonad.Layout.DecorationMadness XMonad.Layout.Dishes- XMonad.Layout.DraggingVisualizer+ XMonad.Layout.MultiDishes XMonad.Layout.DragPane+ XMonad.Layout.DraggingVisualizer XMonad.Layout.Drawer XMonad.Layout.Dwindle XMonad.Layout.DwmStyle@@ -221,8 +228,8 @@ XMonad.Layout.Hidden XMonad.Layout.HintedGrid XMonad.Layout.HintedTile- XMonad.Layout.IfMax XMonad.Layout.IM+ XMonad.Layout.IfMax XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder@@ -245,6 +252,7 @@ XMonad.Layout.MultiColumns XMonad.Layout.MultiToggle XMonad.Layout.MultiToggle.Instances+ XMonad.Layout.MultiToggle.TabBarDecoration XMonad.Layout.Named XMonad.Layout.NoBorders XMonad.Layout.NoFrillsDecoration@@ -268,6 +276,7 @@ XMonad.Layout.Spiral XMonad.Layout.Square XMonad.Layout.StackTile+ XMonad.Layout.StateFull XMonad.Layout.Stoppable XMonad.Layout.SubLayouts XMonad.Layout.TabBarDecoration@@ -282,12 +291,13 @@ XMonad.Layout.WorkspaceDir XMonad.Layout.ZoomRow XMonad.Prompt- XMonad.Prompt.AppendFile XMonad.Prompt.AppLauncher+ XMonad.Prompt.AppendFile XMonad.Prompt.ConfirmPrompt- XMonad.Prompt.Directory XMonad.Prompt.DirExec+ XMonad.Prompt.Directory XMonad.Prompt.Email+ XMonad.Prompt.FuzzyMatch XMonad.Prompt.Input XMonad.Prompt.Layout XMonad.Prompt.Man@@ -305,25 +315,28 @@ XMonad.Util.DebugWindow XMonad.Util.Dmenu XMonad.Util.Dzen- XMonad.Util.ExtensibleState XMonad.Util.EZConfig+ XMonad.Util.ExtensibleState XMonad.Util.Font XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.Loggers XMonad.Util.Loggers.NamedScratchpad+ XMonad.Util.Minimize XMonad.Util.NamedActions XMonad.Util.NamedScratchpad XMonad.Util.NamedWindows XMonad.Util.NoTaskbar XMonad.Util.Paste XMonad.Util.PositionStore+ XMonad.Util.Rectangle XMonad.Util.RemoteWindows XMonad.Util.Replace XMonad.Util.Run XMonad.Util.Scratchpad- XMonad.Util.SpawnOnce XMonad.Util.SpawnNamedPipe+ XMonad.Util.SessionStart+ XMonad.Util.SpawnOnce XMonad.Util.Stack XMonad.Util.StringProp XMonad.Util.Themes