From 43d7d7cb652d49726f7b83a4088c1bf1b34ec61a Mon Sep 17 00:00:00 2001 From: Roman Cheplyaka Date: Sat, 15 Nov 2008 11:47:35 +0100 Subject: added XMonad.Layout.Monitor darcs-hash:20081115104735-3ebed-324fd5c577eb7e16915105c35a20673b1d24bbdc.gz --- XMonad/Layout/Monitor.hs | 131 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) create mode 100644 XMonad/Layout/Monitor.hs (limited to 'XMonad/Layout/Monitor.hs') diff --git a/XMonad/Layout/Monitor.hs b/XMonad/Layout/Monitor.hs new file mode 100644 index 0000000..d46f914 --- /dev/null +++ b/XMonad/Layout/Monitor.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Monitor +-- Copyright : (c) Roman Cheplyaka +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Roman Cheplyaka +-- Stability : unstable +-- Portability : unportable +-- +-- Layout modfier for displaying some window (monitor) above other windows +-- +----------------------------------------------------------------------------- +module XMonad.Layout.Monitor ( + -- * Usage + -- $usage + + -- * Hints + -- $hints + + -- * TODO + -- $todo + Property(..), + MonitorMessage(..), + addMonitor, + addPersistentMonitor, + addNamedMonitor, + addNamedPersistentMonitor + ) where + +import XMonad +import XMonad.Layout.LayoutModifier +import XMonad.Util.WindowProperties +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Monitor +-- +-- Then add monitor to desired layouts: +-- +-- > myLayouts = addMonitor (ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock") (Rectangle (1280-150) (800-150) 150 150) $ tall ||| Full ||| ... +-- +-- After that, if there exists a window with specified properties, it will be +-- displayed on top of all /tiled/ (not floated) windows on specified +-- position. +-- +-- It's also useful to add some keybinding to toggle monitor visibility: +-- +-- > , ((mod1Mask, xK_u ), sendMessage ToggleMonitor) +-- +-- Screenshot: + +data Monitor a = Monitor { + prop :: Property, -- a window which satisfies that property is chosen as monitor + rect :: Rectangle, -- where to put monitor + visible :: Bool, -- is it visible? + mbName :: (Maybe String), -- name of monitor (useful when we have many of them) + persistent :: Bool -- on all layouts? + } deriving (Read, Show) + +data MonitorMessage = ToggleMonitor | ShowMonitor | HideMonitor + | ToggleMonitorNamed String + | ShowMonitorNamed String + | HideMonitorNamed String + deriving (Read,Show,Eq,Typeable) +instance Message MonitorMessage + +withMonitor :: Property -> a -> (Window -> X a) -> X a +withMonitor p a fn = do + monitorWindows <- allWithProperty p + case monitorWindows of + [] -> return a + w:_ -> fn w + +instance LayoutModifier Monitor Window where + redoLayout mon _ _ rects = withMonitor (prop mon) (rects, Nothing) $ \w -> + if visible mon + then do tileWindow w (rect mon) + reveal w + return ((w,rect mon):rects, Nothing) + else do hide w + return (rects, Nothing) + handleMess mon mess + | Just ToggleMonitor <- fromMessage mess = return $ Just $ mon { visible = not $ visible mon } + | Just (ToggleMonitorNamed n) <- fromMessage mess = return $ + if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = not $ visible mon } else Nothing + | Just ShowMonitor <- fromMessage mess = return $ Just $ mon { visible = True } + | Just (ShowMonitorNamed n) <- fromMessage mess = return $ + if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = True } else Nothing + | Just HideMonitor <- fromMessage mess = return $ Just $ mon { visible = False } + | Just (HideMonitorNamed n) <- fromMessage mess = return $ + if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = False } else Nothing + | Just Hide <- fromMessage mess = do unless (persistent mon) $ withMonitor (prop mon) () hide; return Nothing + | otherwise = return Nothing + +addMonitor :: Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addMonitor p r = ModifiedLayout (Monitor p r True Nothing False) +addPersistentMonitor :: Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addPersistentMonitor p r = ModifiedLayout (Monitor p r True Nothing True) +addNamedMonitor :: String -> Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addNamedMonitor name p r = ModifiedLayout (Monitor p r True (Just name) False) +addNamedPersistentMonitor :: String -> Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addNamedPersistentMonitor name p r = ModifiedLayout (Monitor p r True (Just name) True) + +-- $hints +-- - This module assumes that there is only one window satisfying property exists. Also it's good idea to make it unmanaged and (optionally) hide it using ManageHook: +-- +-- > className =? "Cairo-clock"--> (ask >>= \w -> liftX (hide w) >> doF (W.delete w)) +-- +-- - If you want monitor to be available on /all/ layouts, there's no point in +-- hiding it. Also use 'addPersistentMonitor' instead of +-- 'addMonitor' to avoid unnecessary flickering. You can still toggle +-- monitor with a keybinding. +-- +-- - You can use several monitors with nested modifiers. Give them a name using +-- 'addNamedMonitor' or 'addNamedPersistentMonitor' to be able to toggle +-- them independently. +-- +-- - You can display monitor only on specific workspaces with +-- "XMonad.Layout.PerWorkspace". + +-- $todo +-- - make Monitor remember the window it manages +-- +-- - automatically unmanage the window? +-- +-- - specify position relative to the screen -- cgit v1.2.3