mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-09 08:21:51 -07:00
Rewrite minimization-related modules
* Use global state instead of per-layout - so now window is minimized on all workspaces (EWMH requires that windows with _NET_WM_STATE_HIDDEN set should be minimized on any workspace but previously they were not) * Use `windows` instead of `modify`. That should fix bugs related to actions that should be done by `windows` and not done by `modify` (fixes #46) * Mark module X.H.RestoreMinimized as deprecated
This commit is contained in:
37
XMonad/Util/Minimize.hs
Normal file
37
XMonad/Util/Minimize.hs
Normal file
@@ -0,0 +1,37 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Util.Minimize
|
||||
-- Copyright : (c) Bogdan Sinitsyn (2016)
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : bogdan.sinitsyn@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- Stores some common utilities for modules used for window minimizing/maximizing
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
module XMonad.Util.Minimize
|
||||
( RectMap
|
||||
, Minimized(..)
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
type RectMap = M.Map Window (Maybe W.RationalRect)
|
||||
|
||||
data Minimized = Minimized
|
||||
{ rectMap :: RectMap
|
||||
, minimizedStack :: [Window]
|
||||
}
|
||||
deriving (Eq, Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass Minimized where
|
||||
initialValue = Minimized { rectMap = M.empty
|
||||
, minimizedStack = []
|
||||
}
|
||||
extensionType = PersistentExtension
|
Reference in New Issue
Block a user