aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSpencer Janssen <sjanssen@cse.unl.edu>2007-11-09 03:47:22 +0100
committerSpencer Janssen <sjanssen@cse.unl.edu>2007-11-09 03:47:22 +0100
commit4ac83b98a1abf352c27cdd4caefaf4dc86ef59e4 (patch)
tree1e74edcbb5091b1ae0c0d41ff092d0de2ad2f849
parenta2fcbf0cdfff251b13706e630af6af9a3fcd98ba (diff)
downloadxmonad-4ac83b98a1abf352c27cdd4caefaf4dc86ef59e4.tar.gz
xmonad-4ac83b98a1abf352c27cdd4caefaf4dc86ef59e4.tar.xz
xmonad-4ac83b98a1abf352c27cdd4caefaf4dc86ef59e4.zip
New ManageHook system
darcs-hash:20071109024722-a5988-c499d006a8a4a48dd7c8cbaf4e4ea9635ceb1ec4.gz
-rw-r--r--XMonad/Config.hs28
-rw-r--r--XMonad/Core.hs3
-rw-r--r--XMonad/ManageHook.hs55
-rw-r--r--XMonad/Operations.hs4
-rw-r--r--xmonad.cabal1
5 files changed, 66 insertions, 25 deletions
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
diff --git a/xmonad.cabal b/xmonad.cabal
index 2884587..00f10f9 100644
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -30,6 +30,7 @@ library
XMonad.Core
XMonad.Config
XMonad.Layouts
+ XMonad.ManageHook
XMonad.Operations
XMonad.StackSet
ghc-options: -funbox-strict-fields -Wall -Werror -optl-Wl,-s