diff --git a/CHANGES.md b/CHANGES.md index 348811a3..d5f69b3f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -107,6 +107,30 @@ wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make use of the new parameter with "`hiddens amb wset lr mst wrs =`". + * `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 * `XMonad.Layout.MultiToggle.TabBarDecoration` @@ -211,10 +235,10 @@ strategy with fewer quirks for tiled layouts using X.L.Spacing. * `XMonad.Layout.Fullscreen` - + The fullscreen layouts will now not render any window that is totally obscured by fullscreen windows. - + * `XMonad.Layout.Gaps` Extended the sendMessage interface with `ModifyGaps` to allow arbitrary diff --git a/XMonad/Actions/MessageFeedback.hs b/XMonad/Actions/MessageFeedback.hs index 1928d33f..43cee6aa 100644 --- a/XMonad/Actions/MessageFeedback.hs +++ b/XMonad/Actions/MessageFeedback.hs @@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MessageFeedback --- Copyright : (c) Quentin Moser +-- Copyright : (c) -- Quentin Moser +-- 2018 Yclept Nemo -- License : BSD3 -- -- Maintainer : orphaned @@ -13,87 +14,263 @@ -- this facility. ----------------------------------------------------------------------------- -module XMonad.Actions.MessageFeedback ( - -- * Usage - -- $usage +module XMonad.Actions.MessageFeedback + ( -- * Usage + -- $usage - send - , tryMessage - , tryMessage_ - , tryInOrder - , tryInOrder_ - , sm - , sendSM - , sendSM_ - ) where + -- * Messaging variants -import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX ) -import XMonad.StackSet ( current, workspace, layout, tag ) -import XMonad.Operations ( updateLayout ) + -- ** 'SomeMessage' + sendSomeMessageB, sendSomeMessage + , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh + , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent -import Control.Monad.State ( gets ) -import Data.Maybe ( isJust ) -import Control.Applicative ((<$>)) + -- ** 'Message' + , sendMessageB + , 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 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > 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@ --- whereas configuration options will expect a @X ()@ action. --- For example, the key binding +-- whereas configuration options will expect a @X ()@ action. For example, the +-- key binding: -- -- > -- Shrink the master area of a tiled layout, or move the focused window -- > -- 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 --- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@. --- For example, to correct the previous example: +-- is mis-typed. For this reason, this module provides alternatives (not ending +-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than +-- '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 --- message was handled by the layout, False otherwise. -send :: Message a => a -> X Bool -send = sendSM . sm +-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use +-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled, +-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB' +-- 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. --- Returns True if either message was handled, False otherwise. -tryMessage :: (Message a, Message b) => a -> b -> X Bool -tryMessage m1 m2 = do b <- send m1 - if b then return True else send m2 +-- | Variant of 'sendSomeMessageB' that discards the result. +sendSomeMessage :: SomeMessage -> X () +sendSomeMessage = void . sendSomeMessageB -tryMessage_ :: (Message a, Message b) => a -> b -> X () -tryMessage_ m1 m2 = tryMessage m1 m2 >> return () +-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts +-- '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 --- is handled. Returns True if one of the messages was handled, False otherwise. -tryInOrder :: [SomeMessage] -> X Bool -tryInOrder [] = return False -tryInOrder (m:ms) = do b <- sendSM m - if b then return True else tryInOrder ms +-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result. +sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X () +sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m -tryInOrder_ :: [SomeMessage] -> X () -tryInOrder_ ms = tryInOrder ms >> return () +-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the +-- 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 = 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 m = do w <- workspace . current <$> gets windowset - ml' <- handleMessage (layout w) m `catchX` return Nothing - updateLayout (tag w) ml' - return $ isJust ml' - +sendSM = sendSomeMessageWithNoRefreshToCurrentB +-- | See 'sendSomeMessageWithNoRefreshToCurrent'. sendSM_ :: SomeMessage -> X () -sendSM_ m = sendSM m >> return () \ No newline at end of file +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