twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-06 06:51:55 -07:00
Code Issues Packages Projects Releases Wiki Activity

'XMonad.Actions.MessageFeedback': standardize

Browse Source 
- Follow the naming conventions of `XMonad.Operations`. Functions returning
  `X ()` are named regularly (previously these ended in underscore) while
  those returning `X Bool` are suffixed with an uppercase 'B'.

- Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
  `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
  (renamed from `send`).

- The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
  type `SomeMessage -> X Bool`, which means you are no longer constrained
  to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.

- The `send*Messages*` family of funtions allows for sequencing arbitrary
  sets of messages with minimal refresh. It makes little sense for these
  functions to support custom message dispatchers.

- Remain backwards compatible. Maintain deprecated aliases of all renamed
  functions:
  - `send`          -> `sendMessageWithNoRefreshToCurrentB`
  - `sendSM`        -> `sendSomeMessageWithNoRefreshToCurrentB`
  - `sendSM_`       -> `sendSomeMessageWithNoRefreshToCurrent`
  - `tryInOrder`    -> `tryInOrderWithNoRefreshToCurrentB`
  - `tryInOrder_`   -> `tryInOrderWithNoRefreshToCurrent`
  - `tryMessage`    -> `tryMessageWithNoRefreshToCurrentB`
  - `tryMessage_`   -> `tryMessageWithNoRefreshToCurrent`
This commit is contained in:
Yclept Nemo
2018-06-13 12:01:23 -04:00
parent e0b1954e62
commit 8ee2e39fb2
2 changed files with 256 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
CHANGES.md
View File

@@ -89,6 +89,30 @@
- Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
`xmobarRaw`. `xmobarRaw`.
* `XMonad.Actions.MessageFeedback`
- Follow the naming conventions of `XMonad.Operations`. Functions returning
`X ()` are named regularly (previously these ended in underscore) while
those returning `X Bool` are suffixed with an uppercase 'B'.
- Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
`sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
(renamed from `send`).
- The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
type `SomeMessage -> X Bool`, which means you are no longer constrained
to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.
- The `send*Messages*` family of funtions allows for sequencing arbitrary
sets of messages with minimal refresh. It makes little sense for these
functions to support custom message dispatchers.
- Remain backwards compatible. Maintain deprecated aliases of all renamed
functions:
- `send` -> `sendMessageWithNoRefreshToCurrentB`
- `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB`
- `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent`
- `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB`
- `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent`
- `tryMessage` -> `tryMessageWithNoRefreshToCurrentB`
- `tryMessage_` -> `tryMessageWithNoRefreshToCurrent`
### New Modules ### New Modules
* `XMonad.Hooks.RefocusLast` * `XMonad.Hooks.RefocusLast`
@@ -186,10 +210,10 @@
strategy with fewer quirks for tiled layouts using X.L.Spacing. strategy with fewer quirks for tiled layouts using X.L.Spacing.
* `XMonad.Layout.Fullscreen` * `XMonad.Layout.Fullscreen`
The fullscreen layouts will now not render any window that is totally The fullscreen layouts will now not render any window that is totally
obscured by fullscreen windows. obscured by fullscreen windows.
* `XMonad.Layout.Gaps` * `XMonad.Layout.Gaps`
Extended the sendMessage interface with `ModifyGaps` to allow arbitrary Extended the sendMessage interface with `ModifyGaps` to allow arbitrary

283
XMonad/Actions/MessageFeedback.hs
View File

