From edcbdbc27cecfc44716cc7c43cc35dab37293b6e Mon Sep 17 00:00:00 2001
From: elkowar <5300871+elkowar@users.noreply.github.com>
Date: Thu, 31 Dec 2020 15:09:09 +0100
Subject: [PATCH] Fix support for activate screen X event with
independentscreens
---
files/.config/eww/eww.xml | 2 +
files/.xmonad/lib/Config.hs | 89 +++++----
files/.xmonad/lib/FlexiColumns.hs | 13 ++
files/.xmonad/lib/MultiColumns.hs | 183 +++++++++++++++++++
files/.xmonad/my-xmonad.cabal | 2 +
files/nix-stuff/nixpkgs/overlay/carp-new.nix | 49 +++++
files/nix-stuff/nixpkgs/overlay/default.nix | 1 +
files/nix-stuff/nixpkgs/result | 2 +-
8 files changed, 301 insertions(+), 40 deletions(-)
create mode 100644 files/.xmonad/lib/FlexiColumns.hs
create mode 100644 files/.xmonad/lib/MultiColumns.hs
create mode 100644 files/nix-stuff/nixpkgs/overlay/carp-new.nix
diff --git a/files/.config/eww/eww.xml b/files/.config/eww/eww.xml
index 0c7c693..a2987cd 100644
--- a/files/.config/eww/eww.xml
+++ b/files/.config/eww/eww.xml
@@ -6,6 +6,7 @@
testing {{shit}}
+
notify-send 'ree' 'this is {{shit}}'
@@ -104,6 +105,7 @@
+
diff --git a/files/.xmonad/lib/Config.hs b/files/.xmonad/lib/Config.hs
index 9474ed9..d5be0d2 100644
--- a/files/.xmonad/lib/Config.hs
+++ b/files/.xmonad/lib/Config.hs
@@ -18,18 +18,16 @@ import Data.List ( isPrefixOf
)
import qualified Data.List
import System.Exit (exitSuccess)
-import qualified Data.Char
import qualified Rofi
import qualified DescribedSubmap
import qualified TiledDragging
-import qualified FancyBorders
--import qualified WindowSwallowing
import XMonad.Hooks.WindowSwallowing as WindowSwallowing
-import XMonad.Hooks.WindowedFullscreenFix
+--import XMonad.Hooks.WindowedFullscreenFix
--import XMonad.Util.ActionCycle
import Data.Foldable ( for_ )
@@ -95,12 +93,10 @@ import qualified XMonad.StackSet as W
import qualified XMonad.Util.XSelection as XSel
import qualified XMonad.Layout.PerScreen as PerScreen
import Data.Maybe (catMaybes, maybeToList, fromMaybe)
-import qualified Data.Bifunctor
import Data.Bifunctor
import GHC.IO.Unsafe (unsafePerformIO)
-import qualified Data.List.NonEmpty
-import Control.Monad (msum)
import XMonad.Layout.LayoutModifier
+--import XMonad.Layout.MultiColumns (multiCol)
{-# ANN module "HLint: ignore Redundant $" #-}
{-# ANN module "HLint: ignore Redundant bracket" #-}
{-# ANN module "HLint: ignore Move brackets to avoid $" #-}
@@ -182,11 +178,12 @@ myLayout = noBorders
chonkyScreenLayouts = (rn "UltraTall" $ withGaps $ centeredIfSingle 0.6 resizableThreeCol) ||| horizScreenLayouts
horizScreenLayouts =
- (rn "Tall" $ withGaps $ mouseResizableTile {draggerType = BordersDragger})
- ||| (rn "Horizon" $ withGaps $ mouseResizableTileMirrored {draggerType = BordersDragger})
- ||| (rn "BSP" $ withGaps $ borderResize $ emptyBSP)
+ (rn "Tall" $ withGaps $ centeredIfSingle 0.7 mouseResizableTile {draggerType = BordersDragger})
+ ||| (rn "Horizon" $ withGaps $ mouseResizableTileMirrored {draggerType = BordersDragger})
+ ||| (rn "BSP" $ withGaps $ borderResize $ emptyBSP)
||| (rn "ThreeCol" $ mkTabbed $ withGaps $ resizableThreeCol)
||| (rn "TabbedRow" $ mkTabbed $ withGaps $ zoomRow)
+ -- ||| (rn "Colm" $ mkTabbed $ withGaps $ centeredIfSingle 0.7 (multiCol [1] 2 0.05))
vertScreenLayouts =
((rn "ThreeCol" $ mkTabbed $ withGaps $ Mirror $ reflectHoriz $ ThreeColMid 1 (3/100) (1/2))
@@ -195,7 +192,7 @@ myLayout = noBorders
-- | Simple tall layout with tab support
tabbedTall = rn "Tabbed" . mkTabbed . withGaps $ ResizableTall 1 (3/100) (1/2) []
-- | Specific instance of ResizableThreeCol
- resizableThreeCol = ResizableThreeColMid 1 (3/100) (1/2) []
+ resizableThreeCol = ResizableThreeColMid 1 (3/100) (2/5) []
rn n = renamed [Replace n]
@@ -294,13 +291,6 @@ myMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList
[((modMask' .|. shiftMask, button1), TiledDragging.tiledDrag)]
-multiMonitorOperation :: (WorkspaceId -> WindowSet -> WindowSet) -> ScreenId -> X ()
-multiMonitorOperation operation n = do
- monitor <- screenWorkspace n
- case monitor of
- Just mon -> windows $ operation mon
- Nothing -> return ()
-
-- Default mappings that need to be removed
removedKeys :: [String]
removedKeys = ["M-", "M-S-c", "M-S-q", "M-h", "M-l", "M-j", "M-k", "M-S-"]
@@ -340,22 +330,16 @@ myKeys = concat [ zoomRowBindings, tabbedBindings, multiMonitorBindings, program
windows W.focusMaster)
--- -- TODO remove
--- , ("M-S-l", do
--- result <- cycleActionWithResult "ree" $ Data.List.NonEmpty.fromList [ pure "hi", pure "Ho", pure "test" ]
--- spawn $ "notify-send 'teset' '" ++ result ++ "'"
--- )
-
]
multiMonitorBindings :: [(String, X ())]
multiMonitorBindings =
- [ ("M-s", multiMonitorOperation W.view 2)
- , ("M-a", multiMonitorOperation W.view 1)
- , ("M-d", multiMonitorOperation W.view 0)
- , ("M-S-s", (multiMonitorOperation W.shift 2) >> multiMonitorOperation W.view 2)
- , ("M-S-a", (multiMonitorOperation W.shift 1) >> multiMonitorOperation W.view 1)
- , ("M-S-d", (multiMonitorOperation W.shift 0) >> multiMonitorOperation W.view 0)
+ [ ("M-s", windows $ withFocusedOnScreen 2 W.view)
+ , ("M-a", windows $ withFocusedOnScreen 1 W.view)
+ , ("M-d", windows $ withFocusedOnScreen 0 W.view)
+ , ("M-S-s", windows $ withFocusedOnScreen 2 (\wsp -> W.view wsp >> W.shift wsp))
+ , ("M-S-a", windows $ withFocusedOnScreen 1 (\wsp -> W.view wsp >> W.shift wsp))
+ , ("M-S-d", windows $ withFocusedOnScreen 0 (\wsp -> W.view wsp >> W.shift wsp))
, ("M-C-s", windows swapScreenContents)
]
@@ -422,9 +406,12 @@ myKeys = concat [ zoomRowBindings, tabbedBindings, multiMonitorBindings, program
| wspNum <- [1..9 :: Int]
]
where
+ runActionOnWorkspace :: (VirtualWorkspace -> WindowSet -> WindowSet) -> Int -> X ()
runActionOnWorkspace action wspNum = do
wsps <- workspaces' <$> asks config
- windows $ onCurrentScreen action (wsps !! (wspNum - 1))
+ if length wsps > (wspNum - 1)
+ then windows $ onCurrentScreen action (wsps !! (wspNum - 1))
+ else pure ()
windowControlBindings :: [(String, X ())]
@@ -583,7 +570,7 @@ main = do
, handleEventHook = mconcat [ mySwallowEventHook
, activateWindowEventHook
, handleEventHook Desktop.desktopConfig
- , windowedFullscreenFixEventHook
+ , fullscreenFixEventHook
, Ewmh.ewmhDesktopsEventHook
]
--, handleEventHook = minimizeEventHook <+> handleEventHook def <+> hintsEventHook -- <+> Ewmh.fullscreenEventHook
@@ -612,14 +599,13 @@ activateWindowEventHook (ClientMessageEvent { ev_message_type = messageType, ev_
activateWindowAtom <- getAtom "_NET_ACTIVE_WINDOW"
when (messageType == activateWindowAtom) $
- if window `elem` (concatMap (W.integrate' . W.stack . W.workspace) (W.current ws : W.visible ws))
+ if window `elem` W.allWindows ws
then windows (W.focusWindow window)
else do
shouldRaise <- runQuery (className =? "discord" <||> className =? "web.whatsapp.com") window
if shouldRaise
- then windows (W.shiftWin (W.tag $ W.workspace $ W.current ws) window)
- -- TODO make this respect the independentScreen stuff, such that it doesn't raise a workspace on the wrong monitro
- else windows (W.focusWindow window)
+ then windows (W.shiftWin (W.currentTag ws) window)
+ else withWindowSet $ focusWindowIndependentScreens window
return $ All True
activateWindowEventHook _ = return $ All True
@@ -675,7 +661,6 @@ polybarPP monitor = namedScratchpadFilterOutWorkspacePP . (if useSharedWorkspace
}
where
withMargin = wrap " " " "
- removeWord substr = unwords . filter (/= substr) . words
removeWords wrds = unwords . filter (`notElem` wrds). words
withFont fNum = wrap ("%{T" ++ show (fNum :: Int) ++ "}") "%{T}"
withBG col = wrap ("%{B" ++ col ++ "}") "%{B-}"
@@ -729,6 +714,35 @@ ifLayoutName check onLayoutA onLayoutB = do
-- | Get the name of the active layout.
getActiveLayoutDescription :: X String
getActiveLayoutDescription = (description . W.layout . W.workspace . W.current) <$> gets windowset
+
+
+
+
+-- | Focus a window, switching workspace on the correct Xinerama screen if neccessary - respecting IndependentLayouts
+focusWindowIndependentScreens :: Window -> WindowSet -> X ()
+focusWindowIndependentScreens window ws
+ | Just window == W.peek ws = pure ()
+ | otherwise = case W.findTag window ws of
+ Just tag -> windows $ W.focusWindow window . withFocusedOnScreen (unmarshallS tag) W.view
+ Nothing -> pure ()
+
+
+-- | Get the workspace that is active on a given screen
+screenOnMonitor :: ScreenId -> WindowSet -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
+screenOnMonitor screenId ws = Data.List.find ((screenId ==) . W.screen) (W.current ws : W.visible ws)
+
+
+-- | Convert a function that needs a workspace id into a windowset transformation by providing it with the workspace currently focused on a given screen.
+withFocusedOnScreen
+ :: ScreenId -- ^ screen from which the workspaceId will be taken
+ -> (WorkspaceId -> WindowSet -> WindowSet) -- ^ operation that will be transformed
+ -> (WindowSet -> WindowSet)
+withFocusedOnScreen screenId operation ws =
+ case screenOnMonitor screenId ws of
+ Just wsp -> operation (W.tag $ W.workspace wsp) ws
+ Nothing -> ws
+
+
-- }}}
@@ -795,9 +809,6 @@ getXrdbValue key = fromMaybe "" . findValue key <$> runProcessWithInput "xrdb" [
splitAtTrimming :: String -> Int -> (String, String)
splitAtTrimming str idx = bimap trim trim . (second tail) $ splitAt idx str
- trim :: String -> String
- trim = Data.List.dropWhileEnd (Data.Char.isSpace) . Data.List.dropWhile (Data.Char.isSpace)
-
fuckshit = getActiveLayoutDescription >>= debugShit
diff --git a/files/.xmonad/lib/FlexiColumns.hs b/files/.xmonad/lib/FlexiColumns.hs
new file mode 100644
index 0000000..2a223ee
--- /dev/null
+++ b/files/.xmonad/lib/FlexiColumns.hs
@@ -0,0 +1,13 @@
+
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module MultiColumns where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import Control.Monad
+
+
+
+
+data FlexiColumns = FlexiColumns { colRows :: [Int] }
diff --git a/files/.xmonad/lib/MultiColumns.hs b/files/.xmonad/lib/MultiColumns.hs
new file mode 100644
index 0000000..4e68170
--- /dev/null
+++ b/files/.xmonad/lib/MultiColumns.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Layout.MultiColumns
+-- Copyright : (c) Anders Engstrom
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : Anders Engstrom
+-- Stability : unstable
+-- Portability : unportable
+--
+-- This layout tiles windows in a growing number of columns. The number of
+-- windows in each column can be controlled by messages.
+-----------------------------------------------------------------------------
+
+module MultiColumns (
+ -- * Usage
+ -- $usage
+
+ multiCol,
+ MultiCol,
+ ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import Control.Monad
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.MultiColumns
+--
+-- Then edit your @layoutHook@ by adding the multiCol layout:
+--
+-- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc..
+-- > main = xmonad def { layoutHook = myLayouts }
+--
+-- Or alternatively:
+--
+-- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc..
+-- > main = xmonad def { layoutHook = myLayouts }
+--
+-- The maximum number of windows in a column can be controlled using the
+-- IncMasterN messages and the column containing the focused window will be
+-- modified. If the value is 0, all remaining windows will be placed in that
+-- column when all columns before that has been filled.
+--
+-- The size can be set to between 1 and -0.5. If the value is positive, the
+-- master column will be of that size. The rest of the screen is split among
+-- the other columns. But if the size is negative, it instead indicates the
+-- size of all non-master columns and the master column will cover the rest of
+-- the screen. If the master column would become smaller than the other
+-- columns, the screen is instead split equally among all columns. Therefore,
+-- if equal size among all columns are desired, set the size to -0.5.
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | Layout constructor.
+multiCol
+ :: [Int] -- ^ Windows in each column, starting with master. Set to 0 to catch the rest.
+ -> Int -- ^ Default value for all following columns.
+ -> Rational -- ^ How much to change size each time.
+ -> MultiCol a
+multiCol n defn ds = MultiCol (map (max 0) n) (max 0 defn) ds [0.25, 0.25, 0.25, 0.25] 0
+
+data MultiCol a = MultiCol
+ { multiColNWin :: ![Int]
+ , multiColDefWin :: !Int
+ , multiColDeltaSize :: !Rational
+ , multiColSize :: ![Rational]
+ , multiColActive :: !Int
+ } deriving (Show,Read,Eq)
+
+instance LayoutClass MultiCol a where
+ doLayout l r s = return (combine s rlist, resl)
+ where rlist = doL (multiColSize l') (multiColNWin l') r wlen
+ wlen = length $ W.integrate s
+ -- Make sure the list of columns is big enough and update active column
+ nw = multiColNWin l ++ repeat (multiColDefWin l)
+ newMultiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw
+ newColCnt = length newMultiColNWin - length (multiColNWin l)
+ l' = l { multiColNWin = newMultiColNWin
+ , multiColActive = getCol (length $ W.up s) nw
+ , multiColSize = if newColCnt >= 0 then normalizeFractions $ multiColSize l ++ replicate newColCnt 0.5
+ else normalizeFractions $ reverse . drop (abs newColCnt) $ reverse (multiColSize l)
+ }
+ -- Only return new layout if it has been modified
+ resl = if l'==l
+ then Nothing
+ else Just l'
+ combine (W.Stack foc left right) rs = zip (foc : reverse left ++ right) $ raiseFocused (length left) rs
+ handleMessage l m =
+ return $ msum [ fmap resize (fromMessage m)
+ , fmap incmastern (fromMessage m) ]
+ where
+ resize Shrink = l { multiColSize = changeFractionAt (\x -> x - delta) activeCol (multiColSize l)}
+ resize Expand = l { multiColSize = changeFractionAt (+ delta) activeCol (multiColSize l)}
+
+ --resize Shrink = l { multiColSize = max (-0.5) $ s-ds }
+ --resize Expand = l { multiColSize = min 1 $ s+ds }
+ incmastern (IncMasterN x) = l { multiColNWin = take activeCol n ++ [newval] ++ tail r }
+ where newval = max 0 $ head r + x
+ r = drop activeCol n
+ n = multiColNWin l
+ delta = multiColDeltaSize l
+ activeCol = multiColActive l
+ description _ = "MultiCol"
+
+raiseFocused :: Int -> [a] -> [a]
+raiseFocused n xs = actual ++ before ++ after
+ where (before,rest) = splitAt n xs
+ (actual,after) = splitAt 1 rest
+
+-- | Get which column a window is in, starting at 0.
+getCol :: Int -> [Int] -> Int
+getCol w (n:ns) = if n<1 || w < n
+ then 0
+ else 1 + getCol (w-n) ns
+-- Should never occur...
+getCol _ _ = -1
+
+
+
+doL :: [Rational] -> [Int] -> Rectangle -> Int -> [Rectangle]
+doL ratios nwin r n = rlist
+ where -- Number of columns to tile
+ ncol = getCol (n-1) nwin + 1
+ -- Compute the actual size
+ --size = floor $ abs s * fromIntegral (rect_width r)
+ -- Extract all but last column to tile
+ c = take (ncol-1) nwin
+ -- Compute number of windows in last column and add it to the others
+ col = c ++ [n-sum c]
+ -- Compute width of columns
+ --width = if s>0
+ --then if ncol==1
+ ---- Only one window
+ --then [fromIntegral $ rect_width r]
+ ---- Give the master it's space and split the rest equally for the other columns
+ --else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1))
+ --else if fromIntegral ncol * abs s >= 1
+ ---- Split equally
+ --then replicate ncol $ fromIntegral (rect_width r) `div` ncol
+ ---- Let the master cover what is left...
+ --else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size
+ -- Compute the horizontal position of columns
+ xpos = accumEx (fromIntegral $ rect_x r) width
+ -- Exclusive accumulation
+ accumEx a (x:xs) = a:accumEx (a+x) xs
+ accumEx _ _ = []
+ -- Create a rectangle for each column
+ cr = zipWith (\x w -> r { rect_x=floor x, rect_width=floor w }) xpos width
+ -- Split the columns into the windows
+ rlist = concat $ zipWith splitVertically col cr
+
+ width = map (fromIntegral rw *) ratios
+ where Rectangle _ _ rw _ = r
+
+
+
+
+
+
+
+
+normalizeFractions :: Fractional a => [a] -> [a]
+normalizeFractions list = map (/ total) list
+ where total = sum list
+
+
+changeFractionAt :: Fractional a => (a -> a) -> Int -> [a] -> [a]
+changeFractionAt update idx list = normalizeFractions $ updateAt update idx (normalizeFractions list)
+
+
+
+updateAt :: (a -> a) -> Int -> [a] -> [a]
+updateAt _ _ [] = []
+updateAt f 0 (x:xs) = f x : xs
+updateAt f n (x:xs) = x : updateAt f (n - 1) xs
diff --git a/files/.xmonad/my-xmonad.cabal b/files/.xmonad/my-xmonad.cabal
index 8d99ac0..f36734e 100644
--- a/files/.xmonad/my-xmonad.cabal
+++ b/files/.xmonad/my-xmonad.cabal
@@ -14,6 +14,8 @@ executable my-xmonad
WindowSwallowing
FancyBorders
WsContexts
+ MultiColumns
+ --FlexiColumns
default-language: Haskell2010
ghc-options: -Wall -threaded -fno-warn-missing-signatures
diff --git a/files/nix-stuff/nixpkgs/overlay/carp-new.nix b/files/nix-stuff/nixpkgs/overlay/carp-new.nix
new file mode 100644
index 0000000..413e346
--- /dev/null
+++ b/files/nix-stuff/nixpkgs/overlay/carp-new.nix
@@ -0,0 +1,49 @@
+{ lib, stdenv, fetchFromGitHub, makeWrapper, clang, haskellPackages }:
+
+haskellPackages.mkDerivation rec {
+
+ pname = "carp";
+ version = "0.4.8";
+
+ src = fetchFromGitHub {
+ owner = "carp-lang";
+ repo = "Carp";
+ #rev = "v${version}";
+ rev = "6c551a104b96b8a9b3698a5da738e0bf796076ca";
+ sha256 = "0f20grjpg3xz607lydj7pdrzwibimbk7wfw5r4mg8iwjqgbp22vw";
+ };
+
+ buildDepends = [ makeWrapper ];
+
+ executableHaskellDepends = with haskellPackages; [
+ HUnit blaze-markup blaze-html split cmdargs ansi-terminal cmark
+ edit-distance optparse-applicative hashable open-browser
+ ];
+
+ isExecutable = true;
+
+ # The carp executable must know where to find its core libraries and other
+ # files. Set the environment variable CARP_DIR so that it points to the root
+ # of the Carp repo. See:
+ # https://github.com/carp-lang/Carp/blob/master/docs/Install.md#setting-the-carp_dir
+ #
+ # Also, clang must be available run-time because carp is compiled to C which
+ # is then compiled with clang.
+ postInstall = ''
+ wrapProgram $out/bin/carp \
+ --set CARP_DIR $src \
+ --prefix PATH : ${clang}/bin
+ wrapProgram $out/bin/carp-header-parse \
+ --set CARP_DIR $src \
+ --prefix PATH : ${clang}/bin
+ '';
+
+ description = "A statically typed lisp, without a GC, for real-time applications";
+ homepage = "https://github.com/carp-lang/Carp";
+ license = stdenv.lib.licenses.asl20;
+ maintainers = with stdenv.lib.maintainers; [ jluttine ];
+
+ # Windows not (yet) supported.
+ platforms = with stdenv.lib.platforms; unix ++ darwin;
+
+}
diff --git a/files/nix-stuff/nixpkgs/overlay/default.nix b/files/nix-stuff/nixpkgs/overlay/default.nix
index df44c7c..8adc4d3 100644
--- a/files/nix-stuff/nixpkgs/overlay/default.nix
+++ b/files/nix-stuff/nixpkgs/overlay/default.nix
@@ -6,6 +6,7 @@ self: super: {
bashtop = super.callPackage ../packages/bashtop.nix { };
boox = super.callPackage ../packages/boox.nix { };
cool-retro-term = super.callPackage ./cool-retro-term.nix { cool-retro-term = super.cool-retro-term; };
+ carp-new = super.callPackage ./carp-new.nix {};
liquidctl = super.callPackage ../packages/liquidctl.nix { };
mmutils = super.callPackage ../packages/mmutils.nix { };
nixGL = import sources.nixGL { };
diff --git a/files/nix-stuff/nixpkgs/result b/files/nix-stuff/nixpkgs/result
index 487a42b..c4c2ece 120000
--- a/files/nix-stuff/nixpkgs/result
+++ b/files/nix-stuff/nixpkgs/result
@@ -1 +1 @@
-/nix/store/qyshbwsnbiiwbjanxk6yfsqa8pcbkbyq-options.json
\ No newline at end of file
+/nix/store/g0342b3m9b0c8znl1s7xyibadadw0y0w-glibc-locales-2.32
\ No newline at end of file