{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module XMonad.Layout.Groups.Examples (
rowOfColumns
, zoomColumnIn
, zoomColumnOut
, zoomColumnReset
, toggleColumnFull
, zoomWindowIn
, zoomWindowOut
, zoomWindowReset
, toggleWindowFull
, tallTabs
, mirrorTallTabs
, fullTabs
, TiledTabsConfig(..)
, def
, increaseNMasterGroups
, decreaseNMasterGroups
, shrinkMasterGroups
, expandMasterGroups
, nextOuterLayout
, module XMonad.Layout.Groups.Helpers
, shrinkText
, GroupEQ(..)
, zoomRowG
) where
import XMonad
import qualified XMonad.Layout.Groups as G
import XMonad.Layout.Groups.Helpers
import XMonad.Layout.ZoomRow
import XMonad.Layout.Tabbed
import XMonad.Layout.Renamed
import XMonad.Layout.Decoration
import XMonad.Layout.Simplest
data GroupEQ a = GroupEQ
deriving (Int -> GroupEQ a -> ShowS
forall a. Int -> GroupEQ a -> ShowS
forall a. [GroupEQ a] -> ShowS
forall a. GroupEQ a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupEQ a] -> ShowS
$cshowList :: forall a. [GroupEQ a] -> ShowS
show :: GroupEQ a -> String
$cshow :: forall a. GroupEQ a -> String
showsPrec :: Int -> GroupEQ a -> ShowS
$cshowsPrec :: forall a. Int -> GroupEQ a -> ShowS
Show, ReadPrec [GroupEQ a]
ReadPrec (GroupEQ a)
ReadS [GroupEQ a]
forall a. ReadPrec [GroupEQ a]
forall a. ReadPrec (GroupEQ a)
forall a. Int -> ReadS (GroupEQ a)
forall a. ReadS [GroupEQ a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GroupEQ a]
$creadListPrec :: forall a. ReadPrec [GroupEQ a]
readPrec :: ReadPrec (GroupEQ a)
$creadPrec :: forall a. ReadPrec (GroupEQ a)
readList :: ReadS [GroupEQ a]
$creadList :: forall a. ReadS [GroupEQ a]
readsPrec :: Int -> ReadS (GroupEQ a)
$creadsPrec :: forall a. Int -> ReadS (GroupEQ a)
Read)
instance Eq a => EQF GroupEQ (G.Group l a) where
eq :: GroupEQ (Group l a) -> Group l a -> Group l a -> Bool
eq GroupEQ (Group l a)
_ (G.G WithID l a
l1 Zipper a
_) (G.G WithID l a
l2 Zipper a
_) = forall (l :: * -> *) a. WithID l a -> WithID l a -> Bool
G.sameID WithID l a
l1 WithID l a
l2
zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a))
=> ZoomRow GroupEQ (G.Group l a)
zoomRowG :: forall a (l :: * -> *).
(Eq a, Show a, Read a, Show (l a), Read (l a)) =>
ZoomRow GroupEQ (Group l a)
zoomRowG = forall (f :: * -> *) a.
(EQF f a, Show (f a), Read (f a), Show a, Read a) =>
f a -> ZoomRow f a
zoomRowWith forall a. GroupEQ a
GroupEQ
rowOfColumns :: Groups
(ModifiedLayout Rename (Mirror (ZoomRow ClassEQ)))
(ZoomRow GroupEQ)
Window
rowOfColumns = forall (l :: * -> *) (l2 :: * -> *).
l Window -> l2 (Group l Window) -> Groups l l2 Window
G.group ModifiedLayout Rename (Mirror (ZoomRow ClassEQ)) Window
column forall a (l :: * -> *).
(Eq a, Show a, Read a, Show (l a), Read (l a)) =>
ZoomRow GroupEQ (Group l a)
zoomRowG
where column :: ModifiedLayout Rename (Mirror (ZoomRow ClassEQ)) Window
column = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. Int -> Rename a
CutWordsLeft Int
2, forall a. String -> Rename a
PrependWords String
"ZoomColumn"] forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. l a -> Mirror l a
Mirror forall a. (Eq a, Show a, Read a) => ZoomRow ClassEQ a
zoomRow
zoomColumnIn :: X ()
zoomColumnIn :: X ()
zoomColumnIn = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage ZoomMessage
zoomIn
zoomColumnOut :: X ()
zoomColumnOut :: X ()
zoomColumnOut = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage ZoomMessage
zoomOut
zoomColumnReset :: X ()
zoomColumnReset :: X ()
zoomColumnReset = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage ZoomMessage
zoomReset
toggleColumnFull :: X ()
toggleColumnFull :: X ()
toggleColumnFull = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage ZoomMessage
ZoomFullToggle
zoomWindowIn :: X ()
zoomWindowIn :: X ()
zoomWindowIn = forall a. Message a => a -> X ()
sendMessage ZoomMessage
zoomIn
zoomWindowOut :: X ()
zoomWindowOut :: X ()
zoomWindowOut = forall a. Message a => a -> X ()
sendMessage ZoomMessage
zoomOut
zoomWindowReset :: X ()
zoomWindowReset :: X ()
zoomWindowReset = forall a. Message a => a -> X ()
sendMessage ZoomMessage
zoomReset
toggleWindowFull :: X ()
toggleWindowFull :: X ()
toggleWindowFull = forall a. Message a => a -> X ()
sendMessage ZoomMessage
ZoomFullToggle
data TiledTabsConfig s = TTC { forall s. TiledTabsConfig s -> Int
vNMaster :: Int
, forall s. TiledTabsConfig s -> Rational
vRatio :: Rational
, forall s. TiledTabsConfig s -> Rational
vIncrement :: Rational
, forall s. TiledTabsConfig s -> Int
hNMaster :: Int
, forall s. TiledTabsConfig s -> Rational
hRatio :: Rational
, forall s. TiledTabsConfig s -> Rational
hIncrement :: Rational
, forall s. TiledTabsConfig s -> s
tabsShrinker :: s
, forall s. TiledTabsConfig s -> Theme
tabsTheme :: Theme }
instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where
def :: TiledTabsConfig s
def = forall s.
Int
-> Rational
-> Rational
-> Int
-> Rational
-> Rational
-> s
-> Theme
-> TiledTabsConfig s
TTC Int
1 Rational
0.5 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
100) Int
1 Rational
0.5 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
100) DefaultShrinker
shrinkText forall a. Default a => a
def
fullTabs :: TiledTabsConfig s
-> ModifiedLayout
Rename
(ModifiedLayout
(Decoration TabbedDecoration s)
(Groups
(ModifiedLayout Rename Simplest)
(Choose
Full
(Choose
(ModifiedLayout Rename Tall)
(ModifiedLayout Rename (Mirror Tall))))))
Window
fullTabs TiledTabsConfig s
c = forall {a} {l :: * -> *} {s}.
(Eq a, LayoutClass l a, Shrinker s) =>
TiledTabsConfig s
-> l a
-> ModifiedLayout
Rename (ModifiedLayout (Decoration TabbedDecoration s) l) a
_tab TiledTabsConfig s
c forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *).
l Window -> l2 (Group l Window) -> Groups l l2 Window
G.group forall {a}. ModifiedLayout Rename Simplest a
_tabs forall a b. (a -> b) -> a -> b
$ forall a. Full a
Full forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall {s} {a}. TiledTabsConfig s -> ModifiedLayout Rename Tall a
_vert TiledTabsConfig s
c forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall {s} {a}.
TiledTabsConfig s -> ModifiedLayout Rename (Mirror Tall) a
_horiz TiledTabsConfig s
c
tallTabs :: TiledTabsConfig s
-> ModifiedLayout
Rename
(ModifiedLayout
(Decoration TabbedDecoration s)
(Groups
(ModifiedLayout Rename Simplest)
(Choose
(ModifiedLayout Rename Tall)
(Choose (ModifiedLayout Rename (Mirror Tall)) Full))))
Window
tallTabs TiledTabsConfig s
c = forall {a} {l :: * -> *} {s}.
(Eq a, LayoutClass l a, Shrinker s) =>
TiledTabsConfig s
-> l a
-> ModifiedLayout
Rename (ModifiedLayout (Decoration TabbedDecoration s) l) a
_tab TiledTabsConfig s
c forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *).
l Window -> l2 (Group l Window) -> Groups l l2 Window
G.group forall {a}. ModifiedLayout Rename Simplest a
_tabs forall a b. (a -> b) -> a -> b
$ forall {s} {a}. TiledTabsConfig s -> ModifiedLayout Rename Tall a
_vert TiledTabsConfig s
c forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall {s} {a}.
TiledTabsConfig s -> ModifiedLayout Rename (Mirror Tall) a
_horiz TiledTabsConfig s
c forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall a. Full a
Full
mirrorTallTabs :: TiledTabsConfig s
-> ModifiedLayout
Rename
(ModifiedLayout
(Decoration TabbedDecoration s)
(Groups
(ModifiedLayout Rename Simplest)
(Choose
(ModifiedLayout Rename (Mirror Tall))
(Choose Full (ModifiedLayout Rename Tall)))))
Window
mirrorTallTabs TiledTabsConfig s
c = forall {a} {l :: * -> *} {s}.
(Eq a, LayoutClass l a, Shrinker s) =>
TiledTabsConfig s
-> l a
-> ModifiedLayout
Rename (ModifiedLayout (Decoration TabbedDecoration s) l) a
_tab TiledTabsConfig s
c forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) (l2 :: * -> *).
l Window -> l2 (Group l Window) -> Groups l l2 Window
G.group forall {a}. ModifiedLayout Rename Simplest a
_tabs forall a b. (a -> b) -> a -> b
$ forall {s} {a}.
TiledTabsConfig s -> ModifiedLayout Rename (Mirror Tall) a
_horiz TiledTabsConfig s
c forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall a. Full a
Full forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall {s} {a}. TiledTabsConfig s -> ModifiedLayout Rename Tall a
_vert TiledTabsConfig s
c
_tabs :: ModifiedLayout Rename Simplest a
_tabs = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Tabs"] forall a. Simplest a
Simplest
_tab :: TiledTabsConfig s
-> l a
-> ModifiedLayout
Rename (ModifiedLayout (Decoration TabbedDecoration s) l) a
_tab TiledTabsConfig s
c l a
l = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. Int -> Rename a
CutWordsLeft Int
1] forall a b. (a -> b) -> a -> b
$ forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs (forall s. TiledTabsConfig s -> s
tabsShrinker TiledTabsConfig s
c) (forall s. TiledTabsConfig s -> Theme
tabsTheme TiledTabsConfig s
c) l a
l
_vert :: TiledTabsConfig s -> ModifiedLayout Rename Tall a
_vert TiledTabsConfig s
c = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Vertical"] forall a b. (a -> b) -> a -> b
$ forall a. Int -> Rational -> Rational -> Tall a
Tall (forall s. TiledTabsConfig s -> Int
vNMaster TiledTabsConfig s
c) (forall s. TiledTabsConfig s -> Rational
vIncrement TiledTabsConfig s
c) (forall s. TiledTabsConfig s -> Rational
vRatio TiledTabsConfig s
c)
_horiz :: TiledTabsConfig s -> ModifiedLayout Rename (Mirror Tall) a
_horiz TiledTabsConfig s
c = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Horizontal"] forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. l a -> Mirror l a
Mirror forall a b. (a -> b) -> a -> b
$ forall a. Int -> Rational -> Rational -> Tall a
Tall (forall s. TiledTabsConfig s -> Int
hNMaster TiledTabsConfig s
c) (forall s. TiledTabsConfig s -> Rational
hIncrement TiledTabsConfig s
c) (forall s. TiledTabsConfig s -> Rational
hRatio TiledTabsConfig s
c)
increaseNMasterGroups :: X ()
increaseNMasterGroups :: X ()
increaseNMasterGroups = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN Int
1
decreaseNMasterGroups :: X ()
decreaseNMasterGroups :: X ()
decreaseNMasterGroups = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage forall a b. (a -> b) -> a -> b
$ Int -> IncMasterN
IncMasterN (-Int
1)
shrinkMasterGroups :: X ()
shrinkMasterGroups :: X ()
shrinkMasterGroups = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage Resize
Shrink
expandMasterGroups :: X ()
expandMasterGroups :: X ()
expandMasterGroups = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage Resize
Expand
nextOuterLayout :: X ()
nextOuterLayout :: X ()
nextOuterLayout = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ SomeMessage -> GroupsMessage
G.ToEnclosing forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage ChangeLayout
NextLayout