From 4ac83b98a1abf352c27cdd4caefaf4dc86ef59e4 Mon Sep 17 00:00:00 2001
From: Spencer Janssen <sjanssen@cse.unl.edu>
Date: Fri, 9 Nov 2007 03:47:22 +0100
Subject: New ManageHook system

darcs-hash:20071109024722-a5988-c499d006a8a4a48dd7c8cbaf4e4ea9635ceb1ec4.gz
---
 XMonad/ManageHook.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)
 create mode 100644 XMonad/ManageHook.hs

(limited to 'XMonad/ManageHook.hs')

diff --git a/XMonad/ManageHook.hs b/XMonad/ManageHook.hs
new file mode 100644
index 0000000..c6bbc8c
--- /dev/null
+++ b/XMonad/ManageHook.hs
@@ -0,0 +1,55 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad/ManageHook.hs
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  sjanssen@cse.unl.edu
+-- Stability   :  unstable
+-- Portability :  not portable, uses cunning newtype deriving
+--
+-- An EDSL for ManageHooks
+--
+-----------------------------------------------------------------------------
+
+module XMonad.ManageHook where
+
+import XMonad.Core
+import Graphics.X11
+import Graphics.X11.Xlib.Extras
+import Control.Monad
+import Data.Maybe
+import qualified XMonad.StackSet as W
+import XMonad.Operations (floatLocation, reveal)
+
+type ManageHook = Query (WindowSet -> WindowSet)
+type Query a    = Window -> X a
+
+idHook :: ManageHook
+idHook = doF id
+
+(<+>) :: ManageHook -> ManageHook -> ManageHook
+f <+> g = \w -> liftM2 (.) (f w) (g w)
+
+composeAll :: [ManageHook] -> ManageHook
+composeAll = foldr (<+>) idHook
+
+(-->) :: Query Bool -> ManageHook -> ManageHook
+p --> f = \w -> p w >>= \b -> if b then f w else idHook w
+
+(=?) :: Eq a => Query a -> a -> Query Bool
+q =? x = \w -> fmap (== x) (q w)
+
+title, resource, className :: Query String
+title     = \w -> withDisplay $ \d -> fmap (fromMaybe "") $ io $ fetchName d w
+resource  = \w -> withDisplay $ \d -> fmap resName $ io $ getClassHint d w
+className = \w -> withDisplay $ \d -> fmap resClass $ io $ getClassHint d w
+
+doFloat :: ManageHook
+doFloat = \w -> fmap (W.float w . snd) (floatLocation w)
+
+doIgnore :: ManageHook
+doIgnore = \w -> reveal w >> return (W.delete w)
+
+doF :: (WindowSet -> WindowSet) -> ManageHook
+doF f = const (return f)
-- 
cgit v1.2.3