diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -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 \ and \ tags; see `xmobarAction` and + `xmobarRaw`. + + * `XMonad.Layout.NoBorders` + + The layout now maintains a list of windows that never have borders, and a + list of windows that always have borders. Use `BorderMessage` to manage + these lists and the accompanying event hook (`borderEventHook`) to remove + destroyed windows from them. Also provides the `hasBorder` manage hook. + + Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and + `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`. See + the documentation for more information. + + The type signature of `hiddens` was changed to accept a new `Rectangle` + parameter representing the bounds of the parent layout, placed after the + `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous` + will need to update their configuration. For example, replace "`hiddens amb + wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make + use of the new parameter with "`hiddens amb wset lr mst wrs =`". + + * `XMonad.Actions.MessageFeedback` + + - Follow the naming conventions of `XMonad.Operations`. Functions returning + `X ()` are named regularly (previously these ended in underscore) while + those returning `X Bool` are suffixed with an uppercase 'B'. + - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and + `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent` + (renamed from `send`). + - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of + type `SomeMessage -> X Bool`, which means you are no longer constrained + to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher. + - The `send*Messages*` family of funtions allows for sequencing arbitrary + sets of messages with minimal refresh. It makes little sense for these + functions to support custom message dispatchers. + - Remain backwards compatible. Maintain deprecated aliases of all renamed + functions: + - `send` -> `sendMessageWithNoRefreshToCurrentB` + - `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB` + - `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent` + - `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB` + - `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent` + - `tryMessage` -> `tryMessageWithNoRefreshToCurrentB` + - `tryMessage_` -> `tryMessageWithNoRefreshToCurrent` + +### New Modules + + * `XMonad.Layout.MultiToggle.TabBarDecoration` + + Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to + dynamically toggle `XMonad.Layout.TabBarDecoration`. + + * `XMonad.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` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,14 +1,15 @@ # xmonad-contrib: Third Party Extensions to the xmonad Window Manager [![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib) +[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib) 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: (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 diff --git a/XMonad/Actions/Commands.hs b/XMonad/Actions/Commands.hs --- a/XMonad/Actions/Commands.hs +++ b/XMonad/Actions/Commands.hs @@ -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 diff --git a/XMonad/Actions/CycleWorkspaceByScreen.hs b/XMonad/Actions/CycleWorkspaceByScreen.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/CycleWorkspaceByScreen.hs @@ -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 diff --git a/XMonad/Actions/DynamicWorkspaceOrder.hs b/XMonad/Actions/DynamicWorkspaceOrder.hs --- a/XMonad/Actions/DynamicWorkspaceOrder.hs +++ b/XMonad/Actions/DynamicWorkspaceOrder.hs @@ -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. diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -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 () diff --git a/XMonad/Actions/MessageFeedback.hs b/XMonad/Actions/MessageFeedback.hs --- a/XMonad/Actions/MessageFeedback.hs +++ b/XMonad/Actions/MessageFeedback.hs @@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MessageFeedback --- Copyright : (c) Quentin Moser +-- Copyright : (c) -- Quentin Moser +-- 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 diff --git a/XMonad/Actions/Minimize.hs b/XMonad/Actions/Minimize.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/Minimize.hs @@ -0,0 +1,144 @@ +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Minimize +-- Copyright : (c) Bogdan Sinitsyn (2016) +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Bogdan Sinitsyn +-- Stability : unstable +-- Portability : not portable +-- +-- Adds actions for minimizing and maximizing windows +-- +-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your +-- layout modifiers as described in "XMonad.Layout.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 diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -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 --- > ("", "", "", "") --- > [("M-", windowGo ), --- > ("M-S-", windowSwap)] --- > False +-- > main = xmonad $ navigation2DP def +-- > ("", "", "", "") +-- > [("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 diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs --- a/XMonad/Actions/PhysicalScreens.hs +++ b/XMonad/Actions/PhysicalScreens.hs @@ -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) diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -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) diff --git a/XMonad/Actions/SwapPromote.hs b/XMonad/Actions/SwapPromote.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/SwapPromote.hs @@ -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) diff --git a/XMonad/Actions/WindowMenu.hs b/XMonad/Actions/WindowMenu.hs --- a/XMonad/Actions/WindowMenu.hs +++ b/XMonad/Actions/WindowMenu.hs @@ -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 diff --git a/XMonad/Config/Azerty.hs b/XMonad/Config/Azerty.hs --- a/XMonad/Config/Azerty.hs +++ b/XMonad/Config/Azerty.hs @@ -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 diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -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 diff --git a/XMonad/Config/Example.hs b/XMonad/Config/Example.hs new file mode 100644 --- /dev/null +++ b/XMonad/Config/Example.hs @@ -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-", sendMessage (Toggle "Full")) + ] + +-------------------------------------------------------------------------------- +-- | Customize layouts. +-- +-- This layout configuration uses two primary layouts, 'ResizableTall' +-- and 'BinarySpacePartition'. You can also use the 'M-' key +-- binding defined above to toggle between the current layout and a +-- full screen layout. +myLayouts = toggleLayouts (noBorders Full) others + where + others = ResizableTall 1 (1.5/100) (3/5) [] ||| emptyBSP + +-------------------------------------------------------------------------------- +-- | Customize the way 'XMonad.Prompt' looks and behaves. It's a +-- great replacement for dzen. +myXPConfig = def + { position = Top + , alwaysHighlight = True + , promptBorderWidth = 0 + , font = "xft:monospace:size=9" + } + +-------------------------------------------------------------------------------- +-- | Manipulate windows as they are created. The list given to +-- @composeOne@ is processed from top to bottom. The first matching +-- rule wins. +-- +-- Use the `xprop' tool to get the info you need for these matches. +-- For className, use the second value that xprop gives you. +myManageHook = composeOne + [ className =? "Pidgin" -?> doFloat + , className =? "XCalc" -?> doFloat + , className =? "mpv" -?> doFloat + , isDialog -?> doCenterFloat + + -- Move transient windows to their parent: + , transience + ] diff --git a/XMonad/Config/Gnome.hs b/XMonad/Config/Gnome.hs --- a/XMonad/Config/Gnome.hs +++ b/XMonad/Config/Gnome.hs @@ -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. diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -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 "" where t = concat [""] +-- | Encapsulate text with an action. The text will be displayed, and the +-- action executed when the displayed text is clicked. Illegal input is not +-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new +-- syntax wherein the command is surrounded by backticks. +xmobarAction :: String + -- ^ Command. Use of backticks (`) will cause a parse error. + -> String + -- ^ Buttons 1-5, such as "145". Other characters will cause a + -- parse error. + -> String + -- ^ Displayed/wrapped text. + -> String +xmobarAction command button = wrap l r + where + l = "" + r = "" + +-- | 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 [""] + -- ??? add an xmobarEscape function? -- | Strip xmobar markup, specifically the , and 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 = " " diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -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 diff --git a/XMonad/Hooks/FadeWindows.hs b/XMonad/Hooks/FadeWindows.hs --- a/XMonad/Hooks/FadeWindows.hs +++ b/XMonad/Hooks/FadeWindows.hs @@ -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 diff --git a/XMonad/Hooks/Minimize.hs b/XMonad/Hooks/Minimize.hs --- a/XMonad/Hooks/Minimize.hs +++ b/XMonad/Hooks/Minimize.hs @@ -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) diff --git a/XMonad/Hooks/RestoreMinimized.hs b/XMonad/Hooks/RestoreMinimized.hs --- a/XMonad/Hooks/RestoreMinimized.hs +++ b/XMonad/Hooks/RestoreMinimized.hs @@ -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) diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs --- a/XMonad/Hooks/WallpaperSetter.hs +++ b/XMonad/Hooks/WallpaperSetter.hs @@ -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 { diff --git a/XMonad/Hooks/WorkspaceHistory.hs b/XMonad/Hooks/WorkspaceHistory.hs --- a/XMonad/Hooks/WorkspaceHistory.hs +++ b/XMonad/Hooks/WorkspaceHistory.hs @@ -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 diff --git a/XMonad/Layout/BinaryColumn.hs b/XMonad/Layout/BinaryColumn.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/BinaryColumn.hs @@ -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 +-- 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) diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs --- a/XMonad/Layout/BinarySpacePartition.hs +++ b/XMonad/Layout/BinarySpacePartition.hs @@ -20,6 +20,7 @@ -- * Usage -- $usage emptyBSP + , BinarySpacePartition , Rotate(..) , Swap(..) , ResizeDirectional(..) diff --git a/XMonad/Layout/ComboP.hs b/XMonad/Layout/ComboP.hs --- a/XMonad/Layout/ComboP.hs +++ b/XMonad/Layout/ComboP.hs @@ -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 diff --git a/XMonad/Layout/DecorationAddons.hs b/XMonad/Layout/DecorationAddons.hs --- a/XMonad/Layout/DecorationAddons.hs +++ b/XMonad/Layout/DecorationAddons.hs @@ -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 diff --git a/XMonad/Layout/Fullscreen.hs b/XMonad/Layout/Fullscreen.hs --- a/XMonad/Layout/Fullscreen.hs +++ b/XMonad/Layout/Fullscreen.hs @@ -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 diff --git a/XMonad/Layout/Gaps.hs b/XMonad/Layout/Gaps.hs --- a/XMonad/Layout/Gaps.hs +++ b/XMonad/Layout/Gaps.hs @@ -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. diff --git a/XMonad/Layout/Grid.hs b/XMonad/Layout/Grid.hs --- a/XMonad/Layout/Grid.hs +++ b/XMonad/Layout/Grid.hs @@ -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)] diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -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 diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs --- a/XMonad/Layout/ImageButtonDecoration.hs +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -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 diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -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)] diff --git a/XMonad/Layout/Magnifier.hs b/XMonad/Layout/Magnifier.hs --- a/XMonad/Layout/Magnifier.hs +++ b/XMonad/Layout/Magnifier.hs @@ -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) diff --git a/XMonad/Layout/Minimize.hs b/XMonad/Layout/Minimize.hs --- a/XMonad/Layout/Minimize.hs +++ b/XMonad/Layout/Minimize.hs @@ -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 diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs --- a/XMonad/Layout/Mosaic.hs +++ b/XMonad/Layout/Mosaic.hs @@ -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 diff --git a/XMonad/Layout/MultiColumns.hs b/XMonad/Layout/MultiColumns.hs --- a/XMonad/Layout/MultiColumns.hs +++ b/XMonad/Layout/MultiColumns.hs @@ -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 diff --git a/XMonad/Layout/MultiDishes.hs b/XMonad/Layout/MultiDishes.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/MultiDishes.hs @@ -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 +-- 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 diff --git a/XMonad/Layout/MultiToggle.hs b/XMonad/Layout/MultiToggle.hs --- a/XMonad/Layout/MultiToggle.hs +++ b/XMonad/Layout/MultiToggle.hs @@ -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 diff --git a/XMonad/Layout/MultiToggle/TabBarDecoration.hs b/XMonad/Layout/MultiToggle/TabBarDecoration.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/MultiToggle/TabBarDecoration.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiToggle.TabBarDecoration +-- Copyright : (c) 2018 Lucian Poston +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a simple transformer for use with "XMonad.Layout.MultiToggle" to +-- dynamically toggle "XMonad.Layout.TabBarDecoration". +----------------------------------------------------------------------------- + +module XMonad.Layout.MultiToggle.TabBarDecoration ( + SimpleTabBar(..) +) where + +import XMonad.Layout.MultiToggle + +import XMonad +import XMonad.Layout.LayoutModifier +import XMonad.Layout.TabBarDecoration + +-- $usage +-- To use this module with "XMonad.Layout.MultiToggle", add the @SIMPLETABBAR@ +-- to your layout For example, from a basic layout like +-- +-- > layout = tiled ||| Full +-- +-- Add @SIMPLETABBAR@ by changing it this to +-- +-- > layout = mkToggle (single SIMPLETABBAR) (tiled ||| Full) +-- +-- You can now dynamically toggle the 'XMonad.Layout.TabBarDecoration' +-- transformation by adding a key binding such as @mod-x@ as follows. +-- +-- > ... +-- > , ((modm, xK_x ), sendMessage $ Toggle SIMPLETABBAR) +-- > ... + +-- | Transformer for "XMonad.Layout.TabBarDecoration". +data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq, Typeable) +instance Transformer SimpleTabBar Window where + transform _ x k = k (simpleTabBar x) (\(ModifiedLayout _ (ModifiedLayout _ x')) -> x') diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -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 +-- Copyright : (c) -- David Roundy +-- 2018 Yclept Nemo -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen @@ -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 diff --git a/XMonad/Layout/Spacing.hs b/XMonad/Layout/Spacing.hs --- a/XMonad/Layout/Spacing.hs +++ b/XMonad/Layout/Spacing.hs @@ -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 : -- 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 diff --git a/XMonad/Layout/StateFull.hs b/XMonad/Layout/StateFull.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/StateFull.hs @@ -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) diff --git a/XMonad/Layout/ThreeColumns.hs b/XMonad/Layout/ThreeColumns.hs --- a/XMonad/Layout/ThreeColumns.hs +++ b/XMonad/Layout/ThreeColumns.hs @@ -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 ) diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -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 diff --git a/XMonad/Prompt/AppendFile.hs b/XMonad/Prompt/AppendFile.hs --- a/XMonad/Prompt/AppendFile.hs +++ b/XMonad/Prompt/AppendFile.hs @@ -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 diff --git a/XMonad/Prompt/FuzzyMatch.hs b/XMonad/Prompt/FuzzyMatch.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/FuzzyMatch.hs @@ -0,0 +1,104 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.FuzzyMatch +-- Copyright : (C) 2015 Norbert Zeh +-- License : GPL +-- +-- Maintainer : Norbert Zeh +-- Stability : unstable +-- Portability : unportable +-- +-- A module for fuzzy completion matching in prompts akin to emacs ido mode. +-- +-------------------------------------------------------------------------------- + +module XMonad.Prompt.FuzzyMatch ( -- * Usage + -- $usage + fuzzyMatch + , fuzzySort + ) where + +import 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' diff --git a/XMonad/Prompt/Pass.hs b/XMonad/Prompt/Pass.hs --- a/XMonad/Prompt/Pass.hs +++ b/XMonad/Prompt/Pass.hs @@ -8,9 +8,10 @@ -- Stability : unstable -- Portability : unportable -- --- This module provides 3 to ease passwords manipulation (generate, read, remove): +-- This module provides 4 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 . -- --- 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 . +-- - The password store implementation is . -- --- - Inspired from +-- - Inspired by -- ----------------------------------------------------------------------------- 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 +-- - how to setup the password store, see -- 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 diff --git a/XMonad/Prompt/Unicode.hs b/XMonad/Prompt/Unicode.hs --- a/XMonad/Prompt/Unicode.hs +++ b/XMonad/Prompt/Unicode.hs @@ -1,6 +1,7 @@ {- | Module : XMonad.Prompt.Unicode Copyright : (c) 2016 Joachim Breitner + 2017 Nick Hu License : BSD-style (see LICENSE) Maintainer : @@ -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", "-"] diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs --- a/XMonad/Prompt/Window.hs +++ b/XMonad/Prompt/Window.hs @@ -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 diff --git a/XMonad/Util/Dmenu.hs b/XMonad/Util/Dmenu.hs --- a/XMonad/Util/Dmenu.hs +++ b/XMonad/Util/Dmenu.hs @@ -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 @@ -- 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 diff --git a/XMonad/Util/Dzen.hs b/XMonad/Util/Dzen.hs --- a/XMonad/Util/Dzen.hs +++ b/XMonad/Util/Dzen.hs @@ -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: diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -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). diff --git a/XMonad/Util/Minimize.hs b/XMonad/Util/Minimize.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Minimize.hs @@ -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 diff --git a/XMonad/Util/Rectangle.hs b/XMonad/Util/Rectangle.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Rectangle.hs @@ -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) diff --git a/XMonad/Util/SessionStart.hs b/XMonad/Util/SessionStart.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/SessionStart.hs @@ -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 diff --git a/XMonad/Util/SpawnOnce.hs b/XMonad/Util/SpawnOnce.hs --- a/XMonad/Util/SpawnOnce.hs +++ b/XMonad/Util/SpawnOnce.hs @@ -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 diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs --- a/XMonad/Util/Stack.hs +++ b/XMonad/Util/Stack.hs @@ -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 <$>) diff --git a/XMonad/Util/Themes.hs b/XMonad/Util/Themes.hs --- a/XMonad/Util/Themes.hs +++ b/XMonad/Util/Themes.hs @@ -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 } } diff --git a/XMonad/Util/WindowProperties.hs b/XMonad/Util/WindowProperties.hs --- a/XMonad/Util/WindowProperties.hs +++ b/XMonad/Util/WindowProperties.hs @@ -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 diff --git a/XMonad/Util/WorkspaceCompare.hs b/XMonad/Util/WorkspaceCompare.hs --- a/XMonad/Util/WorkspaceCompare.hs +++ b/XMonad/Util/WorkspaceCompare.hs @@ -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 diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -1,5 +1,5 @@ name: xmonad-contrib -version: 0.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