forked from xmonad/xmonad-contrib
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request xmonad#261 from orbisvicis/messaging
- Loading branch information
Showing
2 changed files
with
256 additions
and
55 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,7 +1,8 @@ | ||
| ----------------------------------------------------------------------------- | ||
| -- | | ||
| -- Module : XMonad.Actions.MessageFeedback | ||
| -- Copyright : (c) Quentin Moser <[email protected]> | ||
| -- Copyright : (c) -- Quentin Moser <[email protected]> | ||
| -- 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 (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), 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: | ||
| -- | ||
| -- 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: | ||
| -- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB] | ||
| -- | ||
| -- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50)) | ||
| -- 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 | ||
|
|
||
| -- | 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 | ||
|
|
||
|
|
||
| -- | 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 | ||
|
|
||
| tryInOrder_ :: [SomeMessage] -> X () | ||
| tryInOrder_ ms = tryInOrder ms >> return () | ||
|
|
||
| -- | 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 | ||
|
|
||
| -- | Convenience shorthand for 'XMonad.Core.SomeMessage'. | ||
| -- | 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." #-} | ||
|
|
||
| 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' | ||
| -- $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 = sendSomeMessageWithNoRefreshToCurrentB | ||
|
|
||
| -- | See 'sendSomeMessageWithNoRefreshToCurrent'. | ||
| 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 | ||