xmonad-contrib 0.18.0 → 0.18.1
raw patch · 31 files changed
+2449/−230 lines, 31 filesdep +transformersdep ~basedep ~timedep ~xmonad
Dependencies added: transformers
Dependency ranges changed: base, time, xmonad
Files
- CHANGES.md +101/−2
- XMonad/Actions/GridSelect.hs +16/−6
- XMonad/Actions/Profiles.hs +545/−0
- XMonad/Actions/Search.hs +2/−2
- XMonad/Actions/Submap.hs +22/−4
- XMonad/Actions/WindowBringer.hs +35/−1
- XMonad/Actions/WindowNavigation.hs +279/−80
- XMonad/Actions/WorkspaceNames.hs +1/−1
- XMonad/Hooks/EwmhDesktops.hs +8/−3
- XMonad/Hooks/FloatConfigureReq.hs +126/−0
- XMonad/Hooks/ManageHelpers.hs +10/−0
- XMonad/Hooks/OnPropertyChange.hs +2/−2
- XMonad/Hooks/ScreenCorners.hs +44/−15
- XMonad/Hooks/StatusBar.hs +4/−4
- XMonad/Layout/AutoMaster.hs +1/−1
- XMonad/Layout/CenteredMaster.hs +1/−1
- XMonad/Layout/Column.hs +4/−4
- XMonad/Layout/Columns.hs +480/−0
- XMonad/Layout/Hidden.hs +1/−1
- XMonad/Layout/IfMax.hs +1/−1
- XMonad/Layout/TabBarDecoration.hs +2/−2
- XMonad/Prompt.hs +13/−11
- XMonad/Prompt/OrgMode.hs +56/−21
- XMonad/Util/EZConfig.hs +2/−2
- XMonad/Util/Grab.hs +4/−48
- XMonad/Util/Hacks.hs +4/−0
- XMonad/Util/Rectangle.hs +1/−1
- tests/Main.hs +2/−0
- tests/OrgMode.hs +28/−7
- tests/WindowNavigation.hs +635/−0
- xmonad-contrib.cabal +19/−10
CHANGES.md view
@@ -1,5 +1,106 @@ # Change Log / Release Notes +## _unreleased_++## 0.18.1 (August 20, 2024)++### Breaking Changes++ * `XMonad.Hooks.StatusBars`++ - Move status bar functions from the `IO` to the `X` monad to+ allow them to look up information from `X`, like the screen+ width. Existing configurations may need to use `io` from+ `XMonad.Core` or `liftIO` from `Control.Monad.IO.Class` in+ order to lift any existing `IO StatusBarConfig` values into+ `X StatusBarConfig` values.++ * `XMonad.Prompt`++ - Added an additional `XPConfig` argument to `historyCompletion` and+ `historyCompletionP`. Calls along the lines of `historyCompletionP+ myFunc` should be changed to `historyCompletionP myConf myFunc`.+ If not `myConf` is lying around, `def` can be used instead.++ * `XMonad.Actions.GridSelect`++ - Added the `gs_cancelOnEmptyClick` field to `GSConfig`, which makes+ mouse clicks into "empty space" cancel the current grid-select.+ Users explicitly defining their own `GSConfig` record will have to+ add this to their definitions. Additionally, the field defaults to+ `True`—to retain the old behaviour, set it to `False`.++### New Modules++ * `XMonad.Actions.Profiles`++ - Group workspaces by similarity. Useful when one has lots+ of workspaces and uses only a couple per unit of work.++ * `XMonad.Hooks.FloatConfigureReq`++ - Customize handling of floating windows' move/resize/restack requests+ (ConfigureRequest). Useful as a workaround for some misbehaving client+ applications (Steam, rxvt-unicode, anything that tries to restore+ absolute position of floats).++ * `XMonad.Layout.Columns`++ - Organize windows in columns. This layout allows to move/resize windows in+ every directions.++ * `XMonad.Prompt.WindowBringer`++ - Added `copyMenu`, a convenient way to copy a window to the current workspace.++### Bug Fixes and Minor Changes++ * Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined.++ * `XMonad.Util.EZConfig`++ - Fixed `checkKeymap` warning that all keybindings are duplicates.++ * `XMonad.Hooks.ManageHelpers`++ - Added `isNotification` predicate to check for windows with+ `_NET_WM_WINDOW_TYPE` property of `_NET_WM_WINDOW_TYPE_NOTIFICATION`.++ * `XMonad.Prompt.OrgMode`++ - Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.++ * `XMonad.Prompt`++ - The history file is not extraneously read and written anymore if+ the `historySize` is set to 0.++ * `XMonad.Hooks.EwmhDesktops`++ - Requests for unmanaged windows no longer cause a refresh. This avoids+ flicker and also fixes disappearing menus in the Steam client and+ possibly a few other client applications.++ (See also `XMonad.Hooks.FloatConfigureReq` and/or `XMonad.Util.Hacks`+ for additional Steam client workarounds.)++ * `XMonad.Actions.Submap`++ - Added `visualSubmapSorted` to enable sorting of the keymap+ descriptions.++ * `XMonad.Hooks.ScreenCorners`++ - Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and+ `SCRight`. Now both corners and edges are supported.++ * `XMonad.Actions.WindowNavigation`++ - Improve navigation in presence of floating windows.+ - Handle window switching when in `Full` layout.++### Other changes+ ## 0.18.0 (February 3, 2024) ### Breaking Changes@@ -306,8 +407,6 @@ - Added `zipperFocusedAtFirstOf` to differentiate two lists into a zipper.--### Other changes ## 0.17.1 (September 3, 2022)
XMonad/Actions/GridSelect.hs view
@@ -203,10 +203,13 @@ gs_colorizer :: a -> Bool -> X (String, String), gs_font :: String, gs_navigate :: TwoD a (Maybe a),+ -- ^ Customize key bindings for a GridSelect gs_rearranger :: Rearranger a, gs_originFractX :: Double, gs_originFractY :: Double,- gs_bordercolor :: String+ gs_bordercolor :: String,+ gs_cancelOnEmptyClick :: Bool+ -- ^ When True, click on empty space will cancel GridSelect } -- | That is 'fromClassName' if you are selecting a 'Window', or@@ -386,13 +389,20 @@ stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a) stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop | t == buttonRelease = do- s@TwoDState { td_paneX = px, td_paneY = py,- td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get+ s@TwoDState{ td_paneX = px+ , td_paneY = py+ , td_gsconfig = GSConfig{ gs_cellheight = ch+ , gs_cellwidth = cw+ , gs_cancelOnEmptyClick = cancelOnEmptyClick+ }+ } <- get let gridX = (fi x - (px - cw) `div` 2) `div` cw gridY = (fi y - (py - ch) `div` 2) `div` ch case lookup (gridX,gridY) (td_elementmap s) of Just (_,el) -> return (Just el)- Nothing -> contEventloop+ Nothing -> if cancelOnEmptyClick+ then return Nothing+ else contEventloop | otherwise = contEventloop stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop@@ -648,7 +658,7 @@ liftIO $ mapWindow dpy win liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask) status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime- io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime+ void $ io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime font <- initXMF (gs_font gsconfig) let screenWidth = toInteger $ rect_width scr screenHeight = toInteger $ rect_height scr@@ -706,7 +716,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) "white"+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" True -- | Brings selected window to the current workspace. bringSelected :: GSConfig Window -> X ()
+ XMonad/Actions/Profiles.hs view
@@ -0,0 +1,545 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DerivingVia #-}+++--------------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.Profiles+-- Description : Group your workspaces by similarity.+-- Copyright : (c) Mislav Zanic+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Mislav Zanic <mislavzanic3@gmail.com>+-- Stability : experimental+-- Portability : unportable+--+--------------------------------------------------------------------------------++module XMonad.Actions.Profiles+ ( -- * Overview+ -- $overview++ -- * Usage+ -- $usage++ -- * Types+ ProfileId+ , Profile(..)+ , ProfileConfig(..)++ -- * Hooks+ , addProfiles+ , addProfilesWithHistory++ -- * Switching profiles+ , switchToProfile++ -- * Workspace navigation and keybindings+ , wsFilter+ , bindOn++ -- * Loggers and pretty printers+ , excludeWSPP+ , profileLogger++ -- * Prompts+ , switchProfilePrompt+ , addWSToProfilePrompt+ , removeWSFromProfilePrompt+ , switchProfileWSPrompt+ , shiftProfileWSPrompt++ -- * Utilities+ , currentProfile+ , profileIds+ , previousProfile+ , profileHistory+ , allProfileWindows+ , profileWorkspaces+ )where++--------------------------------------------------------------------------------+import Data.Map.Strict (Map)+import Data.List+import qualified Data.Map.Strict as Map++import Control.DeepSeq++import XMonad+import XMonad.Prelude+import qualified XMonad.StackSet as W++import XMonad.Actions.CycleWS++import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Loggers (Logger)+import XMonad.Prompt.Window (XWindowMap)+import XMonad.Actions.WindowBringer (WindowBringerConfig(..))+import XMonad.Actions.OnScreen (greedyViewOnScreen)+import XMonad.Hooks.Rescreen (addAfterRescreenHook)+import XMonad.Hooks.DynamicLog (PP(ppRename))+import XMonad.Prompt ++--------------------------------------------------------------------------------+-- $overview+-- This module allows you to group your workspaces into 'Profile's based on certain similarities.+-- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace"+-- which states that you can look at a topic/workspace as a+-- single unit of work instead of multiple related units of work.+-- This comes in handy if you have lots of workspaces with windows open and need only to+-- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that+-- require your attention by not displaying, or allowing you to switch to the rest of the workspaces.+-- The best example is having a profile for development and a profile for leisure activities.++--------------------------------------------------------------------------------+-- $usage+-- To use @Profiles@ you need to add it to your XMonad configuration+-- and configure your profiles.+-- +-- First you'll need to handle the imports.+-- +-- > import XMonad.Actions.Profiles +-- > import XMonad.Util.EZConfig -- for keybindings+-- > import qualified XMonad.StackSet as W+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation+--+-- Next you'll need to define your profiles.+--+-- > myStartingProfile :: ProfileId+-- > myStartingProfile = "Work"+-- >+-- > myProfiles :: [Profile]+-- > myProfiles =+-- > [ Profile { profileId = "Home"+-- > , profileWS = [ "www"+-- > , "rss"+-- > , "vid"+-- > , "vms"+-- > , "writing"+-- > , "notes"+-- > ]+-- > }+-- > , Profile { profileId = "Work"+-- > , profileWS = [ "www"+-- > , "slack"+-- > , "dev"+-- > , "k8s"+-- > , "notes"+-- > ]+-- > }+-- > ]+-- +-- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and +-- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces.+--+-- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are+-- sensible keybindings for switching workspaces, you'll need to use+-- 'bindOn' to have different keybindings per profile.+-- Here, we'll use "XMonad.Util.EZConfig" syntax:+-- +-- > myKeys :: [(String, X())]+-- > myKeys = +-- > [ ("M-p", switchProfilePrompt xpConfig)+-- > , ("M-g", switchProfileWSPrompt xpConfig)+-- > , ("M1-j", DO.moveTo Next wsFilter)+-- > , ("M1-k", DO.moveTo Prev wsFilter)+-- > ]+-- > <>+-- > [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i)+-- > | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList+-- > , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")]+-- > ]+-- > where+-- > mby f wid = if wid == "" then return () else f wid+-- > sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y))+-- > tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles+-- +-- After that, you'll need to hook @Profiles@ into your XMonad config:+-- +-- > main = xmonad $ addProfiles def { profiles = myProfiles+-- > , startingProfile = myStartingProfile+-- > }+-- > $ def `additionalKeysP` myKeys+-- ++--------------------------------------------------------------------------------+type ProfileId = String+type ProfileMap = Map ProfileId Profile++--------------------------------------------------------------------------------+-- | Profile representation.+data Profile = Profile+ { profileId :: !ProfileId -- ^ Profile name.+ , profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.+ }++--------------------------------------------------------------------------------+-- | Internal profile state.+data ProfileState = ProfileState+ { profilesMap :: !ProfileMap+ , current :: !(Maybe Profile)+ , previous :: !(Maybe ProfileId)+ }++--------------------------------------------------------------------------------+-- | User config for profiles.+data ProfileConfig = ProfileConfig+ { workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.+ , profiles :: ![Profile] -- ^ A list of user-defined profiles.+ , startingProfile :: !ProfileId -- ^ Profile shown on startup.+ }++--------------------------------------------------------------------------------+instance Default ProfileConfig where+ def = ProfileConfig { workspaceExcludes = []+ , profiles = []+ , startingProfile = ""+ }++--------------------------------------------------------------------------------+instance ExtensionClass ProfileState where+ initialValue = ProfileState Map.empty Nothing Nothing++--------------------------------------------------------------------------------+-- Internal type for history tracking.+-- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware.+-- Because of that, when switching to a previous workspace, you might switch to+-- a workspace+newtype ProfileHistory = ProfileHistory+ { history :: Map ProfileId [(ScreenId, WorkspaceId)]+ }+ deriving (Read, Show)+ deriving NFData via Map ProfileId [(Int, WorkspaceId)]++--------------------------------------------------------------------------------+instance ExtensionClass ProfileHistory where+ extensionType = PersistentExtension+ initialValue = ProfileHistory Map.empty++--------------------------------------------------------------------------------+newtype ProfilePrompt = ProfilePrompt String++--------------------------------------------------------------------------------+instance XPrompt ProfilePrompt where+ showXPrompt (ProfilePrompt x) = x++--------------------------------------------------------------------------------+defaultProfile :: Profile+defaultProfile = defaultProfile++--------------------------------------------------------------------------------+-- | Returns current profile.+currentProfile :: X ProfileId+currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get++--------------------------------------------------------------------------------+-- | Returns previous profile.+previousProfile :: X (Maybe ProfileId)+previousProfile = XS.gets previous++--------------------------------------------------------------------------------+-- | Returns the history of viewed workspaces per profile.+profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])+profileHistory = XS.gets history++--------------------------------------------------------------------------------+profileMap :: X ProfileMap+profileMap = XS.gets profilesMap++--------------------------------------------------------------------------------+-- | Returns ids of all profiles.+profileIds :: X [ProfileId]+profileIds = Map.keys <$> XS.gets profilesMap++--------------------------------------------------------------------------------+currentProfileWorkspaces :: X [WorkspaceId]+currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile++--------------------------------------------------------------------------------+-- | Hook profiles into XMonad. This function adds a startup hook that+-- sets up ProfileState. Also adds an afterRescreenHook for viewing correct+-- workspaces when adding new screens.+addProfiles :: ProfileConfig -> XConfig a -> XConfig a+addProfiles profConf conf = addAfterRescreenHook hook $ conf+ { startupHook = profileStartupHook' <> startupHook conf+ }+ where+ profileStartupHook' :: X()+ profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf)+ hook = currentProfile >>= switchWSOnScreens++--------------------------------------------------------------------------------+-- | Hooks profiles into XMonad and enables Profile history logging.+addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a+addProfilesWithHistory profConf conf = conf'+ { logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf+ }+ where+ conf' = addProfiles profConf conf++--------------------------------------------------------------------------------+profileHistoryHookExclude :: [WorkspaceId] -> X()+profileHistoryHookExclude ews = do+ cur <- gets $ W.current . windowset+ vis <- gets $ W.visible . windowset+ pws <- currentProfileWorkspaces+ p <- currentProfile++ updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis+ where+ workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins)+ filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace)++--------------------------------------------------------------------------------+updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()+updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update+ where+ update pws hs = force $ hs { history = doUpdate pws $ history hs }++ doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs++ f pws sid wid val = case val of+ Nothing -> pure [(sid, wid)]+ Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs++ filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]+ filterWS pws new = filter (\x -> snd x `elem` pws && x /= new)++--------------------------------------------------------------------------------+-- | Adds profiles to ProfileState and sets current profile using .++profilesStartupHook :: [Profile] -> ProfileId -> X ()+profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid+ where+ go :: ProfileState -> ProfileState+ go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}++ update :: ProfileMap -> ProfileMap+ update = Map.union (Map.fromList $ map entry ps)++ entry :: Profile -> (ProfileId, Profile)+ entry p = (profileId p, p)++ setCurrentProfile :: ProfileMap -> Maybe Profile+ setCurrentProfile s = case Map.lookup pid s of+ Nothing -> Just $ Profile pid []+ Just pn -> Just pn++--------------------------------------------------------------------------------+setPrevious :: ProfileId -> X()+setPrevious name = XS.modify update+ where+ update ps = ps { previous = doUpdate ps }+ doUpdate ps = case Map.lookup name $ profilesMap ps of+ Nothing -> previous ps+ Just p -> Just $ profileId p++--------------------------------------------------------------------------------+setProfile :: ProfileId -> X ()+setProfile p = currentProfile >>= setPrevious >> setProfile' p++--------------------------------------------------------------------------------+setProfile' :: ProfileId -> X ()+setProfile' name = XS.modify update+ where+ update ps = ps { current = doUpdate ps }+ doUpdate ps = case Map.lookup name $ profilesMap ps of+ Nothing -> current ps+ Just p -> Just p++--------------------------------------------------------------------------------+-- | Switch to a profile.+switchToProfile :: ProfileId -> X()+switchToProfile pid = setProfile pid >> switchWSOnScreens pid++--------------------------------------------------------------------------------+-- | Returns the workspace ids associated with a profile id.+profileWorkspaces :: ProfileId -> X [WorkspaceId]+profileWorkspaces pid = profileMap >>= findPWs+ where+ findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm++--------------------------------------------------------------------------------+-- | Prompt for adding a workspace id to a profile.+addWSToProfilePrompt :: XPConfig -> X()+addWSToProfilePrompt c = do+ ps <- profileIds+ mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f+ where+ f :: String -> X()+ f p = do+ vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset+ cur <- gets $ W.tag . W.workspace . W.current . windowset+ hid <- gets $ fmap W.tag . W.hidden . windowset+ let+ arr = cur:(vis <> hid)+ in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p)++--------------------------------------------------------------------------------+-- | Prompt for switching profiles.+switchProfilePrompt :: XPConfig -> X()+switchProfilePrompt c = do+ ps <- profileIds+ mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile+ +--------------------------------------------------------------------------------+-- | Prompt for switching workspaces.+switchProfileWSPrompt :: XPConfig -> X ()+switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces+ where+ mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto + mbygoto wid = do+ pw <- profileWorkspaces =<< currentProfile+ unless (wid `notElem` pw) (windows . W.greedyView $ wid)++--------------------------------------------------------------------------------+-- | Prompt for shifting windows to a different workspace.+shiftProfileWSPrompt :: XPConfig -> X ()+shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces+ where+ mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift+ mbyshift wid = do+ pw <- profileWorkspaces =<< currentProfile+ unless (wid `notElem` pw) (windows . W.shift $ wid)++--------------------------------------------------------------------------------+addWSToProfile :: WorkspaceId -> ProfileId -> X()+addWSToProfile wid pid = XS.modify go+ where+ go :: ProfileState -> ProfileState+ go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}++ update :: ProfileMap -> ProfileMap+ update mp = case Map.lookup pid mp of+ Nothing -> mp+ Just p -> if wid `elem` profileWS p then mp else Map.adjust f pid mp++ f :: Profile -> Profile+ f p = Profile pid (wid : profileWS p)++ update' :: Profile -> Maybe Profile+ update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp++--------------------------------------------------------------------------------+-- | Prompt for removing a workspace from a profile.+removeWSFromProfilePrompt :: XPConfig -> X()+removeWSFromProfilePrompt c = do+ ps <- profileIds+ mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f+ where+ f :: String -> X()+ f p = do+ arr <- profileWorkspaces p+ mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $+ \ws -> do+ cp <- currentProfile+ ws `removeWSFromProfile` p + when (cp == p) $ currentProfile >>= switchWSOnScreens++--------------------------------------------------------------------------------+removeWSFromProfile :: WorkspaceId -> ProfileId -> X()+removeWSFromProfile wid pid = XS.modify go+ where+ go :: ProfileState -> ProfileState+ go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}++ update :: ProfileMap -> ProfileMap+ update mp = case Map.lookup pid mp of+ Nothing -> mp+ Just p -> if wid `elem` profileWS p then Map.adjust f pid mp else mp++ f :: Profile -> Profile+ f p = Profile pid (delete wid $ profileWS p)++ update' :: Profile -> Maybe Profile+ update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp++--------------------------------------------------------------------------------+-- | Pretty printer for a bar. Prints workspace ids of current profile.+excludeWSPP :: PP -> X PP+excludeWSPP pp = modifyPP <$> currentProfileWorkspaces+ where+ modifyPP pws = pp { ppRename = ppRename pp . printTag pws }+ printTag pws tag = if tag `elem` pws then tag else ""++--------------------------------------------------------------------------------+-- | For cycling through workspaces associated with the current.+wsFilter :: WSType+wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag)++--------------------------------------------------------------------------------+-- Takes care of placing correct workspaces on their respective screens.+-- It does this by reducing the history of a Profile until it gets an array of length+-- equal to the number of screens with pairs that have unique workspace ids.+switchWSOnScreens :: ProfileId -> X()+switchWSOnScreens pid = do+ hist <- profileHistory+ vis <- gets $ W.visible . windowset+ cur <- gets $ W.current . windowset+ pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid)+ case Map.lookup pid hist of+ Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws+ Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws+ where+ f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]+ f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst)++ reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]+ reorderUniq = map (\(x,y) -> (y,x)) . uniq++ uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]+ uniq = Map.toList . Map.fromList++ viewWS fview sid wid = windows $ fview sid wid++ switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen)++ compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws+ | otherwise = switchScreens hist++ populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws)++--------------------------------------------------------------------------------+chooseAction :: (String -> X ()) -> X ()+chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f++--------------------------------------------------------------------------------+-- | Create keybindings per profile.+bindOn :: [(String, X ())] -> X ()+bindOn bindings = chooseAction chooser+ where+ chooser profile = case lookup profile bindings of+ Just action -> action+ Nothing -> case lookup "" bindings of+ Just action -> action+ Nothing -> return ()++--------------------------------------------------------------------------------+-- | Loggs currentProfile and all profiles with hidden workspaces+-- (workspaces that aren't shown on a screen but have windows).+profileLogger :: (String -> String) -> (String -> String) -> Logger+profileLogger formatFocused formatUnfocused = do+ hws <- gets $ W.hidden . windowset+ p <- currentProfile+ hm <- map fst+ . filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p)+ . Map.toList <$> profileHistory+ return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm+ where+ format p a = if a == p then formatFocused a else formatUnfocused a+ htags wins = W.tag <$> filter (isJust . W.stack) wins++--------------------------------------------------------------------------------+-- | @XWindowMap@ of all windows contained in a profile.+allProfileWindows :: XWindowMap+allProfileWindows = allProfileWindows' def++--------------------------------------------------------------------------------+allProfileWindows' :: WindowBringerConfig -> XWindowMap+allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do+ pws <- currentProfileWorkspaces+ windowSet <- gets windowset+ Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet)+ where keyValuePairs ws = let wins = W.integrate' (W.stack ws)+ in mapM (keyValuePair ws) =<< filterM include wins+ keyValuePair ws w = (, w) <$> titler ws w
XMonad/Actions/Search.hs view
@@ -437,14 +437,14 @@ browser. -} promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X () promptSearchBrowser config browser (SearchEngine name site) = do- hc <- historyCompletionP ("Search [" `isPrefixOf`)+ hc <- historyCompletionP config ("Search [" `isPrefixOf`) mkXPrompt (Search name) config hc $ search browser site {- | Like 'promptSearchBrowser', but only suggest previous searches for the given 'SearchEngine' in the prompt. -} promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X () promptSearchBrowser' config browser (SearchEngine name site) = do- hc <- historyCompletionP (searchName `isPrefixOf`)+ hc <- historyCompletionP config (searchName `isPrefixOf`) mkXPrompt (Search name) config hc $ search browser site where searchName = showXPrompt (Search name)
XMonad/Actions/Submap.hs view
@@ -18,6 +18,7 @@ -- $usage submap, visualSubmap,+ visualSubmapSorted, submapDefault, submapDefaultWithKey, @@ -88,15 +89,32 @@ -> M.Map (KeyMask, KeySym) (String, X ()) -- ^ A map @keybinding -> (description, action)@. -> X ()-visualSubmap wc keys =+visualSubmap = visualSubmapSorted id++-- | Like 'visualSubmap', but is able to sort the descriptions.+-- For example,+--+-- > import Data.Ord (comparing, Down)+-- >+-- > visualSubmapSorted (sortBy (comparing Down)) def+--+-- would sort the @(key, description)@ pairs by their keys in descending+-- order.+visualSubmapSorted :: ([((KeyMask, KeySym), String)] -> [((KeyMask, KeySym), String)])+ -- ^ A function to resort the descriptions+ -> WindowConfig -- ^ The config for the spawned window.+ -> M.Map (KeyMask, KeySym) (String, X ())+ -- ^ A map @keybinding -> (description, action)@.+ -> X ()+visualSubmapSorted sorted wc keys = withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) -> maybe (pure ()) snd (M.lookup (m', s) keys) where descriptions :: [String] descriptions =- zipWith (\key desc -> keyToString key <> ": " <> desc)- (M.keys keys)- (map fst (M.elems keys))+ map (\(key, desc) -> keyToString key <> ": " <> desc)+ . sorted+ $ zip (M.keys keys) (map fst (M.elems keys)) -- | Give a name to an action. subName :: String -> X () -> (String, X ())
XMonad/Actions/WindowBringer.hs view
@@ -22,6 +22,7 @@ WindowBringerConfig(..), gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs', bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',+ copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs', windowMap, windowAppMap, windowMap', bringWindow, actionMenu ) where @@ -33,6 +34,7 @@ import qualified XMonad as X import XMonad.Util.Dmenu (menuMapArgs) import XMonad.Util.NamedWindows (getName, getNameWMClass)+import XMonad.Actions.CopyWindow (copyWindow) -- $usage --@@ -44,6 +46,7 @@ -- -- > , ((modm .|. shiftMask, xK_g ), gotoMenu) -- > , ((modm .|. shiftMask, xK_b ), bringMenu)+-- > , ((modm .|. shiftMask, xK_y ), copyMenu) -- -- For detailed instructions on editing your key bindings, see -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.@@ -90,7 +93,38 @@ gotoMenuArgs' :: String -> [String] -> X () gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args } +-- | Pops open a dmenu with window titles. Choose one, and it will be copied into your current workspace.+copyMenu :: X ()+copyMenu = copyMenuArgs def+ -- | Pops open a dmenu with window titles. Choose one, and it will be+-- copied into your current workspace. This version+-- accepts a configuration object.+copyMenuConfig :: WindowBringerConfig -> X ()+copyMenuConfig wbConfig = actionMenu wbConfig copyBringWindow++-- | Pops open a dmenu with window titles. Choose one, and it will be+-- copied into your current workspace. This version+-- takes a list of arguments to pass to dmenu.+copyMenuArgs :: [String] -> X ()+copyMenuArgs args = copyMenuConfig def { menuArgs = args }++-- | Pops open an application with window titles given over stdin. Choose one,+-- and it will be copied into your current workspace.+copyMenu' :: String -> X ()+copyMenu' cmd = copyMenuConfig def { menuArgs = [], menuCommand = cmd }++-- | Pops open an application with window titles given over stdin. Choose one,+-- and it will be copied into your current+-- workspace. This version allows arguments to the chooser to be specified.+copyMenuArgs' :: String -> [String] -> X ()+copyMenuArgs' cmd args = copyMenuConfig def { menuArgs = args, menuCommand = cmd }++-- | Brings a copy of the specified window into the current workspace.+copyBringWindow :: Window -> X.WindowSet -> X.WindowSet+copyBringWindow w ws = copyWindow w (W.currentTag ws) ws++-- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. bringMenu :: X () bringMenu = bringMenuArgs def@@ -159,7 +193,7 @@ return $ name ++ " [" ++ W.tag ws ++ "]" -- | Returns the window name as will be listed in dmenu. This will--- return the executable name of the window along with it's workspace+-- return the executable name of the window along with its workspace -- ID. decorateAppName :: X.WindowSpace -> Window -> X String decorateAppName ws w = do
@@ -1,10 +1,12 @@+{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowNavigation -- Description : Experimental rewrite of "XMonad.Layout.WindowNavigation". -- Copyright : (c) 2007 David Roundy <droundy@darcs.net>, -- Devin Mullins <me@twifkak.com>--- Maintainer : Devin Mullins <me@twifkak.com>+-- Maintainer : Devin Mullins <me@twifkak.com>,+-- Platon Pronko <platon7pronko@gmail.com> -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable@@ -37,17 +39,19 @@ withWindowNavigationKeys, WNAction(..), go, swap,+ goPure, swapPure, Direction2D(..), WNState, ) where -import XMonad-import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)+import XMonad hiding (state)+import XMonad.Prelude (catMaybes, fromMaybe, sortOn) import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Arrow (second) import Data.IORef import Data.Map (Map())+import Data.List (partition, find) import qualified Data.Map as M import qualified Data.Set as S @@ -101,27 +105,60 @@ withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) withWindowNavigationKeys wnKeys conf = do- posRef <- newIORef M.empty- return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)+ stateRef <- newIORef M.empty+ return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys) `M.union` keys conf cnf,- logHook = logHook conf >> trackMovement posRef }- where fromWNAction posRef (WNGo dir) = go posRef dir- fromWNAction posRef (WNSwap dir) = swap posRef dir+ logHook = logHook conf >> trackMovement stateRef }+ where fromWNAction stateRef (WNGo dir) = go stateRef dir+ fromWNAction stateRef (WNSwap dir) = swap stateRef dir data WNAction = WNGo Direction2D | WNSwap Direction2D type WNState = Map WorkspaceId Point --- go:--- 1. get current position, verifying it matches the current window--- 2. get target windowrect--- 3. focus window--- 4. set new position+-- | Focus window in the given direction. go :: IORef WNState -> Direction2D -> X ()-go = withTargetWindow W.focusWindow+go stateRef dir = runPureAction stateRef (goPure dir) +-- | Swap current window with the window in the given direction.+-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows). swap :: IORef WNState -> Direction2D -> X ()-swap = withTargetWindow swapWithFocused+swap stateRef dir = runPureAction stateRef (swapPure dir)++type WindowRectFn x = (Window -> x (Maybe Rectangle))+-- | (state, oldWindowSet, mappedWindows, windowRect)+type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)+type WNOutput = (WNState, WindowSet)++-- | Run the pure action inside X monad.+runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()+runPureAction stateRef action = do+ oldState <- io (readIORef stateRef)+ oldWindowSet <- gets windowset+ mappedWindows <- gets mapped+ (newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX)+ windows (const newWindowSet)+ io $ writeIORef stateRef newState++-- | Version of `go` not dependent on X monad (needed for testing).+goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput+goPure dir input@(oldState, oldWindowSet, mappedWindows, _) =+ if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1+ then+ -- Handle the special case of Full layout, when there's only one mapped window on a screen.+ return ( oldState+ , case dir of+ U -> W.focusUp oldWindowSet+ L -> W.focusDown oldWindowSet+ D -> W.focusDown oldWindowSet+ R -> W.focusUp oldWindowSet+ )+ else+ withTargetWindow W.focusWindow dir input++-- | Version of `swap` not dependent on X monad (needed for testing).+swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput+swapPure = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = case W.peek winSet of Just currentWin -> W.focusWindow currentWin $@@ -135,87 +172,249 @@ | win == win2 = win1 | otherwise = win -withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()-withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do- targets <- filter ((/= win) . fst) <$> navigableTargets pos dir- whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do- windows (adj targetWin)- setPosition posRef pos targetRect+-- | Select a target window in the given direction and modify the WindowSet.+-- 1. Get current position, verifying it matches the current window (exit if no focused window).+-- 2. Get the target window.+-- 3. Execute an action on the target window and windowset.+-- 4. Set the new position.+withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput+withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do+ whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do+ targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos+ whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) ->+ let newWindowSet = adj targetWin oldWindowSet+ in return (modifyState newWindowSet newPos oldState, newWindowSet) +-- | Update position on outside changes in windows. trackMovement :: IORef WNState -> X ()-trackMovement posRef = fromCurrentPoint posRef $ \win pos ->- windowRect win >>= flip whenJust (setPosition posRef pos . snd)+trackMovement stateRef = do+ oldState <- io (readIORef stateRef)+ oldWindowSet <- gets windowset+ mappedWindows <- gets mapped+ whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do+ io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState -fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()-fromCurrentPoint posRef f = withFocused $ \win ->- currentPosition posRef >>= f win+-- | Get focused window and current position.+getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))+getCurrentWindow input@(_, oldWindowSet, _, _) =+ whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do+ (pos, rect) <- currentPosition input+ return $ Just (window, rect, pos) --- Gets the current position from the IORef passed in, or if nothing (say, from--- a restart), derives the current position from the current window. Also,--- verifies that the position is congruent with the current window (say, if you--- used mod-j/k or mouse or something).-currentPosition :: IORef WNState -> X Point-currentPosition posRef = do- root <- asks theRoot- currentWindow <- gets (W.peek . windowset)- currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)+-- | Gets the current position from the state passed in, or if nothing+-- (say, from a restart), derives the current position from the current window.+-- Also, verifies that the position is congruent with the current window+-- (say, if you moved focus using mouse or something).+-- Returns the window rectangle for convenience, since we'll need it later anyway.+currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)+currentPosition (state, oldWindowSet, _, windowRect) = do+ currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)+ let posMaybe = M.lookup (W.currentTag oldWindowSet) state+ middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)+ return $ case posMaybe of+ Nothing -> (middleOf currentRect, currentRect)+ Just pos -> (centerPosition currentRect pos, currentRect) - wsid <- gets (W.currentTag . windowset)- mp <- M.lookup wsid <$> io (readIORef posRef)+-- | Inserts new position into the state.+modifyState :: WindowSet -> Point -> WNState -> WNState+modifyState oldWindowSet =+ M.insert (W.currentTag oldWindowSet) - return $ maybe (middleOf currentRect) (`inside` currentRect) mp+-- | "Jumps" the current position into the middle of target rectangle.+-- (keeps the position as-is if it is already inside the target rectangle)+centerPosition :: Rectangle -> Point -> Point+centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do+ if pointWithin x y r+ then pos+ else Point (midPoint rx rw) (midPoint ry rh) - where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)+midPoint :: Position -> Dimension -> Position+midPoint pos dim = pos + fromIntegral dim `div` 2 -setPosition :: IORef WNState -> Point -> Rectangle -> X ()-setPosition posRef oldPos newRect = do- wsid <- gets (W.currentTag . windowset)- io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)+-- | Make a list of target windows we can navigate to,+-- sorted by desirability of navigation.+navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]+navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do+ allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input+ let+ screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet+ (thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles -inside :: Point -> Rectangle -> Point-Point x y `inside` Rectangle rx ry rw rh =- Point (x `within` (rx, rw)) (y `within` (ry, rh))- where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim- then pos- else midPoint lower dim+ pos = pointTransform dir currentPos+ wr = rectTransform dir currentRect -midPoint :: Position -> Dimension -> Position-midPoint pos dim = pos + fromIntegral dim `div` 2+ rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) &&+ ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||+ (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis+ sortByP2 = sortOn (rect_p2 . snd)+ posBeforeEdge r = point_p pos < rect_p2 r -navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]-navigableTargets point dir = navigable dir point <$> windowRects+ rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&+ rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr+ rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr+ rectOverlapsBothEdges r = rectOverlapsEdge r &&+ rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r+ distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r))+ distanceToRectCenter r =+ let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos+ in if distance <= 0+ then distance + 1+ else distance+ sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd) --- Filters and sorts the windows in terms of what is closest from the Point in--- the Direction2D.-navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]-navigable d pt = sortby d . filter (inr d pt . snd)+ rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr &&+ rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr+ sortByLength = sortOn (rect_psize . snd) --- Produces a list of normal-state windows, on any screen. Rectangles are--- adjusted based on screen position relative to the current screen, because I'm--- bad like that.-windowRects :: X [(Window, Rectangle)]-windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped+ rectAfterEdge r = rect_p1 r > rect_p2 wr -windowRect :: Window -> X (Maybe (Window, Rectangle))-windowRect win = withDisplay $ \dpy -> do+ -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation:+ inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r++ clamp v v1 v2 | v < v1 = v1+ | v >= v2 = v2 - 1+ | otherwise = v+ dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))++ return $ mapSnd (inversePointTransform dir) $ concat+ [+ -- First, navigate to windows that are fully inside current window+ -- and have higher coordinate bigger than current position.+ -- ┌──────────────────┐+ -- │ current │ (all examples assume direction=R)+ -- │ ┌──────────┐ │+ -- │ ──┼─► inside │ │+ -- │ └──────────┘ │+ -- └──────────────────┘+ -- Also include windows fully overlapping current on the orthogonal axis:+ -- ┌──────────────┐+ -- │ overlapping │+ -- ┌───────────┤ ├────┐+ -- │ current ──┼─► │ │+ -- └───────────┤ ├────┘+ -- └──────────────┘+ mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles++ -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction.+ -- ┌──────────────┬─────────────┐ ┌───────────┐ ┌─────────────┐+ -- │ current │ adjacent │ │ current │ │ current │+ -- │ ──┼─► │ │ ┌───┴───────────────┐ │ ┌───┴─────────────┐+ -- │ │ │ │ ──┼─► │ overlapping │ │ ──┼─► │+ -- │ ├─────────────┘ │ └───┬───────────────┘ └─────────┤ overlapping │+ -- │ │ │ │ │ │+ -- └──────────────┘ └───────────┘ └─────────────────┘+ , mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles++ -- Windows fully overlapping current window "in the middle" on the parallel axis are also included,+ -- if position is inside them:+ -- ┌───────────┐+ -- │ current │+ -- ┌───┤-----------├────────────────┐+ -- │ │ * ──┼─► overlapping │+ -- └───┤-----------├────────────────┘+ -- └───────────┘+ , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles++ -- Then navigate to windows that fully encompass the current window.+ -- ┌─────────────────────┐+ -- │ outer │+ -- │ ┌─────────────┐ │+ -- │ │ current ──┼─► │+ -- │ └─────────────┘ │+ -- └─────────────────────┘+ , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles++ -- Then navigate to windows that are fully after current window in the chosen direction.+ -- ┌──────────────┐+ -- │ current │ ┌────────────────┐+ -- │ │ │ │+ -- │ ──┼──┼─► not adjacent │+ -- │ │ │ │+ -- │ │ └────────────────┘+ -- └──────────────┘+ , mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles++ -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray.+ , mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles++ -- If everything else fails, then navigate to the window that is fully inside current window,+ -- but is before the current position.+ -- This can happen when we are at the last window on a screen, and attempt to navigate even further.+ -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway,+ -- and user is probably not so fully aware of the precise position anyway.+ , mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $+ sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles+ ]++-- Structs for direction-independent space - equivalent to rotating points and rectangles such that+-- navigation direction points to the right.+-- Allows us to abstract over direction in the navigation functions.+data DirPoint = DirPoint+ { point_p :: Position -- coordinate parallel to the direction+ , point_o :: Position -- coordinate orthogonal to the direction+ }+data DirRectangle = DirRectangle+ { rect_p1 :: Position -- lower rectangle coordinate parallel to the direction+ , rect_p2 :: Position -- higher rectangle coordinate parallel to the direction+ , rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction+ , rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction+ }+{- HLINT ignore "Use camelCase" -}+rect_psize :: DirRectangle -> Dimension+rect_psize r = fromIntegral (rect_p2 r - rect_p1 r)++-- | Transform a point from screen space into direction-independent space.+pointTransform :: Direction2D -> Point -> DirPoint+pointTransform dir (Point x y) = case dir of+ U -> DirPoint (negate y - 1) x+ L -> DirPoint (negate x - 1) (negate y - 1)+ D -> DirPoint y (negate x - 1)+ R -> DirPoint x y++-- | Transform a point from direction-independent space back into screen space.+inversePointTransform :: Direction2D -> DirPoint -> Point+inversePointTransform dir p = case dir of+ U -> Point (point_o p) (negate $ point_p p + 1)+ L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1)+ D -> Point (negate $ point_o p + 1) (point_p p)+ R -> Point (point_p p) (point_o p)++-- | Transform a rectangle from screen space into direction-independent space.+rectTransform :: Direction2D -> Rectangle -> DirRectangle+rectTransform dir (Rectangle x y w h) = case dir of+ U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w)+ L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y)+ D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x)+ R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h)++-- | Produces a list of normal-state windows on all screens, excluding currently focused window.+windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]+windowRects (_, oldWindowSet, mappedWindows, windowRect) =+ let+ allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows+ windowRect2 w = fmap (w,) <$> windowRect w+ in catMaybes <$> mapM windowRect2 allWindows++windowRectX :: Window -> X (Maybe Rectangle)+windowRectX win = withDisplay $ \dpy -> do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win- return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))+ return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw) `catchX` return Nothing --- Modified from droundy's implementation of WindowNavigation:+-- Maybe below functions can be replaced with some standard helper functions? -inr :: Direction2D -> Point -> Rectangle -> Bool-inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&- py < ry + fromIntegral h-inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&- py > ry-inr R (Point px py) (Rectangle rx ry w h) = px < rx + fromIntegral w &&- py >= ry && py < ry + fromIntegral h-inr L (Point px py) (Rectangle rx ry _ h) = px > rx &&- py >= ry && py < ry + fromIntegral h+-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.+whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b+whenJust' monadMaybeValue deflt f = do+ maybeValue <- monadMaybeValue+ case maybeValue of+ Nothing -> return deflt+ Just value -> f value -sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]-sortby D = sortOn (rect_y . snd)-sortby R = sortOn (rect_x . snd)-sortby U = reverse . sortby D-sortby L = reverse . sortby R+-- | Filter a list of tuples on the second tuple member.+filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]+filterSnd f = filter (f . snd)++-- | Map a second tuple member in a list of tuples.+mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]+mapSnd f = map (second f)
XMonad/Actions/WorkspaceNames.hs view
@@ -138,7 +138,7 @@ -- | Prompt for a new name for the current workspace and set it. renameWorkspace :: XPConfig -> X () renameWorkspace conf = do- completion <- historyCompletionP (prompt ==)+ completion <- historyCompletionP conf (prompt ==) mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName where prompt = "Workspace name: "
XMonad/Hooks/EwmhDesktops.hs view
@@ -459,10 +459,17 @@ a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cw <- getAtom "_NET_CLOSE_WINDOW" - if | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->+ if | mt == a_cw ->+ killWindow w+ | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n -> if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww) | mt == a_cd -> trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d+ | not (w `W.member` s) ->+ -- do nothing for unmanaged windows; it'd be just a useless+ -- refresh which breaks menus/popups of misbehaving apps that+ -- send _NET_ACTIVE_WINDOW requests for override-redirect wins+ mempty | mt == a_d, n : _ <- d, Just ww <- ws !? fi n -> if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w | mt == a_d ->@@ -473,8 +480,6 @@ if W.peek s == Just w then mempty else windows $ W.focusWindow w | mt == a_aw -> do if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w- | mt == a_cw ->- killWindow w | otherwise -> -- The Message is unknown to us, but that is ok, not all are meant -- to be handled by the window manager
+ XMonad/Hooks/FloatConfigureReq.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE LambdaCase #-}+-- |+-- Module : XMonad.Hooks.FloatConfigureReq+-- Description : Customize handling of floating windows' move\/resize\/restack requests (ConfigureRequest).+-- Copyright : (c) 2024 Tomáš Janoušek <tomi@nomi.cz>+-- License : BSD3+-- Maintainer : Tomáš Janoušek <tomi@nomi.cz>+--+-- xmonad normally honours those requests by doing exactly what the client+-- application asked, and refreshing. There are some misbehaving clients,+-- however, that:+--+-- * try to move their window to the last known absolute position regardless+-- of the current xrandr/xinerama layout+--+-- * move their window to 0, 0 for no particular reason (e.g. rxvt-unicode)+--+-- * issue lots of no-op requests causing flickering (e.g. Steam)+--+-- This module provides a replacement handler for 'ConfigureRequestEvent' to+-- work around such misbehaviours.+--+module XMonad.Hooks.FloatConfigureReq (+ -- * Usage+ -- $usage+ MaybeMaybeManageHook,+ floatConfReqHook,++ -- * Known workarounds+ fixSteamFlicker,+ fixSteamFlickerMMMH,+ ) where++import qualified Data.Map.Strict as M+import XMonad+import XMonad.Hooks.ManageHelpers+import XMonad.Prelude+import qualified XMonad.StackSet as W++-- $usage+-- To use this, include the following in your @xmonad.hs@:+--+-- > import XMonad.Hooks.FloatConfigureReq+-- > import XMonad.Hooks.ManageHelpers+--+-- > myFloatConfReqHook :: MaybeMaybeManageHook+-- > myFloatConfReqHook = composeAll+-- > [ … ]+--+-- > myEventHook :: Event -> X All+-- > myEventHook = mconcat+-- > [ …+-- > , floatConfReqHook myFloatConfReqHook+-- > , … ]+--+-- > main = xmonad $ …+-- > $ def{ handleEventHook = myEventHook+-- > , … }+--+-- Then fill the @myFloatConfReqHook@ with whatever custom rules you need.+--+-- As an example, the following will prevent rxvt-unicode from moving its+-- (floating) window to 0, 0 after a font change but still ensure its size+-- increment hints are respected:+--+-- > className =? "URxvt" -?> pure <$> doFloat+--+-- Another example that avoids flickering and xmonad slowdowns caused by the+-- Steam client (completely ignore all its requests, none of which are+-- meaningful in the context of a tiling WM):+--+-- > map toLower `fmap` className =? "steam" -?> mempty+--+-- (this example is also available as 'fixSteamFlickerMMMH' to be added to+-- one's @myFloatConfReqHook@ and also 'fixSteamFlicker' to be added directly+-- to one's 'handleEventHook')++-- | A variant of 'MaybeManageHook' that additionally may or may not make+-- changes to the 'WindowSet'.+type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet)))++-- | Customizable handler for a 'ConfigureRequestEvent'. If the event's+-- 'ev_window' is a managed floating window, the provided+-- 'MaybeMaybeManageHook' is consulted and its result interpreted as follows:+--+-- * @Nothing@ - no match, fall back to the default handler+--+-- * @Just Nothing@ - match but ignore, no refresh, just send ConfigureNotify+--+-- * @Just (Just a)@ - match, modify 'WindowSet', refresh, send ConfigureNotify+floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All+floatConfReqHook mh ConfigureRequestEvent{ev_window = w} =+ runQuery (join <$> (isFloatQ -?> mh)) w >>= \case+ Nothing -> mempty+ Just e -> do+ whenJust e (windows . appEndo)+ sendConfEvent+ pure (All False)+ where+ sendConfEvent = withDisplay $ \dpy ->+ withWindowAttributes dpy w $ \wa -> do+ io . allocaXEvent $ \ev -> do+ -- We may have made no changes to the window size/position+ -- and thus the X server didn't emit any ConfigureNotify,+ -- so we need to send the ConfigureNotify ourselves to make+ -- sure there is a reply to this ConfigureRequestEvent and the+ -- window knows we (possibly) ignored its request.+ setEventType ev configureNotify+ setConfigureEvent ev w w+ (wa_x wa) (wa_y wa) (wa_width wa)+ (wa_height wa) (wa_border_width wa) none (wa_override_redirect wa)+ sendEvent dpy w False 0 ev+floatConfReqHook _ _ = mempty++-- | A 'Query' to determine if a window is floating.+isFloatQ :: Query Bool+isFloatQ = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset++-- | A pre-packaged 'floatConfReqHook' that fixes flickering of the Steam client by ignoring 'ConfigureRequestEvent's on any of its floating windows.+--+-- To use this, add 'fixSteamFlicker' to your 'handleEventHook'.+fixSteamFlicker :: Event -> X All+fixSteamFlicker = floatConfReqHook fixSteamFlickerMMMH++fixSteamFlickerMMMH :: MaybeMaybeManageHook+fixSteamFlickerMMMH = map toLower `fmap` className =? "steam" -?> mempty
XMonad/Hooks/ManageHelpers.hs view
@@ -51,6 +51,7 @@ isFullscreen, isMinimized, isDialog,+ isNotification, pid, desktop, transientTo,@@ -191,8 +192,17 @@ isMinimized = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN" -- | A predicate to check whether a window is a dialog.+--+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>. isDialog :: Query Bool isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"++-- | A predicate to check whether a window is a notification.+--+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.+isNotification :: Query Bool+isNotification =+ isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_NOTIFICATION" -- | This function returns 'Just' the @_NET_WM_PID@ property for a -- particular window if set, 'Nothing' otherwise.
XMonad/Hooks/OnPropertyChange.hs view
@@ -41,13 +41,13 @@ -- $usage -- You can use this module with the following in your @xmonad.hs@: ----- > import XMonad.Hooks.DynamicProperty+-- > import XMonad.Hooks.OnPropertyChange -- -- Enable it by including in you handleEventHook definition: -- -- > main = xmonad $ def -- > { ...--- > , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5"))+-- > , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5") -- > , ... -- > } --
XMonad/Hooks/ScreenCorners.hs view
@@ -3,7 +3,7 @@ -- | -- Module : XMonad.Hooks.ScreenCorners -- Description : Run X () actions by touching the edge of your screen with your mouse.--- Copyright : (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky+-- Copyright : (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song -- License : BSD3-style (see LICENSE) -- -- Maintainer : Nils Schweinsberg <mail@n-sch.de>@@ -42,6 +42,10 @@ | SCUpperRight | SCLowerLeft | SCLowerRight+ | SCTop+ | SCBottom+ | SCLeft+ | SCRight deriving (Eq, Ord, Show) --------------------------------------------------------------------------------@@ -74,26 +78,50 @@ -- Xlib functions -------------------------------------------------------------------------------- --- "Translate" a ScreenCorner to real (x,y) Positions+-- "Translate" a ScreenCorner to real (x,y) Positions with proper width and+-- height. createWindowAt :: ScreenCorner -> X Window-createWindowAt SCUpperLeft = createWindowAt' 0 0+createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1 createWindowAt SCUpperRight = withDisplay $ \dpy -> let w = displayWidth dpy (defaultScreen dpy) - 1- in createWindowAt' (fi w) 0+ in createWindowAt' (fi w) 0 1 1 createWindowAt SCLowerLeft = withDisplay $ \dpy -> let h = displayHeight dpy (defaultScreen dpy) - 1- in createWindowAt' 0 (fi h)+ in createWindowAt' 0 (fi h) 1 1 createWindowAt SCLowerRight = withDisplay $ \dpy -> let w = displayWidth dpy (defaultScreen dpy) - 1 h = displayHeight dpy (defaultScreen dpy) - 1- in createWindowAt' (fi w) (fi h)+ in createWindowAt' (fi w) (fi h) 1 1 --- Create a new X window at a (x,y) Position-createWindowAt' :: Position -> Position -> X Window-createWindowAt' x y = withDisplay $ \dpy -> io $ do+createWindowAt SCTop = withDisplay $ \dpy ->+ let w = displayWidth dpy (defaultScreen dpy) - 1+ -- leave some gap so corner and edge can work nicely when they overlap+ threshold = 150+ in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1 +createWindowAt SCBottom = withDisplay $ \dpy ->+ let w = displayWidth dpy (defaultScreen dpy) - 1+ h = displayHeight dpy (defaultScreen dpy) - 1+ threshold = 150+ in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1++createWindowAt SCLeft = withDisplay $ \dpy ->+ let h = displayHeight dpy (defaultScreen dpy) - 1+ threshold = 150+ in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2)++createWindowAt SCRight = withDisplay $ \dpy ->+ let w = displayWidth dpy (defaultScreen dpy) - 1+ h = displayHeight dpy (defaultScreen dpy) - 1+ threshold = 150+ in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2)++-- Create a new X window at a (x,y) Position, with given width and height.+createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window+createWindowAt' x y width height = withDisplay $ \dpy -> io $ do+ rootw <- rootWindow dpy (defaultScreen dpy) let@@ -107,8 +135,8 @@ rootw -- parent window x -- x y -- y- 1 -- width- 1 -- height+ width -- width+ height -- height 0 -- border width 0 -- depth inputOnly -- class@@ -122,7 +150,6 @@ sync dpy False return w - -------------------------------------------------------------------------------- -- Event hook --------------------------------------------------------------------------------@@ -162,9 +189,10 @@ -------------------------------------------------------------------------------- -- $usage ----- This extension adds KDE-like screen corners to XMonad. By moving your cursor--- into one of your screen corners you can trigger an @X ()@ action, for--- example @"XMonad.Actions.GridSelect".goToSelected@ or+-- This extension adds KDE-like screen corners and GNOME Hot Edge like+-- features to XMonad. By moving your cursor into one of your screen corners+-- or edges, you can trigger an @X ()@ action, for example+-- @"XMonad.Actions.GridSelect".goToSelected@ or -- @"XMonad.Actions.CycleWS".nextWS@ etc. -- -- To use it, import it on top of your @xmonad.hs@:@@ -176,6 +204,7 @@ -- > myStartupHook = do -- > ... -- > addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})+-- > addScreenCorner SCBottom (goToSelected def) -- > addScreenCorners [ (SCLowerRight, nextWS) -- > , (SCLowerLeft, prevWS) -- > ]
XMonad/Hooks/StatusBar.hs view
@@ -452,7 +452,7 @@ -- 'avoidStruts', check 'dynamicEasySBs'. -- -- Heavily inspired by "XMonad.Hooks.DynamicBars"-dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l+dynamicSBs :: (ScreenId -> X StatusBarConfig) -> XConfig l -> XConfig l dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf { startupHook = startupHook conf >> killAllStatusBars >> updateSBs f , logHook = logHook conf >> logSBs@@ -462,7 +462,7 @@ -- resulting config and adds 'avoidStruts' to the -- layout. dynamicEasySBs :: LayoutClass l Window- => (ScreenId -> IO StatusBarConfig)+ => (ScreenId -> X StatusBarConfig) -> XConfig l -> XConfig (ModifiedLayout AvoidStruts l) dynamicEasySBs f conf =@@ -471,7 +471,7 @@ -- | Given the function to create status bars, update -- the status bars by killing those that shouldn't be -- visible anymore and creates any missing status bars-updateSBs :: (ScreenId -> IO StatusBarConfig) -> X ()+updateSBs :: (ScreenId -> X StatusBarConfig) -> X () updateSBs f = do actualScreens <- withWindowSet $ return . map W.screen . W.screens (toKeep, toKill) <-@@ -480,7 +480,7 @@ cleanSBs (map snd toKill) -- Create new status bars if needed let missing = actualScreens \\ map fst toKeep- added <- io $ traverse (\s -> (s,) <$> f s) missing+ added <- traverse (\s -> (s,) <$> f s) missing traverse_ (sbStartupHook . snd) added XS.put (ASB (toKeep ++ added))
XMonad/Layout/AutoMaster.hs view
@@ -35,7 +35,7 @@ -- in one row, in slave area underlying layout is run. Size of slave area -- automatically increases when number of slave windows is increasing. ----- You can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.AutoMaster --
XMonad/Layout/CenteredMaster.hs view
@@ -38,7 +38,7 @@ -- All other windows in background are managed by base layout. -- topRightMaster is like centerMaster, but places master window in top right corner instead of center. ----- Yo can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.CenteredMaster --
XMonad/Layout/Column.hs view
@@ -11,7 +11,7 @@ -- Portability : unportable -- -- Provides Column layout that places all windows in one column. Windows--- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is+-- heights are calculated from the equation: H1/H2 = H2/H3 = ... = q, where q is -- given. With Shrink/Expand messages you can change the q value. -- -----------------------------------------------------------------------------@@ -25,12 +25,12 @@ import qualified XMonad.StackSet as W -- $usage--- This module defines layot named Column. It places all windows in one--- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... =+-- This module defines layout named Column. It places all windows in one+-- column. Windows heights are calculated from the equation: H1/H2 = H2/H3 = ... = -- q, where `q' is given (thus, windows heights are members of geometric -- progression). With Shrink/Expand messages one can change the `q' value. ----- You can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.Column --
+ XMonad/Layout/Columns.hs view
@@ -0,0 +1,480 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Module: XMonad.Layout.Columns+-- Description: A layout which tiles the windows in columns.+-- Copyright: Jean-Charles Quillet+-- License: BSD-style (see LICENSE)+--+-- Maintainer: none+-- Stability: unstable+-- Portability: unportable+--+-- A layout which tiles the windows in columns. The windows can be moved and+-- resized in every directions.+--+-- The first window appears in a single column in the center of the screen. Its+-- width is configurable (See 'coOneWindowWidth').+--+-- The second window appears in a second column. Starting with two columns, they+-- fill up the screen.+--+-- Subsequent windows appear on the bottom of the last columns.+module XMonad.Layout.Columns+ ( -- * Usage+ -- $usage+ ColumnsLayout (..),++ -- * Messages+ Focus (..),+ Move (..),+ Resize (..),++ -- * Tools+ focusDown,+ focusUp,+ )+where++import Control.Applicative ((<|>))+import Control.Arrow (Arrow (first), second)+import Control.Monad (guard)+import Control.Monad.State (modify)+import Control.Monad.Trans.Maybe (MaybeT (..))+import Data.Foldable (Foldable (..))+import Data.List (scanl')+import Data.Maybe (listToMaybe)+import Data.Ratio ((%))+import XMonad+ ( LayoutClass (..),+ Message,+ Rectangle (..),+ SomeMessage,+ Window,+ WindowSet,+ X,+ XState (..),+ fromMessage,+ gets,+ scaleRationalRect,+ sendMessage,+ )+import qualified XMonad.Operations as O+import XMonad.StackSet+ ( RationalRect (..),+ Screen (..),+ Stack (..),+ StackSet (..),+ integrate,+ peek,+ )+import qualified XMonad.StackSet as StackSet++-- $usage+-- Add 'Columns' to your @layoutHook@ with an initial empty state:+--+-- > myLayout = Full ||| Columns 1 []+--+-- Here is an example of keybindings:+--+-- > -- Focus up/down+-- > ((modm, xK_Tab), focusDown),+-- > ((modm .|. shiftMask, xK_Tab), focusUp),+-- > -- Move windows around+-- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight),+-- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft),+-- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp),+-- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown),+-- > -- Resize them+-- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand),+-- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink),+-- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand),+-- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink),+--+-- This layout is known to work with:+--+-- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using+-- 'XMonad.Layout.WindowNavigation.Go' messages.+-- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with+-- tabs. Note that sometimes when undocking windows, the layout is reset. This is+-- a minor annoyance caused by the difficulty to track windows in the sublayout.++-- | The windows can be moved in every directions.+--+-- Horizontally, a window alone in its column cannot be moved before the first+-- or after the last column. If not alone, moving the window outside those+-- limits will create a new column.+-- The windows can also be moved vertically in their column.+data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Show, Read)++instance Message Move++-- | The windows can be resized in every directions.+--+-- When resizing horizontally:+--+-- * if the window to be resized is not in the last column+--+-- * then the right side of the window will be moved+-- * the last column will compensate the size change+--+-- * if the window is in the last column+--+-- * then the left side of the window will be moved+-- * the column on the left of the current one will compensate the size change+--+-- The same applies when resizing vertically using the bottom side of the+-- window unless it is the last window in the column in which case we use the+-- top side.+data Resize+ = VerticalShrink+ | VerticalExpand+ | HorizontalShrink+ | HorizontalExpand+ deriving (Show, Read)++instance Message Resize++-- | The layout handles focus change messages.+--+-- Built-in focus cannot be used here because @XMonad@ does not make it easy to+-- change the order of windows in the focus list. See also 'focusUp' and+-- 'focusDown' functions.+data Focus = FocusUp | FocusDown+ deriving (Show, Read)++instance Message Focus++-- | A column is a list of windows with their relative vertical dimensions.+type Column = [(Rational, Window)]++-- | The layout is a list of 'Column' with their relative horizontal dimensions.+type Columns = [(Rational, Column)]++data ColumnsLayout a = Columns+ { -- | With of the first column when there is only one window. Usefull on wide+ -- screens.+ coOneWindowWidth :: Rational,+ -- | The current state+ coColumns :: Columns+ }+ deriving (Show, Read)++instance LayoutClass ColumnsLayout Window where+ description _ = layoutDescription++ doLayout (Columns oneWindowWidth columns) rectangle stack =+ pure (rectangles, Just (Columns oneWindowWidth columns'))+ where+ hackedColumns = hackForTabs columns stack+ columns' = updateWindowList hackedColumns stack+ rectangles = toRectangles rectangle' columns'+ -- If there is only one window, we set the destination rectangle according+ -- to the width in the layout setting.+ rectangle'+ | (length . toList $ stack) == 1 =+ scaleRationalRect rectangle singleColumnRR+ | otherwise = rectangle+ singleColumnOffset = (1 - oneWindowWidth) / 2+ singleColumnRR = RationalRect singleColumnOffset 0 oneWindowWidth 1++ handleMessage layout@(Columns oneWindowWidth columns) message = do+ mbStack <- runMaybeT $ handleFocus' =<< getStack+ changedFocus <- traverse updateStack' mbStack++ movedOrResized <-+ runMaybeT $+ Columns oneWindowWidth+ <$> (handleMoveOrResize' =<< peekFocus)++ pure $ movedOrResized <|> changedFocus+ where+ getStack = MaybeT . gets $ StackSet.stack . workspace . current . windowset+ handleFocus' = hoistMaybe . handleFocus columns message+ -- A 'Just' needs to be return for the new stack to be taken into account+ updateStack' s = modify (setStack s) >> pure layout+ peekFocus = MaybeT . gets $ peek . windowset+ handleMoveOrResize' = hoistMaybe . handleMoveOrResize columns message+ hoistMaybe = MaybeT . pure++layoutDescription :: String+layoutDescription = "Columns"++-- | Change the keyboard focus to the previous window+focusUp :: X ()+focusUp =+ sendMsgOrOnWindowsSet FocusUp StackSet.focusUp+ =<< getCurrentLayoutDescription++-- | Change the keyboard focus to the next window+focusDown :: X ()+focusDown =+ sendMsgOrOnWindowsSet FocusDown StackSet.focusDown+ =<< getCurrentLayoutDescription++sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X ()+sendMsgOrOnWindowsSet message f description'+ | description' == layoutDescription = sendMessage message+ | otherwise = O.windows f++getCurrentLayoutDescription :: X String+getCurrentLayoutDescription =+ gets+ ( description+ . StackSet.layout+ . workspace+ . current+ . windowset+ )++setStack :: Stack Window -> XState -> XState+setStack stack state =+ state+ { windowset =+ (windowset state)+ { current =+ (current $ windowset state)+ { workspace =+ (workspace . current $ windowset state)+ { StackSet.stack = Just stack+ }+ }+ }+ }++handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)+handleFocus columns message stack+ | Just FocusDown <- fromMessage message = setFocus' stack <$> mbNext+ | Just FocusUp <- fromMessage message = setFocus' stack <$> mbPrevious+ | otherwise = Nothing+ where+ focused = focus stack+ windows = columnsToWindows columns+ exists = focused `elem` windows+ mbNext = guard exists >> next focused windows+ mbPrevious = guard exists >> previous focused windows+ setFocus' = flip setFocus+ previous a = next a . reverse+ setFocus w = until ((==) w . focus) StackSet.focusDown'+ next _ [] = Nothing+ next a (x : xs)+ | a == x = listToMaybe xs+ | otherwise = next a (xs <> [x])++oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])+oldNewWindows columns stack = (old, new)+ where+ old = filter (`notElem` stackList) windows+ new = filter (`notElem` windows) stackList+ stackList = toList stack+ windows = columnsToWindows columns++-- | Add the new windows to the layout and remove the old ones.+updateWindowList :: Columns -> Stack Window -> Columns+updateWindowList columns stack = addWindows newWindows (removeWindows oldWindows columns)+ where+ (oldWindows, newWindows) = oldNewWindows columns stack++-- | If one window disappeared and another appeared, we assume that the sublayout+-- tabs just changed focused.+hackForTabs :: Columns -> Stack Window -> Columns+hackForTabs columns stack = mapWindow replace columns+ where+ replace window+ | (w1 : _, [w2]) <- oldNewWindows columns stack =+ if window == w1+ then w2+ else window+ | otherwise = window++toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]+toRectangles rectangle columns =+ second (scaleRationalRect rectangle) <$> windowsAndRectangles+ where+ offsetsAndRatios = toOffsetRatio (second toOffsetRatio <$> columns)+ windowsAndRectangles = foldMap toWindowAndRectangle offsetsAndRatios+ toWindowAndRectangle (x, w, cs) = (\(y, h, ws) -> (ws, RationalRect x y w h)) <$> cs++onFocused :: (a -> a) -> Stack a -> Stack a+onFocused f (Stack a before after) = Stack (f a) before after++onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a)+onFocusedM f (Stack a before after) = Stack <$> f a <*> pure before <*> pure after++onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a+onFocusedOrPrevious f (Stack a (a' : others) []) = Stack a (f a' : others) []+onFocusedOrPrevious f stack = onFocused f stack++handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns+handleMoveOrResize columns message window+ | Just msg <- fromMessage message = move msg window columns+ | Just HorizontalShrink <- fromMessage message =+ onFocusedOrPrevious' shrink <$> findInColumns window columns+ | Just HorizontalExpand <- fromMessage message =+ onFocusedOrPrevious' expand <$> findInColumns window columns+ | Just VerticalExpand <- fromMessage message =+ onFocusedM'+ (fmap (onFocusedOrPrevious' shrink) . findInColumn window)+ =<< findInColumns window columns+ | Just VerticalShrink <- fromMessage message =+ onFocusedM'+ (fmap (onFocusedOrPrevious' expand) . findInColumn window)+ =<< findInColumns window columns+ | otherwise = Nothing+ where+ expand = first $ flip (+) (3 / 100)+ shrink = first $ flip (-) (3 / 100)+ onFocusedM' f = fmap integrate . onFocusedM (sequence . second f)+ onFocusedOrPrevious' f = sanitize . integrate . onFocusedOrPrevious f++move :: Move -> Window -> Columns -> Maybe Columns+move direction window columns =+ case (direction, findInColumns window columns) of+ (MoveRight, Just (Stack (_, [(_, _)]) _ [])) -> Nothing+ (MoveLeft, Just (Stack (_, [(_, _)]) [] _)) -> Nothing+ (MoveRight, Just (Stack column@(_, [(_, _)]) before (next : others))) ->+ let (column', next') = swapWindowBetween window column next+ in Just . integrate $ Stack column' before (next' : others)+ (MoveLeft, Just (Stack column@(_, [(_, _)]) (previous : others) after)) ->+ let (column', previous') = swapWindowBetween window column previous+ in Just . integrate $ Stack column' (previous' : others) after+ (MoveRight, Just stack) ->+ let (newColumns', Stack column before after) = rationalize newColumns stack+ windows = removeWindow window column+ in Just . integrate $ Stack windows before (newColumns' <> after)+ (MoveLeft, Just stack) ->+ let (newColumns', Stack column before after) = rationalize newColumns stack+ windows = removeWindow window column+ in Just . integrate $ Stack windows (newColumns' <> before) after+ (MoveUp, Just stack) -> integrate <$> onFocusedM (swapWindowUp window) stack+ (MoveDown, Just stack) -> integrate <$> onFocusedM (swapWindowDown window) stack+ _ -> Nothing+ where+ newColumns = [[(1, window)]]++mapWindow :: (Window -> Window) -> Columns -> Columns+mapWindow = fmap . fmap . fmap . fmap++columnsToWindows :: Columns -> [Window]+columnsToWindows = foldMap ((: []) . snd) . foldMap snd++swapWindowBetween ::+ Window ->+ (Rational, Column) ->+ (Rational, Column) ->+ ((Rational, Column), (Rational, Column))+swapWindowBetween window from to = (removed, added)+ where+ removed = removeWindow window from+ added = appendWindows [window] to++swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column)+swapWindowUp window (width, column)+ | Just (Stack (height, _) (previous : before') after) <- findInColumn window column =+ Just (width, integrate $ Stack previous ((height, window) : before') after)+ | otherwise = Nothing++swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column)+swapWindowDown window (width, column)+ | Just (Stack (height, _) before (next : others)) <- findInColumn window column =+ Just (width, integrate $ Stack next before ((height, window) : others))+ | otherwise = Nothing++-- | Adjust the ratio of a list or a stack of elts so that when adding new+-- elements:+-- - the new elements are distributed according to the total number of elements+-- - the existing elements keep their proportion in the remaining space+rationalize ::+ (Functor f, Foldable f) =>+ [a] ->+ f (Rational, a) ->+ ([(Rational, a)], f (Rational, a))+rationalize new existing = (new', existing')+ where+ nbNew = fromIntegral $ length new+ nbInColumn = fromIntegral $ length existing+ newRatio = nbNew % (nbNew + nbInColumn)+ existingRatio = 1 - newRatio+ new' = fitElements newRatio new+ existing' = first (* existingRatio) <$> existing++append :: [a] -> [(Rational, a)] -> [(Rational, a)]+append new existing = uncurry (flip mappend) (rationalize new existing)++appendWindows ::+ [Window] ->+ (Rational, [(Rational, Window)]) ->+ (Rational, [(Rational, Window)])+appendWindows windows = second (append windows)++fitElements :: Rational -> [a] -> [(Rational, a)]+fitElements dimension elts = (dimension',) <$> elts+ where+ dimension' = dimension / fromIntegral (length elts)++singleColumn :: Rational -> Rational -> [Window] -> Columns+singleColumn width height windows = [(width, fitElements height windows)]++findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))+findElement' predicate list+ | (before, c : after) <- break (predicate . snd) list =+ Just $ Stack c (reverse before) after+ | otherwise = Nothing++findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column))+findInColumns window = findElement' (any ((== window) . snd))++findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window))+findInColumn window = findElement' (== window)++removeWindows :: [Window] -> Columns -> Columns+removeWindows windows = removeEmptyColumns . fmap (second removeWindows')+ where+ inWindows (_, window) = window `notElem` windows+ removeWindows' = normalize . filter inWindows+ removeEmptyColumns = normalize . filter (not . null . snd)++removeWindow :: Window -> (Rational, Column) -> (Rational, Column)+removeWindow window = second (normalize . filter ((/= window) . snd))++addWindows :: [Window] -> Columns -> Columns+addWindows [] columns = columns+-- When there is only one column, create a new one on the right+addWindows windows [(_, windows')] = (1 % 2, windows') : singleColumn (1 % 2) 1 windows+-- When there is more, append the windows to the last column+addWindows windows columns+ | Just (columns', column) <- unsnoc columns =+ sanitizeColumns $ columns' <> [appendWindows windows column]+ | otherwise = singleColumn 1 1 windows++-- | Make sure the sum of all dimensions is 1+normalize :: [(Rational, a)] -> [(Rational, a)]+normalize elts = fmap (first (/ total)) elts+ where+ total = sum (fst <$> elts)++-- | Update the last dimension so that the sum of all dimensions is 1+sanitize :: [(Rational, a)] -> [(Rational, a)]+sanitize list+ | Just (elts, (_, a)) <- unsnoc list = elts <> [(1 - sum (fst <$> elts), a)]+ | otherwise = []++-- | Same on the whole layout+sanitizeColumns :: Columns -> Columns+sanitizeColumns = sanitize . fmap (second sanitize)++toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)]+toOffsetRatio ra = zipWith toTruple ra positions+ where+ toTruple (dimension, a) position = (position, dimension, a)+ positions = scanl' (\position (dimension, _) -> position + dimension) 0 ra++unsnoc :: [a] -> Maybe ([a], a)+unsnoc [] = Nothing+unsnoc (x : xs)+ | Just (is, l) <- unsnoc xs = Just (x : is, l)+ | otherwise = Just ([], x)
XMonad/Layout/Hidden.hs view
@@ -118,7 +118,7 @@ -------------------------------------------------------------------------------- hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a)) hideWindowMsg (HiddenWindows hidden) win = do- modify (\s -> s { windowset = W.delete' win $ windowset s })+ modifyWindowSet $ W.delete' win return . Just . HiddenWindows $ hidden ++ [win] --------------------------------------------------------------------------------
XMonad/Layout/IfMax.hs view
@@ -36,7 +36,7 @@ -- IfMax layout will run one layout if number of windows on workspace is as -- maximum N, and else will run another layout. ----- You can use this module by adding folowing in your @xmonad.hs@:+-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.IfMax --
XMonad/Layout/TabBarDecoration.hs view
@@ -46,8 +46,8 @@ -- 'tabBar' will give you the possibility of setting a custom shrinker -- and a custom theme. ----- The deafult theme can be dynamically change with the xmonad theme--- selector. See "XMonad.Prompt.Theme". For more themse, look at+-- The default theme can be dynamically changed with the xmonad theme+-- selector. See "XMonad.Prompt.Theme". For more themes, look at -- "XMonad.Util.Themes" -- | Add, on the top of the screen, a simple bar of tabs to a given
XMonad/Prompt.hs view
@@ -562,7 +562,7 @@ s <- gets $ screenRect . W.screenDetail . W.current . windowset cleanMask <- cleanKeyMask cachedir <- asks (cacheDir . directories)- hist <- io $ readHistory cachedir+ hist <- io $ readHistory conf cachedir fs <- initXMF (font conf) let width = getWinWidth s (position conf) st' <- io $@@ -582,7 +582,7 @@ releaseXMF fs when (successful st') $ do let prune = take (historySize conf)- io $ writeHistory cachedir $+ io $ writeHistory conf cachedir $ M.insertWith (\xs ys -> prune . historyFilter conf $ xs ++ ys) historyKey@@ -1690,16 +1690,18 @@ getHistoryFile :: FilePath -> FilePath getHistoryFile cachedir = cachedir ++ "/prompt-history" -readHistory :: FilePath -> IO History-readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory+readHistory :: XPConfig -> FilePath -> IO History+readHistory (XPC { historySize = 0 }) _ = return emptyHistory+readHistory _ cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory where readHist = do let path = getHistoryFile cachedir xs <- withFile path ReadMode hGetLine readIO xs -writeHistory :: FilePath -> History -> IO ()-writeHistory cachedir hist = do+writeHistory :: XPConfig -> FilePath -> History -> IO ()+writeHistory (XPC { historySize = 0 }) _ _ = return ()+writeHistory _ cachedir hist = do let path = getHistoryFile cachedir filtered = M.filter (not . null) hist writeFile path (show filtered) `E.catch` \(SomeException e) ->@@ -1793,17 +1795,17 @@ -- | 'historyCompletion' provides a canned completion function much like -- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work -- from the query history stored in the XMonad cache directory.-historyCompletion :: X ComplFunction-historyCompletion = historyCompletionP (const True)+historyCompletion :: XPConfig -> X ComplFunction+historyCompletion conf = historyCompletionP conf (const True) -- | Like 'historyCompletion' but only uses history data from Prompts whose -- name satisfies the given predicate.-historyCompletionP :: (String -> Bool) -> X ComplFunction-historyCompletionP p = do+historyCompletionP :: XPConfig -> (String -> Bool) -> X ComplFunction+historyCompletionP conf p = do cd <- asks (cacheDir . directories) pure $ \x -> let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []- in toComplList . M.filterWithKey (const . p) <$> readHistory cd+ in toComplList . M.filterWithKey (const . p) <$> readHistory conf cd -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off -- laziness and stability for efficiency.
XMonad/Prompt/OrgMode.hs view
@@ -53,6 +53,7 @@ Date (..), Time (..), TimeOfDay (..),+ OrgTime (..), DayOfWeek (..), #endif @@ -122,7 +123,9 @@ it for the /next/ Monday (the one in seven days). The time is specified in the @HH:MM@ or @HHMM@ format. The minutes may-be omitted, in which case we assume a full hour is specified.+be omitted, in which case we assume a full hour is specified. It is also+possible to enter a time span using the syntax @HH:MM-HH:MM@ or @HH:MM+HH@.+In the former case, minutes may be omitted. A few examples are probably in order. Suppose we have bound the key above, pressed it, and are now confronted with a prompt:@@ -137,6 +140,10 @@ - @hello +d today 12:30@ works just like above, but creates a deadline. + - @hello +d today 12:30-14:30@ works like the above, but gives the+ event a duration of two hours. An alternative way to specify+ this would be @hello +d today 12:30+2@.+ - @hello +s thu@ would schedule the note for next thursday. - @hello +s 11@ would schedule it for the 11th of this month and this@@ -356,21 +363,30 @@ -- @HH:MM@ time. data Time = Time { date :: Date- , tod :: Maybe TimeOfDay+ , tod :: Maybe OrgTime } deriving (Eq, Show) -- | The time in HH:MM.-data TimeOfDay = TimeOfDay Int Int+data TimeOfDay = HHMM Int Int deriving (Eq) instance Show TimeOfDay where show :: TimeOfDay -> String- show (TimeOfDay h m) = pad h <> ":" <> pad m+ show (HHMM h m) = pad h <> ":" <> pad m where pad :: Int -> String pad n = (if n <= 9 then "0" else "") <> show n +-- | The time—possibly as a span—in HH:MM format.+data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay+ deriving (Eq)++instance Show OrgTime where+ show :: OrgTime -> String+ show (MomentInTime tod) = show tod+ show (TimeSpan tod tod') = show tod <> "-" <> show tod'+ -- | Type for specifying exactly which day one wants. data Date = Today@@ -383,7 +399,7 @@ -- ^ Manual date entry in the format DD [MM] [YYYY] deriving (Eq, Ord, Show) -toOrgFmt :: Maybe TimeOfDay -> Day -> String+toOrgFmt :: Maybe OrgTime -> Day -> String toOrgFmt tod day = mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"] where@@ -498,8 +514,8 @@ -- | Parse the given string into a 'Note'. pInput :: String -> Maybe Note pInput inp = (`runParser` inp) . choice $- [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority- , Deadline <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority+ [ Scheduled <$> (getLast "+s" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority+ , Deadline <$> (getLast "+d" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority , do s <- munch1 (pure True) let (s', p) = splitAt (length s - 3) s pure $ case tryPrio p of@@ -507,6 +523,12 @@ Nothing -> NormalMsg s NoPriority ] where+ fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time+ fixTime d tod = case (d, tod) of+ (Nothing, Nothing) -> mempty -- no day and no time+ (Nothing, Just{}) -> pure (Time Today tod) -- no day, but a time+ (Just d', _) -> pure (Time d' tod) -- day given+ tryPrio :: String -> Maybe Priority tryPrio [' ', '#', x] | x `elem` ("Aa" :: String) = Just A@@ -533,21 +555,33 @@ -- | Parse a 'Priority'. pPriority :: Parser Priority pPriority = option NoPriority $- " " *> skipSpaces *> choice+ skipSpaces *> choice [ "#" *> foldCase "a" $> A , "#" *> foldCase "b" $> B , "#" *> foldCase "c" $> C ] -- | Try to parse a 'Time'.-pTimeOfDay :: Parser (Maybe TimeOfDay)-pTimeOfDay = option Nothing $- skipSpaces >> Just <$> choice- [ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM- , pHHMM -- HHMM- , TimeOfDay <$> pHour <*> pure 0 -- HH- ]+pOrgTime :: Parser (Maybe OrgTime)+pOrgTime = option Nothing $+ between skipSpaces (void " " <|> eof) $+ Just <$> choice+ [ TimeSpan <$> (pTimeOfDay <* ("--" <|> "-" <|> "–")) <*> pTimeOfDay+ -- Org is not super smart around times with this syntax, so+ -- we pretend not to be as well.+ , do from@(HHMM h m) <- pTimeOfDay <* "+"+ off <- pHour+ pure $ TimeSpan from (HHMM (h + off) m)+ , MomentInTime <$> pTimeOfDay+ ] where+ pTimeOfDay :: Parser TimeOfDay+ pTimeOfDay = choice+ [ HHMM <$> pHour <* ":" <*> pMinute -- HH:MM+ , pHHMM -- HHMM+ , HHMM <$> pHour <*> pure 0 -- HH+ ]+ pHHMM :: Parser TimeOfDay pHHMM = do let getTwo = count 2 (satisfy isDigit)@@ -555,18 +589,19 @@ guard (hh >= 0 && hh <= 23) mm <- read <$> getTwo guard (mm >= 0 && mm <= 59)- pure $ TimeOfDay hh mm+ pure $ HHMM hh mm+ pHour :: Parser Int = pNumBetween 0 23 pMinute :: Parser Int = pNumBetween 0 59 --- | Parse a 'Date'.-pDate :: Parser Date-pDate = skipSpaces *> choice+-- | Try to parse a 'Date'.+pDate :: Parser (Maybe Date)+pDate = skipSpaces *> optional (choice [ pPrefix "tod" "ay" Today , pPrefix "tom" "orrow" Tomorrow , Next <$> pNext , Date <$> pDate'- ]+ ]) where pNext :: Parser DayOfWeek = choice [ pPrefix "m" "onday" Monday , pPrefix "tu" "esday" Tuesday@@ -585,7 +620,7 @@ pDate' :: Parser (Int, Maybe Int, Maybe Integer) pDate' =- (,,) <$> pNumBetween 1 31 -- day+ (,,) <$> (pNumBetween 1 31 <* (void " " <|> eof)) -- day <*> optional (skipSpaces *> choice [ pPrefix "ja" "nuary" 1 , pPrefix "f" "ebruary" 2 , pPrefix "mar" "ch" 3 , pPrefix "ap" "ril" 4
XMonad/Util/EZConfig.hs view
@@ -552,8 +552,8 @@ doKeymapCheck conf km = (bad,dups) where ks = map ((readKeySequence conf &&& id) . fst) km bad = nub . map snd . filter (isNothing . fst) $ ks- dups = map (snd . NE.head)- . mapMaybe nonEmpty+ dups = map (snd . NE.head . notEmpty)+ . filter ((>1) . length) . groupBy ((==) `on` fst) . sortBy (comparing fst) . map (first fromJust)
XMonad/Util/Grab.hs view
@@ -29,15 +29,12 @@ ) where -- core-import XMonad hiding (mkGrabs)+import XMonad import Control.Monad ( when )-import Data.Bits ( setBit ) import Data.Foldable ( traverse_ ) -- base-import qualified Data.Map.Strict as M import Data.Semigroup ( All(..) )-import Data.Traversable ( for ) -- }}} @@ -70,9 +67,8 @@ -> [(KeyMask, KeySym)] -- ^ Keys to ungrab -> X () grabUngrab gr ugr = do- f <- mkGrabs- traverse_ (uncurry ungrabKP) (f ugr)- traverse_ (uncurry grabKP) (f gr)+ traverse_ (uncurry ungrabKP) =<< mkGrabs ugr+ traverse_ (uncurry grabKP) =<< mkGrabs gr -- | A convenience function to grab keys. This also ungrabs all -- previously grabbed keys.@@ -88,49 +84,9 @@ e@MappingNotifyEvent{} -> do io (refreshKeyboardMapping e) when (ev_request e `elem` [mappingKeyboard, mappingModifier])- $ setNumlockMask+ $ cacheNumlockMask >> regr pure (All False) _ -> pure (All True) -- }}}---- --< Private Utils >-- {{{---- | Private action shamelessly copied and restyled from XMonad.Main source.-setNumlockMask :: X ()-setNumlockMask = withDisplay $ \dpy -> do- ms <- io (getModifierMapping dpy)- xs <- sequence- [ do- ks <- io (keycodeToKeysym dpy kc 0)- pure $ if ks == xK_Num_Lock- then setBit 0 (fromIntegral m)- else 0 :: KeyMask- | (m, kcs) <- ms- , kc <- kcs- , kc /= 0- ]- modify $ \s -> s { numberlockMask = foldr (.|.) 0 xs }---- | Private function shamelessly copied and refactored from XMonad.Main source.-mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])-mkGrabs = withDisplay $ \dpy -> do- let (minCode, maxCode) = displayKeycodes dpy- allCodes = [fromIntegral minCode .. fromIntegral maxCode]- syms <- io . for allCodes $ \code -> keycodeToKeysym dpy code 0- let keysymMap = M.fromListWith (++) (zip syms $ pure <$> allCodes)- keysymToKeycodes sym = M.findWithDefault [] sym keysymMap- extraMods <- extraModifiers- pure $ \ks -> do- (mask, sym) <- ks- keycode <- keysymToKeycodes sym- extraMod <- extraMods- pure (mask .|. extraMod, keycode)---- }}}----- NOTE: there is some duplication between this module and core. The--- latter probably will never change, but this needs to be kept in sync--- with any potential bugs that might arise.
XMonad/Util/Hacks.hs view
@@ -40,10 +40,14 @@ trayerPaddingXmobarEventHook, trayPaddingXmobarEventHook, trayPaddingEventHook,++ -- * Steam flickering fix+ fixSteamFlicker, ) where import XMonad+import XMonad.Hooks.FloatConfigureReq (fixSteamFlicker) import XMonad.Hooks.StatusBar (xmonadPropLog') import XMonad.Prelude (All (All), fi, filterM, when) import System.Posix.Env (putEnv)
XMonad/Util/Rectangle.hs view
@@ -67,7 +67,7 @@ -- @[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,+-- considers pixels as row/column 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.
tests/Main.hs view
@@ -14,6 +14,7 @@ import qualified OrgMode import qualified GridSelect import qualified EZConfig+import qualified WindowNavigation main :: IO () main = hspec $ do@@ -53,3 +54,4 @@ context "OrgMode" OrgMode.spec context "GridSelect" GridSelect.spec context "EZConfig" EZConfig.spec+ context "WindowNavigation" WindowNavigation.spec
tests/OrgMode.hs view
@@ -45,7 +45,7 @@ `shouldBe` Just ( Deadline "todo"- (Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})+ (Time {date = Date (1, Nothing, Nothing), tod = Just $ MomentInTime(HHMM 1 1)}) NoPriority ) it "works with todo +d 22 jan 2021 01:01 #b" $ do@@ -53,9 +53,23 @@ `shouldBe` Just ( Deadline "todo"- (Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1})+ (Time {date = Date (22, Just 1, Just 2021), tod = Just $ MomentInTime(HHMM 1 1)}) B )+ it "parses no day as today when given a time" $ do+ pInput "todo +s 12:00"+ `shouldBe` Just (Scheduled "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 12 0)}) NoPriority)+ pInput "todo +d 14:05 #B"+ `shouldBe` Just (Deadline "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 14 5)}) B)+ it "parses `blah+d`, `blah +d`, `blah +d `, and `blah +d #B` as normal messages" $ do+ pInput "blah+d"+ `shouldBe` Just (NormalMsg "blah+d" NoPriority)+ pInput "blah +d"+ `shouldBe` Just (NormalMsg "blah +d" NoPriority)+ pInput "blah +d "+ `shouldBe` Just (NormalMsg "blah +d " NoPriority)+ pInput "blah +d #B"+ `shouldBe` Just (NormalMsg "blah +d" B) context "no priority#b" $ do it "parses to the correct thing" $@@ -100,10 +114,10 @@ prio -> " #" <> show prio ppTime :: Time -> String-ppTime (Time d t) = ppDate d <> ppTOD t+ppTime (Time d t) = ppDate d <> ppOrgTime t where- ppTOD :: Maybe TimeOfDay -> String- ppTOD = maybe "" ((' ' :) . show)+ ppOrgTime :: Maybe OrgTime -> String+ ppOrgTime = maybe "" ((' ' :) . show) ppDate :: Date -> String ppDate dte = case days !? dte of@@ -179,7 +193,7 @@ [ pure Today , pure Tomorrow , Next . toEnum <$> choose (0, 6)- , do d <- posInt+ , do d <- posInt `suchThat` (<= 31) m <- mbPos `suchThat` (<= Just 12) Date . (d, m, ) <$> if isNothing m then pure Nothing@@ -188,7 +202,14 @@ instance Arbitrary TimeOfDay where arbitrary :: Gen TimeOfDay- arbitrary = TimeOfDay <$> hourInt <*> minuteInt+ arbitrary = HHMM <$> hourInt <*> minuteInt++instance Arbitrary OrgTime where+ arbitrary :: Gen OrgTime+ arbitrary = oneof+ [ MomentInTime <$> arbitrary+ , TimeSpan <$> arbitrary <*> arbitrary+ ] ------------------------------------------------------------------------ -- Util
@@ -0,0 +1,635 @@+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module WindowNavigation where++import Test.Hspec++import qualified Data.Map as M+import qualified Data.Set as S+import Data.Functor.Identity++import XMonad+import XMonad.Util.Types (Direction2D(..))+import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState)+import qualified XMonad.StackSet as W++spec :: Spec+spec = do+ it "two-window adjacent go right (empty state)" $ do+ -- Simplest case - just move the focus once.+ -- ┌─────┬──────┐+ -- │ 1 ──┼─► 2 │+ -- └─────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)+ runNav R M.empty (mkws 1 [] [2])+ `shouldBe` (mkstate 960 640, mkws 2 [1] [])++ it "two-window adjacent go right (populated state)" $ do+ -- Like the previous test, but this time internal stat is already populated with a position.+ -- ┌─────┬──────┐+ -- │ 1 ──┼─► 2 │+ -- └─────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)+ runNav R (mkstate 100 100) (mkws 1 [] [2])+ `shouldBe` (mkstate 960 100, mkws 2 [1] [])++ it "two-window adjacent go right (incorrectly-populated state)" $ do+ -- This time we set the position incorrectly, testing if it will be reset to the center of focused window.+ -- ┌─────┬──────┐+ -- │ 1 ──┼─► 2 │+ -- └─────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)+ runNav R (mkstate 1000 100) (mkws 1 [] [2])+ `shouldBe` (mkstate 960 640, mkws 2 [1] [])++ it "swap windows" $ do+ -- Swap windows around.+ -- ┌─────┬──────┐+ -- │ 1 ◄─┼─► 2 │+ -- └─────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ ]+ runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))+ `shouldBe` (mkstate 960 640, mkws 1 [2] [])++ it "tall layout, go up" $ do+ -- ┌─────┬─────┐+ -- │ │ 2 ▲ │+ -- │ 1 ├───┼─┤+ -- │ │ 3 │ │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 640)+ , (3, Rectangle 960 640 960 640)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect)+ runNav U M.empty (mkws 3 [] [1, 2])+ `shouldBe` (mkstate 1440 639, mkws 2 [1, 3] [])++ it "tall layout, go down" $ do+ -- ┌─────┬─────┐+ -- │ │ 2 │+ -- │ ├─────┤+ -- │ 1 │ 3 │ │+ -- │ ├───┼─┤+ -- │ │ 4 ▼ │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ runNav D M.empty (mkws 3 [] [1, 2, 4])+ `shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] [])++ it "tall layout, go left" $ do+ -- ┌─────┬─────┐+ -- │ ◄─┼── 2 │+ -- │ ├─────┤+ -- │ 1 │ 3 │+ -- │ ├─────┤+ -- │ │ 4 │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ runNav L M.empty (mkws 2 [] [1, 3, 4])+ `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])++ it "tall layout, go left and then right (window 2)" $ do+ -- ┌─────┬─────┐+ -- │ ◄─┼── 2 │+ -- │ ──┼─► │+ -- │ ├─────┤+ -- │ 1 │ 3 │+ -- │ ├─────┤+ -- │ │ 4 │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4])+ (st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4])++ it "tall layout, go left and then right (window 3)" $ do+ -- ┌─────┬─────┐+ -- │ │ 2 │+ -- │ ├─────┤+ -- │ 1 ◄─┼── 3 │+ -- │ ──┼─► │+ -- │ ├─────┤+ -- │ │ 4 │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4])+ (st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4])++ it "tall layout, go left and then right (window 4)" $ do+ -- ┌─────┬─────┐+ -- │ │ 2 │+ -- │ ├─────┤+ -- │ 1 │ 3 │+ -- │ ├─────┤+ -- │ ◄─┼── 4 │+ -- │ ──┼─► │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3])+ (st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3])++ it "grid layout, go in a circle" $ do+ -- ┌─────┬─────┐+ -- │ 1 ──┼─► 2 │+ -- │ │ │+ -- │ ▲ │ │ │+ -- ├─┼───┼───┼─┤+ -- │ │ │ ▼ │+ -- │ │ │+ -- │ 3 ◄─┼── 4 │+ -- └─────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 640)+ , (2, Rectangle 960 0 960 640)+ , (3, Rectangle 0 640 960 640)+ , (4, Rectangle 960 640 960 640)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4])+ (st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4])+ let (st3, ws3) = runNav D st2 ws2+ (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] [])+ let (st4, ws4) = runNav L st3 ws3+ (st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4])+ let (st5, ws5) = runNav U st4 ws4+ (st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4])++ it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do+ -- ┌─────┬──────┬──────┐+ -- │ ┌───┴──────┴────┐ │+ -- │ │ | 4 | │ │+ -- │ └───┬──────┬────┘ │+ -- │ 1 │ 2 ──┼─► 3 │+ -- └─────┴──────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 600 1280)+ , (2, Rectangle 600 0 600 1280)+ , (3, Rectangle 1200 0 720 1280)+ , (4, Rectangle 200 200 1520 400)+ ]+ runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect))+ `shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4])++ it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do+ -- ┌─────────────────┐+ -- │ ┌──────┐ │+ -- │ 1 │ │ │+ -- ├─────┤------├────┤+ -- │ │ │ │+ -- │ 2 │ 4 ──┼─► │+ -- │ │ │ │+ -- ├─────┤------├────┤+ -- │ 3 │ │ │+ -- │ └──────┘ │+ -- └─────────────────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 1920 400)+ , (2, Rectangle 0 400 1920 400)+ , (3, Rectangle 0 800 1920 480)+ , (4, Rectangle 800 200 400 880)+ ]+ runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect))+ `shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3])++ it "go from inner window to outer" $ do+ -- ┌───────────────┐+ -- │ ┌──────┐ │+ -- │ 1 ◄─┼── 2 │ │+ -- │ └──────┘ │+ -- └───────────────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 1920 1280)+ , (2, Rectangle 600 600 600 600)+ ]+ runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect))+ `shouldBe` (mkstate 599 900, mkws 1 [2] [])++ it "if there are multiple outer windows, go to the smaller one" $ do+ -- ┌────────────────────────┐+ -- │ ┌───────────────┐ │+ -- │ │ ┌──────┐ │ │+ -- │ │ 2 ◄─┼── 3 │ │ 1 │+ -- │ │ └──────┘ │ │+ -- │ └───────────────┘ │+ -- └────────────────────────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 1920 1280)+ , (2, Rectangle 200 200 1520 880)+ , (3, Rectangle 400 400 400 400)+ ]+ runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect))+ `shouldBe` (mkstate 399 600, mkws 2 [1, 3] [])++ it "two tiled and one floating, floating fully inside" $ do+ -- ┌───────────────────┬─────┐+ -- │ ┌───────┐ │ │+ -- │ ──┼─► ──┼─► ──┼─► │+ -- │ │ 3 │ 1 │ 2 │+ -- │ │ ◄─┼── ◄─┼── │+ -- │ └───────┘ │ │+ -- └───────────────────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ , (3, Rectangle 400 400 400 400)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)+ let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3])+ (st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] [])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3])+ let (st4, ws4) = runNav R st3 ws3+ (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3])+ let (st5, ws5) = runNav L st4 ws4+ (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3])+ let (st6, ws6) = runNav L st5 ws5+ (st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] [])++ it "two floating windows inside one big tiled one" $ do+ -- ┌─────────┐+ -- │ │ │+ -- │ ┌──┼──┐ │+ -- │ │ ▼ │ │+ -- │ │ 3 │ │+ -- │ └──┼──┘ │+ -- │ ▼ │+ -- │ 1 │+ -- │ ┌──┼──┐ │+ -- │ │ ▼ │ │+ -- │ │ 4 │ │+ -- │ └──┼──┘ │+ -- │ ▼ │+ -- ├────┼────┤+ -- │ ▼ │+ -- │ 2 │+ -- └─────────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 1920 640)+ , (2, Rectangle 0 640 1920 640)+ , (3, Rectangle 200 200 100 100)+ , (4, Rectangle 1000 400 100 100)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4])+ (st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4])+ let (st3, ws3) = runNav D st2 ws2+ (st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4])+ let (st4, ws4) = runNav D st3 ws3+ (st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] [])+ let (st5, ws5) = runNav D st4 ws4+ (st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4])+ let (st6, ws6) = runNav D st5 ws5+ (st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4])++ it "floating window between two tiled ones" $ do+ -- ┌───────┬────────┐+ -- │ 1 ┌───┴───┐ 2 │+ -- │ ──┼─► 3 ──┼─► │+ -- │ └───┬───┘ │+ -- └───────┴────────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ , (3, Rectangle 860 540 200 200)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)+ let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3])+ (st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] [])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3])++ it "floating window overlapping four tiled ones" $ do+ -- ┌───────┬───────┐+ -- │ ┌───┴───┐ │+ -- │ 1 │ │ 2 │+ -- ├───┤ ├───┤+ -- │ ──┼─► 5 ──┼─► │+ -- │ 3 └───┬───┘ 4 │+ -- └───────┴───────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 640)+ , (2, Rectangle 960 0 960 640)+ , (3, Rectangle 0 640 960 640)+ , (4, Rectangle 960 640 960 640)+ , (5, Rectangle 760 440 400 400)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)+ let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5])+ (st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] [])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5])++ it "sequential inner floating windows" $ do+ -- ┌───────────────────────────────────┬──────┐+ -- │ ┌───────┐ │ │+ -- │ │ │ ┌───────┐ │ │+ -- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─► ──┼─► 2 │+ -- │ ◄─┼── ◄─┼── ◄─┼── ◄─┼── ◄─┼── │+ -- │ └───────┘ │ │ │ │+ -- │ └───────┘ │ │+ -- └───────────────────────────────────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ , (3, Rectangle 200 200 200 200)+ , (4, Rectangle 600 600 200 200)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4])+ (st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4])+ let (st4, ws4) = runNav R st3 ws3+ (st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] [])+ let (st5, ws5) = runNav R st4 ws4+ (st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4])+ let (st6, ws6) = runNav R st5 ws5+ (st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4])+ let (st7, ws7) = runNav L st6 ws6+ (st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4])+ let (st8, ws8) = runNav L st7 ws7+ (st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] [])+ let (st9, ws9) = runNav L st8 ws8+ (st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4])+ let (st10, ws10) = runNav L st9 ws9+ (st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4])+ let (st11, ws11) = runNav L st10 ws10+ (st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4])++ it "overlapping inner floating windows" $ do+ -- ┌─────────────────────┬──────┐+ -- │ ┌─────────┐ │ │+ -- │ │ 3 ┌────┴─┐ │ │+ -- │ │ ──┼─► ──┼─► 1 ──┼─► 2 │+ -- │ │ ◄─┼── ◄─┼── ◄─┼── │+ -- │ │ │ 4 │ │ │+ -- │ └────┤ │ │ │+ -- │ └──────┘ │ │+ -- └─────────────────────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ , (3, Rectangle 200 200 400 400)+ , (4, Rectangle 300 300 400 400)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)+ let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4])+ (st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] [])+ let (st3, ws3) = runNav R st2 ws2+ (st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4])+ let (st4, ws4) = runNav R st3 ws3+ (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4])+ let (st5, ws5) = runNav L st4 ws4+ (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4])+ let (st6, ws6) = runNav L st5 ws5+ (st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] [])+ let (st7, ws7) = runNav L st6 ws6+ (st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4])++ it "bounce back from the wall to the floating window" $ do+ -- ┌────────────────┬─────┐+ -- │ 1 ┌──────┐ │ │+ -- │ ┌───┼─► 3 │ │ 2 │+ -- │ └── │ │ │ │+ -- │ └──────┘ │ │+ -- └────────────────┴─────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 1280)+ , (3, Rectangle 400 400 200 200)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)+ runNav L (mkstate 100 640) (mkws 1 [] [2, 3])+ `shouldBe` (mkstate 400 599, mkws 3 [2, 1] [])++ it "jump between screens" $ do+ -- ┌─────┬──────┐ ┌────────┐+ -- │ │ 2 │ │ 5 │+ -- │ ├──────┤ ├────────┤+ -- │ 1 │ 3 ──┼──┼─► 6 │+ -- │ ├──────┤ └────────┘+ -- │ │ 4 │+ -- └─────┴──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ , (5, Rectangle 1920 0 1280 384)+ , (6, Rectangle 1920 384 1280 384)+ ]+ initWindowSet =+ W.StackSet+ { W.current =+ W.Screen+ { W.workspace =+ W.Workspace+ { W.tag = "A"+ , W.layout = Layout NullLayout+ , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }+ }+ , W.screen = 1+ , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }+ }+ , W.visible =+ [ W.Screen+ { W.workspace =+ W.Workspace+ { W.tag = "B"+ , W.layout = Layout NullLayout+ , W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] }+ }+ , W.screen = 2+ , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }+ }+ ]+ , W.hidden = []+ , W.floating = M.empty+ }+ expectedWindowSet =+ W.StackSet+ { W.current =+ W.Screen+ { W.workspace =+ W.Workspace+ { W.tag = "B"+ , W.layout = Layout NullLayout+ , W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] }+ }+ , W.screen = 2+ , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }+ }+ , W.visible =+ [ W.Screen+ { W.workspace =+ W.Workspace+ { W.tag = "A"+ , W.layout = Layout NullLayout+ , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }+ }+ , W.screen = 1+ , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }+ }+ ]+ , W.hidden = []+ , W.floating = M.empty+ }++ runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect))+ `shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet)++ it "floating window overlapping fully in the orthogonal direction" $ do+ -- ┌─────┬──────────────────┐+ -- │ │ ┌───────┐ │+ -- │ │ 2 │ │ │+ -- │ ├──────┤-------├───┤+ -- │ 1 │ 3 │ │ 3 │+ -- │ ◄─┼── ◄─┼── 5 ◄─┼── │+ -- │ ├──────┤-------├───┤+ -- │ │ 4 │ │ │+ -- │ │ └───────┘ │+ -- └─────┴──────────────────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 960 0 960 400)+ , (3, Rectangle 960 400 960 400)+ , (4, Rectangle 960 800 960 480)+ , (5, Rectangle 1360 200 200 800)+ ]+ runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)+ let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5])+ (st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] [])+ let (st3, ws3) = runNav L st2 ws2+ (st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5])+ let (st4, ws4) = runNav L st3 ws3+ (st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5])++ it "navigation to free-floating windows on the same screen" $ do+ -- ┌──────┐+ -- │ │ ┌──────┐+ -- │ │ │ │+ -- │ ──┼──┼─► 2 │+ -- │ │ │ │+ -- │ 1 │ └──────┘+ -- │ │+ -- │ │+ -- └──────┘+ let windowRect w =+ Identity $ M.lookup w $ M.fromList+ [ (1, Rectangle 0 0 960 1280)+ , (2, Rectangle 1200 400 400 400)+ ]+ runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))+ `shouldBe` (mkstate 1200 640, mkws 2 [1] [])++ it "switch between windows in Full layout" $ do+ let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)]+ runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect))+ `shouldBe` (M.empty, mkws 2 [1] [3])++data NullLayout a = NullLayout deriving (Show, Read, Eq)+instance LayoutClass NullLayout a++-- to make WindowSets comparable+instance Eq (Layout w) where+ (==) a b = show a == show b+ (/=) a b = show a /= show b++-- make a state with a position for a single workspace+mkstate :: Position -> Position -> WNState+mkstate px py = M.fromList [("A", Point px py)]++-- make a single-workspace WindowSet+mkws :: Window -> [Window] -> [Window] -> WindowSet+mkws focusedWindow upWindows downWindows = W.StackSet+ { W.current = W.Screen+ { W.workspace = W.Workspace+ { W.tag = "A"+ , W.layout = Layout NullLayout+ , W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows }+ }+ , W.screen = 1+ , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }+ }+ , W.visible = []+ , W.hidden = []+ , W.floating = M.empty+ }
xmonad-contrib.cabal view
@@ -1,5 +1,5 @@ name: xmonad-contrib-version: 0.18.0+version: 0.18.1 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_* homepage: https://xmonad.org/@@ -38,7 +38,7 @@ build-type: Simple bug-reports: https://github.com/xmonad/xmonad-contrib/issues -tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1+tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.6 || == 9.8.2 || == 9.10.1 source-repository head type: git@@ -54,29 +54,30 @@ manual: True library- build-depends: base >= 4.11 && < 5,+ build-depends: base >= 4.12 && < 5, bytestring >= 0.10 && < 0.13, containers >= 0.5 && < 0.8, directory, filepath,- time >= 1.8 && < 1.13,+ time >= 1.8 && < 1.15, process, random, mtl >= 1 && < 3,+ transformers, unix, X11 >= 1.10 && < 1.11,- xmonad >= 0.16.99999 && < 0.19,+ xmonad >= 0.18.0 && < 0.19, utf8-string, deepseq default-language: Haskell2010 cpp-options: -DXMONAD_CONTRIB_VERSION_MAJOR=0 -DXMONAD_CONTRIB_VERSION_MINOR=18- -DXMONAD_CONTRIB_VERSION_PATCH=0+ -DXMONAD_CONTRIB_VERSION_PATCH=1 ghc-options: -Wall -Wno-unused-do-bind if flag(pedantic)- ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports+ ghc-options: -Werror -Wwarn=deprecations -- Keep this in sync with the oldest version in 'tested-with' if impl(ghc > 8.6.5)@@ -130,6 +131,7 @@ XMonad.Actions.PhysicalScreens XMonad.Actions.Plane XMonad.Actions.Prefix+ XMonad.Actions.Profiles XMonad.Actions.Promote XMonad.Actions.RandomBackground XMonad.Actions.RepeatAction@@ -191,6 +193,7 @@ XMonad.Hooks.EwmhDesktops XMonad.Hooks.FadeInactive XMonad.Hooks.FadeWindows+ XMonad.Hooks.FloatConfigureReq XMonad.Hooks.FloatNext XMonad.Hooks.Focus XMonad.Hooks.InsertPosition@@ -234,6 +237,7 @@ XMonad.Layout.Circle XMonad.Layout.CircleEx XMonad.Layout.Column+ XMonad.Layout.Columns XMonad.Layout.Combo XMonad.Layout.ComboP XMonad.Layout.Cross@@ -425,7 +429,9 @@ RotateSome Selective SwapWorkspaces+ WindowNavigation Utils+ XMonad.Actions.CopyWindow XMonad.Actions.CycleRecentWS XMonad.Actions.CycleWS XMonad.Actions.FocusNth@@ -437,10 +443,13 @@ XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.WindowBringer+ XMonad.Actions.WindowGo+ XMonad.Actions.WindowNavigation XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.UrgencyHook XMonad.Hooks.WorkspaceHistory+ XMonad.Hooks.StatusBar.PP XMonad.Layout.Decoration XMonad.Layout.LayoutModifier XMonad.Layout.LimitWindows@@ -474,13 +483,13 @@ XMonad.Util.XUtils XPrompt hs-source-dirs: tests, .- build-depends: base+ build-depends: base >= 4.12 && < 5 , QuickCheck >= 2 , X11 >= 1.10 && < 1.11 , bytestring >= 0.10 && < 0.13 , containers , directory- , time >= 1.8 && < 1.13+ , time >= 1.8 && < 1.15 , hspec >= 2.4.0 && < 3 , mtl , random@@ -494,7 +503,7 @@ default-language: Haskell2010 if flag(pedantic)- ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports+ ghc-options: -Werror -Wwarn=deprecations -- Keep this in sync with the oldest version in 'tested-with' if impl(ghc > 8.6.5)