diff --git a/CHANGES.md b/CHANGES.md index e365037c..c5e2e4a5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -130,6 +130,11 @@ ### New Modules + * `XMonad.Hooks.TaffybarPagerHints` + + Add a module that exports information about XMonads internal state that is + not available through EWMH that is used by the taffybar status bar. + * `XMonad.Hooks.StatusBar.PP` Originally contained inside `XMonad.Hooks.DynamicLog`, this module provides the diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 1bda5e61..47669a5c 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -578,6 +578,11 @@ Here is a list of the modules found in @XMonad.Hooks@: pretty-printing abstraction 'XMonad.Hooks.StatusBar.PP.PP' and a set of functions to interact with it. +* "XMonad.Hooks.TaffybarPagerHints" + This module exports additional X properties that allow + [taffybar](https://github.com/taffybar/taffybar) to understand the state of + XMonad. + * "XMonad.Hooks.ToggleHook": Hook and keybindings for toggling hook behavior. diff --git a/XMonad/Hooks/TaffybarPagerHints.hs b/XMonad/Hooks/TaffybarPagerHints.hs new file mode 100644 index 00000000..f71f5b30 --- /dev/null +++ b/XMonad/Hooks/TaffybarPagerHints.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.TaffybarPagerHints +-- Copyright : (c) 2020 Ivan Malison +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ivan Malison +-- Stability : unstable +-- Portability : unportable +-- +-- This module exports additional X properties that allow +-- [taffybar](https://github.com/taffybar/taffybar) to understand the state of +-- XMonad. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.TaffybarPagerHints ( + -- $usage + pagerHints, + pagerHintsLogHook, + pagerHintsEventHook, + + setCurrentLayoutProp, + setVisibleWorkspacesProp, + ) where + +import Codec.Binary.UTF8.String (encode) +import Foreign.C.Types (CInt) + +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W + +-- $usage +-- +-- You can use this module with the following in your @xmonad.hs@ file: +-- +-- > import XMonad.Hooks.TaffybarPagerHints (pagerHints) +-- > +-- > main = xmonad $ ewmh $ pagerHints $ defaultConfig +-- > ... + +-- | The \"Current Layout\" custom hint. +xLayoutProp :: X Atom +xLayoutProp = getAtom "_XMONAD_CURRENT_LAYOUT" + +-- | The \"Visible Workspaces\" custom hint. +xVisibleProp :: X Atom +xVisibleProp = getAtom "_XMONAD_VISIBLE_WORKSPACES" + +-- | Add support for the \"Current Layout\" and \"Visible Workspaces\" custom +-- hints to the given config. +pagerHints :: XConfig a -> XConfig a +pagerHints c = + c { handleEventHook = handleEventHook c <> pagerHintsEventHook + , logHook = logHook c <> pagerHintsLogHook + } + +-- | Update the current values of both custom hints. +pagerHintsLogHook :: X () +pagerHintsLogHook = do + withWindowSet + (setCurrentLayoutProp . description . W.layout . W.workspace . W.current) + withWindowSet + (setVisibleWorkspacesProp . map (W.tag . W.workspace) . W.visible) + +-- | Set the value of the \"Current Layout\" custom hint to the one given. +setCurrentLayoutProp :: String -> X () +setCurrentLayoutProp l = withDisplay $ \dpy -> do + r <- asks theRoot + a <- xLayoutProp + c <- getAtom "UTF8_STRING" + let l' = map fromIntegral (encode l) + io $ changeProperty8 dpy r a c propModeReplace l' + +-- | Set the value of the \"Visible Workspaces\" hint to the one given. +setVisibleWorkspacesProp :: [String] -> X () +setVisibleWorkspacesProp vis = withDisplay $ \dpy -> do + r <- asks theRoot + a <- xVisibleProp + c <- getAtom "UTF8_STRING" + let vis' = map fromIntegral $ concatMap ((++[0]) . encode) vis + io $ changeProperty8 dpy r a c propModeReplace vis' + +-- | Handle all \"Current Layout\" events received from pager widgets, and +-- set the current layout accordingly. +pagerHintsEventHook :: Event -> X All +pagerHintsEventHook ClientMessageEvent + { ev_message_type = mt + , ev_data = d + } = withWindowSet $ \_ -> do + a <- xLayoutProp + when (mt == a) $ sendLayoutMessage d + return (All True) +pagerHintsEventHook _ = return (All True) + +-- | Request a change in the current layout by sending an internal message +-- to XMonad. +sendLayoutMessage :: [CInt] -> X () +sendLayoutMessage (x:_) | x < 0 = sendMessage FirstLayout + | otherwise = sendMessage NextLayout +sendLayoutMessage [] = return () diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 555e06ba..64dda3dc 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -192,6 +192,7 @@ library XMonad.Hooks.SetWMName XMonad.Hooks.StatusBar XMonad.Hooks.StatusBar.PP + XMonad.Hooks.TaffybarPagerHints XMonad.Hooks.ToggleHook XMonad.Hooks.UrgencyHook XMonad.Hooks.WallpaperSetter