mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
99 lines
3.6 KiB
Haskell
99 lines
3.6 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Actions.MessageFeedback
|
|
-- Copyright : (c) Quentin Moser <moserq@gmail.com>
|
|
-- License : BSD3
|
|
--
|
|
-- Maintainer : orphaned
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge
|
|
-- of whether the message was handled, and utility functions based on
|
|
-- this facility.
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Actions.MessageFeedback (
|
|
-- * Usage
|
|
-- $usage
|
|
|
|
send
|
|
, tryMessage
|
|
, tryMessage_
|
|
, tryInOrder
|
|
, tryInOrder_
|
|
, sm
|
|
, sendSM
|
|
, sendSM_
|
|
) where
|
|
|
|
import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
|
|
import XMonad.StackSet ( current, workspace, layout, tag )
|
|
import XMonad.Operations ( updateLayout )
|
|
|
|
import Control.Monad.State ( gets )
|
|
import Data.Maybe ( isJust )
|
|
import Control.Applicative ((<$>))
|
|
|
|
-- $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.
|
|
--
|
|
-- 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
|
|
--
|
|
-- > -- 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))
|
|
--
|
|
-- 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:
|
|
--
|
|
-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))
|
|
--
|
|
|
|
|
|
-- | 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
|
|
|
|
-- | 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
|
|
|
|
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
|
|
tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
|
|
|
|
-- | 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
|
|
|
|
tryInOrder_ :: [SomeMessage] -> X ()
|
|
tryInOrder_ ms = tryInOrder ms >> return ()
|
|
|
|
|
|
-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
|
|
sm :: Message a => a -> SomeMessage
|
|
sm = SomeMessage
|
|
|
|
|
|
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_ :: SomeMessage -> X ()
|
|
sendSM_ m = sendSM m >> return () |