Window decorations on floating windows

[Vermoot]

I realise window decorations are an xmonad-contrib thing, but as far as I understand (and that's not much), the way xmonad core handles floating windows makes it impossible to display decorations on floating windows.

(As an aside, as I understand it it's the same kind of thing making it impossible to do things like X.L.BorderResize on actual floating windows? That would be neat as well.)

There's an old PR floating around by @NaOHman (#41) that apparently solved this (with a sister PR in contrib), but it never ended up happening.

Is that something that could be done reasonably easily?

Thanks!

[slotThe]

I suppose the easiest way would be to 1) resurrect #41 and its associated contrib PR and 2) rip "most" of #41 out of core and put it into contrib (which was suggested in the original PR and I think should definitely be possible)

So... help wanted, I suppose? :)

[Vermoot]

That would be great.
While I'm sure not many xmonad people care about them, I definitely think decorations (and floating windows) need some love <3

[geekosaur]

Not sure which of the two is the bigger hack. :)

[Vermoot]

I know! But I feel like they're essential features for a WM, even if most of its users only use tiled layouts (myself included), without any window decorations.

Sometimes those are really useful. And for my setup, even though they'd be used sparingly, sometimes I really miss them.

[slotThe]

Well, at least it still seems to work:

Cleanup if definitely needed though (and much like the original reviewer, I also think that a lot of the core stuff could and should be moved to contrib); I will include the patches below if anyone feels up to the task.

core patch

diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs
index a450fbc..95893ff 100644
--- a/src/XMonad/Config.hs
+++ b/src/XMonad/Config.hs
@@ -28,11 +28,11 @@ module XMonad.Config (defaultConfig, Default(..)) where
 import XMonad.Core as XMonad hiding
     (workspaces,manageHook,keys,logHook,startupHook,borderWidth,mouseBindings
     ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
-    ,handleEventHook,clickJustFocuses,rootMask,clientMask)
+    ,handleEventHook,clickJustFocuses,rootMask,clientMask,focusRaisesFloat,floatFocusFollowsMouse)
 import qualified XMonad.Core as XMonad
     (workspaces,manageHook,keys,logHook,startupHook,borderWidth,mouseBindings
     ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
-    ,handleEventHook,clickJustFocuses,rootMask,clientMask)
+    ,handleEventHook,clickJustFocuses,rootMask,clientMask,focusRaisesFloat,floatFocusFollowsMouse)
 
 import XMonad.Layout
 import XMonad.Operations
@@ -147,6 +147,10 @@ layout = tiled ||| Mirror tiled ||| Full
      -- Percent of screen to increment by when resizing panes
      delta   = 3/100
 
+-- |  the decorations applied o floating windows
+floatDecorator :: FloatDec Window
+floatDecorator = noFloatDec
+
 ------------------------------------------------------------------------
 -- Event Masks:
 
@@ -176,6 +180,13 @@ focusFollowsMouse = True
 clickJustFocuses :: Bool
 clickJustFocuses = True
 
+-- | Whether focus follows the mouse pointer for floating windows
+floatFocusFollowsMouse :: Bool
+floatFocusFollowsMouse = True
+
+-- | Whether clicking a floating window raises it
+focusRaisesFloat :: Bool
+focusRaisesFloat = True
 
 -- | The xmonad key bindings. Add, modify or remove key bindings here.
 --
