Merge pull request #640 from subbyte/master

Add X.U.ActionQueue and X.H.BorderPerWindow

CHANGES.md

@@ -11,6 +11,16 @@
     Layout modifier that, if only a single window is on screen, places that window
     in the middle of the screen.
 
+  * `XMonad.Util.ActionQueue`
+
+    Put XMonad actions in the queue to be executed every time the
+    `logHook` (or, alternatively, a hook of your choice) runs.
+
+  * `XMonad.Hooks.BorderPerWindow`
+
+    While XMonad provides config to set all window borders at the same
+    width, this extension defines and sets border width for each window.
+
 ### Bug Fixes and Minor Changes
 
   * `XMonad.Prompt`

XMonad/Hooks/BorderPerWindow.hs

@@ -0,0 +1,78 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.BorderPerWindow
+-- Description :  Set border width for each window in all layouts.
+-- Copyright   :  (c) 2021 Xiaokui Shu
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  subbyte@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Want to customize border width, for each window on all layouts? Want
+-- specific window have no border on all layouts? Try this.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.BorderPerWindow ( -- * Usage
+                                      -- $usage
+                                      defineBorderWidth
+                                    , actionQueue
+
+                                      -- * Design Considerations
+                                      -- $design
+                                    ) where
+
+
+import Graphics.X11.Xlib (Dimension)
+import XMonad
+import XMonad.Util.ActionQueue (enqueue, actionQueue)
+
+-- $usage
+--
+-- To use this module, first import it
+--
+-- > import XMonad.Hooks.BorderPerWindow (defineBorderWidth, actionQueue)
+--
+-- Then specify which window to customize the border of in your
+-- @manageHook@:
+--
+-- > myManageHook :: ManageHook
+-- > myManageHook = composeAll
+-- >     [ className =? "firefox"  --> defineWindowWidth 0
+-- >     , className =? "Chromium" --> defineWindowWidth 0
+-- >     , isDialog                --> defineWindowWidth 8
+-- >     ]
+--
+-- Finally, add the 'actionQueue' combinator and @myManageHook@ to your
+-- config:
+--
+-- > main = xmonad $ actionQueue $ def
+-- >     { ...
+-- >     , manageHook = myManageHook
+-- >     , ...
+-- >     }
+--
+-- Note that this module is incompatible with other ways of changing
+-- borders, like "XMonad.Layout.NoBorders".  This is because we are
+-- changing the border exactly /once/ (when the window first appears)
+-- and not every time some condition is satisfied.
+
+-- $design
+--
+-- 1. Keep it simple. Since the extension does not aim to change border setting
+--    when layout changes, only execute the border setting function once to
+--    avoid potential window flashing/jumping/scaling.
+--
+-- 2. The 'ManageHook' eDSL is a nice language for specifying windows. Let's
+--    build on top of it and use it to specify window to define border.
+
+defineBorderWidth :: Dimension -> ManageHook
+defineBorderWidth bw = do
+    w <- ask
+    liftX . enqueue $ updateBorderWidth w bw
+    idHook
+
+updateBorderWidth :: Window -> Dimension -> X ()
+updateBorderWidth w bw = do
+    withDisplay $ \d -> io $ setWindowBorderWidth d w bw
+    refresh

XMonad/Util/ActionQueue.hs

