From 6ab4d9c0bc1256f8d4892afcee97cce3b1b76890 Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 16 Nov 2020 14:16:19 +0100 Subject: [PATCH 01/10] XMonad.Prompt.Window: Remove deprecations --- XMonad/Prompt/Window.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs index 2e116335..2d7d59d5 100644 --- a/XMonad/Prompt/Window.hs +++ b/XMonad/Prompt/Window.hs @@ -26,11 +26,6 @@ module XMonad.Prompt.Window allApplications, wsWindows, XWindowMap, - - -- * Deprecated - windowPromptGoto, - windowPromptBring, - windowPromptBringCopy, ) where import XMonad.Prelude (forM) @@ -112,15 +107,6 @@ instance XPrompt WindowModePrompt where bringCopyAction = winAction bringCopyWindow bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s) --- | Deprecated. Use windowPrompt instead. -{-# DEPRECATED windowPromptGoto "Use windowPrompt instead." #-} -{-# DEPRECATED windowPromptBring "Use windowPrompt instead." #-} -{-# DEPRECATED windowPromptBringCopy "Use windowPrompt instead." #-} -windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () -windowPromptGoto c = windowPrompt c Goto windowMap -windowPromptBring c = windowPrompt c Bring windowMap -windowPromptBringCopy c = windowPrompt c BringCopy windowMap - -- | A helper to get the map of all windows. allWindows :: XWindowMap allWindows = windowMap From 16701c2df2990f92a9ffbb13e8532ce7e3f4d9e1 Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 16 Nov 2020 14:28:17 +0100 Subject: [PATCH 02/10] XMonad.Actions.MessageFeedback: Remove deprecations --- XMonad/Actions/MessageFeedback.hs | 49 ------------------------------- 1 file changed, 49 deletions(-) diff --git a/XMonad/Actions/MessageFeedback.hs b/XMonad/Actions/MessageFeedback.hs index b0305ac2..58df3721 100644 --- a/XMonad/Actions/MessageFeedback.hs +++ b/XMonad/Actions/MessageFeedback.hs @@ -42,12 +42,6 @@ module XMonad.Actions.MessageFeedback -- ** Aliases , sm - - -- * Backwards Compatibility - -- $backwardsCompatibility - , send, sendSM, sendSM_ - , tryInOrder, tryInOrder_ - , tryMessage, tryMessage_ ) where import XMonad ( Window ) @@ -230,46 +224,3 @@ tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m -- | Convenience shorthand for 'SomeMessage'. sm :: Message a => a -> SomeMessage sm = SomeMessage - --------------------------------------------------------------------------------- --- Backwards Compatibility: --------------------------------------------------------------------------------- -{-# DEPRECATED send "Use sendMessageB instead." #-} -{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-} -{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-} -{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-} -{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-} -{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-} -{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-} - --- $backwardsCompatibility --- The following functions exist solely for compatibility with pre-0.14 --- releases. - --- | See 'sendMessageWithNoRefreshToCurrentB'. -send :: Message a => a -> X Bool -send = sendMessageWithNoRefreshToCurrentB - --- | See 'sendSomeMessageWithNoRefreshToCurrentB'. -sendSM :: SomeMessage -> X Bool -sendSM = sendSomeMessageWithNoRefreshToCurrentB - --- | See 'sendSomeMessageWithNoRefreshToCurrent'. -sendSM_ :: SomeMessage -> X () -sendSM_ = sendSomeMessageWithNoRefreshToCurrent - --- | See 'tryInOrderWithNoRefreshToCurrentB'. -tryInOrder :: [SomeMessage] -> X Bool -tryInOrder = tryInOrderWithNoRefreshToCurrentB - --- | See 'tryInOrderWithNoRefreshToCurrent'. -tryInOrder_ :: [SomeMessage] -> X () -tryInOrder_ = tryInOrderWithNoRefreshToCurrent - --- | See 'tryMessageWithNoRefreshToCurrentB'. -tryMessage :: (Message a, Message b) => a -> b -> X Bool -tryMessage = tryMessageWithNoRefreshToCurrentB - --- | See 'tryMessageWithNoRefreshToCurrent'. -tryMessage_ :: (Message a, Message b) => a -> b -> X () -tryMessage_ = tryMessageWithNoRefreshToCurrent From d8a23d47bfbcb88678e7fe8b5d7af708aecf6024 Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 16 Nov 2020 14:45:14 +0100 Subject: [PATCH 03/10] XMonad.Layout.Spacing: Remove deprecations --- XMonad/Layout/Spacing.hs | 36 ------------------------------------ 1 file changed, 36 deletions(-) diff --git a/XMonad/Layout/Spacing.hs b/XMonad/Layout/Spacing.hs index 306c3f03..08e23643 100644 --- a/XMonad/Layout/Spacing.hs +++ b/XMonad/Layout/Spacing.hs @@ -41,12 +41,6 @@ module XMonad.Layout.Spacing -- * Modify Borders , Border (..) , borderMap, borderIncrementBy - - -- * Backwards Compatibility - , SpacingWithEdge - , SmartSpacing, SmartSpacingWithEdge - , ModifySpacing (..) - , setSpacing, incSpacing ) where import XMonad @@ -220,9 +214,6 @@ instance Eq a => LayoutModifier Spacing a where = Just $ s { windowBorder = f wb } | Just (ModifyWindowBorderEnabled f) <- fromMessage m = Just $ s { windowBorderEnabled = f wbe } - | Just (ModifySpacing f) <- fromMessage m - = Just $ let f' = borderMap (fromIntegral . f . fromIntegral) - in s { screenBorder = f' sb, windowBorder = f' wb } | otherwise = Nothing @@ -365,25 +356,6 @@ orderSelect o (lt,eq,gt) = case o of ----------------------------------------------------------------------------- -- Backwards Compatibility: ----------------------------------------------------------------------------- -{-# DEPRECATED SpacingWithEdge, SmartSpacing, SmartSpacingWithEdge "Use Spacing instead." #-} -{-# DEPRECATED ModifySpacing "Use SpacingModifier instead, perhaps with sendMessages." #-} -{-# DEPRECATED setSpacing "Use setScreenWindowSpacing instead." #-} -{-# DEPRECATED incSpacing "Use incScreenWindowSpacing instead." #-} - --- | A type synonym for the 'Spacing' 'LayoutModifier'. -type SpacingWithEdge = Spacing - --- | A type synonym for the 'Spacing' 'LayoutModifier'. -type SmartSpacing = Spacing - --- | A type synonym for the 'Spacing' 'LayoutModifier'. -type SmartSpacingWithEdge = Spacing - --- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of --- the screen spacing and window spacing. See 'SpacingModifier'. -newtype ModifySpacing = ModifySpacing (Int -> Int) - -instance Message ModifySpacing -- | Surround all windows by a certain number of pixels of blank space. See -- 'spacingRaw'. @@ -410,11 +382,3 @@ smartSpacing i = spacingRaw True (uniformBorder 0) False (uniformBorder i') True smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True where i' = fromIntegral i - --- | See 'setScreenWindowSpacing'. -setSpacing :: Int -> X () -setSpacing = setScreenWindowSpacing . fromIntegral - --- | See 'incScreenWindowSpacing'. -incSpacing :: Int -> X () -incSpacing = incScreenWindowSpacing . fromIntegral From 287b8bf95f0400b382a238b07e37c414d564a7c4 Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 16 Nov 2020 14:46:17 +0100 Subject: [PATCH 04/10] XMonad.Layout.Navigation2D: Remove deprecations --- XMonad/Actions/Navigation2D.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs index 1e0eaac4..1769204a 100644 --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -46,7 +46,6 @@ module XMonad.Actions.Navigation2D ( -- * Usage , sideNavigation , sideNavigationWithBias , hybridOf - , hybridNavigation , fullScreenRect , singleWindowRect , switchLayer @@ -359,10 +358,6 @@ hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2 where applyToBoth f g a b c = f a b c <|> g a b c -{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-} -hybridNavigation :: Navigation2D -hybridNavigation = hybridOf lineNavigation centerNavigation - -- | Stores the configuration of directional navigation. The 'Default' instance -- uses line navigation for the tiled layer and for navigation between screens, -- and center navigation for the float layer. No custom navigation strategies From 6f49a9394f542a54fc70c82c0705df68bf5ed5eb Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 23 Nov 2020 11:31:02 +0100 Subject: [PATCH 05/10] XMonad.Hooks.ICCCMFocus: Remove --- XMonad/Hooks/ICCCMFocus.hs | 42 -------------------------------------- xmonad-contrib.cabal | 1 - 2 files changed, 43 deletions(-) delete mode 100644 XMonad/Hooks/ICCCMFocus.hs diff --git a/XMonad/Hooks/ICCCMFocus.hs b/XMonad/Hooks/ICCCMFocus.hs deleted file mode 100644 index d1ade74a..00000000 --- a/XMonad/Hooks/ICCCMFocus.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.ICCCMFocus --- Description : Deprecated. --- License : BSD --- --- Maintainer : Tony Morris --- --- Implemented in your @logHook@, Java swing applications will not misbehave --- when it comes to taking and losing focus. --- --- This has been done by taking the patch in and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@. --- --- @ --- conf' = --- conf { --- logHook = takeTopFocus --- } --- @ ------------------------------------------------------------------------------ -module XMonad.Hooks.ICCCMFocus -{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-} -( - atom_WM_TAKE_FOCUS -, takeFocusX -, takeTopFocus -) where - -import XMonad -import XMonad.Hooks.SetWMName -import qualified XMonad.StackSet as W - -takeFocusX :: - Window - -> X () -takeFocusX _w = return () - --- | The value to add to your log hook configuration. -takeTopFocus :: - X () -takeTopFocus = - withWindowSet (maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D" diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 976498b0..6ec7b113 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -190,7 +190,6 @@ library XMonad.Hooks.FadeWindows XMonad.Hooks.FloatNext XMonad.Hooks.Focus - XMonad.Hooks.ICCCMFocus XMonad.Hooks.InsertPosition XMonad.Hooks.ManageDebug XMonad.Hooks.ManageDocks From d28c0a242517e12eb6958d3ed27e5c2d94bbb16f Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 23 Nov 2020 11:31:31 +0100 Subject: [PATCH 06/10] XMonad.Layout.LayoutBuilderP: Remove --- XMonad/Layout/LayoutBuilderP.hs | 208 -------------------------------- xmonad-contrib.cabal | 1 - 2 files changed, 209 deletions(-) delete mode 100644 XMonad/Layout/LayoutBuilderP.hs diff --git a/XMonad/Layout/LayoutBuilderP.hs b/XMonad/Layout/LayoutBuilderP.hs deleted file mode 100644 index 867649bf..00000000 --- a/XMonad/Layout/LayoutBuilderP.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.LayoutBuilderP --- Description : (DEPRECATED) An old version of "XMonad.Layout.LayoutBuilderP". --- Copyright : (c) 2009 Anders Engstrom , 2011 Ilya Portnov --- License : BSD3-style (see LICENSE) --- --- Maintainer : Ilya Portnov --- Stability : unstable --- Portability : unportable --- --- DEPRECATED. Use 'XMonad.Layout.LayoutBuilder' instead. --- ------------------------------------------------------------------------------ - -module XMonad.Layout.LayoutBuilderP {-# DEPRECATED "Use XMonad.Layout.LayoutBuilder instead" #-} ( - LayoutP (..), - layoutP, layoutAll, - B.relBox, B.absBox, - -- * Overloading ways to select windows - -- $selectWin - Predicate (..), Proxy(..), - ) where - -import XMonad -import XMonad.Prelude hiding (Const) -import qualified XMonad.StackSet as W -import XMonad.Util.WindowProperties - -import qualified XMonad.Layout.LayoutBuilder as B - --- $selectWin --- --- 'Predicate' exists because layouts are required to be serializable, and --- "XMonad.Util.WindowProperties" is not sufficient (for example it does not --- allow using regular expressions). --- --- compare "XMonad.Util.Invisible" - --- | Type class for predicates. This enables us to manage not only Windows, --- but any objects, for which instance Predicate is defined. --- --- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras -class Predicate p w where - alwaysTrue :: Proxy w -> p -- ^ A predicate that is always True. - checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate - --- | Contains no actual data, but is needed to help select the correct instance --- of 'Predicate' -data Proxy a = Proxy - --- | Data type for our layout. -data LayoutP p l1 l2 a = - LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a)) - deriving (Show,Read) - --- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain. --- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout. -{-# DEPRECATED layoutP "Use XMonad.Layout.LayoutBuilder.layoutP instead." #-} -layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) => - p - -> B.SubBox -- ^ The box to place the windows in - -> Maybe B.SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left - -> l1 a -- ^ The layout to use in the specified area - -> LayoutP p l2 l3 a -- ^ Where to send the remaining windows - -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout -layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next) - --- | Use the specified layout in the described area for all remaining windows. -{-# DEPRECATED layoutAll "Use XMonad.Layout.LayoutBuilder.layoutAll instead." #-} -layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) => - B.SubBox -- ^ The box to place the windows in - -> l1 a -- ^ The layout to use in the specified area - -> LayoutP p l1 Full a -- ^ The resulting layout -layoutAll box sub = - let a = alwaysTrue (Proxy :: Proxy a) - in LayoutP Nothing Nothing a box Nothing sub Nothing - -instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) => - LayoutClass (LayoutP p l1 l2) w where - - -- | Update window locations. - runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect - = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf - let selBox = if isJust nextf' - then box - else fromMaybe box mbox - - (sublist,sub') <- handle sub subs $ calcArea selBox rect - - (nextlist,next') <- case next of Nothing -> return ([],Nothing) - Just n -> do (res,l) <- handle n nexts rect - return (res,Just l) - - return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' ) - where - handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r - let l' = fromMaybe l ml - return (res,l') - - -- | Propagate messages. - handleMessage l m - | Just (IncMasterN _) <- fromMessage m = sendFocus l m - | Just Shrink <- fromMessage m = sendFocus l m - | Just Expand <- fromMessage m = sendFocus l m - | otherwise = sendBoth l m - - -- | Descriptive name for layout. - description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next - description (LayoutP _ _ _ _ _ sub Nothing) = "layoutP "++ description sub - - -sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendSub (LayoutP subf nextf prop box mbox sub next) m = - do sub' <- handleMessage sub m - return $ if isJust sub' - then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') next - else Nothing - -sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m -sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m = - do sub' <- handleMessage sub m - next' <- handleMessage next m - return $ if isJust sub' || isJust next' - then Just $ LayoutP subf nextf prop box mbox (fromMaybe sub sub') (Just $ fromMaybe next next') - else Nothing - -sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing -sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m = - do next' <- handleMessage next m - return $ if isJust next' - then Just $ LayoutP subf nextf prop box mbox sub next' - else Nothing - -sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) - => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) -sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf - if foc then sendSub l m - else sendNext l m - -isFocus :: (Show a) => Maybe a -> X Bool -isFocus Nothing = return False -isFocus (Just w) = do ms <- W.stack . W.workspace . W.current <$> gets windowset - return $ maybe False (\s -> show w == show (W.focus s)) ms - - --- | Split given list of objects (i.e. windows) using predicate. -splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w]) -splitBy prop = foldM step ([], []) - where - step (good, bad) w = do - ok <- checkPredicate prop w - return $ if ok - then (w:good, bad) - else (good, w:bad) - -splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w) -splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing) -splitStack (Just s) prop subf nextf = do - let ws = W.integrate s - (good, other) <- splitBy prop ws - let subf' = foc good subf - nextf' = foc other nextf - return ( differentiate' subf' good - , differentiate' nextf' other - , subf' - , nextf' - ) - where - foc [] _ = Nothing - foc l f - | W.focus s `elem` l = Just $ W.focus s - | maybe False (`elem` l) f = f - | otherwise = Just $ head l - -calcArea :: B.SubBox -> Rectangle -> Rectangle -calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' - where - xpos' = calc False xpos $ rect_width rect - ypos' = calc False ypos $ rect_height rect - width' = calc True width $ rect_width rect - xpos' - height' = calc True height $ rect_height rect - ypos' - - calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ - case val of B.Rel v -> floor $ v * fromIntegral tot - B.Abs v -> if v<0 || (zneg && v==0) - then fromIntegral tot+v - else v - -differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) -differentiate' _ [] = Nothing -differentiate' Nothing w = W.differentiate w -differentiate' (Just f) w - | f `elem` w = Just $ W.Stack { W.focus = f - , W.up = reverse $ takeWhile (/=f) w - , W.down = tail $ dropWhile (/=f) w - } - | otherwise = W.differentiate w - -instance Predicate Property Window where - alwaysTrue _ = Const True - checkPredicate = hasProperty diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 6ec7b113..4966b85a 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -259,7 +259,6 @@ library XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder - XMonad.Layout.LayoutBuilderP XMonad.Layout.LayoutCombinators XMonad.Layout.LayoutHints XMonad.Layout.LayoutModifier From 4a8bd762afd5c25df716d1e66201490761bddb70 Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 23 Nov 2020 11:32:20 +0100 Subject: [PATCH 07/10] XMonad.Hooks.RestoreMinimized: Remove --- XMonad/Hooks/RestoreMinimized.hs | 42 -------------------------------- xmonad-contrib.cabal | 1 - 2 files changed, 43 deletions(-) delete mode 100644 XMonad/Hooks/RestoreMinimized.hs diff --git a/XMonad/Hooks/RestoreMinimized.hs b/XMonad/Hooks/RestoreMinimized.hs deleted file mode 100644 index 66eda6d9..00000000 --- a/XMonad/Hooks/RestoreMinimized.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.RestoreMinimized --- Description : Deprecated: Use XMonad.Hooks.Minimize. --- Copyright : (c) Jan Vornberger 2009 --- License : BSD3-style (see LICENSE) --- --- Maintainer : jan.vornberger@informatik.uni-oldenburg.de --- Stability : unstable --- Portability : not portable --- --- (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized --- windows (see "XMonad.Layout.Minimize") by selecting them on a --- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE). --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.RestoreMinimized - {-# DEPRECATED "Use XMonad.Hooks.Minimize instead, this module has no effect" #-} - ( -- * Usage - -- $usage - RestoreMinimized (..) - , restoreMinimizedEventHook - ) where - -import XMonad.Prelude - -import XMonad - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.RestoreMinimized --- > --- > myHandleEventHook = restoreMinimizedEventHook --- > --- > main = xmonad def { handleEventHook = myHandleEventHook } - -data RestoreMinimized = RestoreMinimized deriving ( Show, Read ) - -restoreMinimizedEventHook :: Event -> X All -restoreMinimizedEventHook _ = return (All True) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 4966b85a..c25ffcb3 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -200,7 +200,6 @@ library XMonad.Hooks.PositionStoreHooks XMonad.Hooks.RefocusLast XMonad.Hooks.Rescreen - XMonad.Hooks.RestoreMinimized XMonad.Hooks.ScreenCorners XMonad.Hooks.Script XMonad.Hooks.ServerMode From 3bf9d80c40b9ec8f2900fe9fffa4fc17627b5b0d Mon Sep 17 00:00:00 2001 From: slotThe Date: Tue, 24 Nov 2020 12:33:56 +0100 Subject: [PATCH 08/10] XMonad.Layout.Named: Deprecate --- XMonad/Config/Bluetile.hs | 12 ++++++------ XMonad/Config/Droundy.hs | 10 +++++----- XMonad/Layout/Groups/Examples.hs | 7 +++---- XMonad/Layout/Groups/Wmii.hs | 5 ++--- XMonad/Layout/LayoutModifier.hs | 2 +- XMonad/Layout/Named.hs | 2 +- 6 files changed, 18 insertions(+), 20 deletions(-) diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index f39fdd17..93086cd8 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -29,7 +29,7 @@ module XMonad.Config.Bluetile ( import XMonad import XMonad.Layout.BorderResize -import XMonad.Layout.BoringWindows +import XMonad.Layout.BoringWindows hiding (Replace) import XMonad.Layout.ButtonDecoration import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons @@ -37,7 +37,7 @@ import XMonad.Layout.DraggingVisualizer import XMonad.Layout.Maximize import XMonad.Layout.Minimize import XMonad.Layout.MouseResizableTile -import XMonad.Layout.Named +import XMonad.Layout.Renamed import XMonad.Layout.NoBorders import XMonad.Layout.PositionStoreFloat import XMonad.Layout.WindowSwitcherDecoration @@ -183,10 +183,10 @@ bluetileManageHook = composeAll , isFullscreen --> doFullFloat] bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ - named "Floating" floating ||| - named "Tiled1" tiled1 ||| - named "Tiled2" tiled2 ||| - named "Fullscreen" fullscreen + renamed [Replace "Floating"] floating ||| + renamed [Replace "Tiled1"] tiled1 ||| + renamed [Replace "Tiled2"] tiled2 ||| + renamed [Replace "Fullscreen"] fullscreen where floating = floatingDeco $ maximize $ borderResize positionStoreFloat tiled1 = tilingDeco $ maximize mouseResizableTileMirrored diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index f4afe848..6fa76f76 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -20,7 +20,7 @@ import System.Exit ( exitSuccess ) import XMonad.Layout.Tabbed ( tabbed, shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) import XMonad.Layout.Combo ( combineTwo ) -import XMonad.Layout.Named ( named ) +import XMonad.Layout.Renamed ( Rename(Replace), renamed ) import XMonad.Layout.LayoutCombinators import XMonad.Layout.Square ( Square(Square) ) import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L), @@ -124,10 +124,10 @@ config = docks $ ewmh def , layoutHook = showWName $ workspaceDir "~" $ boringWindows $ smartBorders $ windowNavigation $ maximizeVertical $ toggleLayouts Full $ avoidStruts $ - named "tabbed" mytab ||| - named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| - named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| - named "widescreen" ((mytab *||* mytab) + renamed [Replace "tabbed"] mytab ||| + renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) ||| + renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| + renamed [Replace "widescreen"] ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5 , terminal = "xterm" -- The preferred terminal program. diff --git a/XMonad/Layout/Groups/Examples.hs b/XMonad/Layout/Groups/Examples.hs index 877ef6bd..fb5e375d 100644 --- a/XMonad/Layout/Groups/Examples.hs +++ b/XMonad/Layout/Groups/Examples.hs @@ -59,7 +59,6 @@ import XMonad.Layout.Groups.Helpers import XMonad.Layout.ZoomRow import XMonad.Layout.Tabbed -import XMonad.Layout.Named import XMonad.Layout.Renamed import XMonad.Layout.Decoration import XMonad.Layout.Simplest @@ -209,13 +208,13 @@ tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c -_tabs = named "Tabs" Simplest +_tabs = renamed [Replace "Tabs"] Simplest _tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l -_vert c = named "Vertical" $ Tall (vNMaster c) (vIncrement c) (vRatio c) +_vert c = renamed [Replace "Vertical"] $ Tall (vNMaster c) (vIncrement c) (vRatio c) -_horiz c = named "Horizontal" $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c) +_horiz c = renamed [Replace "Horizontal"] $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c) -- | Increase the number of master groups by one increaseNMasterGroups :: X () diff --git a/XMonad/Layout/Groups/Wmii.hs b/XMonad/Layout/Groups/Wmii.hs index 26cc711c..714cf4db 100644 --- a/XMonad/Layout/Groups/Wmii.hs +++ b/XMonad/Layout/Groups/Wmii.hs @@ -41,7 +41,6 @@ import XMonad.Layout.Groups.Examples import XMonad.Layout.Groups.Helpers import XMonad.Layout.Tabbed -import XMonad.Layout.Named import XMonad.Layout.Renamed import XMonad.Layout.MessageControl import XMonad.Layout.Simplest @@ -90,8 +89,8 @@ import XMonad.Layout.Simplest -- | A layout inspired by wmii wmii s t = G.group innerLayout zoomRowG - where column = named "Column" $ Tall 0 (3/100) (1/2) - tabs = named "Tabs" Simplest + where column = renamed [Replace "Column"] $ Tall 0 (3/100) (1/2) + tabs = renamed [Replace "Tabs"] Simplest innerLayout = renamed [CutWordsLeft 3] $ addTabs s t $ ignore NextLayout diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index e9d8ffc8..d70ccfe5 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -73,7 +73,7 @@ import XMonad.StackSet ( Stack, Workspace (..) ) -- -- * "XMonad.Layout.Reflect" -- --- * "XMonad.Layout.Named" +-- * "XMonad.Layout.Renamed" -- -- * "XMonad.Layout.WindowNavigation" -- diff --git a/XMonad/Layout/Named.hs b/XMonad/Layout/Named.hs index eebbbe52..a8bca247 100644 --- a/XMonad/Layout/Named.hs +++ b/XMonad/Layout/Named.hs @@ -16,7 +16,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.Named +module XMonad.Layout.Named {-# DEPRECATED "Use XMonad.Layout.Renamed instead" #-} ( -- * Usage -- $usage named, From f02b3a98691d4c51bd8ea2171d6a7ce9a94064a3 Mon Sep 17 00:00:00 2001 From: slotThe Date: Tue, 24 Nov 2020 12:38:37 +0100 Subject: [PATCH 09/10] XMonad.Actions.SinkAll: Deprecate --- XMonad/Actions/SinkAll.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/XMonad/Actions/SinkAll.hs b/XMonad/Actions/SinkAll.hs index 5dd2056e..e0453c3a 100644 --- a/XMonad/Actions/SinkAll.hs +++ b/XMonad/Actions/SinkAll.hs @@ -13,7 +13,7 @@ -- 'sinkAll' function for backwards compatibility. ----------------------------------------------------------------------------- -module XMonad.Actions.SinkAll ( +module XMonad.Actions.SinkAll {-# DEPRECATED "Use XMonad.Actions.WithAll instead" #-} ( -- * Usage -- $usage From 1e3b49f064e743cd7a8ab637549e42a0db2f19ca Mon Sep 17 00:00:00 2001 From: slotThe Date: Mon, 16 Nov 2020 14:59:27 +0100 Subject: [PATCH 10/10] CHANGES: Mention deprecations and removals This reflects the changes made in the following previous commits: - f02b3a98691d4c51bd8ea2171d6a7ce9a94064a3 - 3bf9d80c40b9ec8f2900fe9fffa4fc17627b5b0d - 4a8bd762afd5c25df716d1e66201490761bddb70 - d28c0a242517e12eb6958d3ed27e5c2d94bbb16f - 6f49a9394f542a54fc70c82c0705df68bf5ed5eb - 287b8bf95f0400b382a238b07e37c414d564a7c4 - d8a23d47bfbcb88678e7fe8b5d7af708aecf6024 - 16701c2df2990f92a9ffbb13e8532ce7e3f4d9e1 - 6ab4d9c0bc1256f8d4892afcee97cce3b1b76890 --- CHANGES.md | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 3babef49..6bfd3856 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,10 +4,52 @@ ### Breaking Changes -* `XMonad.Util.NamedScratchpad`: + * `XMonad.Util.NamedScratchpad`: - Deprecated the module; use `XMonad.Util.NamedScratchpad` instead. + * `XMonad.Actions.Navigation2D` + + - Removed deprecated function `hybridNavigation`. + + * `XMonad.Layout.Spacing` + + - Removed deprecated functions `SpacingWithEdge`, `SmartSpacing`, + `SmartSpacingWithEdge`, `ModifySpacing`, `setSpacing`, and + `incSpacing`. + + * `XMonad.Actions.MessageFeedback` + + - Removed deprecated functions `send`, `sendSM`, `sendSM`_, + `tryInOrder`, `tryInOrder`_, `tryMessage`, and `tryMessage`_. + + * `XMonad.Prompt.Window` + + - Removed deprecated functions `windowPromptGoto`, + `windowPromptBring`, and `windowPromptBringCopy`. + + * `XMonad.Hooks.ICCCMFocus` + + - Removed deprecated module. This was merged into xmonad. + + * `XMonad.Layout.LayoutBuilderP` + + - Removed deprecated module; use `XMonad.Layout.LayoutBuilder` + instead. + + * `XMonad.Hooks.RestoreMinimized` + + - Removed deprecated module; use `XMonad.Hooks.Minimize` instead. + + * `XMonad.Layout.Named` + + - Deprecated the entire module, use `XMonad.Layout.Renamed` instead. + + * `XMonad.Actions.SinkAll` + + - Deprecated the entire module, use `XMonad.Actions.WithAll` + instead. + ### New Modules ### Bug Fixes and Minor Changes