content: {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Layout.Tabbed
  -- Copyright   :  (c) 2007 David Roundy, Andrea Rossato
  -- License     :  BSD-style (see xmonad/LICENSE)
  --
  -- Maintainer  :  andrea.rossato@unibz.it
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- A tabbed layout for the Xmonad Window Manager
  --
  -----------------------------------------------------------------------------
  
  module XMonad.Layout.Tabbed
      ( -- * Usage:
        -- $usage
        simpleTabbed, tabbed, addTabs
      , simpleTabbedAlways, tabbedAlways, addTabsAlways
      , simpleTabbedBottom, tabbedBottom, addTabsBottom
      , simpleTabbedLeft, tabbedLeft, addTabsLeft
      , simpleTabbedRight, tabbedRight, addTabsRight
      , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways
      , simpleTabbedLeftAlways, tabbedLeftAlways, addTabsLeftAlways
      , simpleTabbedRightAlways, tabbedRightAlways, addTabsRightAlways
      , Theme (..)
      , def
      , defaultTheme
      , TabbedDecoration (..)
      , shrinkText, CustomShrink(CustomShrink)
      , Shrinker(..)
      , TabbarShown, Direction2D(..)
      ) where
  
  import Data.List
  
  import XMonad
  import qualified XMonad.StackSet as S
  import XMonad.Layout.Decoration
  import XMonad.Layout.Simplest ( Simplest(Simplest) )
  import XMonad.Util.Types (Direction2D(..))
  
  -- $usage
  -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
  --
  -- > import XMonad.Layout.Tabbed
  --
  -- Then edit your @layoutHook@ by adding the Tabbed layout:
  --
  -- > myLayout = simpleTabbed ||| Full ||| etc..
  --
  -- or, if you want a specific theme for you tabbed layout:
  --
  -- > myLayout = tabbed shrinkText def ||| Full ||| etc..
  --
  -- and then:
  --
  -- > main = xmonad def { layoutHook = myLayout }
  --
  -- This layout has hardcoded behaviour for mouse clicks on tab decorations:
  -- Left click on the tab switches focus to that window.
  -- Middle click on the tab closes the window.
  --
  -- The default Tabbar behaviour is to hide it when only one window is open
  -- on the workspace.  To have it always shown, use one of the layouts or
  -- modifiers ending in @Always@.
  --
  -- For more detailed instructions on editing the layoutHook see:
  --
  -- "XMonad.Doc.Extending#Editing_the_layout_hook"
  --
  -- You can also edit the default configuration options.
  --
  -- > myTabConfig = def { inactiveBorderColor = "#FF0000"
  -- >                   , activeTextColor = "#00FF00"}
  --
  -- and
  --
  -- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..
  
  -- Layouts
  
  -- | A tabbed layout with the default xmonad Theme.
  --
  -- This is a minimal working configuration:
  --
  -- > import XMonad
  -- > import XMonad.Layout.Tabbed
  -- > main = xmonad def { layoutHook = simpleTabbed }
  simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
  simpleTabbed = tabbed shrinkText def
  
  simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
  simpleTabbedAlways = tabbedAlways shrinkText def
  
  -- | A bottom-tabbed layout with the default xmonad Theme.
  simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
  simpleTabbedBottom = tabbedBottom shrinkText def
  
  -- | A bottom-tabbed layout with the default xmonad Theme.
  simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
  simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def
  
  -- | A side-tabbed layout with the default xmonad Theme.
  simpleTabbedLeft, simpleTabbedRight :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) 
                                          Simplest Window
  simpleTabbedLeft = tabbedLeft shrinkText def
  simpleTabbedRight = tabbedRight shrinkText def
  
  -- | A side-tabbed layout with the default xmonad Theme.
  simpleTabbedLeftAlways, simpleTabbedRightAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) 
                                                    Simplest Window
  simpleTabbedLeftAlways = tabbedLeftAlways shrinkText def
  simpleTabbedRightAlways = tabbedRightAlways shrinkText def
  
  -- | A layout decorated with tabs and the possibility to set a custom
  -- shrinker and theme.
  tabbed     :: (Eq a, Shrinker s) => s -> Theme
             -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
  tabbed s c = addTabs s c Simplest
  
  tabbedAlways     :: (Eq a, Shrinker s) => s -> Theme
                   -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
  tabbedAlways s c = addTabsAlways s c Simplest
  
  -- | A layout decorated with tabs at the bottom and the possibility to set a custom
  -- shrinker and theme.
  tabbedBottom     :: (Eq a, Shrinker s) => s -> Theme
                   -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
  tabbedBottom s c = addTabsBottom s c Simplest
  
  tabbedBottomAlways     :: (Eq a, Shrinker s) => s -> Theme
                         -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
  tabbedBottomAlways s c = addTabsBottomAlways s c Simplest
  
  -- | A layout decorated with tabs and the possibility to set a custom
  -- shrinker and theme.
  tabbedLeft, tabbedRight :: (Eq a, Shrinker s) => s -> Theme
                          -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
  tabbedLeft s c = addTabsLeft s c Simplest
  tabbedRight s c = addTabsRight s c Simplest
  
  -- | A layout decorated with tabs and the possibility to set a custom
  -- shrinker and theme.
  tabbedLeftAlways, tabbedRightAlways :: (Eq a, Shrinker s) => s -> Theme
                                      -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
  tabbedLeftAlways s c = addTabsLeftAlways s c Simplest
  tabbedRightAlways s c = addTabsRightAlways s c Simplest
  
  -- Layout Modifiers
  
  -- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout.
  addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
          -> ModifiedLayout (Decoration TabbedDecoration s) l a
  addTabs = createTabs WhenPlural U
  
  addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                -> ModifiedLayout (Decoration TabbedDecoration s) l a
  addTabsAlways = createTabs Always U
  
  -- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout.
  addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                -> ModifiedLayout (Decoration TabbedDecoration s) l a
  addTabsBottom = createTabs WhenPlural D
  
  addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                      -> ModifiedLayout (Decoration TabbedDecoration s) l a
  addTabsBottomAlways = createTabs Always D
  
  -- | A layout modifier that uses the provided shrinker and theme to add tabs to the side of any layout.
  addTabsRight, addTabsLeft :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                              -> ModifiedLayout (Decoration TabbedDecoration s) l a
  addTabsRight = createTabs WhenPlural R
  addTabsLeft = createTabs WhenPlural L
  
  addTabsRightAlways, addTabsLeftAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                                        -> ModifiedLayout (Decoration TabbedDecoration s) l a
  addTabsRightAlways = createTabs Always R
  addTabsLeftAlways = createTabs Always L
  
  -- Tab creation abstractions.  Internal use only.
  
  -- Create tabbar when required at the given location with the given
  -- shrinker and theme to the supplied layout.
  createTabs                ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> Direction2D -> s
                            -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a
  
  createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l
  
  data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq)
  
  data TabbedDecoration a = Tabbed Direction2D TabbarShown deriving (Read, Show)
  
  instance Eq a => DecorationStyle TabbedDecoration a where
      describeDeco (Tabbed U _ ) = "Tabbed"
      describeDeco (Tabbed D _ ) = "Tabbed Bottom"
      describeDeco (Tabbed L _ ) = "Tabbed Left"
      describeDeco (Tabbed R _ ) = "Tabbed Right"
      decorationEventHook _ ds ButtonEvent { ev_window     = ew
                                           , ev_event_type = et
                                           , ev_button     = eb }
          | et == buttonPress
          , Just ((w,_),_) <- findWindowByDecoration ew ds =
             if eb == button2
                 then killWindow w
                 else focus w
      decorationEventHook _ _ _ = return ()
  
      pureDecoration (Tabbed lc sh) wt ht _ s wrs (w,r@(Rectangle x y wh hh))
          = if ((sh == Always && numWindows > 0) || numWindows > 1)
            then Just $ case lc of
                          U -> upperTab
                          D -> lowerTab
                          L -> leftTab
                          R -> rightTab
            else Nothing
          where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s)
                loc k h i = k + fi ((h * fi i) `div` max 1 (fi $ length ws))
                esize k h = fi $ maybe k (\i -> loc k h (i+1) - loc k h i) $ w `elemIndex` ws
                wid = esize x wh
                hid = esize y hh
                n k h = maybe k (loc k h) $ w `elemIndex` ws
                nx = n x wh
                ny = n y hh
                upperTab = Rectangle nx  y wid (fi ht)
                lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht)
                leftTab = Rectangle x ny (fi wt) hid
                rightTab = Rectangle (x + fi (wh - wt)) ny (fi wt) hid
                numWindows = length ws
      shrink (Tabbed loc _ ) (Rectangle _ _ dw dh) (Rectangle x y w h)
          = case loc of
              U -> Rectangle x (y + fi dh) w (h - dh)
              D -> Rectangle x y w (h - dh)
              L -> Rectangle (x + fi dw) y (w - dw) h
              R -> Rectangle x y (w - dw) h
  