aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/ToggleLayouts.hs
blob: 7fe68dcb932051572a06a97a8276dd2f6357bad1 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Layout.ToggleLayouts
-- Copyright    : (c) David Roundy <droundy@darcs.net>
-- License      : BSD
--
-- Maintainer   : David Roundy <droundy@darcs.net>
-- Stability    : unstable
-- Portability  : portable
--
-- A module to toggle between two layouts.
-----------------------------------------------------------------------------

module XMonad.Layout.ToggleLayouts (
    -- * Usage
    -- $usage
    toggleLayouts, ToggleLayout(..)
    ) where

import XMonad

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.ToggleLayouts
--
-- Then edit your @layoutHook@ by adding the ToggleLayouts layout:
--
-- > myLayouts = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc..
-- > main = xmonad defaultConfig { layoutHook = myLayouts }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- To toggle between layouts add a key binding like
--
-- >    , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)
--
-- or a key binding like
--
-- >    , ((modMask x .|. controlMask, xK_space), sendMessage (Toggle "Full"))
--
-- For detailed instruction on editing the key binding see:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".

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')
    emptyLayout (ToggleLayouts True lt lf) r = do (ws,mlt') <- emptyLayout lt r
                                                  return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')
    emptyLayout (ToggleLayouts False lt lf) r = do (ws,mlf') <- emptyLayout lf r
                                                   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'