From 1b9363d20a0a9862478a45d06dea1dfce68a6aac Mon Sep 17 00:00:00 2001 From: "l.mai" Date: Sat, 28 Jul 2007 17:38:26 +0200 Subject: SwitchTrans.hs, initial version darcs-hash:20070728153826-42ea9-f95bda9274b0d754087cca52f0df42af09695a00.gz --- SwitchTrans.hs | 161 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 161 insertions(+) create mode 100644 SwitchTrans.hs (limited to 'SwitchTrans.hs') diff --git a/SwitchTrans.hs b/SwitchTrans.hs new file mode 100644 index 0000000..0aadfff --- /dev/null +++ b/SwitchTrans.hs @@ -0,0 +1,161 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SwitchTrans +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +{-# OPTIONS_GHC -fglasgow-exts #-} + +-- | Ordinary layout transformers are simple and easy to use but inflexible. +-- This module provides a more structured interface to them. +-- +-- The basic idea is to have a base layout and a set of layout transformers, +-- of which at most one is active at any time. Enabling another transformer +-- first disables any currently active transformer; i.e. it works like +-- a group of radio buttons. +-- +-- A side effect of this meta-layout is that layout transformers no longer +-- receive any messages; any message not handled by @SwitchTrans@ itself +-- will undo the current layout transformer, pass the message on to the base +-- layout, then reapply the transformer. +-- +-- Here's how you might use this in Config.hs: +-- +-- > defaultLayouts = +-- > map ( +-- > mkSwitch (M.singleton "full" (const $ noBorders full)) . +-- > mkSwitch (M.singleton "mirror" mirror) +-- > ) [ tiled ] +-- +-- (The noBorders transformer is from @XMonadContrib.NoBorders@.) +-- +-- This example is probably overkill but it's very close to what I actually use. +-- Anyway, this layout behaves like the default @tiled@ layout, until you send it +-- @Enable@\/@Disable@\/@Toggle@ messages. From the definition of @keys@: +-- +-- > ... +-- > , ((modMask, xK_f ), sendMessage $ Toggle "full") +-- > , ((modMask, xK_r ), sendMessage $ Toggle "mirror") +-- +-- (You may want to use other keys. I don't use Xinerama so the default mod-r +-- binding is useless to me.) +-- +-- After this, pressing @mod-f@ switches the current window to fullscreen mode. +-- Pressing @mod-f@ again switches it back. Similarly, @mod-r@ rotates the layout +-- by 90 degrees (and back). The nice thing is that your changes are kept: +-- Rotating first then changing the size of the master area then rotating back +-- does not undo the master area changes. +-- +-- The reason I use two stacked @SwitchTrans@ transformers instead of +-- @mkSwitch (M.fromList [("full", const $ noBorders full), ("mirror", mirror)])@ +-- is that I use @mod-f@ to "zoom in" on interesting windows, no matter what other +-- layout transformers may be active. Having an extra fullscreen mode on top of +-- everything else means I can zoom in and out without implicitly undoing "normal" +-- layout transformers, like @mirror@. Remember, inside a @SwitchTrans@ there can +-- be at most one active layout transformer. +module XMonadContrib.SwitchTrans ( + Toggle(..), + Enable(..), + Disable(..), + mkSwitch +) where + +import XMonad +import Operations + +import qualified Data.Map as M +import Data.Map (Map) + +-- | Toggle the specified layout transformer. +data Toggle = Toggle String deriving (Eq, Typeable) +instance Message Toggle +-- | Enable the specified transformer. +data Enable = Enable String deriving (Eq, Typeable) +instance Message Enable +-- | Disable the specified transformer. +data Disable = Disable String deriving (Eq, Typeable) +instance Message Disable + +data State a = State { + base :: Layout a, + currTag :: Maybe String, + currLayout :: Layout a, + currFilt :: Layout a -> Layout a, + filters :: Map String (Layout a -> Layout a) +} + +-- | Take a transformer table and a base layout, and return a +-- SwitchTrans layout. +mkSwitch :: Map String (Layout a -> Layout a) -> Layout a -> Layout a +mkSwitch fs b = switched st + where + st = State{ + base = b, + currTag = Nothing, + currLayout = b, + currFilt = id, + filters = fs } + +provided :: Bool -> X (Maybe a) -> X (Maybe a) +provided c x + | c = x + | otherwise = return Nothing + +switched :: State a -> Layout a +switched + state@State{ + base = b, + currTag = ct, + currLayout = cl, + currFilt = cf, + filters = fs + } = Layout {doLayout = dl, modifyLayout = ml} + where + enable tag alt = do + modifyLayout cl (SomeMessage UnDoLayout) + return . Just . switched $ state{ + currTag = Just tag, + currFilt = alt, + currLayout = alt b } + disable = do + modifyLayout cl (SomeMessage UnDoLayout) + return . Just . switched $ state{ + currTag = Nothing, + currFilt = id, + currLayout = b } + dl r s = do + (x, _) <- doLayout cl r s + return (x, Nothing) -- sorry Dave, I can't let you do that + ml m + | Just (Disable tag) <- fromMessage m + , M.member tag fs + = provided (ct == Just tag) $ disable + | Just (Enable tag) <- fromMessage m + , Just alt <- M.lookup tag fs + = provided (ct /= Just tag) $ enable tag alt + | Just (Toggle tag) <- fromMessage m + , Just alt <- M.lookup tag fs + = + if (ct == Just tag) then + disable + else + enable tag alt + | Just UnDoLayout <- fromMessage m + = do + modifyLayout cl m + return Nothing + | otherwise = do + x <- modifyLayout b m + case x of + Nothing -> return Nothing + Just b' -> do + modifyLayout cl (SomeMessage UnDoLayout) + return . Just $ switched state{ + base = b', + currLayout = cf b' } -- cgit v1.2.3