From 3be5dcfad0ec38802d64f6ef95185e064559d439 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Fri, 28 Sep 2007 01:10:02 +0200 Subject: Remove Tabbed.hs darcs-hash:20070927231002-a5988-c1cbb1c0724912f2327879eaba41917366d66dc4.gz --- Tabbed.hs | 146 -------------------------------------------------------------- 1 file changed, 146 deletions(-) delete mode 100644 Tabbed.hs (limited to 'Tabbed.hs') diff --git a/Tabbed.hs b/Tabbed.hs deleted file mode 100644 index 8f21fae..0000000 --- a/Tabbed.hs +++ /dev/null @@ -1,146 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.Tabbed --- Copyright : (c) David Roundy --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : email@address.com --- Stability : unstable --- Portability : unportable --- --- A tabbed layout for the Xmonad Window Manager --- ------------------------------------------------------------------------------ - -module XMonadContrib.Tabbed ( - -- * Usage: - -- $usage - tabbed - , Shrinker, shrinkText - , TConf (..), defaultTConf - ) where - -import Control.Monad.State ( gets ) - -import Graphics.X11.Xlib -import XMonad -import XMonadContrib.Decoration -import Operations ( focus, initColor ) -import qualified StackSet as W - -import XMonadContrib.NamedWindows -import XMonadContrib.SimpleStacking ( simpleStacking ) -import XMonadContrib.LayoutHelpers ( idModify ) - --- $usage --- You can use this module with the following in your configuration file: --- --- > import XMonadContrib.Tabbed --- --- > defaultLayouts :: [Layout Window] --- > defaultLayouts = [ tabbed shrinkText defaultTConf --- > , ... ] --- --- You can also edit the default configuration options. --- --- > myconfig = defaultTConf { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} --- --- and --- --- > defaultLayouts = [ tabbed shrinkText myconfig --- > , ... ] - --- %import XMonadContrib.Tabbed --- %layout , tabbed shrinkText defaultTConf - -data TConf = - TConf { activeColor :: String - , inactiveColor :: String - , activeBorderColor :: String - , inactiveTextColor :: String - , inactiveBorderColor :: String - , activeTextColor :: String - , fontName :: String - , tabSize :: Int - } deriving (Show, Read) - -defaultTConf :: TConf -defaultTConf = - TConf { activeColor ="#999999" - , inactiveColor = "#666666" - , activeBorderColor = "#FFFFFF" - , inactiveBorderColor = "#BBBBBB" - , activeTextColor = "#FFFFFF" - , inactiveTextColor = "#BFBFBF" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , tabSize = 20 - } - -tabbed :: Shrinker -> TConf -> Layout Window -tabbed s t = simpleStacking $ tabbed' s t - -tabbed' :: Shrinker -> TConf -> Layout Window -tabbed' shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = idModify } - -dolay :: Shrinker -> TConf - -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window)) -dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing) -dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> - do ac <- io $ initColor dpy $ activeColor conf - ic <- io $ initColor dpy $ inactiveColor conf - abc <- io $ initColor dpy $ activeBorderColor conf - ibc <- io $ initColor dpy $ inactiveBorderColor conf - atc <- io $ initColor dpy $ activeTextColor conf - itc <- io $ initColor dpy $ inactiveTextColor conf - let ws = W.integrate s - ts = gentabs conf x y wid (length ws) - tws = zip ts ws - focusColor w incol actcol = (maybe incol (\focusw -> if focusw == w - then actcol else incol) . W.peek) - `fmap` gets windowset - make_tabs [] l = return l - make_tabs (tw':tws') l = do bc <- focusColor (snd tw') ibc abc - l' <- maketab tw' bc l - make_tabs tws' l' - maketab (t,ow) bg = newDecoration ow t 1 bg ac - (fontName conf) (drawtab t ow) (focus ow) - drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = - do nw <- getName ow - (fc,tc) <- focusColor ow (ic,itc) (ac,atc) - io $ setForeground d gc fc - io $ fillRectangles d w' gc [Rectangle 0 0 wt ht] - io $ setForeground d gc tc - centerText d w' gc fn r (show nw) - centerText d w' gc fontst (Rectangle _ _ wt ht) name = - do let (_,asc,_,_) = textExtents fontst name - name' = shrinkWhile shr (\n -> textWidth fontst n > - fromIntegral wt - fromIntegral (ht `div` 2)) name - width = textWidth fontst name' - io $ drawString d w' gc - (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2)) - ((fromIntegral ht + fromIntegral asc) `div` 2) name' - l' <- make_tabs tws $ tabbed shr conf - return (map (\w -> (w,shrink conf sc)) ws, Just l') - -type Shrinker = String -> [String] - -shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String -shrinkWhile sh p x = sw $ sh x - where sw [n] = n - sw [] = "" - sw (n:ns) | p n = sw ns - | otherwise = n - -shrinkText :: Shrinker -shrinkText "" = [""] -shrinkText cs = cs : shrinkText (init cs) - -shrink :: TConf -> Rectangle -> Rectangle -shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c)) - -gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle] -gentabs _ _ _ _ 0 = [] -gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2) - : gentabs c (x + fromIntegral wid) y (w - wid) (num - 1) - where wid = w `div` (fromIntegral num) -- cgit v1.2.3