From f6a589c128a45ec862b704ba5d02a7bc91deae2b Mon Sep 17 00:00:00 2001 From: David Roundy Date: Sun, 11 Nov 2007 20:50:36 +0100 Subject: add two new modules, one to name layouts, another to select a layout. The latter is pretty useless, as there's no way to find out what layouts are available, but it can at least allow you to select between any layouts that you happen to be using already (in one workspace or another). The former is handy any time you'd rather have a short name for a layout (either for selecting, or for viewing in a status bar). darcs-hash:20071111195036-72aca-8ffbd496a9dbbdd7ca7e92a5bbedb568b2384485.gz --- XMonad/Layout/Named.hs | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 XMonad/Layout/Named.hs (limited to 'XMonad/Layout/Named.hs') diff --git a/XMonad/Layout/Named.hs b/XMonad/Layout/Named.hs new file mode 100644 index 0000000..54ef89b --- /dev/null +++ b/XMonad/Layout/Named.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Named +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Named ( + -- * Usage + -- $usage + Named(Named) + ) where + +import XMonad + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Layout.Named +-- +-- and change the name of a given layout by +-- +-- > layout = Named "real big" Full ||| ... + +data Named l a = Named String (l a) deriving ( Read, Show ) + +instance (LayoutClass l a) => LayoutClass (Named l) a where + doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s + return (ws, Named n `fmap` ml') + handleMessage (Named n l) mess = do ml' <- handleMessage l mess + return $ Named n `fmap` ml' + description (Named n _) = n -- cgit v1.2.3