mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
3bc06447d2
The former was removed in [1], so only the latter is valid code right
now.
[1]: 5140f5b5d06790e055eb7fb0cf3eccc4997aa736
(Remove things deprecated by Data.Default)
104 lines
3.3 KiB
Haskell
104 lines
3.3 KiB
Haskell
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Hooks.TaffybarPagerHints
|
|
-- Description : Export additional X properties for [taffybar](https://github.com/taffybar/taffybar).
|
|
-- Copyright : (c) 2020 Ivan Malison
|
|
-- License : BSD3-style (see LICENSE)
|
|
--
|
|
-- Maintainer : Ivan Malison <ivanmalison@gmail.com>
|
|
-- 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 $ def
|
|
-- > ...
|
|
|
|
-- | 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 ()
|