Hierarchify

darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz

8 files changed, 792 insertions, 0 deletions

diff --git a/XMonad/Util/Anneal.hs b/XMonad/Util/Anneal.hs
new file mode 100644
index 0000000..6852308
--- /dev/null
+++ b/XMonad/Util/Anneal.hs
@@ -0,0 +1,90 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Anneal
+-- Copyright   :  (c) David Roundy
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  David Roundy <droundy@darcs.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Requires the 'random' package
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Anneal ( Rated(Rated), the_value, the_rating
+                            , anneal, annealMax ) where
+
+import System.Random ( StdGen, Random, mkStdGen, randomR )
+import Control.Monad.State ( State, runState, put, get, gets, modify )
+
+-- %import XMonad.Util.Anneal
+
+data Rated a b = Rated !a !b
+                 deriving ( Show )
+instance Functor (Rated a) where
+    f `fmap` (Rated v a) = Rated v (f a)
+
+the_value :: Rated a b -> b
+the_value (Rated _ b) = b
+the_rating :: Rated a b -> a
+the_rating (Rated a _) = a
+
+instance Eq a => Eq (Rated a b) where
+    (Rated a _) == (Rated a' _) = a == a'
+instance Ord a => Ord (Rated a b) where
+    compare (Rated a _) (Rated a' _) = compare a a'
+
+anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
+anneal st r sel = runAnneal st r (do_anneal sel)
+
+annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
+annealMax st r sel = runAnneal st (negate . r) (do_anneal sel)
+
+do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a)
+do_anneal sel = do sequence_ $ replicate 100 da
+                   gets best
+    where da = do select_metropolis sel
+                  modify $ \s -> s { temperature = temperature s *0.99 }
+
+data Anneal a = A { g :: StdGen
+                  , best :: Rated Double a
+                  , current :: Rated Double a
+                  , rate :: a -> Rated Double a
+                  , temperature :: Double }
+
+runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b
+runAnneal start r x = fst $ runState x (A { g = mkStdGen 137
+                                          , best = Rated (r start) start
+                                          , current = Rated (r start) start
+                                          , rate = \xx -> Rated (r xx) xx
+                                          , temperature = 1.0 })
+
+select_metropolis :: (a -> [a]) -> State (Anneal a) ()
+select_metropolis x = do c <- gets current
+                         a <- select $ x $ the_value c
+                         metropolis a
+
+metropolis :: a -> State (Anneal a) ()
+metropolis x = do r <- gets rate
+                  c <- gets current
+                  t <- gets temperature
+                  let rx = r x
+                      boltz = exp $ (the_rating c - the_rating rx) / t
+                  if rx < c then do modify $ \s -> s { current = rx, best = rx }
+                            else do p <- getOne (0,1)
+                                    if p < boltz
+                                       then modify $ \s -> s { current = rx }
+                                       else return ()
+
+select :: [a] -> State (Anneal a) a
+select [] = the_value `fmap` gets best
+select [x] = return x
+select xs = do n <- getOne (0,length xs - 1)
+               return (xs !! n)
+
+getOne :: (Random a) => (a,a) -> State (Anneal x) a
+getOne bounds = do s <- get
+                   (x,g') <- return $ randomR bounds (g s)
+                   put $ s { g = g' }
+                   return x
diff --git a/XMonad/Util/Dmenu.hs b/XMonad/Util/Dmenu.hs
new file mode 100644
index 0000000..8eeb0d9
--- /dev/null
+++ b/XMonad/Util/Dmenu.hs
@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Dmenu
+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A convenient binding to dmenu.
+--
+-- Requires the process-1.0 package
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Dmenu (
+                            -- * Usage
+                            -- $usage
+                            dmenu, dmenuXinerama, dmenuMap
+                           ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified Data.Map as M
+import Control.Monad.State
+import XMonad.Util.Run
+
+-- $usage
+-- You can use this module with the following in your Config.hs file:
+--
+-- > import XMonad.Util.Dmenu
+
+-- %import XMonad.Util.Dmenu
+
+-- | Starts dmenu on the current screen. Requires this patch to dmenu:
+-- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>
+dmenuXinerama :: [String] -> X String
+dmenuXinerama opts = do
+    curscreen <- (fromIntegral . W.screen . W.current) `liftM` gets windowset :: X Int
+    io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
+
+dmenu :: [String] -> X String
+dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts)
+
+dmenuMap :: M.Map String a -> X (Maybe a)
+dmenuMap selectionMap = do
+  selection <- dmenu (M.keys selectionMap)
+  return $ M.lookup selection selectionMap
diff --git a/XMonad/Util/Dzen.hs b/XMonad/Util/Dzen.hs
new file mode 100644
index 0000000..02fce05
--- /dev/null
+++ b/XMonad/Util/Dzen.hs
@@ -0,0 +1,71 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Dzen
+-- Copyright   :  (c) glasser@mit.edu
+-- License     :  BSD
+--
+-- Maintainer  :  glasser@mit.edu
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Handy wrapper for dzen. Requires dzen >= 0.2.4.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Dzen (dzen, dzenWithArgs, dzenScreen,
+                           dzenUrgencyHook, dzenUrgencyHookWithArgs,
+                           seconds) where
+
+import Control.Monad (when)
+import Control.Monad.State (gets)
+import qualified Data.Set as S
+import Graphics.X11.Types (Window)
+
+import qualified XMonad.StackSet as W
+import XMonad
+
+import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.Run (runProcessWithInputAndWait, seconds)
+
+-- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds.
+-- Example usage:
+-- > dzen "Hi, mom!" (5 `seconds`)
+dzen :: String -> Int -> X ()
+dzen str timeout = dzenWithArgs str [] timeout
+
+-- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen.
+-- Example usage:
+-- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`)
+dzenWithArgs :: String -> [String] -> Int -> X ()
+dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout
+  -- dzen seems to require the input to terminate with exactly one newline.
+  where unchomp s@['\n'] = s
+        unchomp []       = ['\n']
+        unchomp (c:cs)   = c : unchomp cs
+
+-- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@.
+-- Requires dzen to be compiled with Xinerama support.
+dzenScreen :: ScreenId -> String -> Int -> X()
+dzenScreen sc str timeout = dzenWithArgs str ["-xs", screen] timeout
+    where screen  = toXineramaArg sc
+          toXineramaArg n = show ( ((fromIntegral n)+1)::Int )
+
+-- | Flashes when a window requests your attention and you can't see it. For use with
+-- XMonadContrib.UrgencyHook. Usage:
+-- > urgencyHook = dzenUrgencyHook (5 `seconds`)
+dzenUrgencyHook :: Int -> Window -> X ()
+dzenUrgencyHook = dzenUrgencyHookWithArgs []
+
+-- | Flashes when a window requests your attention and you can't see it. For use with
+-- XMonadContrib.UrgencyHook. Usage:
+-- > urgencyHook = dzenUrgencyHookWithArgs ["-bg", "darkgreen"] (5 `seconds`)
+dzenUrgencyHookWithArgs :: [String] -> Int -> Window -> X ()
+dzenUrgencyHookWithArgs args duration w = do
+    visibles <- gets mapped
+    name <- getName w
+    ws <- gets windowset
+    whenJust (W.findTag w ws) (flash name visibles)
+  where flash name visibles index =
+              when (not $ S.member w visibles) $
+              dzenWithArgs (show name ++ " requests your attention on workspace " ++ index)
+                           args duration
diff --git a/XMonad/Util/Invisible.hs b/XMonad/Util/Invisible.hs
new file mode 100644
index 0000000..f387158
--- /dev/null
+++ b/XMonad/Util/Invisible.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Invisible
+-- Copyright   :  (c) 2007 Andrea Rossato, David Roundy
+-- License     :  BSD-style (see xmonad/LICENSE)
+-- 
+-- Maintainer  :  andrea.rossato@unibz.it, droundy@darcs.net
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A data type to store the layout state
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Invisible ( 
+                             -- * Usage:
+                             -- $usage
+                             Invisible (..)
+                            , whenIJust
+                            , fromIMaybe
+                            ) where
+
+-- $usage
+-- A wrapper data type to store layout state that shouldn't be persisted across
+-- restarts. A common wrapped type to use is @Maybe a@.
+-- Invisible derives trivial definitions for Read and Show, so the wrapped data
+-- type need not do so.
+
+newtype Invisible m a = I (m a) deriving (Monad, Functor)
+
+instance (Functor m, Monad m) => Read (Invisible m a) where
+    readsPrec _ s = [(fail "Read Invisible", s)]
+
+instance Monad m => Show (Invisible m a) where
+    show _ = ""
+
+whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m ()
+whenIJust (I (Just x)) f  = f x
+whenIJust (I  Nothing) _  = return ()
+
+fromIMaybe :: a -> Invisible Maybe a -> a
+fromIMaybe _ (I (Just x)) = x
+fromIMaybe a (I  Nothing) = a
diff --git a/XMonad/Util/NamedWindows.hs b/XMonad/Util/NamedWindows.hs
new file mode 100644
index 0000000..05613b2
--- /dev/null
+++ b/XMonad/Util/NamedWindows.hs
@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.NamedWindows
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module allows you to associate the X titles of windows with
+-- them.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.NamedWindows (
+                                   -- * Usage
+                                   -- $usage
+                                   NamedWindow, 
+                                   getName, 
+                                   withNamedWindow, 
+                                   unName 
+                                  ) where
+
+import Control.Monad.Reader ( asks )
+import Control.Monad.State ( gets )
+
+import qualified XMonad.StackSet as W ( peek )
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+import XMonad
+
+-- $usage
+--   See "XMonadContrib.Mosaic" for an example of its use.
+
+
+data NamedWindow = NW !String !Window
+instance Eq NamedWindow where
+    (NW s _) == (NW s' _) = s == s'
+instance Ord NamedWindow where
+    compare (NW s _) (NW s' _) = compare s s'
+instance Show NamedWindow where
+    show (NW n _) = n
+
+getName :: Window -> X NamedWindow
+getName w = asks display >>= \d -> do s <- io $ getClassHint d w
+                                      n <- maybe (resName s) id `fmap` io (fetchName d w)
+                                      return $ NW n w
+
+unName :: NamedWindow -> Window
+unName (NW _ w) = w
+
+withNamedWindow :: (NamedWindow -> X ()) -> X ()
+withNamedWindow f = do ws <- gets windowset
+                       whenJust (W.peek ws) $ \w -> getName w >>= f
diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs
new file mode 100644
index 0000000..39a653a
--- /dev/null
+++ b/XMonad/Util/Run.hs
@@ -0,0 +1,114 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Run
+-- Copyright   :  (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Christian Thiemann <mail@christian-thiemann.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This modules provides several commands to run an external process.
+-- It is composed of functions formerly defined in XMonad.Util.Dmenu (by
+-- Spenver Jannsen), XMonad.Util.Dzen (by glasser@mit.edu) and
+-- XMonad.Util.RunInXTerm (by Andrea Rossato).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Run (
+                          -- * Usage
+                          -- $usage
+                          runProcessWithInput,
+                          runProcessWithInputAndWait,
+                          safeSpawn,
+                          unsafeSpawn,
+                          runInTerm,
+                          safeRunInTerm,
+                          seconds
+                         ) where
+
+import Control.Monad.Reader
+import System.Posix.Process (createSession, forkProcess, executeFile,
+                             getProcessStatus)
+import Control.Concurrent (threadDelay)
+import Control.Exception (try)
+import System.Exit (ExitCode(ExitSuccess), exitWith)
+import System.IO (IO, FilePath, hPutStr, hGetContents, hFlush, hClose)
+import System.Process (runInteractiveProcess, waitForProcess)
+import XMonad
+
+-- $usage
+-- For an example usage of runInTerm see XMonad.Prompt.Ssh
+--
+-- For an example usage of runProcessWithInput see
+-- XMonad.Prompt.{DirectoryPrompt,Dmenu,ShellPrompt,WmiiActions,WorkspaceDir}
+--
+-- For an example usage of runProcessWithInputAndWait see XMonad.Util.Dzen
+
+-- | Returns Just output if the command succeeded, and Nothing if it didn't.
+-- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation.
+runProcessWithInput :: FilePath -> [String] -> String -> IO String
+runProcessWithInput cmd args input = do
+    (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
+    hPutStr pin input
+    hClose pin
+    output <- hGetContents pout
+    when (output==output) $ return ()
+    hClose pout
+    hClose perr
+    waitForProcess ph
+    return output
+
+-- wait is in us
+runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()
+runProcessWithInputAndWait cmd args input timeout = do
+    pid <- forkProcess $ do
+       forkProcess $ do -- double fork it over to init
+         createSession
+         (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
+         hPutStr pin input
+         hFlush pin
+         threadDelay timeout
+         hClose pin
+         hClose pout
+         hClose perr
+         waitForProcess ph
+         return ()
+       exitWith ExitSuccess
+       return ()
+    getProcessStatus True False pid
+    return ()
+
+{- | Multiplies by ONE MILLION, for use with runProcessWithInputAndWait.
+     Use like:
+     > (5.5 `seconds`)
+-}
+seconds :: Rational -> Int
+seconds = fromEnum . (* 1000000)
+
+{- | safeSpawn bypasses XMonad's 'spawn' command, because spawn passes strings to /bin/sh to be interpreted as shell
+   commands. This is often what one wants, but in many cases the passed string will contain shell metacharacters
+   which one does not want interpreted as such (URLs particularly often have shell metacharacters like '&' in them).
+   In this case, it is more useful to specify a file or program to be run and a string to give it as an argument so
+   as to bypass the shell and be certain the program will receive the string as you typed it.
+   unsafeSpawn is an alias for XMonad's 'spawn', to remind one that use of it can be, well, unsafe.
+   Examples:
+   >     , ((modMask,               xK_Print ), unsafeSpawn "import -window root png:$HOME/xwd-$(date +%s)$$.png")
+   >     , ((modMask,               xK_d     ), safeSpawn "firefox" "")
+
+   Note that the unsafeSpawn example must be unsafe and not safe because it makes use of shell interpretation by relying on
+   $HOME and interpolation, whereas the safeSpawn example can be safe because Firefox doesn't need any arguments if it is
+   just being started.
+-}
+safeSpawn :: FilePath -> String -> X ()
+safeSpawn prog arg = io (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ())
+unsafeSpawn :: String -> X ()
+unsafeSpawn = spawn
+
+-- | Run a given program in the preferred terminal emulator. This uses safeSpawn.
+safeRunInTerm :: String -> X ()
+safeRunInTerm command = asks (terminal . config) >>= \t -> safeSpawn t ("-e " ++ command)
+
+unsafeRunInTerm, runInTerm :: String -> X ()
+unsafeRunInTerm command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " -e " ++ command
+runInTerm = unsafeRunInTerm
diff --git a/XMonad/Util/XSelection.hs b/XMonad/Util/XSelection.hs
new file mode 100644
index 0000000..00d6723
--- /dev/null
+++ b/XMonad/Util/XSelection.hs
@@ -0,0 +1,175 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.XSelection
+-- Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman
+-- License     :  BSD3
+--
+-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>,
+--                Matthew Sackman <matthew@wellquite.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting).
+-- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available:
+--
+-- $ darcs get "http:\/\/gorgias.mine.nu\/repos\/xmonad-utils"
+-----------------------------------------------------------------------------
+
+module XMonad.Util.XSelection (
+                                 -- * Usage
+                                 -- $usage
+                                 getSelection,
+                                 promptSelection,
+                                 safePromptSelection,
+                                 putSelection) where
+
+import Graphics.X11.Xlib.Extras (Graphics.X11.Xlib.Extras.Event(ev_event_display,
+							       ev_time, ev_property, ev_target, ev_selection,
+							       ev_requestor, ev_event_type),
+				xConvertSelection, xGetSelectionOwner, xSetSelectionOwner, getEvent,
+				currentTime, setSelectionNotify, getWindowProperty8, changeProperty8,
+				propModeReplace)
+import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr,
+			 sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow,
+			 defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask)
+import Control.Concurrent (forkIO)
+import Control.Exception as E (catch)
+import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)
+import Data.Char (chr, ord)
+import Data.Maybe (fromMaybe)
+import Foreign(Word8, Data.Bits.Bits (shiftL, (.&.), (.|.)))
+import XMonad.Util.Run (safeSpawn, unsafeSpawn)
+import XMonad (X, io)
+
+{- $usage
+    Add 'import XMonadContrib.XSelection' to the top of Config.hs
+    Then make use of getSelection or promptSelection as needed; if
+    one wanted to run Firefox with the selection as an argument (say,
+    the selection is an URL you just highlighted), then one could add
+    to the Config.hs a line like thus:
+
+>  , ((modMask .|. shiftMask, xK_b     ), promptSelection "firefox")
+
+    TODO:
+
+             * Fix Unicode handling. Currently it's still better than calling
+               'chr' to translate to ASCII, though.
+               As near as I can tell, the mangling happens when the String is
+               outputted somewhere, such as via promptSelection's passing through
+               the shell, or GHCi printing to the terminal. utf-string has IO functions
+               which can fix this, though I do not know have to use them here. It's
+               a complex issue; see
+               <http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
+               and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
+
+             * Possibly add some more elaborate functionality: Emacs' registers are nice.
+-}
+
+-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is
+-- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.
+getSelection :: IO String
+getSelection = do
+  dpy <- openDisplay ""
+  let dflt = defaultScreen dpy
+  rootw  <- rootWindow dpy dflt
+  win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
+  p <- internAtom dpy "PRIMARY" True
+  ty <- E.catch
+               (E.catch
+                     (internAtom dpy "UTF8_STRING" False)
+                     (\_ -> internAtom dpy "COMPOUND_TEXT" False))
+             (\_ -> internAtom dpy "sTring" False)
+  clp <- internAtom dpy "BLITZ_SEL_STRING" False
+  xConvertSelection dpy p ty clp win currentTime
+  allocaXEvent $ \e -> do
+    nextEvent dpy e
+    ev <- getEvent e
+    if ev_event_type ev == selectionNotify
+       then do res <- getWindowProperty8 dpy clp win
+               return $ decode  . fromMaybe [] $ res
+       else destroyWindow dpy win >> return ""
+
+-- | Set the current X Selection to a given String.
+putSelection :: String -> IO ()
+putSelection text = do
+  dpy <- openDisplay ""
+  let dflt = defaultScreen dpy
+  rootw  <- rootWindow dpy dflt
+  win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
+  p <- internAtom dpy "PRIMARY" True
+  ty <- internAtom dpy "UTF8_STRING" False
+  xSetSelectionOwner dpy p win currentTime
+  winOwn <- xGetSelectionOwner dpy p
+  if winOwn == win
+    then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return ()
+    else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win
+  return ()
+                     where
+                       processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO ()
+                       processEvent dpy ty txt e = do
+                                                      nextEvent dpy e
+                                                      ev <- getEvent e
+                                                      if ev_event_type ev == selectionRequest
+                                                       then do print ev
+                                                    -- selection == eg PRIMARY
+                                                    -- target == type eg UTF8
+                                                    -- property == property name or None
+                                                               allocaXEvent $ \replyPtr -> do
+                                                                 changeProperty8 (ev_event_display ev)
+                                                                                 (ev_requestor ev)
+                                                                                 (ev_property ev)
+                                                                                 ty
+                                                                                 propModeReplace
+                                                                                 (map (fromIntegral . ord) txt)
+                                                                 setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) (ev_target ev) (ev_property ev) (ev_time ev)
+                                                                 sendEvent dpy (ev_requestor ev) False noEventMask replyPtr
+                                                                 sync dpy False
+                                                       else do putStrLn "Unexpected Message Received"
+                                                               print ev
+                                                      processEvent dpy ty text e
+
+{- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument.
+This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to
+         @promptSelection \"firefox\"@;
+this would allow you to highlight a URL string and then immediately open it up in Firefox.
+
+promptSelection passes strings through the shell; if you do not wish your selected text to be interpreted/mangled
+by the shell, use safePromptSelection which will bypass the shell using safeSpawn from Run.hs; see Run.hs for more
+details on the advantages/disadvantages of this. -}
+promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
+promptSelection = unsafePromptSelection
+safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection)
+unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
+
+{- UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library
+   <http://code.haskell.org/utf8-string/> (version 0.1), which is BSD-3 licensed, as is this module.
+   It'd be better to just import Codec.Binary.UTF8.String (decode), but then users of this would need to install it; Xmonad has enough
+   dependencies already. -}
+decode :: [Word8] -> String
+decode [    ] = ""
+decode (c:cs)
+  | c < 0x80  = chr (fromEnum c) : decode cs
+  | c < 0xc0  = replacement_character : decode cs
+  | c < 0xe0  = multi_byte 1 0x1f 0x80
+  | c < 0xf0  = multi_byte 2 0xf  0x800
+  | c < 0xf8  = multi_byte 3 0x7  0x10000
+  | c < 0xfc  = multi_byte 4 0x3  0x200000
+  | c < 0xfe  = multi_byte 5 0x1  0x4000000
+  | otherwise = replacement_character : decode cs
+  where
+    replacement_character :: Char
+    replacement_character = '\xfffd'
+
+    multi_byte :: Int -> Word8 -> Int -> [Char]
+    multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))
+      where
+        aux :: Int -> [Word8] -> Int -> [Char]
+        aux 0 rs acc
+          | overlong <= acc && acc <= 0x10ffff &&
+            (acc < 0xd800 || 0xdfff < acc)     &&
+            (acc < 0xfffe || 0xffff < acc)      = chr acc : decode rs
+          | otherwise = replacement_character : decode rs
+        aux n (r:rs) acc
+          | r .&. 0xc0 == 0x80 = aux (n-1) rs
+                               $ shiftL acc 6 .|. fromEnum (r .&. 0x3f)
+        aux _ rs     _ = replacement_character : decode rs
diff --git a/XMonad/Util/XUtils.hs b/XMonad/Util/XUtils.hs
new file mode 100644
index 0000000..3986389
--- /dev/null
+++ b/XMonad/Util/XUtils.hs
@@ -0,0 +1,191 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.XUtils
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+-- 
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module for painting on the screen
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.XUtils  ( 
+                             -- * Usage:
+                             -- $usage
+                             stringToPixel
+                             , averagePixels
+                             , initFont
+                             , releaseFont
+                             , createNewWindow
+                             , showWindow
+                             , hideWindow
+                             , deleteWindow
+                             , paintWindow
+                             , Align (..)
+                             , stringPosition
+                             , paintAndWrite
+                            ) where
+
+
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+import Control.Monad.Reader
+import Data.Maybe
+import XMonad
+import XMonad.Operations
+
+-- $usage
+-- See Tabbed or DragPane for usage examples
+
+-- | Get the Pixel value for a named color: if an invalid name is
+-- given the black pixel will be returned.
+stringToPixel :: String -> X Pixel
+stringToPixel s = do
+  d <- asks display
+  io $ catch (getIt d) (fallBack d)
+    where getIt    d = initColor d s
+          fallBack d = const $ return $ blackPixel d (defaultScreen d)
+
+-- | Compute the weighted average the colors of two given Pixel values.
+averagePixels :: Pixel -> Pixel -> Double -> X Pixel
+averagePixels p1 p2 f =
+    do d <- asks display
+       let cm = defaultColormap d (defaultScreen d)
+       [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0]
+       let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f))
+       Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)
+       return p
+
+-- | Given a fontname returns the fonstructure. If the font name is
+--  not valid the default font will be loaded and returned.
+initFont :: String -> X FontStruct
+initFont s = do
+  d <- asks display
+  io $ catch (getIt d) (fallBack d)
+      where getIt    d = loadQueryFont d s
+            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+
+releaseFont :: FontStruct -> X ()
+releaseFont fs = do
+  d <- asks display
+  io $ freeFont d fs
+
+-- | Create a simple window given a rectangle. If Nothing is given
+-- only the exposureMask will be set, otherwise the Just value.
+-- Use 'showWindow' to map and hideWindow to unmap.
+createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window
+createNewWindow (Rectangle x y w h) m col = do
+  d   <- asks display
+  rw  <- asks theRoot
+  c <- stringToPixel col
+  win <- io $ createSimpleWindow d rw x y w h 0 c c
+  case m of
+    Just em -> io $ selectInput d win em
+    Nothing -> io $ selectInput d win exposureMask
+  return win
+
+-- | Map a window
+showWindow :: Window -> X ()
+showWindow w = do
+  d <- asks display
+  io $ mapWindow d w
+
+-- | unmap a window
+hideWindow :: Window -> X ()
+hideWindow w = do
+  d <- asks display
+  io $ unmapWindow d w
+
+-- | destroy a window
+deleteWindow :: Window -> X ()
+deleteWindow w = do
+  d <- asks display
+  io $ destroyWindow d w
+
+-- | Fill a window with a rectangle and a border
+paintWindow :: Window     -- ^ The window where to draw 
+            -> Dimension  -- ^ Window width
+            -> Dimension  -- ^ Window height 
+            -> Dimension  -- ^ Border width
+            -> String     -- ^ Window background color
+            -> String     -- ^ Border color
+            -> X ()
+paintWindow w wh ht bw c bc =
+    paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing
+
+-- | String position
+data Align = AlignCenter | AlignRight | AlignLeft
+
+-- | Return the string x and y 'Position' in a 'Rectangle', given a
+-- 'FontStruct' and the 'Align'ment
+stringPosition :: FontStruct -> Rectangle -> Align -> String -> (Position,Position)
+stringPosition fs (Rectangle _ _ w h) al s = (x,y)
+    where width     = textWidth   fs s
+          (_,a,d,_) = textExtents fs s
+          y         = fi $ ((h - fi (a + d)) `div` 2) + fi a
+          x         = case al of 
+                        AlignCenter -> fi (w `div` 2) - fi (width `div` 2)
+                        AlignLeft   -> 1
+                        AlignRight  -> fi (w - (fi width + 1))
+
+-- | Fill a window with a rectangle and a border, and write a string at given position
+paintAndWrite :: Window     -- ^ The window where to draw 
+              -> FontStruct -- ^ The FontStruct
+              -> Dimension  -- ^ Window width
+              -> Dimension  -- ^ Window height 
+              -> Dimension  -- ^ Border width
+              -> String     -- ^ Window background color
+              -> String     -- ^ Border color
+              -> String     -- ^ String color
+              -> String     -- ^ String background color
+              -> Align      -- ^ String 'Align'ment
+              -> String     -- ^ String to be printed
+              -> X ()
+paintAndWrite w fs wh ht bw bc borc ffc fbc al str =
+    paintWindow' w r bw bc borc ms
+    where ms    = Just (fs,ffc,fbc,str)
+          r     = Rectangle x y wh ht
+          (x,y) = stringPosition fs (Rectangle 0 0 wh ht) al str
+
+-- This stuf is not exported
+
+paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (FontStruct,String,String,String) -> X ()
+paintWindow' win (Rectangle x y wh ht) bw color b_color str = do
+  d  <- asks display
+  p  <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d)
+  gc <- io $ createGC d p
+  -- draw
+  io $ setGraphicsExposures d gc False
+  [c',bc'] <- mapM stringToPixel [color,b_color]
+  -- we start with the border
+  io $ setForeground d gc bc'
+  io $ fillRectangle d p gc 0 0 wh ht
+  -- and now again
+  io $ setForeground d gc c'
+  io $ fillRectangle d p gc (fi bw) (fi bw) ((wh - (bw * 2))) (ht - (bw * 2))
+  when (isJust str) $ do
+    let (fs,fc,bc,s) = fromJust str
+    io $ setFont d gc $ fontFromFontStruct fs
+    printString d p gc fc bc x y s
+  -- copy the pixmap over the window
+  io $ copyArea      d p win gc 0 0 wh ht 0 0
+  -- free the pixmap and GC
+  io $ freePixmap    d p
+  io $ freeGC        d gc
+
+-- | Prints a string on a 'Drawable'
+printString :: Display -> Drawable -> GC -> String -> String
+            -> Position -> Position -> String  -> X ()
+printString d drw gc fc bc x y s = do
+  [fc',bc'] <- mapM stringToPixel [fc,bc]
+  io $ setForeground   d gc fc'
+  io $ setBackground   d gc bc'
+  io $ drawImageString d drw gc x y s
+
+-- | Short-hand for 'fromIntegral'
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral