summaryrefslogtreecommitdiffstats
path: root/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2023-09-12 12:56:39 +0200
committertv <tv@krebsco.de>2023-09-13 16:23:38 +0200
commitfbd485cd86c7e9984819357398f912a2d5510845 (patch)
treee1a9e2eedacfa25018d6b0eef3f4628a4d503ebc /tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks
parent5370e0485788224126861e076110ac705013d2de (diff)
tv: emigrate
Diffstat (limited to 'tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks')
-rw-r--r--tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs117
1 files changed, 0 insertions, 117 deletions
diff --git a/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs b/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
deleted file mode 100644
index bf8431446..000000000
--- a/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs
+++ /dev/null
@@ -1,117 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
-module XMonad.Hooks.EwmhDesktops.Extra where
-
-import Control.Monad (when)
-import Data.Maybe (fromMaybe)
-import Data.Monoid (All)
-import Data.Tuple.Extra (both)
-import Graphics.X11.EWMH (getDesktopNames, setDesktopNames)
-import Graphics.X11.EWMH.Atom (_NET_DESKTOP_NAMES)
-import Graphics.X11.Xlib.Display.Extra (withDefaultDisplay)
-import XMonad hiding (workspaces)
-import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace, removeEmptyWorkspaceByTag)
-import XMonad.StackSet (mapWorkspace, tag, workspaces)
-import XMonad.Util.WorkspaceCompare (getSortByIndex)
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-import qualified XMonad
-
-
-ewmhExtra :: XConfig a -> IO (XConfig a)
-ewmhExtra c = do
- -- XMonad.Hooks.EwmhDesktops.setDesktopViewport uses _NET_DESKTOP_VIEWPORT
- -- only if it exists. This seems to be a harmless issue, but by creating
- -- the atom here, we suppress the error message:
- --
- -- xmonad: X11 error: BadAtom (invalid Atom parameter),
- -- request code=18, error code=5
- --
- _ <-
- withDefaultDisplay $ \dpy -> internAtom dpy "_NET_DESKTOP_VIEWPORT" False
-
- initialWorkspaces <-
- Data.Maybe.fromMaybe (XMonad.workspaces def)
- <$> withDefaultDisplay getDesktopNames
-
- return
- c { handleEventHook = ewmhDesktopsExtraEventHook <> handleEventHook c
- , rootMask = rootMask c .|. propertyChangeMask
- , XMonad.workspaces = initialWorkspaces
- }
-
-ewmhDesktopsExtraEventHook :: Event -> X All
-ewmhDesktopsExtraEventHook = \case
- PropertyEvent{ev_window, ev_atom} -> do
- r <- asks theRoot
- when (ev_window == r && ev_atom == _NET_DESKTOP_NAMES) $
- withDisplay $ \dpy -> do
- sort <- getSortByIndex
-
- oldNames <- gets $ map tag . sort . workspaces . windowset
- newNames <- fromMaybe oldNames <$> io (getDesktopNames dpy)
-
- let
- (renamesFrom, renamesTo) = both Set.fromList $ unzip renames
-
- renames = go oldNames newNames where
- go old@(headOld : tailOld) new@(headNew : tailNew) = do
- let
- deleteOld = Set.member headOld deleteNameSet
- createNew = Set.member headNew createNameSet
-
- if
- | headOld == headNew ->
- -- assert (not deleteOld && not createNew)
- go tailOld tailNew
-
- | deleteOld && createNew ->
- (headOld, headNew) :
- go tailOld tailNew
-
- | deleteOld ->
- go tailOld new
-
- | createNew ->
- go old tailNew
-
- | otherwise ->
- -- assert (headOld == headNew)
- go tailOld tailNew
-
- go _ _ = []
-
- oldNameSet = Set.fromList oldNames
- newNameSet = Set.fromList newNames
- deleteNameSet = Set.difference oldNameSet newNameSet
- createNameSet = Set.difference newNameSet oldNameSet
-
- deleteNames = Set.toAscList $
- Set.difference deleteNameSet renamesFrom
- createNames = Set.toAscList $
- Set.difference createNameSet renamesTo
-
- mapM_ addHiddenWorkspace createNames
- mapM_ removeEmptyWorkspaceByTag deleteNames
- when (not (null renames)) $ do
- let
- renameMap = Map.fromList renames
- rename w =
- case Map.lookup (tag w) renameMap of
- Just newName -> w { tag = newName }
- Nothing -> w
-
- modifyWindowSet $ mapWorkspace rename
-
- names <- gets $ map tag . sort . workspaces . windowset
-
- when (names /= newNames) $ do
- trace $ "setDesktopNames " <> show names
- io (setDesktopNames names dpy)
-
- mempty
-
- _ ->
- mempty