diff --git a/XMonad/Util/OneState.hs b/XMonad/Util/OneState.hs new file mode 100644 index 0000000000..9d1502d380 --- /dev/null +++ b/XMonad/Util/OneState.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -Werror #-} + +module XMonad.Util.OneState + ( OneState (..) + , get + , put + , modify + , add + , once + , onceM + ) where + +import Control.Monad ((>=>)) +import Data.Maybe (fromMaybe) +import XMonad hiding (config, get, modify, put, + state, trace) +import qualified XMonad.Util.ExtensibleConf as XC +import qualified XMonad.Util.ExtensibleState as XS + + +{- | + +OneState is a replacement for both @XMonad.Util.ExtensibleState@ and @XMonad.Util.ExtensibleConf@ + +A comparison of these three modules is as follows: + +- @ExtensibleConf@ allows the programmer to accept a user-supplied value at config-time. + However, this value cannot be changed during runtime. + +- @ExtensibleState@ allows the programmer to keep mutable state. + However, the initial value for this state must be known at compile-time and is not + configurable at config-time. + +- @OneState@ proves an API which matches the power of both @ExtensibleConf@ and @ExtensibleState@, + allowing the programmer to keep mutable state *and* allowing this mutable state to be configured + at config-time. + +-} + + +class Typeable state => OneState state where + + -- | Associated type of config-time modifications to state + type Mod state + + -- | + -- + -- How to apply a modification + -- + -- This operation may have effects in the X monad. However, no strong + -- guarantees are made about its evaluation, such as guarantees about + -- timing or multiplicity. Beware! + merge :: Mod state -> (state -> X state) + + -- | Default value for the state + defaultState :: state + + +-- hook into ExtensibleState +newtype State state = State (Maybe state) + deriving (Typeable) + +instance OneState state => ExtensionClass (State state) where + initialValue = State Nothing + +-- hook into ExtensibleConf +newtype Config state = Config [Mod state] + deriving newtype (Typeable, Semigroup) + +trivialConfig :: Config state +trivialConfig = Config [] + + +-- | +-- +-- Like @ExtensibleState.get@ +-- +-- Retrieve the current state value +-- +-- * If the state has been explicitly set during runtime, then the most recent +-- set value will be returned +-- +-- * Otherwise, if the state was configured during config-time, then all the +-- config-time @Mod state@ values will be applied to @defaultState@, and +-- that will be returned +-- +-- * Otherwise, @default@ is returned +get :: forall state. OneState state => X state +get = XS.get >>= \case + State (Just state) -> pure state + State Nothing -> foldConfig + + where + + foldConfig :: X state + foldConfig = do + Config deltas :: Config state <- fromMaybe trivialConfig <$> XC.ask + let bigDelta = foldr (>=>) pure $ merge <$> deltas + result <- bigDelta defaultState + put result -- modifications are monadic; ensure we only perform them once + pure result + + +-- | Like @ExtensibleState.put@ +put :: OneState state => state -> X () +put = XS.put . State . Just + +-- | Like @ExtensibleState.modify@ +modify :: OneState state => (state -> state) -> X () +modify f = put =<< (f <$> get) + + +-- | Like @ExtensibleConf.onceM@ +onceM + :: forall state m l + . (OneState state, Applicative m) + => (XConfig l -> m (XConfig l)) + -> Mod state + -> (XConfig l -> m (XConfig l)) +onceM modX modState = XC.onceM modX (Config @state . one $ modState) + where one x = [x] + +-- | Like @ExtensibleConf.once@ +once + :: forall state l + . OneState state + => (XConfig l -> XConfig l) + -> Mod state + -> (XConfig l -> XConfig l) +once modX modState = XC.once modX (Config @state . one $ modState) + where one x = [x] + +-- | Like @ExtensibleConf.add@ +add :: forall state l. OneState state => Mod state -> (XConfig l -> XConfig l) +add = once @state id diff --git a/XMonad/WorkspaceLayout/Core.hs b/XMonad/WorkspaceLayout/Core.hs new file mode 100644 index 0000000000..c9cb8011d6 --- /dev/null +++ b/XMonad/WorkspaceLayout/Core.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -Werror #-} + +{- | + +Generic operations for workspace layouts + +See 'XMonad.WorkspaceLayout.Grid' + +-} + +module XMonad.WorkspaceLayout.Core where + +import Prelude hiding (span) + +import Control.Category ((>>>)) +import Data.Function (on) +import Data.List (elemIndex) +import GHC.Generics (Generic) +import XMonad hiding (config, modify, state, + trace, workspaces) +import XMonad.Hooks.StatusBar.PP (PP (..)) +import XMonad.StackSet (tag) +import XMonad.Util.WorkspaceCompare (mkWsSort) + + +-- | +-- +-- Encompasses information needed to render a workspace layout +data WorkspaceLayoutView = WSLView + { label :: String + , neighborhood :: [WorkspaceId] + , toName :: WorkspaceId -> String + } deriving (Generic) + + +-- | Render a workspace layout onto an existing 'PP' +modPPWithWorkspaceLayout :: WorkspaceLayoutView -> (PP -> PP) +modPPWithWorkspaceLayout (WSLView { neighborhood, toName, label }) pp = + pp + -- display the workspace names + { ppRename = (fmap . fmap) toName (ppRename pp) + + -- display only a subset of workspaces (the "neighborhood") of the current workspace + , ppSort = do + oldSort <- ppSort pp + newSort <- do + sortIt <- (mkWsSort . pure) (compare `on` flip elemIndex neighborhood) + let filterIt = filter (tag >>> (`elem` neighborhood)) + pure $ filterIt >>> sortIt + pure $ newSort . oldSort + + -- display label to the left + , ppOrder = ppOrder pp >>> (\(ws : rest) -> (label <> ws) : rest) + } diff --git a/XMonad/WorkspaceLayout/Cycle.hs b/XMonad/WorkspaceLayout/Cycle.hs new file mode 100644 index 0000000000..0b7de46e57 --- /dev/null +++ b/XMonad/WorkspaceLayout/Cycle.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall -Werror #-} + +{- | + +Cyclic one-dimensional workspace layouts for XMonad + +This module is intended mostly to serve as another example workspace +layout other than 'XMonad.WorkspaceLayout.Grid'. + +However, a cyclic layout is not particularly useful, and so this +module isn't /really/ intended to be used. Feel free to if you want, +though. It should still work! + +-} + +module XMonad.WorkspaceLayout.Cycle + ( Coord (..) + , Config (..) + , BoundsMode (..) + , move + , swap + , hook + , getView + ) where + +import Prelude + +import Control.Monad.State (execState) +import GHC.Generics (Generic) +import qualified XMonad +import XMonad hiding (config, state, trace, + workspaces) +import XMonad.StackSet (greedyView, shift) + +import qualified XMonad.Util.OneState as St +import XMonad.Util.OneState (OneState (..)) +import XMonad.WorkspaceLayout.Core (WorkspaceLayoutView (..)) +import XMonad.WorkspaceLayout.Util (affineMod, (!%)) + + + +data Coord = Coord + { offset :: Int + , position :: Int + } + deriving (Show, Eq, Ord, Generic) + +data Config = Config + { width :: Int + , workspaces :: [WorkspaceId] + } + deriving (Show, Generic) + +data State = State + { coord :: Coord + , config :: Config + } + deriving (Show, Generic) + +instance OneState State where + type Mod State = State -> State + merge ma s = pure (ma s) + defaultState = State + { coord = Coord 0 0 + , config = Config 5 (single <$> ['a' .. 'j']) + } + where single = (:[]) + + +data BoundsMode = Clamp | Wrap + +move :: BoundsMode -> (Coord -> Coord) -> X () +move mode f = do + (coord', wid') <- calc mode f + St.modify $ \st -> st { coord = coord' } + windows (greedyView wid') + +swap :: BoundsMode -> (Coord -> Coord) -> X () +swap mode f = do + (_, wid') <- calc mode f + windows (shift wid') + +calc :: BoundsMode -> (Coord -> Coord) -> X (Coord, WorkspaceId) +calc mode f = do + State coord (Config { width, workspaces }) <- St.get + let coord' = flip execState coord $ do + modify f + offset' <- offset <$> get + modify $ + let updatePosition = + (let lo = offset' - width `div` 2 + hi = offset' + width `div` 2 + in case mode of + Clamp -> max lo . min hi + Wrap -> affineMod (lo, hi)) + in \st -> st { position = updatePosition (position st) } + let wid = workspaces !% (position coord') + pure (coord', wid) + + +hook :: Config -> XConfig l -> XConfig l +hook config = St.once @State + (\xc -> xc { XMonad.workspaces = workspaces config }) + (\state -> state { config = config }) + +getView :: X WorkspaceLayoutView +getView = do + State (Coord { offset }) (Config { width, workspaces }) <- St.get + pure $ WSLView + { toName = id + , label = "" + , neighborhood = + (do pos <- [offset - width `div` 2 .. offset + width `div` 2] + pure $ workspaces !% (pos `mod` length workspaces) + ) + } + diff --git a/XMonad/WorkspaceLayout/Grid.hs b/XMonad/WorkspaceLayout/Grid.hs new file mode 100644 index 0000000000..9f05fea993 --- /dev/null +++ b/XMonad/WorkspaceLayout/Grid.hs @@ -0,0 +1,483 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wall -Werror #-} + +{- | + +Two-dimensional workspaces for XMonad. + +This is like @XMonad.Util.Plane@, but more featureful and not hacky. +(This module does, however, have a more complex API.) + +-} + +module XMonad.WorkspaceLayout.Grid + + -- * Example + -- $example + + -- * Hooking into XMonad + ( hook + , getView + , Init (..) + , Wrapping (..) + + -- * Runtime interaction + , Coord (..) + , move + , swap + , update + + -- * 'Mapping's and ways to construct them + , Dims (..) + , fromMap + , fromFunction + , grid + , grid' + , group + , column + , Mapping (..) + , SomeMapping (..) + + -- * Core module types + , Formatted (..) + , IsFormatted (..) + , unsafeChangeFormatting + + ) where + +import Prelude hiding (span) + +import Data.Foldable (fold, toList) +import Data.Function ((&)) +import Data.List (nub) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (catMaybes, fromMaybe) +import Data.Monoid (Endo (..), appEndo) +import GHC.Generics (Generic) +import XMonad hiding (config, state, trace) +import XMonad.StackSet (greedyView, shift) + +import qualified XMonad.Util.OneState as St +import XMonad.WorkspaceLayout.Core (WorkspaceLayoutView (..)) +import XMonad.WorkspaceLayout.Util (affineMod) + +-- | +-- +-- For the grid layout to work, it has to know of (and possibly have control +-- over) the names of the XMonad workspaces. +-- +-- The can either choose to give this module full control of the workspace +-- names (represented by 'Formatted'). In return, this module provides some +-- affordances for easily configuring the workspace grid (see e.g. 'grid'). +-- +-- Alternatively, the user may choose to retain control of their workspace +-- names (represented by 'Unfortmatted'). However, they will have to put +-- slightly more work into configuring the workspace layout. +data Formatted + + = Unformatted + -- ^ + -- Workspace IDs are left untouched + + | Formatted + -- ^ + -- Workspace IDs are formatted + -- + -- This means /specifically/ that workspace IDs are of the format + -- \:\ + -- + -- where + -- + -- * \ contains a uniquely-identifying string + -- * \ contains the workspace name + -- * \ may not contain colons + -- + -- Note that workspace IDs will not be /displayed/ this way. This + -- is just what they will be stored as "under the hood". + + -- (note: ideally, I'd like to allow custom formats beyond + -- just this specific one. Such a desire is, however, in tension with + -- retaining the static guarantee that formats are not mixed. Achieving + -- this might be possible, but I'm judging it not worth the effort.) + + +doFormat :: forall ftd. IsFormatted ftd => Coord -> String -> WorkspaceId +doFormat (XY x y) name = + case demoteFormatted @ftd of + Formatted -> show y <> "/" <> show x <> ":" <> name + Unformatted -> name + + +doToName :: forall ftd. IsFormatted ftd => WorkspaceId -> String +doToName = + case demoteFormatted @ftd of + Unformatted -> id + Formatted -> dropThrough ':' + + where + + -- dropThrough '~' "aa~bb~cc" == "bb~cc" + dropThrough :: Char -> String -> String + dropThrough delim = drop 1 . dropWhile (/= delim) + + +-- | Provides type-to-value demotion on 'Formatted' +class IsFormatted (ftd :: Formatted) where + demoteFormatted :: Formatted + +instance IsFormatted 'Unformatted where + demoteFormatted = Unformatted + +instance IsFormatted 'Formatted where + demoteFormatted = Formatted + + +-- | +-- +-- A 'Mapping' is a mapping from a grid coordinate to its associated workspace id. +-- +-- If two coordinates have the same workspace id, then they will share content! +newtype Mapping (ftd :: Formatted) = Mapping { unMapping :: Map Coord WorkspaceId } + deriving (Show, Generic) + + +-- | +-- +-- Change the type of a 'Mapping' +-- +-- This is unsafe because it allows for having a value which is typed as 'Mapping' ''Formatted' +-- despite not following the prescribed formatting. +unsafeChangeFormatting :: forall old (ftd :: Formatted). Mapping old -> Mapping ftd +unsafeChangeFormatting (Mapping mp) = Mapping mp + +instance Semigroup (Mapping ftd) where + Mapping ma <> Mapping mb = Mapping (mb <> ma) -- right-biased + +instance Monoid (Mapping ftd) where + mempty = Mapping mempty + + +-- | Existential over 'Mapping' +data SomeMapping = forall ftd. IsFormatted ftd => SomeMapping (Mapping ftd) + +getTheMap :: SomeMapping -> Map Coord WorkspaceId +getTheMap (SomeMapping (Mapping mp)) = mp + +range :: Ord x => (Coord -> x) -> SomeMapping -> Maybe (x, x) +range proj (getTheMap -> mapping) = + let xs = proj <$> Map.keys mapping + in case xs of + [] -> Nothing + _ -> Just (minimum xs, maximum xs) + +span :: (Ord x, Enum x) => (Coord -> x) -> SomeMapping -> [x] +span proj (getTheMap -> mapping) = + let xs = proj <$> Map.keys mapping + in case xs of + [] -> [] + _ -> [minimum xs .. maximum xs] + + + +-- | Grid dimensions +data Dims = Dims { width :: Int, height :: Int } + + +-- | Construct a 'Mapping' from a 'Map' +fromMap :: Map Coord WorkspaceId -> Mapping 'Unformatted +fromMap = Mapping + + +-- | Construct a 'Mapping' from a function +fromFunction :: Dims -> (Coord -> WorkspaceId) -> Mapping 'Unformatted +fromFunction (Dims { width, height }) = + let domain = XY <$> [0 .. width - 1] <*> [0 .. height - 1] + in fromMap . funToMap domain + + where + funToMap :: Ord k => [k] -> (k -> v) -> Map k v + funToMap xs f = Map.fromList $ (\k -> (k, f k)) <$> xs + + +-- | +-- +-- Construct a 2d grid 'Mapping' +-- +-- Each coordinate @(x, y)@ will be given the name @show (x + 1)@ +grid :: Dims -> Mapping 'Formatted +grid = grid' (\(XY x _) -> show $ x + 1) + + +-- | +-- +-- Construct a 2d grid 'Mapping' +-- +-- Each coordinate will be assigned a name according to the supplied function +grid' :: (Coord -> String) -> Dims -> Mapping 'Formatted +grid' toName (Dims { width, height }) = + Mapping . fold $ do + y <- [0 .. height - 1] + x <- [0 .. width - 1] + let coord = XY x y + pure $ Map.singleton coord (doFormat @'Formatted coord $ toName coord) + + +-- | +-- +-- Glue together a group of workspaces +-- +-- Inteded to be used alongside the 'Monoid' instance for 'Mapping'. For example, +-- to create a 4x4 grid with the right-hand column glued together, one could write +-- +-- > let dims = Dims { width = 4, height = 4 } +-- > in grid dims <> column dims 4 "my-workspace" +group :: forall f ftd. (IsFormatted ftd, Foldable f) => f Coord -> String -> Mapping ftd +group (toList -> xs) name = case xs of + [] -> Mapping mempty + (x0:_) -> Mapping $ xs & foldMap (\x -> Map.singleton x (doFormat @ftd x0 name)) + + +-- | +-- +-- Glue together a column of workspaces +column :: forall ftd. IsFormatted ftd => Dims -> Int -> String -> Mapping ftd +column + (Dims { height }) -- ^ Grid dimension + x -- ^ The column coordinate + name -- ^ The name to give to workspaces in the column + = + Mapping . fold $ do + y <- [0 .. height - 1] + let topLeft = XY x 0 + pure $ Map.singleton (XY x y) (doFormat @ftd topLeft name) + + + +-- | A grid coordinate. Grids are zero-indexed! +data Coord = XY { x :: Int, y :: Int } + deriving (Show, Ord, Eq, Generic) + +-- | +-- +-- Whether or not moving out-of-bounds should wrap over +-- +-- If 'True', wrap. If 'False', refuse to move. +data Wrapping = Wrapping + { wrapX :: Bool + , wrapY :: Bool + } + deriving (Show, Generic) + +data State = State + { mapping :: SomeMapping + -- ^ Coordinate -> WorkspaceId mapping + , labelf :: Coord -> Maybe String + -- ^ Labels + , wrapping :: Wrapping + -- ^ Wrapping mode + , coord :: Coord + -- ^ Current coordinate + } deriving (Generic) + +instance St.OneState State where + type Mod State = State -> State + merge ma s = pure (ma s) + defaultState = State + { mapping = SomeMapping (grid $ Dims 5 5) + , wrapping = Wrapping False False + , coord = XY 0 0 + , labelf = const Nothing + } + +-- Wrap a coordinate around the x/y axes according to the configured wrapping mode +wrap :: State -> (Coord -> Coord) +wrap state = + + appEndo . fromMaybe (Endo id) $ do + xRange <- range x (mapping state) + yRange <- range y (mapping state) + + pure $ guard (state & wrapping & wrapX) (Endo $ \c -> c { x = affineMod xRange (x c) }) + <> guard (state & wrapping & wrapY) (Endo $ \c -> c { y = affineMod yRange (y c) }) + + where + + guard :: Monoid m => Bool -> m -> m + guard = \case { True -> id; False -> const mempty } + + + +-- | +-- +-- If @c@ is the current coordinate, calling @move f@ will move XMonad +-- to the coordinate @f c@. +-- +-- For instance, the following will move one workspace to the right: +-- +-- > move (\(XY x y) -> XY (x + 1) y) +-- +-- And this will move to row 3: +-- +-- > move (\(XY x _) -> XY x 3) +move :: (Coord -> Coord) -> X () +move = update $ \coord wid -> do + St.modify $ \st -> st { coord = coord } + windows (greedyView wid) + + +-- | +-- +-- Like 'move', but for moving windows around +swap :: (Coord -> Coord) -> X () +swap = update $ \_ wid -> windows (shift wid) + +update :: (Coord -> WorkspaceId -> X ()) -> (Coord -> Coord) -> X () +update act f = do + state@State { coord, mapping } <- St.get + let coord' = coord & f & wrap state + case Map.lookup coord' (getTheMap mapping) of + Nothing -> pure () + Just wid -> do + act coord' wid + + +-- | Initialization options +data Init = Init + { initMapping :: SomeMapping + -- ^ Physical layout + , initWrapping :: Wrapping + -- ^ Wrapping mode + , initLabelf :: Coord -> Maybe String + -- ^ + -- Displayed to the left of the axis workspaces + -- + -- When 'Nothing' is returned, uses a fallback + } + + +-- | +-- +-- Hook the grid layout into XMonad +-- +-- __Please note:__ if the 'initMapping' you supply contains a: +-- +-- - 'Mapping' ''Formatted', then your XMonad workspace names /will be overriden/. +-- - 'Mapping' ''Unfotmatted', then your XMonad workspace names will be deduplicated +hook :: Init -> XConfig l -> XConfig l +hook Init { initMapping, initWrapping, initLabelf } = + St.once @State + (\xc -> xc { XMonad.workspaces = workspaces }) + (\state -> state + { mapping = initMapping + , wrapping = initWrapping + , labelf = initLabelf + }) + + where + workspaces = toList (getTheMap initMapping) + & nub -- account for two coordinates pointing to the same workspace + -- WANT: does deduplication need to happen on @Mapping 'Unformatted@s? + +-- | +-- +-- Generate the layout view. +-- +-- Use this with 'XMonad.WorkspaceLayout.Core.render' to render to your status bar. +getView :: X WorkspaceLayoutView +getView = do + State { coord, mapping, labelf } <- St.get + let XY _ y = coord + pure $ WSLView + { neighborhood = + let coords = (flip XY y) <$> span x mapping + in coords & fmap (flip Map.lookup (getTheMap mapping)) & catMaybes & nub + , toName = case mapping of SomeMapping (_ :: Mapping ftd) -> doToName @ftd + , label = labelf coord & fromMaybe (show (y + 1) <> " / ") + } + + + + +{- $example + +Example usage of this module might look something like the following. + +Assume we've imported this module as @Grid@. First we create the config: + +> gridConfig :: Grid.Init +> gridConfig = +> let dims = Grid.Dims { Grid.width = 5, Grid.height = 3 } +> getName (Grid.XY x y) = show y <> "/" <> show (x + 1) +> mapping = Grid.grid' getName dims <> Grid.column dims 4 "gutter" +> in Grid.Init +> { Grid.initMapping = Grid.SomeMapping mapping +> , Grid.initWrapping = Grid.Wrapping True True +> , Grid.initLabelf = \(Grid.XY _ y) -> Just ("y=" <> show y <> ": ") +> } + +This configuration says the following: + +- We want a 5x3 grid +- Where a workspace at @(x, y)@ has the name @{y}/{x+1}@ +- Except for the column at @x=4@, which should all be one workspace called @gutter@ +- There should be a label with the format @y={y}@ + +Visually, our grid looks like this: + +@ +0\/1 0\/2 0\/3 0\/4 gutter + |||||| +1\/1 1\/2 1\/3 1\/4 gutter + |||||| +2\/1 2\/2 2\/3 2\/4 gutter + |||||| +3\/1 3\/2 3\/3 3\/4 gutter +@ + +Where the @||||||@ bars mean that the gutter on the right is all one workspace. + +For this config to actually be useful, we also need to: + +- Hook into XMonad with @Grid.hook gridConfig@ +- Set up keybindings for 'move' to move around the layout +- Set up the layout display by generating a 'XMonad.Hooks.StatusBar.PP.PP' with @XMonad.WorkspaceLayouts.Core.render \<$\> Grid.getView@ and displaying that @PP@ however we like + +I use XMobar to display my status bar, and with this configuration I get something that looks like this: + +<> + +In this screenshot: + +- On the left, the configured label displays @y=0@ +- Only the workspaces on the current row are displayed: @0\/1@, @0\/2@, @0\/3@, @0\/4@, and @gutter@ +- The workspace @0\/4@ is displayed as @...@ because it has no windows +- The workspace @0\/3@ is displayed with brackets because it is my current workspace. + +Using my configured keybindings, I can move around this row: + +<> + +<> + +Or move to other rows: + +<> + +Here, on row @y=1@, almost every workspace is displayed as @...@. The workspace @1/2@ is not because it is my current workspace, and the workspace @gutter@ is not because it isn't empty--recall that the @gutter@ workspace is the same on all rows, and that it was not empty on row @y=0@. + +-} diff --git a/XMonad/WorkspaceLayout/Util.hs b/XMonad/WorkspaceLayout/Util.hs new file mode 100644 index 0000000000..6d8b8c211b --- /dev/null +++ b/XMonad/WorkspaceLayout/Util.hs @@ -0,0 +1,11 @@ +module XMonad.WorkspaceLayout.Util where + +(!%) :: [a] -> Int -> a +xs !% n = xs !! (n `mod` length xs) + +-- Doubly-inclusive +affineMod :: (Ord a, Num a) => (a, a) -> (a -> a) +affineMod range@(lo, hi) x + | x > hi = affineMod range (x - (hi - lo + 1)) + | x < lo = affineMod range (x + (hi - lo + 1)) + | otherwise = x diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 8ddccfc819..58db1259b7 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -390,6 +390,7 @@ library XMonad.Util.NamedScratchpad XMonad.Util.NamedWindows XMonad.Util.NoTaskbar + XMonad.Util.OneState XMonad.Util.Parser XMonad.Util.Paste XMonad.Util.PositionStore @@ -415,6 +416,10 @@ library XMonad.Util.WorkspaceCompare XMonad.Util.XSelection XMonad.Util.XUtils + XMonad.WorkspaceLayout.Core + XMonad.WorkspaceLayout.Cycle + XMonad.WorkspaceLayout.Grid + XMonad.WorkspaceLayout.Util test-suite tests type: exitcode-stdio-1.0