diff --git a/nix/configurations/vanadium/home/xmonad/leanamonad.cabal b/nix/configurations/vanadium/home/xmonad/leanamonad.cabal index de874f27..c1978c6c 100644 --- a/nix/configurations/vanadium/home/xmonad/leanamonad.cabal +++ b/nix/configurations/vanadium/home/xmonad/leanamonad.cabal @@ -24,7 +24,8 @@ library import: common hs-source-dirs: lib exposed-modules: - Leanamonad.Layouts.ReflectMsg + Leanamonad.Layout.ReflectMsg + Leanamonad.Layout.ResizableTile Leanamonad.GreekChar executable leanamonad diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layouts/ReflectMsg.hs b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs similarity index 94% rename from nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layouts/ReflectMsg.hs rename to nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs index f86e4632..8b69af56 100644 --- a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layouts/ReflectMsg.hs +++ b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Leanamonad.Layouts.ReflectMsg where +module Leanamonad.Layout.ReflectMsg where import XMonad ( Resize (Expand, Shrink), diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs new file mode 100644 index 00000000..f12ec245 --- /dev/null +++ b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ResizableTile +-- Description : More useful tiled layout that allows you to change a width\/height of window. +-- Copyright : (c) MATSUYAMA Tomohiro +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : MATSUYAMA Tomohiro +-- Stability : unstable +-- Portability : unportable +-- +-- More useful tiled layout that allows you to change a width\/height of window. +-- +----------------------------------------------------------------------------- + +-- Ported from upstream XMonad.Layout.ResizableTile +-- Related https://github.com/xmonad/xmonad-contrib/issues/954 +module Leanamonad.Layout.ResizableTile ( + -- * Usage + -- $usage + ResizableTall(..), MirrorResize(..) + ) where + +import XMonad hiding (tile, splitVertically, splitHorizontallyBy) +import XMonad.Prelude +import qualified XMonad.StackSet as W +import qualified Data.Map as M + +-- $usage +-- You can use this module with the following in your @xmonad.hs@: +-- +-- > import XMonad.Layout.ResizableTile +-- +-- Then edit your @layoutHook@ by adding the ResizableTile layout: +-- +-- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. +-- > main = xmonad def { layoutHook = myLayout } +-- +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". +-- +-- You may also want to add the following key bindings: +-- +-- > , ((modm, xK_a), sendMessage MirrorShrink) +-- > , ((modm, xK_z), sendMessage MirrorExpand) +-- +-- For detailed instruction on editing the key binding see: +-- +-- . + +data MirrorResize = MirrorShrink | MirrorExpand +instance Message MirrorResize + +data ResizableTall a = ResizableTall + { _nmaster :: Int -- ^ number of master windows + , _delta :: Rational -- ^ change when resizing by 'Shrink', 'Expand', + -- 'MirrorShrink', 'MirrorExpand' + , _frac :: Rational -- ^ width of master + , _slaves :: [Rational] -- ^ fraction to multiply the window + -- height that would be given when divided equally. + -- + -- slave windows are assigned their modified + -- heights in order, from top to bottom + -- + -- unspecified values are replaced by 1 + } deriving (Show, Read) + +instance LayoutClass ResizableTall a where + doLayout (ResizableTall nmaster _ frac mfrac) r = + return . (, Nothing) . + ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate + handleMessage (ResizableTall nmaster delta frac mfrac) m = + do ms <- W.stack . W.workspace . W.current <$> gets windowset + fs <- M.keys . W.floating <$> gets windowset + return $ ms >>= unfloat fs >>= handleMesg + where handleMesg s = msum [fmap resize (fromMessage m) + ,fmap (`mresize` s) (fromMessage m) + ,fmap incmastern (fromMessage m)] + unfloat fs s = if W.focus s `elem` fs + then Nothing + else Just (s { W.up = W.up s \\ fs + , W.down = W.down s \\ fs }) + resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac + resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac + mresize MirrorShrink s = mresize' s delta + mresize MirrorExpand s = mresize' s (negate delta) + mresize' s d = let n = length $ W.up s + total = n + length (W.down s) + 1 + pos = if n == (nmaster-1) || n == (total-1) then n-1 else n + mfrac' = modifymfrac (mfrac ++ repeat 1) d pos + in ResizableTall nmaster delta frac $ take total mfrac' + modifymfrac [] _ _ = [] + modifymfrac (f:fx) d n | n == 0 = f+d : fx + | otherwise = f : modifymfrac fx d (n-1) + incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac + description (ResizableTall {_nmaster}) = "ResizableTall " <> show _nmaster + +tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] +tile f mf r nmaster n = if n <= nmaster || nmaster == 0 + then splitVertically mf n r + else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns + where (r1,r2) = splitHorizontallyBy f r + +splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] +splitVertically [] _ r = [r] +splitVertically _ n r | n < 2 = [r] +splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh : + splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) + where smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) --hmm, this is a fold or map. + +splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) +splitHorizontallyBy f (Rectangle sx sy sw sh) = + ( Rectangle sx sy leftw sh + , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh) + where leftw = floor $ fromIntegral sw * f diff --git a/nix/configurations/vanadium/home/xmonad/xmonad.hs b/nix/configurations/vanadium/home/xmonad/xmonad.hs index 301d0afc..366737db 100644 --- a/nix/configurations/vanadium/home/xmonad/xmonad.hs +++ b/nix/configurations/vanadium/home/xmonad/xmonad.hs @@ -13,7 +13,7 @@ import XMonad.Hooks.StatusBar import XMonad.Layout.NoBorders import XMonad.Layout.Reflect import XMonad.Layout.Renamed -import XMonad.Layout.ResizableTile +-- import XMonad.Layout.ResizableTile import XMonad.Layout.Spacing import qualified XMonad.StackSet as W import XMonad.Util.EZConfig @@ -26,7 +26,8 @@ import qualified Data.Map.Strict as M import System.Posix import Graphics.X11.ExtraTypes.XF86 -import Leanamonad.Layouts.ReflectMsg +import Leanamonad.Layout.ReflectMsg +import Leanamonad.Layout.ResizableTile import Leanamonad.GreekChar main :: IO () @@ -65,7 +66,7 @@ main = putEnv "MOZ_USE_XINPUT2=1" -- Force touchpad for firefox , layoutHook = - let tallr = named "Normal" + let tallr = renamed [ KeepWordsRight 2 ] {- keep "ResizableTall n" -} $ smartSpacingWithEdge 5 $ reflectMsg . reflectHoriz $ ResizableTall 1 (1/10) (3/7) []