@@ -260,6 +271,7 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
     { XMonad.borderWidth        = borderWidth
     , XMonad.workspaces         = workspaces
     , XMonad.layoutHook         = layout
+    , XMonad.floatHook          = floatDecorator
     , XMonad.terminal           = terminal
     , XMonad.normalBorderColor  = normalBorderColor
     , XMonad.focusedBorderColor = focusedBorderColor
@@ -270,8 +282,10 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
     , XMonad.mouseBindings      = mouseBindings
     , XMonad.manageHook         = manageHook
     , XMonad.handleEventHook    = handleEventHook
+    , XMonad.floatFocusFollowsMouse = floatFocusFollowsMouse
     , XMonad.focusFollowsMouse  = focusFollowsMouse
-    , XMonad.clickJustFocuses       = clickJustFocuses
+    , XMonad.clickJustFocuses   = clickJustFocuses
+    , XMonad.focusRaisesFloat   = focusRaisesFloat
     , XMonad.clientMask         = clientMask
     , XMonad.rootMask           = rootMask
     , XMonad.handleExtraArgs = \ xs theConf -> case xs of
diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs
index f02081e..2ad870f 100644
--- a/src/XMonad/Core.hs
+++ b/src/XMonad/Core.hs
@@ -24,8 +24,11 @@ module XMonad.Core (
     Layout(..), readsLayout, Typeable, Message,
     SomeMessage(..), fromMessage, LayoutMessages(..),
     StateExtension(..), ExtensionClass(..), ConfExtension(..),
+    FLayer(..), FloatClass(..), FloatDec(..), noFloatDec,
+    insertFDec, deleteByDec, newFDec, deleteByOrig, NoFloatDec(..),
     runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
-    withDisplay, withWindowSet, isRoot, runOnWorkspaces,
+    withDisplay, withWindowSet, withFLayer,
+    isRoot, runOnWorkspaces, modifyFLayer,
     getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX,
     getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
@@ -73,6 +76,7 @@ data XState = XState
     , waitingUnmap     :: !(M.Map Window Int)            -- ^ the number of expected UnmapEvents
     , dragging         :: !(Maybe (Position -> Position -> X (), X ()))
     , numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
+    , floatingLayer    :: !(FLayer Window)
     , extensibleState  :: !(M.Map String (Either String StateExtension))
     -- ^ stores custom state information.
     --
@@ -105,6 +109,7 @@ data XConfig l = XConfig
     , focusedBorderColor :: !String              -- ^ Focused windows border color. Default: \"#ff0000\"
     , terminal           :: !String              -- ^ The preferred terminal application. Default: \"xterm\"
     , layoutHook         :: !(l Window)          -- ^ The available layouts
+    , floatHook          :: !(FloatDec Window)
     , manageHook         :: !ManageHook          -- ^ The action to run when a new window is opened
     , handleEventHook    :: !(Event -> X All)    -- ^ Handle an X event, returns (All True) if the default handler
                                                  -- should also be run afterwards. mappend should be used for combining
@@ -119,6 +124,8 @@ data XConfig l = XConfig
     , logHook            :: !(X ())              -- ^ The action to perform when the windows set is changed
     , startupHook        :: !(X ())              -- ^ The action to perform on startup
     , focusFollowsMouse  :: !Bool                -- ^ Whether window entry events can change focus
+    , floatFocusFollowsMouse  :: !Bool           -- ^ Whether window entry events can change focus in the floating layer
+    , focusRaisesFloat   :: !Bool                -- ^ Whether focus raises thea float
     , clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
     , clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
     , rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
@@ -221,6 +228,10 @@ withDisplay   f = asks display >>= f
 withWindowSet :: (WindowSet -> X a) -> X a
 withWindowSet f = gets windowset >>= f
 
+-- | Run a monad action with the current floating layer
+withFLayer :: (FLayer Window -> X a) -> X a
+withFLayer    f = gets floatingLayer >>= f
+
 -- | Safely access window attributes.
 withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
 withWindowAttributes dpy win f = do
@@ -773,3 +784,116 @@ uninstallSignalHandlers = io $ do
     installHandler openEndedPipe Default Nothing
     installHandler sigCHLD Default Nothing
     return ()
+
+--------------------------------------------------------------------
+-- Float Layer data support
+--------------------------------------------------------------------
+
+-- | Existential type for the floating decorations
+data FloatDec a = forall fc. (FloatClass fc a) => FloatDec (fc a)
+
+-- | the data the floating layer needs in order to function
+data FLayer a = FLayer
+    { -- map from the floating wins to their decorations,
+      -- Nothing means the window should not be decorated
+      fWins :: M.Map a (Maybe a)
+      -- map from the decorations to their parent windows
+    , decWins :: M.Map a a
+      -- the Floating decorator
+    , fDec ::  FloatDec a
+    }
+
+-- | given a decoration window, remove it and it's parent from the floating layer
+deleteByDec :: Ord a => a -> FLayer a -> FLayer a
+deleteByDec dw f@(FLayer fws dcs fd) = case M.lookup dw dcs of
+    Just fw -> FLayer (M.delete fw fws) (M.delete dw dcs) fd
+    _       -> f
+
+-- | given a floating window, remove it and it's decoration from the floating layer
+deleteByOrig :: Ord a => a -> FLayer a -> FLayer a
+deleteByOrig ow f@(FLayer fws dcs fd) = case M.lookup ow fws of
+    -- The window is decorated, remove the decoration
+    Just (Just dw) -> FLayer (M.delete ow fws) (M.delete dw dcs) fd
+    -- The window is not decorated
+    Just _ -> FLayer (M.delete ow fws) dcs fd
+    -- Something funny is happening, just ignore it
+    _ -> f
+
+-- | add a given window and maybe it's decoration to the floating layer
+insertFDec :: Ord a => a -> Maybe a -> FLayer a -> FLayer a
+insertFDec ow Nothing (FLayer fs ds fd) = FLayer (M.insert ow Nothing fs) ds fd
+insertFDec ow (Just dw) (FLayer fs ds fd) =
+    let fs' = M.insert ow (Just dw) fs
+        ds' = M.insert dw ow ds
+    in FLayer fs' ds' fd
+
+-- | replace the floating layer's decorator
+newFDec :: Maybe (FloatDec a) -> FLayer a -> FLayer a
+newFDec (Just fd) fl = fl {fDec = fd}
+newFDec Nothing fl = fl
+
+-- | convinience wrapper for changes to the floating layer
+modifyFLayer :: (FLayer Window -> FLayer Window) -> X ()
+modifyFLayer f = modify $ \s -> s{floatingLayer = f $ floatingLayer s}
+
+-- | All floating decorations must be instances of this class, none of
+-- the functions need to be implemented
+class FloatClass fc a where
+    -- | handle a some message
+    handleFloatMessage :: fc a -> SomeMessage -> X (Maybe (fc a))
+    handleFloatMessage _ _ = return Nothing
+
+    -- | Given a window create a new one or return Nothing if the
+    -- window should not be decorated
+    -- | You are are responsible for making sure the window is shown
+    createFDec :: fc a -> a -> X (Maybe a, Maybe (fc a))
+    createFDec _ _ = return (Nothing, Nothing)
+
+    -- | called whenever the parent window is resized or moved
+    -- adjust, the decoration to match
+    moveFDec :: fc a -> a -> a -> X (Maybe (fc a))
+    moveFDec _ _ _ = return Nothing
+
+    -- | called whenever the parent window is hidden. The decoration
+    -- window will be automatically hidden, but not until after this
+    -- function is called
+    hideFDec :: fc a -> a -> a -> X (Maybe (fc a))
+    hideFDec _ _ _ = return Nothing
+
+    -- | called when the parent window is sunk or destroyed. The
+    -- decoration will be automatically destroyed after this function is called
+    removeFDec :: fc a -> a -> a -> X (Maybe (fc a))
+    removeFDec _ _ _ = return Nothing
+
+    -- | called before a parent is about to be dragged, prepare the
+    -- decoration window
+    startDecDrag :: fc a -> a -> a -> X (Maybe (fc a))
+    startDecDrag _ _ _ = return Nothing
+
+    -- | a function that allows a decoration window to respond to changes to
+    -- it's parent window by a dragging function. Return a function that will
+    -- adjust the decoration window in accordance with the parent's new size
+    whileDecDrag :: fc a -> a -> a -> X (Rectangle -> X ())
+    whileDecDrag _ _ _ = return $ \_ -> return ()
+
+    -- | called when the parent is done being dragged
+    finishDecDrag :: fc a -> a -> a -> X (Maybe (fc a))
+    finishDecDrag _ _ _ = return Nothing
+
+-- | default floating layer, no decorations
+data NoFloatDec a = NoFloatDec
+instance FloatClass NoFloatDec a
+
+--- | return the default floating layer wrapped in a FloatDec
+noFloatDec :: FloatDec Window
+noFloatDec = FloatDec NoFloatDec
+
+instance FloatClass FloatDec Window where
+    handleFloatMessage (FloatDec f)  m = fmap FloatDec <$> handleFloatMessage f m
+    createFDec (FloatDec f) dw  = fmap (fmap FloatDec) <$>  createFDec f dw
+    moveFDec (FloatDec f) ow dw = fmap FloatDec <$> moveFDec f ow dw
+    hideFDec (FloatDec f) ow dw = fmap FloatDec <$> hideFDec f ow dw
+    removeFDec (FloatDec f) ow dw = fmap FloatDec <$> removeFDec f ow dw
+    startDecDrag (FloatDec f) ow dw = fmap FloatDec <$> startDecDrag f ow dw
+    finishDecDrag (FloatDec f) ow dw = fmap FloatDec <$> finishDecDrag f ow dw
+    whileDecDrag (FloatDec f) = whileDecDrag f
diff --git a/src/XMonad/Main.hs b/src/XMonad/Main.hs
index da1d1f7..926e0c9 100644
--- a/src/XMonad/Main.hs
+++ b/src/XMonad/Main.hs
@@ -227,6 +227,7 @@ launch initxmc drs = do
             , mapped          = S.empty
             , waitingUnmap    = M.empty
             , dragging        = Nothing
+            , floatingLayer   = FLayer mempty mempty (floatHook xmc)
             , extensibleState = M.empty
             }
 
@@ -380,13 +381,16 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
 -- True in the user's config.
 handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
     | t == enterNotify && ev_mode   e == notifyNormal
-    = whenX (asks $ focusFollowsMouse . config) $ do
-        dpy <- asks display
-        root <- asks theRoot
-        (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
-        -- when Xlib cannot find a child that contains the pointer,
-        -- it returns None(0)
-        when (w' == 0 || w == w') (focus w)
+    = do ws <- gets windowset
+         dpy <- asks display
+         root <- asks theRoot
+         (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
+         -- when Xlib cannot find a child that contains the pointer,
+         -- it returns None(0)
+         when (w' == 0 || w == w') $
+           if M.member w (W.floating ws)
+               then whenX (asks $ floatFocusFollowsMouse . config) (focus w)
+               else whenX (asks $ focusFollowsMouse      . config) (focus w)
 
 -- left a window, check if we need to focus root
 handle e@(CrossingEvent {ev_event_type = t})
diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs
index ce29def..f81fa10 100644
--- a/src/XMonad/Operations.hs
+++ b/src/XMonad/Operations.hs
@@ -36,7 +36,7 @@ module XMonad.Operations (
     StateFile (..), writeStateToFile, readStateFile, restart,
 
     -- * Floating Layer
-    float, floatLocation,
+    float, floatLocation, whenDec,
 
     -- * Window Size Hints
     D, mkAdjust, applySizeHints, applySizeHints', applySizeHintsContents,
@@ -148,10 +148,16 @@ kill = withFocused killWindow
 -- | Modify the current window list with a pure function, and refresh
 windows :: (WindowSet -> WindowSet) -> X ()
 windows f = do
-    XState { windowset = old } <- get
+    old <- gets windowset
+    frf <- asks (focusRaisesFloat . config)
     let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
         newwindows = W.allWindows ws \\ W.allWindows old
-        ws = f old
+        oldFloats = M.keys $ M.difference (W.floating old) (W.floating ws)
+        mws = f old
+        ws = if frf && maybe False (\fw -> M.member fw (W.floating mws)) (W.peek mws)
+                then W.shiftMaster mws
+                else mws
+    mapM_ removeFloatDec oldFloats
     XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
 
     mapM_ setInitialProperties newwindows
@@ -191,7 +197,9 @@ windows f = do
                     , Just r <- [M.lookup fw m]]
             vs = flt ++ rs
 
-        io $ restackWindows d (map fst vs)
+        mapM_ (showFloatDec . fst) flt
+        fl <- gets floatingLayer
+        io $ restackWindows d (concatMap (stackDec fl . fst) vs)
         -- return the visible windows for this workspace:
         return vs
 
@@ -267,6 +275,7 @@ setWindowBorderWithFallback dpy w color basic = io $
 -- | Hide a window by unmapping it and setting Iconified.
 hide :: Window -> X ()
 hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
+    hideFloatDec w
     cMask <- asks $ clientMask . config
     io $ do selectInput d w (cMask .&. complement structureNotifyMask)
             unmapWindow d w
@@ -458,6 +467,7 @@ broadcastMessage a = withWindowSet $ \ws -> do
         v = map W.workspace . W.visible $ ws
         h = W.hidden ws
     mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
+    sendMessageToFloat a
 
 -- | Send a message to a layout, without refreshing.
 sendMessageWithNoRefresh :: Message a => a -> WindowSpace -> X ()
@@ -570,6 +580,7 @@ readStateFile xmc = do
                     , mapped          = S.empty
                     , waitingUnmap    = M.empty
                     , dragging        = Nothing
+                    , floatingLayer   = FLayer mempty mempty (floatHook xmc)
                     , extensibleState = extState
                     }
   where
@@ -602,7 +613,7 @@ floatLocation w =
     catchX go $ do
       -- Fallback solution if `go' fails.  Which it might, since it
       -- calls `getWindowAttributes'.
-      sc <- W.current <$> gets windowset
+      sc <- gets $ W.current . windowset
       return (W.screen sc, W.RationalRect 0 0 1 1)
 
   where fi x = fromIntegral x
@@ -689,33 +700,40 @@ mouseDragCursor cursorGlyph f done = do
 -- | Drag the window under the cursor with the mouse while it is dragged.
 mouseMoveWindow :: Window -> X ()
 mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+    WindowAttributes{ wa_x = wax, wa_y = way, wa_width = waw, wa_height = wah
+                    , wa_border_width = wabw} <- io $ getWindowAttributes d w
     (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
     let ox = fromIntegral ox'
         oy = fromIntegral oy'
+    startDraggingDec w
+    dragHandler <- whileDraggingDec w
     mouseDragCursor
               (Just xC_fleur)
-              (\ex ey -> do
-                  io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
-                                      (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
-                  float w
-              )
-              (float w)
+              (\ex ey ->
+                  let nx = fromIntegral wax + fromIntegral (ex - ox)
+                      ny = fromIntegral way + fromIntegral (ey - oy)
+                      r = Rectangle nx ny (fromIntegral (waw + 2 * wabw)) (fromIntegral wah)
+                   in io (moveWindow d w nx ny) >> dragHandler r)
+              (float w >> finishDraggingDec w)
 
 -- | Resize the window under the cursor with the mouse while it is dragged.
 mouseResizeWindow :: Window -> X ()
 mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+    WindowAttributes{ wa_x = wax, wa_y = way, wa_width = waw, wa_height = wah
+                    , wa_border_width = wabw} <- io $ getWindowAttributes d w
     sh <- io $ getWMNormalHints d w
-    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+    io $ warpPointer d none w 0 0 0 0 (fromIntegral waw) (fromIntegral wah)
+    startDraggingDec w
+    dragHandler <- whileDraggingDec w
     mouseDragCursor
               (Just xC_bottom_right_corner)
-              (\ex ey -> do
-                 io $ resizeWindow d w `uncurry`
-                    applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
-                                               ey - fromIntegral (wa_y wa))
-                 float w)
-              (float w)
+              (\ex ey ->
+                 let (nw, nh) = applySizeHintsContents sh ( ex - fromIntegral wax
+                                                          , ey - fromIntegral way)
+                     r = Rectangle (fromIntegral wax) (fromIntegral way)
+                                   (nw + fromIntegral (2 * wabw)) nh
+                  in io (resizeWindow d w nw nh) >> dragHandler r)
+              (float w >> finishDraggingDec w)
 
 -- ---------------------------------------------------------------------
 -- Support for window size hints
@@ -774,3 +792,86 @@ applyResizeIncHint (iw,ih) x@(w,h) =
 applyMaxSizeHint  :: D -> D -> D
 applyMaxSizeHint (mw,mh) x@(w,h) =
     if mw > 0 && mh > 0 then (min w mw,min h mh) else x
+
+
+--------------------------------------------------------------
+-- Floating Layer Functions
+-------------------------------------------------------------
+
+-- | If the window is decorated, hide it's decoration
+hideFloatDec :: Window -> X ()
+hideFloatDec = withDec' $ \fd ow dw -> do
+    withDisplay $ \d -> io $ unmapWindow d dw
+    hideFDec fd ow dw
+
+-- | Send a message to the floating layer
+sendMessageToFloat :: Message a => a -> X ()
+sendMessageToFloat a = withFLayer $ \(FLayer _ _ fd) -> do
+    mfd <- handleFloatMessage fd (SomeMessage a)
+    modifyFLayer (newFDec mfd)
+
+-- | If a window is decorated, prepare it's decoration for dragging
+startDraggingDec :: Window -> X ()
+startDraggingDec = withDec' startDecDrag
+
+-- | If a window is decorated, alert the decortation that the dragging has ended
+finishDraggingDec :: Window -> X ()
+finishDraggingDec = withDec' finishDecDrag
+
+-- | If a window is decorated allow the decoration to respond to the new position
+whileDraggingDec :: Window -> X (Rectangle -> X ())
+whileDraggingDec ow = withFLayer $ \(FLayer fws _ fd) -> case M.lookup ow fws of
+    Just (Just dw) -> whileDecDrag fd ow dw
+    _              -> return $ \_ -> return ()
+
+-- | If a window is decorated, destroy the decoration
+removeFloatDec :: Window -> X ()
+removeFloatDec ow = do withDec ow (\fd dw -> do
+                            nfd <- removeFDec fd ow dw
+                            withDisplay $ \d -> io $ destroyWindow d dw
+                            modifyFLayer $ newFDec nfd)
+                       modifyFLayer $ deleteByOrig ow
+
+-- | Reorder the floating windows such that their decorations are paired with
+-- their parents
+stackDec :: Ord a => FLayer a -> a -> [a]
+stackDec (FLayer fws _ _) w = case M.lookup w fws of
+    Just (Just dw) -> [dw, w]
+    _              -> [w]
+
+-- | Show the decoration for the given floating window or create it if necessary
+showFloatDec :: Window -> X ()
+showFloatDec w = withFLayer $ \(FLayer fws _ fd) ->
+    case M.lookup w fws of
+        --Decration exists, and may need to be modified
+        Just (Just dw) -> do
+            reveal dw
+            nfd <- moveFDec fd w dw
+            modifyFLayer (newFDec nfd)
+        --The window was just added to the floating layer
+        --Create a the corresponding decoration
+        Nothing -> do
+            (mw, mfd) <- createFDec fd w
+            modifyFLayer (newFDec mfd . insertFDec w mw)
+        --The window should not be decorated
+        _ -> return ()
+
+-- | a convience wrapper that takes a applies the given function to a the
+-- floating window in it's context and adjusts the Floating Layer in accordance
+withDec' :: (FloatDec Window -> Window -> Window -> X (Maybe (FloatDec Window)))
+                                                              -> Window -> X ()
+withDec' wf ow = withFLayer $ \(FLayer fws _ fl) -> case M.lookup ow fws of
+    Just (Just dw) -> wf fl ow dw >>= \nfd -> modifyFLayer $ newFDec nfd
+    _              -> return ()
+
+-- | if the given window is decorated, apply the given function to it's decorated context
+withDec :: Window -> (FloatDec Window -> Window -> X ()) -> X ()
+withDec ow f = withFLayer $ \(FLayer fws _ fl) -> case M.lookup ow fws of
+    Just (Just dw) -> f fl dw
+    _              -> return ()
+
+-- | If the given window is a decoration, apply the given function to it's parent window
+whenDec :: Window -> (Window -> X ()) -> X ()
+whenDec dw f = withFLayer $ \(FLayer _ dws _) -> case M.lookup dw dws of
+    Just ow -> f ow
+    _       -> return ()

contrib patch

diff --git a/XMonad/Layout/SimplestFloatDec.hs b/XMonad/Layout/SimplestFloatDec.hs
new file mode 100644
index 00000000..5270ee17
--- /dev/null
+++ b/XMonad/Layout/SimplestFloatDec.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.SimplestFloatDec
+-- Copyright   :  (c) 2015 Jeffrey Lyman
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  JLyman@macalester.edu
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A Floating window decorater that draws inspiration from
+-- Andrea Rossato/Jan Vornberger's Layout.Decoration module
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.SimplestFloatDec
+    ( SimplestDec(..)
+    , simplestDec
+    , Theme(..)
+    , def
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration hiding (shrink)
+import Control.Monad
+import Control.Applicative ((<$>))
+import XMonad.Util.XUtils
+import XMonad.Util.Font
+import XMonad.Util.Invisible
+import XMonad.Hooks.UrgencyHook
+import XMonad.Util.NamedWindows (getName)
+import qualified XMonad.StackSet as W
+import qualified Data.Map as M
+import Data.Bits
+import Data.List (foldl')
+import Graphics.X11.Xlib.Window
+
+-- $usage
+-- This module provides a simple decoration that allows users to move windows by
+-- dragging the decoration and delete windows clicking the window decoration with
+-- the second mouse button
+
+-- | a decoration consists of a list of 'Query's to ignore, a list of 'Theme'
+-- a 'Shrinker' and a 'XMonadFont' used to draw the decorations
+--
+-- For more information on 'Shrinker's and 'Themes' see "XMonad.Layout.Decoration"
+data SimplestDec a = SDec [Query Bool] Theme DefaultShrinker (Invisible Maybe XMonadFont)
+
+-- | given a list of 'Query's to ignore and a 'Theme' create a FloatDec
+simplestDec :: [Query Bool] -> Theme -> FloatDec Window
+simplestDec is t = FloatDec (SDec is t shrinkText (I Nothing))
+
+-- | whether the given window should be decorated
+shouldDec :: [Query Bool] -> Window -> X Bool
+shouldDec qs w = not <$> foldl' p (return False) qs
+    where p tv q = liftM2 (||) tv (runQuery q w)
+
+instance FloatClass SimplestDec Window where
+    handleFloatMessage (SDec _ Theme{decoHeight = h} _ _) m
+        | Just e@ButtonEvent{ ev_event_type = buttonPress, ev_button = b, ev_window = w} <- fromMessage m
+            = do when (b == 1) $ decMovesWindow (0, fromIntegral h) w
+                 when (b == 2) $ decDeletesWindow w
+                 return Nothing
+    handleFloatMessage _ _ = return Nothing
+
+    createFDec os@(SDec i t s _) ow = do
+        dec <- shouldDec i ow
+        if dec
+            then do
+                (f, ns) <- initFont os
+                dr <- decSize t ow
+                dw <- createDecoWindow t dr
+                showWindow dw
+                updateFDec t s f ow dw dr
+                return (Just dw, ns)
+            else return (Nothing, Nothing)
+
+    moveFDec os@(SDec _ t s _) ow dw = do
+        (f, ns) <- initFont os
+        dr@(Rectangle x y w h) <- decSize t ow
+        withDisplay $ \d -> do
+            io $ raiseWindow d dw
+            io $ moveResizeWindow d dw x y w h
+        updateFDec t s f ow dw dr
+        return ns
+
+    finishDecDrag _ ow _ = do
+        windows $ W.shiftMaster . W.focusWindow ow
+        return Nothing
+
+    startDecDrag _ _ dw = do
+        withDisplay $ \d -> io $ raiseWindow d dw
+        return Nothing
+
+    whileDecDrag (SDec _ Theme{ decoHeight = h } _ _) _ dw =
+        return $ followWindow h dw
+
+--------------------------------------------------------------
+--                     Actions                              --
+--------------------------------------------------------------
+
+-- | Given a decoration's height, move it so that it matches it's
+-- parent's position
+followWindow :: Dimension -> Window -> Rectangle -> X ()
+followWindow h dw (Rectangle x y w _) = withDisplay $ \d ->
+    io $ moveResizeWindow d dw x (y - fromIntegral h) w h
+
+-- | given an theme and the parent window, return a rectangle
+-- representing the dimensions of it's decoration
+decSize :: Theme -> Window -> X Rectangle
+decSize Theme {decoHeight = h} ow = do
+        ws <- gets windowset
+        let sr = screenRect $ W.screenDetail $ W.current ws
+            Just rr = M.lookup ow (W.floating ws)
+            or@(Rectangle x y w _) = scaleRationalRect sr rr
+        return $ Rectangle x (y - fromIntegral h) w (fromIntegral h)
+
+-- | given a theme an a bounding rectangle, create a window for the decoration
+createDecoWindow :: Theme -> Rectangle -> X Window
+createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in
+                       createNewWindow r mask (inactiveColor t) True
+
+-- | given the amount the parent should be offset from the decoration, move the
+-- parrent window so that it follows the when the float window is dragged
+decMovesWindow :: (Position, Position) -> Window -> X ()
+decMovesWindow (dx,dy) dw = whenDec dw $ \ow -> withDisplay $ \d -> do
+    io $ raiseWindow d dw
+    io $ raiseWindow d ow
+    WindowAttributes{ wa_x = wax, wa_y = way } <- io $ getWindowAttributes d dw
+    (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d dw
+    let ox = fromIntegral ox'
+        oy = fromIntegral oy'
+        nx ex = fromIntegral wax + fromIntegral (ex - ox)
+        ny ey = fromIntegral way + fromIntegral (ey - oy)
+    mouseDrag (\ex ey -> do io $ moveWindow d dw (nx ex) (ny ey)
+                            io $ moveWindow d ow (dx + nx ex) (dy + ny ey) )
+              (float ow >> windows (W.shiftMaster . W.focusWindow ow))
+
+-- | given a window, if it is a decoration, delete it's parent
+decDeletesWindow :: Window -> X ()
+decDeletesWindow w = whenDec w $ \ow -> killWindow ow
+
+--------------------------------------------------------------
+--                     Drawing                              --
+--------------------------------------------------------------
+
+-- | ensure that the font we use for the decorations is loaded
+initFont :: SimplestDec Window -> X (XMonadFont, Maybe (SimplestDec Window))
+initFont (SDec _ _ _ (I (Just xf))) = return (xf, Nothing)
+initFont (SDec i t s (I Nothing))  = do
+    xf <- initXMF (fontName t)
+    return (xf, Just (SDec i t s (I (Just xf))))
+
+-- | Paint the decoration to match the theme
+updateFDec :: Shrinker s => Theme -> s -> XMonadFont -> Window -> Window -> Rectangle -> X ()
+updateFDec t sh fs ow dw (Rectangle _ _ wh ht) = do
+  nw  <- getName ow
+  ur  <- readUrgents
+  dpy <- asks display
+  let focusColor win ic ac uc = (maybe ic (\focusw -> case () of
+                                                       _ | focusw == win -> ac
+                                                         | win `elem` ur -> uc
+                                                         | otherwise     -> ic) . W.peek)
+                                `fmap` gets windowset
+  (bc,borderc,tc) <- focusColor ow (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)
+                                  (activeColor   t, activeBorderColor   t, activeTextColor   t)
+                                  (urgentColor   t, urgentBorderColor   t, urgentTextColor   t)
+  let s = shrinkIt sh
+  name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n
+                                  return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
+  let als = AlignCenter : map snd (windowTitleAddons t)
+      strs = name : map fst (windowTitleAddons t)
+      i_als = map snd (windowTitleIcons t)
+      icons = map fst (windowTitleIcons t)
+  paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons
diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal
index 57d34887..109eb88d 100644
--- a/xmonad-contrib.cabal
+++ b/xmonad-contrib.cabal
@@ -290,6 +290,7 @@ library
                         XMonad.Layout.SimpleFloat
                         XMonad.Layout.Simplest
                         XMonad.Layout.SimplestFloat
+                        XMonad.Layout.SimplestFloatDec
                         XMonad.Layout.SortedLayout
                         XMonad.Layout.Spacing
                         XMonad.Layout.Spiral