X.U.XUtils: Add framework for manipulating simple windows

Adds several new functions and type for manipulating "simple windows".

There are several ways to draw windows in X.U.XUtils and other places
already, but they are all quite manual.  Most of the time one does not
want to think about dimensions much and assumes that the code is smart
enough to "figure it out"; this is an attempt to do exactly that.

There is a less-managed version `showSimpleWindow`, which just creates
and shows the windows, as well as a wrapper-like `withSimpleWindow` that
also destroys the window once some action finishes executing.

With these functions it should be possible to refactor some contrib
modules that currently draw windows manually, like X.U.EasyMotion.

CHANGES.md

@@ -121,6 +121,12 @@
     - Added `keymaskToString` and `keyToString` to show a key mask and a
       key in the style of `XMonad.Util.EZConfig`.
 
+  * `XMonad.Util.XUtils`
+
+    - Added `withSimpleWindow`, `showSimpleWindow`, `WindowConfig`, and
+      `WindowRect` in order to simplify the handling of simply popup
+      windows.
+
 ## 0.17.0 (October 27, 2021)
 
 ### Breaking Changes

XMonad/Util/XUtils.hs

@@ -1,3 +1,7 @@
+{-# LANGUAGE CPP             #-}
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE TupleSections   #-}
+{-# LANGUAGE RecordWildCards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Util.XUtils
@@ -17,7 +21,11 @@
 module XMonad.Util.XUtils
     ( -- * Usage:
       -- $usage
-      averagePixels
+      withSimpleWindow
+    , showSimpleWindow
+    , WindowConfig(..)
+    , WindowRect(..)
+    , averagePixels
     , createNewWindow
     , showWindow
     , showWindows
@@ -37,6 +45,7 @@ import XMonad.Prelude
 import XMonad
 import XMonad.Util.Font
 import XMonad.Util.Image
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or
@@ -157,6 +166,86 @@ paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do
         is = Just (ffc, fbc, zip iconPositions icons)
     paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is
 
+-- | The config for a window, as interpreted by 'showSimpleWindow'.
+--
+-- The font @winFont@ can either be specified in the TODO format or as an
+-- xft font.  For example:
+--
+-- > winFont = "xft:monospace-20"
+--
+-- or
+--
+-- > winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+data WindowConfig = WindowConfig
+  { winFont :: !String      -- ^ Font to use.
+  , winBg   :: !String      -- ^ Background color.
+  , winFg   :: !String      -- ^ Foreground color.
+  , winRect :: !WindowRect  -- ^ Position and size of the rectangle.
+  }
+
+instance Default WindowConfig where
+  def = WindowConfig
+    {
+#ifdef XFT
+      winFont = "xft:monospace-20"
+#else
+      winFont = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+#endif
+    , winBg   = "black"
+    , winFg   = "white"
+    , winRect = CenterWindow
+    }
+
+-- | What kind of window we should be.
+data WindowRect
+  = CenterWindow         -- ^ Centered, big enough to fit all the text.
+  | CustomRect Rectangle -- ^ Completely custom dimensions.
+
+-- | Create a window, then fill and show it with the given text.  If you
+-- are looking for a version of this function that also takes care of
+-- destroying the window, refer to 'withSimpleWindow'.
+showSimpleWindow :: WindowConfig -- ^ Window config.
+                 -> [String]     -- ^ Lines of text to show.
+                 -> X Window
+showSimpleWindow WindowConfig{..} strs = do
+  let pad = 20
+  font <- initXMF winFont
+  dpy  <- asks display
+  Rectangle sx sy sw sh <- getRectangle winRect
+
+  -- Text extents for centering all fonts
+  extends <- maximum . map (uncurry (+)) <$> traverse (textExtentsXMF font) strs
+  -- Height and width of entire window
+  height <- pure . fi $ (1 + length strs) * fi extends
+  width  <- (+ pad) . fi . maximum <$> traverse (textWidthXMF dpy font) strs
+
+  let -- x and y coordinates that specify the upper left corner of the window
+      x = sx + (fi sw - width  + 2) `div` 2
+      y = sy + (fi sh - height + 2) `div` 2
+      -- y position of first string
+      yFirst = (height + extends) `div` fi (1 + length strs)
+      -- (x starting, y starting) for all strings
+      strPositions = map (pad `div` 2, ) [yFirst, yFirst + extends ..]
+
+  w <- createNewWindow (Rectangle x y (fi width) (fi height)) Nothing "" True
+  let ms = Just (font, winFg, winBg, zip strs strPositions)
+  showWindow w
+  paintWindow' w (Rectangle 0 0 (fi width) (fi height)) 0 winBg "" ms Nothing
+  releaseXMF font
+  pure w
+ where
+  getRectangle :: WindowRect -> X Rectangle
+  getRectangle = \case
+    CenterWindow -> gets $ screenRect . W.screenDetail . W.current . windowset
+    CustomRect r -> pure r
+
+-- | Like 'showSimpleWindow', but fully manage the window; i.e., destroy
+-- it after the given function finishes its execution.
+withSimpleWindow :: WindowConfig -> [String] -> X a -> X a
+withSimpleWindow wc strs doStuff = do
+  w <- showSimpleWindow wc strs
+  doStuff <* withDisplay (io . (`destroyWindow` w))
+
 -- This stuff is not exported
 
 -- | Paints a titlebar with some strings and icons