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/Config.hs     | 28 +++++++-------------------
 XMonad/Core.hs       |  3 ++-
 XMonad/ManageHook.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 XMonad/Operations.hs |  4 +---
 4 files changed, 65 insertions(+), 25 deletions(-)
 create mode 100644 XMonad/ManageHook.hs

(limited to 'XMonad')

diff --git a/XMonad/Config.hs b/XMonad/Config.hs
index 5c988c9..1cab6a3 100644
--- a/XMonad/Config.hs
+++ b/XMonad/Config.hs
@@ -29,6 +29,7 @@ import qualified XMonad.Core as XMonad
 
 import XMonad.Layouts
 import XMonad.Operations
+import XMonad.ManageHook
 import qualified XMonad.StackSet as W
 import Data.Ratio
 import Data.Bits ((.|.))
@@ -112,28 +113,13 @@ defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
 --  xprop | grep WM_CLASS
 -- and click on the client you're interested in.
 --
-manageHook :: Window -- ^ the new window to manage
-           -> String -- ^ window title
-           -> String -- ^ window resource name
-           -> String -- ^ window resource class
-           -> X (WindowSet -> WindowSet)
-
--- Always float various programs:
-manageHook w _ _ c | c `elem` floats = fmap (W.float w . snd) (floatLocation w)
+manageHook :: ManageHook
+manageHook = composeAll . concat $
+                [ [ className =? c --> doFloat | c <- floats]
+                , [ resource =? r --> doIgnore | r <- ignore]
+                , [ resource =? "Gecko" --> doF (W.shift "web") ]]
  where floats = ["MPlayer", "Gimp"]
-
--- Desktop panels and dock apps should be ignored by xmonad:
-manageHook w _ n _ | n `elem` ignore = reveal w >> return (W.delete w)
- where ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"]
-
--- Automatically send Firefox windows to the "web" workspace:
--- If a workspace named "web" doesn't exist, the window will appear on the
--- current workspace.
-manageHook _ _ "Gecko" _ = return $ W.shift "web"
-
--- The default rule: return the WindowSet unmodified.  You typically do not
--- want to modify this line.
-manageHook _ _ _ _ = return id
+       ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"]
 
 ------------------------------------------------------------------------
 -- Logging
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 3f96592..56700c0 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -67,7 +67,7 @@ data XConfig = XConfig
     , focusedBorderColor :: !String
     , terminal           :: !String
     , layoutHook         :: !(Layout Window)
-    , manageHook         :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)
+    , manageHook         :: Window -> X (WindowSet -> WindowSet)
     , workspaces         :: [String]
     , defaultGaps        :: [(Int,Int,Int,Int)]
     , numlockMask        :: !KeyMask
@@ -78,6 +78,7 @@ data XConfig = XConfig
     , logHook            :: X ()
     }
 
+
 type WindowSet   = StackSet  WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 type WindowSpace = Workspace WorkspaceId (Layout Window) Window
 
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)
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 3d9a3b0..fa5d3cc 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -63,10 +63,8 @@ manage w = whenX (fmap not $ isClient w) $ withDisplay $ \d -> do
              | otherwise                  = W.insertUp w ws
             where i = fromMaybe (W.tag . W.workspace . W.current $ ws) $ W.lookupWorkspace sc ws
 
-    n <- fmap (fromMaybe "") $ io $ fetchName d w
-    (ClassHint rn rc) <- io $ getClassHint d w
     mh <- asks (manageHook . config)
-    g <- mh w n rn rc `catchX` return id
+    g <- mh w `catchX` return id
     windows (g . f)
 
 -- | unmanage. A window no longer exists, remove it from the window
-- 
cgit v1.2.3