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:
Bogdan Sinitsyn
2016-10-25 07:02:01 +03:00
parent a226ca62c7
commit c99606bbdd
11 changed files with 205 additions and 101 deletions

37
XMonad/Util/Minimize.hs Normal file
View 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