mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
288 lines
12 KiB
Haskell
288 lines
12 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.LayoutCombinators
|
|
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
|
-- License : BSD
|
|
--
|
|
-- Maintainer : none
|
|
-- Stability : unstable
|
|
-- Portability : portable
|
|
--
|
|
-- The "XMonad.Layout.LayoutCombinators" module provides combinators
|
|
-- for easily combining multiple layouts into one composite layout, as
|
|
-- well as a way to jump directly to any particular layout (say, with
|
|
-- a keybinding) without having to cycle through other layouts to get
|
|
-- to it.
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Layout.LayoutCombinators
|
|
( -- * Usage
|
|
-- $usage
|
|
|
|
-- * Layout combinators
|
|
-- $combine
|
|
|
|
-- ** Combinators using DragPane vertical
|
|
-- $dpv
|
|
(*||*), (**||*),(***||*),(****||*),(***||**),(****||***)
|
|
, (***||****),(*||****),(**||***),(*||***),(*||**)
|
|
|
|
-- ** Combinators using DragPane horizontal
|
|
-- $dph
|
|
, (*//*), (**//*),(***//*),(****//*),(***//**),(****//***)
|
|
, (***//****),(*//****),(**//***),(*//***),(*//**)
|
|
|
|
-- ** Combinators using Tall (vertical)
|
|
-- $tv
|
|
, (*|*), (**|*),(***|*),(****|*),(***|**),(****|***)
|
|
, (***|****),(*|****),(**|***),(*|***),(*|**)
|
|
|
|
-- ** Combinators using Mirror Tall (horizontal)
|
|
-- $mth
|
|
, (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)
|
|
, (***/****),(*/****),(**/***),(*/***),(*/**)
|
|
|
|
-- * New layout choice combinator and 'JumpToLayout'
|
|
-- $jtl
|
|
, (|||)
|
|
, JumpToLayout(..)
|
|
) where
|
|
|
|
import Data.Maybe ( isJust, isNothing )
|
|
|
|
import XMonad hiding ((|||))
|
|
import XMonad.StackSet (Workspace (..))
|
|
import XMonad.Layout.Combo
|
|
import XMonad.Layout.DragPane
|
|
|
|
-- $usage
|
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )
|
|
--
|
|
-- Then edit your @layoutHook@ to use the new layout combinators. For
|
|
-- example:
|
|
--
|
|
-- > myLayout = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc..
|
|
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
|
--
|
|
-- For more detailed instructions on editing the @layoutHook@ see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
|
--
|
|
-- To use the 'JumpToLayout' message, hide the normal @|||@ operator instead:
|
|
--
|
|
-- > import XMonad hiding ( (|||) )
|
|
-- > import XMonad.Layout.LayoutCombinators
|
|
--
|
|
-- If you import XMonad.Layout, you will need to hide it from there as well.
|
|
-- Then bind some keys to a 'JumpToLayout' message:
|
|
--
|
|
-- > , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full") -- jump directly to the Full layout
|
|
--
|
|
-- See below for more detailed documentation.
|
|
|
|
-- $combine
|
|
-- Each of the following combinators combines two layouts into a
|
|
-- single composite layout by splitting the screen into two regions,
|
|
-- one governed by each layout. Asterisks in the combinator names
|
|
-- denote the relative amount of screen space given to the respective
|
|
-- layouts. For example, the '***||*' combinator gives three times as
|
|
-- much space to the left-hand layout as to the right-hand layout.
|
|
|
|
infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**,
|
|
*//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**,
|
|
*|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** ,
|
|
*/* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */**
|
|
|
|
-- $dpv
|
|
-- These combinators combine two layouts using "XMonad.DragPane" in
|
|
-- vertical mode.
|
|
|
|
(*||*),(**||*),(***||*),(****||*), (***||**),(****||***),
|
|
(***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
|
|
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
|
|
|
|
(*||*) = combineTwo (dragPane Vertical 0.1 (1/2))
|
|
(**||*) = combineTwo (dragPane Vertical 0.1 (2/3))
|
|
(***||*) = combineTwo (dragPane Vertical 0.1 (3/4))
|
|
(****||*) = combineTwo (dragPane Vertical 0.1 (4/5))
|
|
(***||**) = combineTwo (dragPane Vertical 0.1 (3/5))
|
|
(****||***) = combineTwo (dragPane Vertical 0.1 (4/7))
|
|
(***||****) = combineTwo (dragPane Vertical 0.1 (3/7))
|
|
(*||****) = combineTwo (dragPane Vertical 0.1 (1/5))
|
|
(**||***) = combineTwo (dragPane Vertical 0.1 (2/5))
|
|
(*||***) = combineTwo (dragPane Vertical 0.1 (1/4))
|
|
(*||**) = combineTwo (dragPane Vertical 0.1 (1/3))
|
|
|
|
-- $dph
|
|
-- These combinators combine two layouts using "XMonad.DragPane" in
|
|
-- horizontal mode.
|
|
|
|
(*//*),(**//*),(***//*),(****//*), (***//**),(****//***),
|
|
(***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
|
|
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
|
|
|
|
(*//*) = combineTwo (dragPane Horizontal 0.1 (1/2))
|
|
(**//*) = combineTwo (dragPane Horizontal 0.1 (2/3))
|
|
(***//*) = combineTwo (dragPane Horizontal 0.1 (3/4))
|
|
(****//*) = combineTwo (dragPane Horizontal 0.1 (4/5))
|
|
(***//**) = combineTwo (dragPane Horizontal 0.1 (3/5))
|
|
(****//***) = combineTwo (dragPane Horizontal 0.1 (4/7))
|
|
(***//****) = combineTwo (dragPane Horizontal 0.1 (3/7))
|
|
(*//****) = combineTwo (dragPane Horizontal 0.1 (1/5))
|
|
(**//***) = combineTwo (dragPane Horizontal 0.1 (2/5))
|
|
(*//***) = combineTwo (dragPane Horizontal 0.1 (1/4))
|
|
(*//**) = combineTwo (dragPane Horizontal 0.1 (1/3))
|
|
|
|
-- $tv
|
|
-- These combinators combine two layouts vertically using @Tall@.
|
|
|
|
(*|*),(**|*),(***|*),(****|*), (***|**),(****|***),
|
|
(***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)
|
|
=> l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a
|
|
(*|*) = combineTwo (Tall 1 0.1 (1/2))
|
|
(**|*) = combineTwo (Tall 1 0.1 (2/3))
|
|
(***|*) = combineTwo (Tall 1 0.1 (3/4))
|
|
(****|*) = combineTwo (Tall 1 0.1 (4/5))
|
|
(***|**) = combineTwo (Tall 1 0.1 (3/5))
|
|
(****|***) = combineTwo (Tall 1 0.1 (4/7))
|
|
(***|****) = combineTwo (Tall 1 0.1 (3/7))
|
|
(*|****) = combineTwo (Tall 1 0.1 (1/5))
|
|
(**|***) = combineTwo (Tall 1 0.1 (2/5))
|
|
(*|***) = combineTwo (Tall 1 0.1 (1/4))
|
|
(*|**) = combineTwo (Tall 1 0.1 (1/3))
|
|
|
|
|
|
-- $mth
|
|
-- These combinators combine two layouts horizontally using @Mirror
|
|
-- Tall@.
|
|
|
|
(*/*),(**/*),(***/*),(****/*), (***/**),(****/***),
|
|
(***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)
|
|
=> l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a
|
|
(*/*) = combineTwo (Mirror $ Tall 1 0.1 (1/2))
|
|
(**/*) = combineTwo (Mirror $ Tall 1 0.1 (2/3))
|
|
(***/*) = combineTwo (Mirror $ Tall 1 0.1 (3/4))
|
|
(****/*) = combineTwo (Mirror $ Tall 1 0.1 (4/5))
|
|
(***/**) = combineTwo (Mirror $ Tall 1 0.1 (3/5))
|
|
(****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7))
|
|
(***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7))
|
|
(*/****) = combineTwo (Mirror $ Tall 1 0.1 (1/5))
|
|
(**/***) = combineTwo (Mirror $ Tall 1 0.1 (2/5))
|
|
(*/***) = combineTwo (Mirror $ Tall 1 0.1 (1/4))
|
|
(*/**) = combineTwo (Mirror $ Tall 1 0.1 (1/3))
|
|
|
|
infixr 5 |||
|
|
|
|
-- $jtl
|
|
-- The standard xmonad core exports a layout combinator @|||@ which
|
|
-- represents layout choice. This is a reimplementation which also
|
|
-- provides the capability to support 'JumpToLayout' messages. To use
|
|
-- it, be sure to hide the import of @|||@ from the xmonad core; if either of
|
|
-- these two lines appear in your configuration:
|
|
--
|
|
-- > import XMonad
|
|
-- > import XMonad.Layout
|
|
--
|
|
-- replace them with these instead, respectively:
|
|
--
|
|
-- > import XMonad hiding ( (|||) )
|
|
-- > import XMonad.Layout hiding ( (|||) )
|
|
--
|
|
-- The argument given to a 'JumpToLayout' message should be the
|
|
-- @description@ of the layout to be selected. If you use
|
|
-- "XMonad.Hooks.DynamicLog", this is the name of the layout displayed
|
|
-- in your status bar. Alternatively, you can use GHCi to determine
|
|
-- the proper name to use. For example:
|
|
--
|
|
-- > $ ghci
|
|
-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
|
|
-- > Loading package base ... linking ... done.
|
|
-- > :set prompt "> " -- don't show loaded module names
|
|
-- > > :m +XMonad.Core -- load the xmonad core
|
|
-- > > :m +XMonad.Layout.Grid -- load whatever module you want to use
|
|
-- > > description Grid -- find out what it's called
|
|
-- > "Grid"
|
|
--
|
|
-- As yet another (possibly easier) alternative, you can use the
|
|
-- "XMonad.Layout.Named" modifier to give custom names to your
|
|
-- layouts, and use those.
|
|
--
|
|
-- For the ability to select a layout from a prompt, see
|
|
-- "Xmonad.Prompt.Layout".
|
|
|
|
-- | A reimplementation of the combinator of the same name from the
|
|
-- xmonad core, providing layout choice, and the ability to support
|
|
-- 'JumpToLayout' messages.
|
|
(|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a
|
|
(|||) = NewSelect True
|
|
|
|
data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show )
|
|
|
|
-- |
|
|
data JumpToLayout = JumpToLayout String -- ^ A message to jump to a particular layout
|
|
-- , specified by its description string..
|
|
| NextLayoutNoWrap
|
|
| Wrap
|
|
deriving ( Read, Show, Typeable )
|
|
instance Message JumpToLayout
|
|
|
|
instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where
|
|
runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r
|
|
return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')
|
|
|
|
runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r
|
|
return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
|
|
description (NewSelect True l1 _) = description l1
|
|
description (NewSelect False _ l2) = description l2
|
|
handleMessage l@(NewSelect False _ _) m
|
|
| Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m
|
|
handleMessage l@(NewSelect amfirst _ _) m
|
|
| Just NextLayoutNoWrap <- fromMessage m =
|
|
if amfirst then when' isNothing (passOnM m l) $
|
|
fmap Just $ swap l >>= passOn (SomeMessage Wrap)
|
|
else passOnM m l
|
|
handleMessage l m
|
|
| Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
|
|
fmap Just $ swap l >>= passOn (SomeMessage Wrap)
|
|
handleMessage l@(NewSelect True _ l2) m
|
|
| Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l
|
|
handleMessage l@(NewSelect False l1 _) m
|
|
| Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l
|
|
handleMessage l m
|
|
| Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
|
|
do ml' <- passOnM m $ sw l
|
|
case ml' of
|
|
Nothing -> return Nothing
|
|
Just l' -> Just `fmap` swap (sw l')
|
|
handleMessage (NewSelect b l1 l2) m
|
|
| Just ReleaseResources <- fromMessage m =
|
|
do ml1' <- handleMessage l1 m
|
|
ml2' <- handleMessage l2 m
|
|
return $ if isJust ml1' || isJust ml2'
|
|
then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2')
|
|
else Nothing
|
|
handleMessage l m = passOnM m l
|
|
|
|
swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
|
|
swap l = sw `fmap` passOn (SomeMessage Hide) l
|
|
|
|
sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a
|
|
sw (NewSelect b lt lf) = NewSelect (not b) lt lf
|
|
|
|
passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>
|
|
SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
|
|
passOn m l = maybe l id `fmap` passOnM m l
|
|
|
|
passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>
|
|
SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
|
|
passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m
|
|
return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'
|
|
passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
|
|
return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'
|
|
|
|
when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
|
|
when' f a b = do a1 <- a; if f a1 then b else return a1
|