mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-01 04:31:52 -07:00
X.L.LayoutCombinators: Update for new X.L.(|||)
With xmonad/xmonad@45b2275b88 going live the functionality of X.L.LayoutCombinators.(|||) was moved into xmonad core, more specifically into X.L.(|||). We just need to clean up the contrib side of things, which involves making JumpToLayout and NewSelect type aliases and cutting out the custom layout combinator. Related: - https://github.com/xmonad/xmonad/pull/281 - xmonad/xmonad@45b2275b88 - https://github.com/xmonad/xmonad-contrib/issues/116
This commit is contained in:
slotThe
Tomas Janousek
@@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.LayoutCombinators
|
||||
@@ -10,10 +9,7 @@
|
||||
-- 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.
|
||||
-- for easily combining multiple layouts into one composite layout.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.LayoutCombinators
|
||||
@@ -43,26 +39,20 @@ module XMonad.Layout.LayoutCombinators
|
||||
, (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)
|
||||
, (***/****),(*/****),(**/***),(*/***),(*/**)
|
||||
|
||||
-- * New layout choice combinator and 'JumpToLayout'
|
||||
-- $jtl
|
||||
-- * Re-exports for backwards compatibility
|
||||
, (|||)
|
||||
, JumpToLayout(..)
|
||||
|
||||
-- * Types
|
||||
, NewSelect
|
||||
) where
|
||||
|
||||
import XMonad.Prelude ( isJust, isNothing )
|
||||
|
||||
import XMonad hiding ((|||))
|
||||
import XMonad.StackSet (Workspace (..))
|
||||
import XMonad
|
||||
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 ( (|||) )
|
||||
-- > import XMonad.Layout.LayoutCombinators
|
||||
--
|
||||
-- Then edit your @layoutHook@ to use the new layout combinators. For
|
||||
-- example:
|
||||
@@ -74,17 +64,6 @@ import XMonad.Layout.DragPane
|
||||
--
|
||||
-- "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
|
||||
@@ -177,114 +156,5 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
|
||||
(*/***) = 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) <$> 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') <$> ml2')
|
||||
description (NewSelect True l1 _) = description l1
|
||||
description (NewSelect False _ l2) = description l2
|
||||
handleMessage l@(NewSelect False _ _) m
|
||||
| Just Wrap <- fromMessage m = Just <$> (swap l >>= passOn m)
|
||||
handleMessage l@(NewSelect amfirst _ _) m
|
||||
| Just NextLayoutNoWrap <- fromMessage m =
|
||||
if amfirst then when' isNothing (passOnM m l) $
|
||||
Just <$> (swap l >>= passOn (SomeMessage Wrap))
|
||||
else passOnM m l
|
||||
handleMessage l m
|
||||
| Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
|
||||
Just <$> (swap l >>= passOn (SomeMessage Wrap))
|
||||
handleMessage l@(NewSelect True _ l2) m
|
||||
| Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just <$> swap l
|
||||
handleMessage l@(NewSelect False l1 _) m
|
||||
| Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just <$> 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 <$> 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 <$> 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 <$> 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) <$> mlt'
|
||||
passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
|
||||
return $ (\lf' -> NewSelect False lt lf') <$> 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
|
||||
type NewSelect = Choose
|
||||
{-# DEPRECATED NewSelect "Use 'Choose' instead." #-}
|
||||
|
||||
Reference in New Issue
Block a user