aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad
diff options
context:
space:
mode:
authorAudun Skaugen audunskaugen@gmail.com <gentoo-haskell@vcs.intern>2010-11-16 23:16:11 +0100
committerAudun Skaugen audunskaugen@gmail.com <gentoo-haskell@vcs.intern>2010-11-16 23:16:11 +0100
commite3d226ca44f80bc17e7422181c6b3f5579d240ed (patch)
tree8ea617709024eb3bf6c9d35205fe0e804ddf0f88 /XMonad
parent1ec6561af48ced6631c73ee4e94014afe68d5570 (diff)
downloadXMonadContrib-e3d226ca44f80bc17e7422181c6b3f5579d240ed.tar.gz
XMonadContrib-e3d226ca44f80bc17e7422181c6b3f5579d240ed.tar.xz
XMonadContrib-e3d226ca44f80bc17e7422181c6b3f5579d240ed.zip
Add X.L.Fullscreen
Ignore-this: 4b460e9a25abbb4f988801052232147a darcs-hash:20101116221611-dc3a6-529b2debf0b89fa9ac9283abd22fbf8ac513b41a.gz
Diffstat (limited to 'XMonad')
-rw-r--r--XMonad/Layout/Fullscreen.hs223
1 files changed, 223 insertions, 0 deletions
diff --git a/XMonad/Layout/Fullscreen.hs b/XMonad/Layout/Fullscreen.hs
new file mode 100644
index 0000000..1c547b6
--- /dev/null
+++ b/XMonad/Layout/Fullscreen.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Layout.Decoration
+-- Copyright : (c) 2010 Audun Skaugen
+-- License : BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer : audunskaugen@gmail.com
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Hooks for sending messages about fullscreen windows to layouts, and
+-- a few example layout modifier that implement fullscreen windows.
+-----------------------------------------------------------------------------
+module XMonad.Layout.Fullscreen
+ ( -- * Usage:
+ -- $usage
+ fullscreenFull
+ ,fullscreenFocus
+ ,fullscreenFullRect
+ ,fullscreenFocusRect
+ ,fullscreenFloat
+ ,fullscreenFloatRect
+ ,fullscreenEventHook
+ ,fullscreenManageHook
+ ,fullscreenManageHookWith
+ ,FullscreenMessage(..)
+ ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.WindowProperties
+import XMonad.Hooks.ManageHelpers (isFullscreen)
+import qualified XMonad.StackSet as W
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Map as M
+import Control.Monad
+import Control.Arrow (second)
+
+-- $usage
+-- Provides a ManageHook and an EventHook that sends layout messages
+-- with information about fullscreening windows. This allows layouts
+-- to make their own decisions about what they should to with a
+-- window that requests fullscreen.
+--
+-- The module also includes a few layout modifiers as an illustration
+-- of how such layouts should behave.
+--
+-- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook'
+-- to your config, i.e.
+--
+-- > xmonad defaultconfig { eventHook = fullscreenEventHook,
+-- > manageHook = fullscreenManageHook,
+-- > layoutHook = myLayouts }
+--
+-- Now you can use layouts that respect fullscreen, for example the
+-- provided 'fullscreenFull':
+--
+-- > myLayouts = fullscreenFull someLayout
+--
+
+-- | Messages that control the fullscreen state of the window.
+-- AddFullscreen and RemoveFullscreen are sent to all layouts
+-- when a window wants or no longer wants to be fullscreen.
+-- FullscreenChanged is sent to the current layout after one
+-- of the above have been sent.
+data FullscreenMessage = AddFullscreen Window
+ | RemoveFullscreen Window
+ | FullscreenChanged
+ deriving (Typeable)
+
+instance Message FullscreenMessage
+
+data FullscreenFull a = FullscreenFull W.RationalRect [a]
+ deriving (Read, Show)
+
+data FullscreenFocus a = FullscreenFocus W.RationalRect [a]
+ deriving (Read, Show)
+
+data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))
+ deriving (Read, Show)
+
+instance LayoutModifier FullscreenFull Window where
+ pureMess (FullscreenFull frect fulls) m = case fromMessage m of
+ Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls
+ Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls
+ _ -> Nothing
+
+ pureModifier (FullscreenFull frect fulls) rect _ list =
+ (map (flip (,) rect') visfulls ++ rest, Nothing)
+ where visfulls = intersect fulls $ map fst list
+ rest = filter (flip notElem visfulls . fst) list
+ rect' = scaleRationalRect rect frect
+
+instance LayoutModifier FullscreenFocus Window where
+ pureMess (FullscreenFocus frect fulls) m = case fromMessage m of
+ Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls
+ Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls
+ _ -> Nothing
+
+ pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
+ | f `elem` fulls = ((f, rect') : rest, Nothing)
+ | otherwise = (list, Nothing)
+ where rest = filter ((/= f) . fst) list
+ rect' = scaleRationalRect rect frect
+ pureModifier _ _ Nothing list = (list, Nothing)
+
+instance LayoutModifier FullscreenFloat Window where
+ handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
+ Just (AddFullscreen win) -> do
+ mrect <- (M.lookup win . W.floating) `fmap` gets windowset
+ return $ case mrect of
+ Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
+ Nothing -> Nothing
+
+ Just (RemoveFullscreen win) ->
+ return $ Just $ FullscreenFloat frect $ M.adjust (second $ const False) win fulls
+
+ -- Modify the floating member of the stack set directly; this is the hackish part.
+ Just FullscreenChanged -> do
+ state <- get
+ let ws = windowset state
+ flt = W.floating ws
+ flt' = M.intersectionWith doFull fulls flt
+ put state {windowset = ws {W.floating = M.union flt' flt}}
+ return $ Just $ FullscreenFloat frect $ M.filter snd fulls
+ where doFull (_, True) _ = frect
+ doFull (rect, False) _ = rect
+
+ Nothing -> return Nothing
+
+-- | Layout modifier that makes fullscreened window fill the
+-- entire screen.
+fullscreenFull :: LayoutClass l a =>
+ l a -> ModifiedLayout FullscreenFull l a
+fullscreenFull = fullscreenFullRect $ W.RationalRect 0 0 1 1
+
+-- | As above, but the fullscreened window will fill the
+-- specified rectangle instead of the entire screen.
+fullscreenFullRect :: LayoutClass l a =>
+ W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a
+fullscreenFullRect r = ModifiedLayout $ FullscreenFull r []
+
+-- | Layout modifier that makes the fullscreened window fill
+-- the entire screen only if it is currently focused.
+fullscreenFocus :: LayoutClass l a =>
+ l a -> ModifiedLayout FullscreenFocus l a
+fullscreenFocus = fullscreenFocusRect $ W.RationalRect 0 0 1 1
+
+-- | As above, but the fullscreened window will fill the
+-- specified rectangle instead of the entire screen.
+fullscreenFocusRect :: LayoutClass l a =>
+ W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
+fullscreenFocusRect r = ModifiedLayout $ FullscreenFocus r []
+
+-- | Hackish layout modifier that makes floating fullscreened
+-- windows fill the entire screen.
+fullscreenFloat :: LayoutClass l a =>
+ l a -> ModifiedLayout FullscreenFloat l a
+fullscreenFloat = fullscreenFloatRect $ W.RationalRect 0 0 1 1
+
+-- | As above, but the fullscreened window will fill the
+-- specified rectangle instead of the entire screen.
+fullscreenFloatRect :: LayoutClass l a =>
+ W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
+fullscreenFloatRect r = ModifiedLayout $ FullscreenFloat r M.empty
+
+-- | The event hook required for the layout modifiers to work
+fullscreenEventHook :: Event -> X All
+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
+ state <- getAtom "_NET_WM_STATE"
+ fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+ wstate <- fromMaybe [] `fmap` getProp32 state win
+ let fi :: (Integral i, Num n) => i -> n
+ fi = fromIntegral
+ isFull = fi fullsc `elem` wstate
+ remove = 0
+ add = 1
+ toggle = 2
+ ptype = 4
+ chWState f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)
+ when (typ == state && fi fullsc `elem` dats) $ do
+ when (action == add || (action == toggle && not isFull)) $ do
+ chWState (fi fullsc:)
+ broadcastMessage $ AddFullscreen win
+ sendMessage FullscreenChanged
+ when (action == remove || (action == toggle && isFull)) $ do
+ chWState $ delete (fi fullsc)
+ broadcastMessage $ RemoveFullscreen win
+ sendMessage FullscreenChanged
+ return $ All True
+
+fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do
+ -- When a window is destroyed, the layouts should remove that window
+ -- from their states.
+ broadcastMessage $ RemoveFullscreen w
+ cw <- (W.workspace . W.current) `fmap` gets windowset
+ sendMessageWithNoRefresh FullscreenChanged cw
+ return $ All True
+
+fullscreenEventHook _ = return $ All True
+
+-- | Manage hook that sets the fullscreen property for
+-- windows that are initially fullscreen
+fullscreenManageHook :: ManageHook
+fullscreenManageHook = fullscreenManageHook' isFullscreen
+
+-- | A version of fullscreenManageHook that lets you specify
+-- your own query to decide whether a window should be fullscreen.
+fullscreenManageHookWith :: Query Bool -> ManageHook
+fullscreenManageHookWith h = fullscreenManageHook' $ isFullscreen <||> h
+
+fullscreenManageHook' :: Query Bool -> ManageHook
+fullscreenManageHook' isFull = isFull --> do
+ w <- ask
+ liftX $ do
+ broadcastMessage $ AddFullscreen w
+ cw <- (W.workspace . W.current) `fmap` gets windowset
+ sendMessageWithNoRefresh FullscreenChanged cw
+ idHook
+