From fbd485cd86c7e9984819357398f912a2d5510845 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Tue, 12 Sep 2023 12:56:39 +0200
Subject: tv: emigrate

---
 tv/5pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs     |  14 ---
 .../src/XMonad/Hooks/EwmhDesktops/Extra.hs         | 117 ---------------------
 2 files changed, 131 deletions(-)
 delete mode 100644 tv/5pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs
 delete mode 100644 tv/5pkgs/haskell/xmonad-tv/src/XMonad/Hooks/EwmhDesktops/Extra.hs

(limited to 'tv/5pkgs/haskell/xmonad-tv/src/XMonad')

diff --git a/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs b/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs
deleted file mode 100644
index 74222712..00000000
--- a/tv/5pkgs/haskell/xmonad-tv/src/XMonad/Extra.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module XMonad.Extra where
-
-import XMonad
-import qualified Data.Map as Map
-import qualified XMonad.StackSet as W
-
-
-isFloating :: Window -> WindowSet -> Bool
-isFloating w =
-    Map.member w . W.floating
-
-isFloatingX :: Window -> X Bool
-isFloatingX w =
-    isFloating w <$> gets windowset
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 bf843144..00000000
--- 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
-- 
cgit v1.2.3