Initial commit

lib/ConfigurableBorders.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
+
+module ConfigurableBorders ( configureBorders
+                           , configBorderWidth
+                           , resetBorderWidth
+                           , doConfigBorderWidth
+                           , doConfigBorderOff
+                           ) where
+
+
+import qualified XMonad.Core as XM
+import XMonad.Operations (sendMessage)
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+import Graphics.X11.Types (Window)
+import Graphics.X11.Xlib.Types (Dimension)
+import Graphics.X11.Xlib.Window (setWindowBorderWidth)
+
+import Control.Monad.Reader
+
+import Data.Monoid
+import Data.Typeable
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+
+defaultBorderWidth :: XM.X Dimension
+defaultBorderWidth = asks (XM.borderWidth . XM.config)
+
+
+data BorderWidth = BorderWidth Window Dimension deriving Typeable
+
+instance XM.Message BorderWidth
+
+
+configBorderWidth :: Dimension -> Window -> XM.X ()
+configBorderWidth w win = sendMessage $ BorderWidth win w
+
+resetBorderWidth :: Window -> XM.X ()
+resetBorderWidth win = do
+  defBW <- defaultBorderWidth
+  configBorderWidth defBW win
+
+doConfigBorderWidth :: Dimension -> XM.ManageHook
+doConfigBorderWidth w = XM.Query $ do
+                        win <- ask
+                        lift $ configBorderWidth w win
+                        return $ Endo id
+
+doConfigBorderOff :: XM.ManageHook
+doConfigBorderOff = doConfigBorderWidth 0
+
+
+data ConfigureBorders a = ConfigureBorders (M.Map a Dimension) (M.Map a Dimension)
+                          deriving (Show, Read)
+
+configureBorders :: (XM.LayoutClass l a) =>
+                    l a
+                 -> ModifiedLayout ConfigureBorders l a
+configureBorders = ModifiedLayout $ ConfigureBorders M.empty M.empty
+
+
+instance LayoutModifier ConfigureBorders Window where
+    modifierDescription _ = "ConfigureBorders"
+                            
+    pureMess (ConfigureBorders wm wmlast) m
+        | Just (BorderWidth win width) <- XM.fromMessage m = do
+                                                  let wmnew = M.insert win width wm
+                                                  return $ ConfigureBorders wmnew wmlast
+
+    pureMess _ _ = Nothing
+    
+    redoLayout (ConfigureBorders wm wmlast) _ _ wrs = do
+      setBorders wmlast
+      return (wrs, Just $ ConfigureBorders M.empty wm)
+        where
+          ws = S.fromList $ map fst wrs
+
+
+setBorders :: (M.Map Window Dimension) -> XM.X ()
+setBorders wm = forM_ (M.toList wm) $ \(win,width) -> setBorder win width
+
+
+setBorder :: Window -> Dimension -> XM.X ()
+setBorder w width = XM.withDisplay $ \dpy -> XM.io $ setWindowBorderWidth dpy w width

lib/FullscreenManager.hs