@@ -1,7 +1,8 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Actions.MessageFeedback -- Module : XMonad.Actions.MessageFeedback
-- Copyright : (c) Quentin Moser <moserq@gmail.com> -- Copyright : (c) -- Quentin Moser <moserq@gmail.com>
-- 2018 Yclept Nemo
-- License : BSD3 -- License : BSD3
-- --
-- Maintainer : orphaned -- Maintainer : orphaned
@@ -13,87 +14,263 @@
-- this facility. -- this facility.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad.Actions.MessageFeedback ( module XMonad.Actions.MessageFeedback
-- * Usage ( -- * Usage
-- $usage -- $usage
send -- * Messaging variants
, tryMessage
, tryMessage_
, tryInOrder
, tryInOrder_
, sm
, sendSM
, sendSM_
) where
import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX ) -- ** 'SomeMessage'
import XMonad.StackSet ( current, workspace, layout, tag ) sendSomeMessageB, sendSomeMessage
import XMonad.Operations ( updateLayout ) , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
, sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
import Control.Monad.State ( gets ) -- ** 'Message'
import Data.Maybe ( isJust ) , sendMessageB
import Control.Applicative ((<$>)) , sendMessageWithNoRefreshB
, sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
-- * Utility Functions
-- ** Send All
, sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
-- ** Send Until
, tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
, tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
-- ** Aliases
, sm
-- * Backwards Compatibility
-- $backwardsCompatibility
, send, sendSM, sendSM_
, tryInOrder, tryInOrder_
, tryMessage, tryMessage_
) where
import XMonad ( Window )
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
import XMonad.Operations ( updateLayout, refresh, windows )
import Data.Maybe ( isJust )
import Control.Monad ( when, void )
import Control.Monad.State ( gets )
import Control.Applicative ( (<$>), liftA2 )
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
-- --
-- > import XMonad.Actions.MessageFeedback -- > import XMonad.Actions.MessageFeedback
-- --
-- You can then use this module's functions wherever an action is expected. -- You can then use this module's functions wherever an action is expected. All
-- feedback variants are supported:
--
-- * message to any workspace with no refresh
-- * message to current workspace with no refresh
-- * message to current workspace with refresh
--
-- Except "message to any workspace with refresh" which makes little sense.
-- --
-- Note that most functions in this module have a return type of @X Bool@ -- Note that most functions in this module have a return type of @X Bool@
-- whereas configuration options will expect a @X ()@ action. -- whereas configuration options will expect a @X ()@ action. For example, the
-- For example, the key binding -- key binding:
-- --
-- > -- Shrink the master area of a tiled layout, or move the focused window -- > -- Shrink the master area of a tiled layout, or move the focused window
-- > -- to the left in a WindowArranger-based layout -- > -- to the left in a WindowArranger-based layout
-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50)) -- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
-- --
-- is mis-typed. For this reason, this module provides alternatives (ending with -- is mis-typed. For this reason, this module provides alternatives (not ending
-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@. -- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
-- For example, to correct the previous example: -- 'sendMessageB') that discard their boolean result and return an @X ()@. For
-- example, to correct the previous example:
-- --
-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50)) -- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
-- --
-- This module also provides 'SomeMessage' variants of each 'Message' function
-- for when the messages are of differing types (but still instances of
-- 'Message'). First box each message using 'SomeMessage' or the convenience
-- alias 'sm'. Then, for example, to send each message:
--
-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
--
-- This is /not/ equivalent to the following example, which will not refresh
-- the workspace unless the last message is handled:
--
-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB
-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the -- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
-- message was handled by the layout, False otherwise. -- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
send :: Message a => a -> X Bool -- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
send = sendSM . sm -- for efficiency this is pretty much an exact copy of the
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB m = do
w <- workspace . current <$> gets windowset
ml <- handleMessage (layout w) m `catchX` return Nothing
whenJust ml $ \l ->
windows $ \ws -> ws { current = (current ws)
{ workspace = (workspace $ current ws)
{ layout = l }}}
return $ isJust ml
-- | Sends the first message, and if it was not handled, sends the second. -- | Variant of 'sendSomeMessageB' that discards the result.
-- Returns True if either message was handled, False otherwise. sendSomeMessage :: SomeMessage -> X ()
tryMessage :: (Message a, Message b) => a -> b -> X Bool sendSomeMessage = void . sendSomeMessageB
tryMessage m1 m2 = do b <- send m1
if b then return True else send m2
tryMessage_ :: (Message a, Message b) => a -> b -> X () -- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
tryMessage_ m1 m2 = tryMessage m1 m2 >> return () -- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
-- @True@ if the message was handled, @False@ otherwise.
sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB m w
= handleMessage (layout w) m `catchX` return Nothing
>>= liftA2 (>>) (updateLayout $ tag w) (return . isJust)
-- | Tries sending every message of the list in order until one of them -- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
-- is handled. Returns True if one of the messages was handled, False otherwise. sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
tryInOrder :: [SomeMessage] -> X Bool sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
tryInOrder [] = return False
tryInOrder (m:ms) = do b <- sendSM m
if b then return True else tryInOrder ms
tryInOrder_ :: [SomeMessage] -> X () -- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
tryInOrder_ ms = tryInOrder ms >> return () -- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
-- handled, @False@ otherwise. This function is somewhat of a cross between
-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB m
= (gets $ workspace . current . windowset)
>>= sendSomeMessageWithNoRefreshB m
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
-- result.
sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB
-- | Convenience shorthand for 'XMonad.Core.SomeMessage'. -- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
-- was handled, @False@ otherwise.
sendMessageB :: Message a => a -> X Bool
sendMessageB = sendSomeMessageB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
-- handled, @False@ otherwise.
sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage
-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB
-- | Send each 'SomeMessage' to the current layout without refresh (using
-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
-- message was handled, refresh. If you want to sequence a series of messages
-- that would have otherwise used 'XMonad.Operations.sendMessage' while
-- minimizing refreshes, use this.
sendSomeMessagesB :: [SomeMessage] -> X [Bool]
sendSomeMessagesB m
= mapM sendSomeMessageWithNoRefreshToCurrentB m
>>= liftA2 (>>) (flip when refresh . or) return
-- | Variant of 'sendSomeMessagesB' that discards the results.
sendSomeMessages :: [SomeMessage] -> X ()
sendSomeMessages = void . sendSomeMessagesB
-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
-- 'SomeMessage'. Use this if all the messages are of the same type.
sendMessagesB :: Message a => [a] -> X [Bool]
sendMessagesB = sendSomeMessagesB . map SomeMessage
-- | Variant of 'sendMessagesB' that discards the results.
sendMessages :: Message a => [a] -> X ()
sendMessages = void . sendMessagesB
-- | Apply the dispatch function in order to each message of the list until one
-- is handled. Returns @True@ if so, @False@ otherwise.
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB _ [] = return False
tryInOrderB f (m:ms) = do b <- f m
if b then return True else tryInOrderB f ms
-- | Variant of 'tryInOrderB' that sends messages to the current layout without
-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB
-- | Apply the dispatch function to the first message, and if it was not
-- handled, apply it to the second. Returns @True@ if either message was
-- handled, @False@ otherwise.
tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]
-- | Variant of 'tryMessageB' that sends messages to the current layout without
-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryMessage' that discards the results.
tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
-- | Convenience shorthand for 'SomeMessage'.
sm :: Message a => a -> SomeMessage sm :: Message a => a -> SomeMessage
sm = SomeMessage sm = SomeMessage
--------------------------------------------------------------------------------
-- Backwards Compatibility:
--------------------------------------------------------------------------------
{-# DEPRECATED send "Use sendMessageB instead." #-}
{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
-- $backwardsCompatibility
-- The following functions exist solely for compatibility with pre-0.14
-- releases.
-- | See 'sendMessageWithNoRefreshToCurrentB'.
send :: Message a => a -> X Bool
send = sendMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrentB'.
sendSM :: SomeMessage -> X Bool sendSM :: SomeMessage -> X Bool
sendSM m = do w <- workspace . current <$> gets windowset sendSM = sendSomeMessageWithNoRefreshToCurrentB
ml' <- handleMessage (layout w) m `catchX` return Nothing
updateLayout (tag w) ml'
return $ isJust ml'
-- | See 'sendSomeMessageWithNoRefreshToCurrent'.
sendSM_ :: SomeMessage -> X () sendSM_ :: SomeMessage -> X ()
sendSM_ m = sendSM m >> return () sendSM_ = sendSomeMessageWithNoRefreshToCurrent
-- | See 'tryInOrderWithNoRefreshToCurrentB'.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder = tryInOrderWithNoRefreshToCurrentB
-- | See 'tryInOrderWithNoRefreshToCurrent'.
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ = tryInOrderWithNoRefreshToCurrent
-- | See 'tryMessageWithNoRefreshToCurrentB'.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage = tryMessageWithNoRefreshToCurrentB
-- | See 'tryMessageWithNoRefreshToCurrent'.
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ = tryMessageWithNoRefreshToCurrent