@@ -0,0 +1,99 @@
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.ActionQueue
+-- Description :  Queue of XMonad actions
+-- Copyright   :  (c) 2021 Xiaokui Shu
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  subbyte@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Put XMonad actions in the queue to be executed in either the
+-- @logHook@ or another hook of your choice.
+-----------------------------------------------------------------------------
+
+module XMonad.Util.ActionQueue ( -- * Usage
+                                 -- $usage
+                                 ActionQueue
+                               , actionQueue
+                               , enqueue
+                               , exequeue
+                               ) where
+
+import XMonad
+import qualified XMonad.Util.ExtensibleConf  as XC
+import qualified XMonad.Util.ExtensibleState as XS
+
+import Data.Sequence (Seq (..), ViewL (..), viewl, (|>))
+
+-- $usage
+--
+-- This module provides a queue that, by default, gets executed every
+-- time the @logHook@ runs.  To use this module
+--
+-- 1. Enqueue `X ()` actions at the place you need; e.g.:
+--
+-- > enqueue myAction
+--
+-- 2. Add the 'actionQueue' combinator to your configuration:
+--
+-- > main = xmonad $ actionQueue $ def
+-- >     { ... }
+--
+-- This will execute all of the actions in the queue (if any) every time
+-- the @logHook@ runs.  Developers of other extensions using this module
+-- should re-export 'actionQueue'.
+--
+-- Alternatively, you can directly add 'exequeue' to a hook of your choice.
+-- This is discouraged when writing user-facing modules, as (accidentally)
+-- adding 'exequeue' to two different hooks might lead to undesirable
+-- behaviour.  'actionQueue' uses the "XMonad.Util.ExtensibleConf" interface to
+-- circumvent this.
+--
+
+newtype ActionQueue = ActionQueue (Seq (X ()))
+  deriving newtype (Semigroup)
+
+-- NOTE: The 'Semigroup' instance is technically wrong for a queue
+-- (simply appending two queues together).  However, since these are
+-- only needed for essentially the unit element and multiplication with
+-- the unit, this does not seem like a big deal.
+--
+-- Indeed, since 'ActionQueue' is exported as an abstract type, there is
+-- no way to build up a queue outside os using 'enqueue', meaning users
+-- can't abuse these.
+
+instance ExtensionClass ActionQueue where
+    initialValue = emptyQueue
+
+emptyQueue :: ActionQueue
+emptyQueue = ActionQueue mempty
+
+-- | Every time the @logHook@ runs, execute all actions in the queue.
+actionQueue :: XConfig l -> XConfig l
+actionQueue = XC.once (\cfg -> cfg{ logHook = logHook cfg <> exequeue })
+                      emptyQueue
+
+-- | Enqueue an action.
+enqueue :: X () -> X ()
+enqueue = XS.modify . go
+  where
+    go :: X () -> ActionQueue -> ActionQueue
+    go a (ActionQueue as) = ActionQueue $ as |> a
+
+-- | Execute every action in the queue.
+exequeue :: X ()
+exequeue = do
+    -- Note that we are executing all actions one by one.  Otherwise, we may
+    -- not execute the actions in the right order.  Any of them may call
+    -- 'refresh' or 'windows', which triggers the logHook, which may trigger
+    -- 'exequeue' again if it is used in the logHook.
+    ActionQueue aas <- XS.get
+    case viewl aas of
+      EmptyL  -> pure ()
+      a :< as -> do XS.put (ActionQueue as)
+                    a `catchX` pure ()
+                    exequeue

XMonad/Util/ExtensibleConf.hs

@@ -62,7 +62,7 @@ import qualified Data.Map as M
 -- > newtype MyConf = MyConf{ fromMyConf :: [Int] } deriving Semigroup
 -- >
 -- > customLogger :: Int -> XConfig l -> XConfig l
--- > customLogger i = XC.once (MyConf [i]) $ \c -> c{ logHook = logHook c <> lh }
+-- > customLogger i = XC.once (\c -> c{ logHook = logHook c <> lh }) (MyConf [i])
 -- >   where
 -- >     lh :: X ()
 -- >     lh = XC.with $ io . print . fromMyConf

xmonad-contrib.cabal

@@ -168,6 +168,7 @@ library
                         XMonad.Doc.Configuring
                         XMonad.Doc.Developing
                         XMonad.Doc.Extending
+                        XMonad.Hooks.BorderPerWindow
                         XMonad.Hooks.CurrentWorkspaceOnTop
                         XMonad.Hooks.DebugEvents
                         XMonad.Hooks.DebugKeyEvents
@@ -335,6 +336,7 @@ library
                         XMonad.Prompt.XMonad
                         XMonad.Prompt.Zsh
                         XMonad.Util.ActionCycle
+                        XMonad.Util.ActionQueue
                         XMonad.Util.ClickableWorkspaces
                         XMonad.Util.Cursor
                         XMonad.Util.CustomKeys