@@ -0,0 +1,138 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
+
+module FullscreenManager (
+                          manageFullscreen,
+                          handleFullscreen,
+                          doFullscreen,
+                          doFloatMaybeFullscreen,
+                          setFullscreen,
+                          unsetFullscreen,
+                          setFullscreenFloat,
+                          unsetFullscreenFloat
+                         ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Hooks.ManageHelpers (isFullscreen)
+
+import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
+import Graphics.X11.Types (Window)
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+
+
+data SetFullscreen = SetFullscreen Window Bool Bool deriving Typeable
+
+instance Message SetFullscreen
+
+
+data FullscreenManager a = FullscreenManager (M.Map a W.RationalRect)
+                           deriving (Show, Read)
+
+manageFullscreen :: (LayoutClass l a) =>
+                    l a
+                 -> ModifiedLayout FullscreenManager l a
+manageFullscreen = ModifiedLayout $ FullscreenManager M.empty
+
+
+instance LayoutModifier FullscreenManager Window where
+    modifierDescription _ = "FullscreenManager"
+    
+    handleMess (FullscreenManager wm) m
+        | Just (SetFullscreen win fs ff) <- fromMessage m = do
+             let ptype = 4
+             state <- getAtom "_NET_WM_STATE"
+             fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+             winstate <- withDisplay $ \dpy -> io $ getWindowProperty32 dpy state win
+             let stateset = S.fromList $ fromMaybe [] winstate
+             
+             if fs then do
+                     floats <- isFloating win
+                     let float = if ff then True else floats
+                     (_,loc) <- floatLocation win
+                     
+                     let wmnew = if float then
+                                     M.union wm $ M.singleton win loc
+                                 else
+                                     wm
+                     withDisplay $ \dpy -> io $ changeProperty32 dpy win state ptype propModeReplace $ S.toList $ S.insert (fromIntegral fullsc) stateset
+                     fullscreenWin win
+                     return $ Just $ FullscreenManager wmnew
+                   else do
+                     let float = if ff then True else M.member win wm
+                     withDisplay $ \dpy -> io $ changeProperty32 dpy win state ptype propModeReplace $ S.toList $ S.delete (fromIntegral fullsc) stateset
+                     if float then do
+                                (_,defloc) <- floatLocation win
+                                let loc = M.findWithDefault defloc win wm
+                                floatWin win loc
+                              else
+                                tileWin win
+                     return $ Just $ FullscreenManager $ M.delete win wm
+    
+    handleMess _ _ = return Nothing
+    
+    redoLayout (FullscreenManager wm) _ _ wrs = do
+      ws <- gets windowset
+      let wmnew = M.filterWithKey (\w _ -> M.member w $ W.floating ws) wm
+      return (wrs, Just $ FullscreenManager $ wmnew)
+               
+
+
+isFloating :: Window -> X (Bool)
+isFloating w = gets windowset >>= \ws -> return $ M.member w (W.floating ws)
+
+
+doFullscreen :: ManageHook
+doFullscreen = Query $ do
+                 w <- ask
+                 lift $ setFullscreen w
+                 return $ Endo id
+
+doFloatMaybeFullscreen :: ManageHook
+doFloatMaybeFullscreen = Query $ do
+                           w <- ask
+                           isFull <- lift $ runQuery isFullscreen w
+                           lift $ if isFull then setFullscreenFloat w else unsetFullscreenFloat w
+                           return $ Endo id
+
+
+setFullscreen, unsetFullscreen, setFullscreenFloat, unsetFullscreenFloat :: Window -> X ()
+setFullscreen w = sendMessage $ SetFullscreen w True False
+unsetFullscreen w = sendMessage $ SetFullscreen w False False
+setFullscreenFloat w = sendMessage $ SetFullscreen w True True
+unsetFullscreenFloat w = sendMessage $ SetFullscreen w False True
+
+fullscreenWin, tileWin :: Window -> X ()
+fullscreenWin w = windows $ W.float w $ W.RationalRect 0 0 1 1
+tileWin w = windows $ W.sink w
+
+floatWin :: Window -> W.RationalRect -> X ()
+floatWin w loc = windows $ W.float w loc
+
+
+handleFullscreen :: Event -> X All
+handleFullscreen (ClientMessageEvent _ _ _ _ win typ dat) = do
+  state <- getAtom "_NET_WM_STATE"
+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+  isFull <- runQuery isFullscreen win
+
+  -- Constants for the _NET_WM_STATE protocol
+  let remove = 0
+      add = 1
+      toggle = 2
+      action = head dat
+  
+  when (typ == state && (fromIntegral fullsc) `elem` tail dat) $ do
+    when (action == add || (action == toggle && not isFull)) $ setFullscreen win
+    when (head dat == remove || (action == toggle && isFull)) $ unsetFullscreen win
+  
+  return $ All True
+
+handleFullscreen _ = return $ All True

lib/NoBorders.hs

@@ -0,0 +1,214 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.NoBorders
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Make a given layout display without borders.  This is useful for
+-- full-screen or tabbed layouts, where you don't really want to waste a
+-- couple of pixels of real estate just to inform yourself that the visible
+-- window has focus.
+--
+-----------------------------------------------------------------------------
+
+module NoBorders (
+                                -- * Usage
+                                -- $usage
+                                noBorders,
+                                smartBorders,
+                                withBorder,
+                                lessBorders,
+                                SetsAmbiguous(..),
+                                Ambiguity(..),
+                                With(..)
+                 ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet as W
+import Control.Monad
+import Data.List
+import qualified Data.Map as M
+import Data.Function (on)
+
+-- $usage
+-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Layout.NoBorders
+--
+-- and modify the layouts to call noBorders on the layouts you want to lack
+-- borders:
+--
+-- > layoutHook = ... ||| noBorders Full ||| ...
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- todo, use an InvisibleList.
+data WithBorder a = WithBorder Dimension (M.Map a Dimension) deriving ( Read, Show )
+
+instance LayoutModifier WithBorder Window where
+    unhook (WithBorder _ s) = setBorders $ M.toList s
+
+    redoLayout (WithBorder n sold) _ _ wrs = do
+        s <- mapM (\w -> winBorderWidth w >>= \bw -> return (w,bw)) ws >>= return . M.fromList
+        let snew = M.mapWithKey (\w bw -> M.findWithDefault bw w sold) s
+        
+        setBorders $ M.toList $ M.filterWithKey (\w _ -> elem w ws) sold
+        setBorders $ map (\w -> (w, n)) ws
+        return (wrs, Just $ WithBorder n $ snew)
+     where
+        ws = map fst wrs
+
+
+winBorderWidth :: Window -> X Dimension
+winBorderWidth w = withDisplay $ \d -> (fromIntegral . wa_border_width) `fmap` io (getWindowAttributes d w)
+
+-- | Removes all window borders from the specified layout.
+noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window
+noBorders = withBorder 0
+
+-- | Forces a layout to use the specified border width. 'noBorders' is
+-- equivalent to @'withBorder' 0@.
+withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a
+withBorder b = ModifiedLayout $ WithBorder b M.empty
+
+setBorders :: [(Window, Dimension)] -> X ()
+setBorders ws = withDisplay $ \d -> mapM_ (\(w,bw) -> io $ setWindowBorderWidth d w bw) ws
+
+singleton :: [a] -> Bool
+singleton = null . drop 1
+
+type SmartBorder = ConfigurableBorder Ambiguity
+
+-- | Removes the borders from a window under one of the following conditions:
+--
+--  * There is only one screen and only one window. In this case it's obvious
+--  that it has the focus, so no border is needed.
+--
+--  * A floating window covers the entire screen (e.g. mplayer).
+--
+smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a
+smartBorders = lessBorders Never
+
+-- | Apply a datatype that has a SetsAmbiguous instance to provide a list of
+-- windows that should not have borders.
+--
+-- This gives flexibility over when borders should be drawn, in particular with
+-- xinerama setups: 'Ambiguity' has a number of useful 'SetsAmbiguous'
+-- instances
+lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) =>
+        p -> l a -> ModifiedLayout (ConfigurableBorder p) l a
+lessBorders amb = ModifiedLayout (ConfigurableBorder amb M.empty)
+
+data ConfigurableBorder p w = ConfigurableBorder p (M.Map w Dimension) deriving (Read, Show)
+
+instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
+    unhook (ConfigurableBorder _ s) = do
+      setBorders $ M.toList s
+
+    redoLayout (ConfigurableBorder p sold) _ mst wrs = do
+        wsh <- withWindowSet (\wset -> return (hiddens p wset mst wrs))
+        s <- mapM (\w -> winBorderWidth w >>= \bw -> return (w,bw)) ws >>= return . M.fromList
+        let snew = M.mapWithKey (\w bw -> M.findWithDefault bw w sold) s
+        
+        setBorders $ M.toList $ M.filterWithKey (\w _ -> notElem w wsh) sold
+        setBorders $ map (\w -> (w, 0)) wsh
+        return (wrs, Just $ ConfigurableBorder p snew)
+      where
+        ws = map fst wrs
+
+-- | SetsAmbiguous allows custom actions to generate lists of windows that
+-- should not have borders drawn through 'ConfigurableBorder'
+--
+-- To add your own (though perhaps those options would better belong as an
+-- aditional constructor to 'Ambiguity'), you can add the function as such:
+--
+-- > data MyAmbiguity = MyAmbiguity deriving (Read, Show)
+--
+-- > instance SetsAmbiguous MyAmbiguity where
+-- >  hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat
+-- >     where otherHiddens p = hiddens p wset mst wrs
+--
+-- The above example is redundant, because you can have the same result with:
+--
+-- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... )
+--
+-- To get the same result as smartBorders:
+--
+-- > layoutHook = lessBorders (Combine Never) (Tall 1 0.5 0.03 ||| ...)
+--
+-- This indirect method is required to keep the Read and Show for
+-- ConfigurableBorder so that xmonad can serialize state.
+class SetsAmbiguous p where
+    hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
+
+instance SetsAmbiguous Ambiguity where
+    hiddens amb wset mst wrs
+      | Combine Union a b <- amb = on union next a b
+      | Combine Difference a b <- amb = on (\\) next a b
+      | Combine Intersection a b <- amb = on intersect next a b
+      | otherwise = tiled ms ++ floating
+      where next p = hiddens p wset mst wrs
+            nonzerorect (Rectangle _ _ 0 0) = False
+            nonzerorect _ = True
+
+            screens =
+              [ scr | scr <- W.screens wset,
+                      case amb of
+                            Never -> True
+                            _ -> not $ null $ integrate scr,
+                      nonzerorect . screenRect $ W.screenDetail scr]
+            floating = [ w |
+                        (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
+                        px <= 0, py <= 0,
+                        wx + px >= 1, wy + py >= 1]
+            ms = filter (`elem` W.integrate' mst) $ map fst wrs
+            tiled [w]
+              | Screen <- amb = [w]
+              | OnlyFloat <- amb = []
+              | OtherIndicated <- amb
+              , let nonF = map integrate $ W.current wset : W.visible wset
+              , length (concat nonF) > length wrs
+              , singleton $ filter (1==) $ map length nonF = [w]
+              | singleton screens = [w]
+            tiled _ = []
+            integrate y = W.integrate' . W.stack $ W.workspace y
+
+-- | In order of increasing ambiguity (less borders more frequently), where
+-- subsequent constructors add additional cases where borders are not drawn
+-- than their predecessors. These behaviors make most sense with with multiple
+-- screens: for single screens, Never or 'smartBorders' makes more sense.
+data Ambiguity = Combine With Ambiguity Ambiguity
+                             -- ^ This constructor is used to combine the
+                             -- borderless windows provided by the
+                             -- SetsAmbiguous instances from two other
+                             -- 'Ambiguity' data types.
+               | OnlyFloat   -- ^ Only remove borders on floating windows that
+                             -- cover the whole screen
+               | Never       -- ^ Never remove borders when ambiguous:
+                             -- this is the same as smartBorders
+               | EmptyScreen -- ^ Focus in an empty screens does not count as
+                             -- ambiguous.
+               | OtherIndicated
+                             -- ^ No borders on full when all other screens
+                             -- have borders.
+               | Screen      -- ^ Borders are never drawn on singleton screens.
+                             -- With this one you really need another way such
+                             -- as a statusbar to detect focus.
+    deriving (Read, Show)
+
+-- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two
+-- lists should be combined.
+data With = Union        -- ^ Combine with Data.List.union
+          | Difference   -- ^ Combine with Data.List.\\
+          | Intersection -- ^ Combine with Data.List.intersect
+        deriving (Read, Show)

xmonad.hs

@@ -0,0 +1,68 @@
+import XMonad
+import XMonad.Config.Desktop
+import XMonad.Config.Gnome
+import XMonad.Actions.CycleWS
+import XMonad.Actions.NoBorders
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import qualified XMonad.StackSet as W
+import XMonad.Util.EZConfig
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.Monoid
+
+import ConfigurableBorders
+import FullscreenManager
+import NoBorders
+
+
+main = xmonad $ gnomeConfig
+       { modMask = mod4Mask -- set the mod key to the windows key
+       , manageHook = myManageHook
+       , layoutHook = desktopLayoutModifiers myLayoutHook
+       , startupHook = myStartupHook
+       , handleEventHook = handleFullscreen
+       }
+       `additionalKeysP`
+       [ ("M-<Left>",    prevWS )
+       , ("M-<Right>",   nextWS )
+       , ("M-S-<Left>",  shiftToPrev )
+       , ("M-S-<Right>", shiftToNext )
+       , ("M-S-b", withFocused toggleBorder >> refresh)
+       , ("M1-<F4>", kill)
+       ]
+
+
+myStartupHook :: X ()
+myStartupHook = do
+  startupHook gnomeConfig
+  spawn "xcompmgr"
+
+myManageHook :: ManageHook
+myManageHook = composeAll
+               [ composeOne
+                 [ className =? "Guake.py"   -?> (doFloatMaybeFullscreen <+> doConfigBorderOff)
+                 , className =? "Do"         -?> (doFloat <+> doConfigBorderOff)
+                 , className =? "MPlayer"    -?> doCenterFloat
+                 , className =? "Gimp"       -?> doFloat
+                 , className =? "Gajim.py"   -?> doFloat
+                 , isFullscreen              -?> doFullscreen
+                 ]
+               , manageHook gnomeConfig
+               ]
+        
+
+myLayoutHook = manageFullscreen $ configureBorders $ smartBorders (tiled ||| Mirror tiled ||| Full)
+  where
+    -- default tiling algorithm partitions the screen into two panes
+    tiled   = Tall nmaster delta ratio
+ 
+    -- The default number of windows in the master pane
+    nmaster = 1
+ 
+    -- Default proportion of screen occupied by master pane
+    ratio   = 1/2 
+
+    -- Percent of screen to increment by when resizing panes
+    delta   = 3/100