From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- XMonad/Layout/ToggleLayouts.hs | 84 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 XMonad/Layout/ToggleLayouts.hs (limited to 'XMonad/Layout/ToggleLayouts.hs') diff --git a/XMonad/Layout/ToggleLayouts.hs b/XMonad/Layout/ToggleLayouts.hs new file mode 100644 index 0000000..0130cf7 --- /dev/null +++ b/XMonad/Layout/ToggleLayouts.hs @@ -0,0 +1,84 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ToggleLayouts +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for writing easy Layouts +----------------------------------------------------------------------------- + +module XMonad.Layout.ToggleLayouts ( + -- * Usage + -- $usage + toggleLayouts, ToggleLayout(..) + ) where + +import XMonad + +-- $usage +-- Use toggleLayouts to toggle between two layouts. +-- +-- import XMonad.Layout.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' -- cgit v1.2.3