mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-29 19:21:51 -07:00
scripts
tests
Accordion.hs
Anneal.hs
Circle.hs
Combo.hs
Commands.hs
ConstrainedResize.hs
CopyWindow.hs
CycleWS.hs
DeManage.hs
DirectoryPrompt.hs
Dishes.hs
Dmenu.hs
DragPane.hs
DwmPromote.hs
DynamicLog.hs
DynamicWorkspaces.hs
Dzen.hs
EwmhDesktops.hs
FindEmptyWorkspace.hs
FlexibleManipulate.hs
FlexibleResize.hs
FloatKeys.hs
FocusNth.hs
Grid.hs
HintedTile.hs
Invisible.hs
LICENSE
LayoutCombinators.hs
LayoutHints.hs
LayoutModifier.hs
LayoutScreens.hs
MagicFocus.hs
Magnifier.hs
ManPrompt.hs
ManageDocks.hs
Maximize.hs
MetaModule.hs
Mosaic.hs
MosaicAlt.hs
MouseGestures.hs
NamedWindows.hs
NoBorders.hs
README
ResizableTile.hs
Roledex.hs
RotSlaves.hs
RotView.hs
Run.hs
SetWMName.hs
ShellPrompt.hs
SimpleDate.hs
SinkAll.hs
Spiral.hs
Square.hs
SshPrompt.hs
Submap.hs
SwapWorkspaces.hs
SwitchTrans.hs
Tabbed.hs
TagWindows.hs
ThreeColumns.hs
TilePrime.hs
ToggleLayouts.hs
TwoPane.hs
UrgencyHook.hs
Warp.hs
WindowBringer.hs
WindowNavigation.hs
WindowPrompt.hs
WmiiActions.hs
WorkspaceDir.hs
WorkspacePrompt.hs
XMonadPrompt.hs
XPrompt.hs
XPropManage.hs
XSelection.hs
XUtils.hs
86 lines
4.1 KiB
Haskell
86 lines
4.1 KiB
Haskell
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonadContrib.ToggleLayouts
|
|
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
|
-- License : BSD
|
|
--
|
|
-- Maintainer : David Roundy <droundy@darcs.net>
|
|
-- Stability : unstable
|
|
-- Portability : portable
|
|
--
|
|
-- A module for writing easy Layouts
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonadContrib.ToggleLayouts (
|
|
-- * Usage
|
|
-- $usage
|
|
toggleLayouts, ToggleLayout(..)
|
|
) where
|
|
|
|
import XMonad
|
|
import Operations ( LayoutMessages(Hide, ReleaseResources) )
|
|
|
|
-- $usage
|
|
-- Use toggleLayouts to toggle between two layouts.
|
|
--
|
|
-- import XMonadContrib.ToggleLayouts
|
|
--
|
|
-- and add to your layoutHook something like
|
|
--
|
|
-- > layoutHook = Layout $ toggleLayouts (noBorders Full) $ Select layouts
|
|
--
|
|
-- and a key binding like
|
|
-- > , ((modMask .|. controlMask, xK_space), sendMessage ToggleLayout)
|
|
--
|
|
-- or a key binding like
|
|
-- > , ((modMask .|. controlMask, xK_space), sendMessage (Toggle "Full"))
|
|
|
|
data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show)
|
|
data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show,Typeable)
|
|
instance Message ToggleLayout
|
|
|
|
toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleLayouts lt lf a
|
|
toggleLayouts = ToggleLayouts False
|
|
|
|
instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where
|
|
doLayout (ToggleLayouts True lt lf) r s = do (ws,mlt') <- doLayout lt r s
|
|
return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')
|
|
doLayout (ToggleLayouts False lt lf) r s = do (ws,mlf') <- doLayout lf r s
|
|
return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf')
|
|
description (ToggleLayouts True lt _) = description lt
|
|
description (ToggleLayouts False _ lf) = description lf
|
|
handleMessage (ToggleLayouts bool lt lf) m
|
|
| Just ReleaseResources <- fromMessage m =
|
|
do mlf' <- handleMessage lf m
|
|
mlt' <- handleMessage lt m
|
|
return $ case (mlt',mlf') of
|
|
(Nothing ,Nothing ) -> Nothing
|
|
(Just lt',Nothing ) -> Just $ ToggleLayouts bool lt' lf
|
|
(Nothing ,Just lf') -> Just $ ToggleLayouts bool lt lf'
|
|
(Just lt',Just lf') -> Just $ ToggleLayouts bool lt' lf'
|
|
handleMessage (ToggleLayouts True lt lf) m
|
|
| Just ToggleLayout <- fromMessage m = do mlt' <- handleMessage lt (SomeMessage Hide)
|
|
let lt' = maybe lt id mlt'
|
|
return $ Just $ ToggleLayouts False lt' lf
|
|
| Just (Toggle d) <- fromMessage m,
|
|
d == description lt || d == description lf =
|
|
do mlt' <- handleMessage lt (SomeMessage Hide)
|
|
let lt' = maybe lt id mlt'
|
|
return $ Just $ ToggleLayouts False lt' lf
|
|
| otherwise = do mlt' <- handleMessage lt m
|
|
return $ fmap (\lt' -> ToggleLayouts True lt' lf) mlt'
|
|
handleMessage (ToggleLayouts False lt lf) m
|
|
| Just ToggleLayout <- fromMessage m = do mlf' <- handleMessage lf (SomeMessage Hide)
|
|
let lf' = maybe lf id mlf'
|
|
return $ Just $ ToggleLayouts True lt lf'
|
|
| Just (Toggle d) <- fromMessage m,
|
|
d == description lt || d == description lf =
|
|
do mlf' <- handleMessage lf (SomeMessage Hide)
|
|
let lf' = maybe lf id mlf'
|
|
return $ Just $ ToggleLayouts True lt lf'
|
|
| otherwise = do mlf' <- handleMessage lf m
|
|
return $ fmap (\lf' -> ToggleLayouts False lt lf') mlf'
|