[XMonad] Use taffybar pager hints from xmonad-contrib

This commit is contained in:
Ivan Malison 2021-07-31 20:51:03 -06:00
parent 5f113c0476
commit ef41b4ec04
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8
5 changed files with 3 additions and 85 deletions

View File

@ -1,81 +0,0 @@
module PagerHints where
import Codec.Binary.UTF8.String (encode)
import Control.Monad
import Data.Monoid
import Foreign.C.Types (CInt)
import XMonad
import qualified XMonad.StackSet as W
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@ file:
--
-- > import System.Taffybar.Hooks.PagerHints (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
}
where x +++ y = x `mappend` y
-- | Update the current values of both custom hints.
pagerHintsLogHook :: X ()
pagerHintsLogHook = do
withWindowSet
(setCurrentLayout . description . W.layout . W.workspace . W.current)
withWindowSet
(setVisibleWorkspaces . map (W.tag . W.workspace) . W.visible)
-- | Set the value of the \"Current Layout\" custom hint to the one given.
setCurrentLayout :: String -> X ()
setCurrentLayout 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.
setVisibleWorkspaces :: [String] -> X ()
setVisibleWorkspaces 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 evData = case evData of
[] -> return ()
x:_ -> if x < 0
then sendMessage FirstLayout
else sendMessage NextLayout

View File

@ -31,5 +31,4 @@ executable imalison-xmonad
, xmonad-contrib , xmonad-contrib
, xmonad , xmonad
hs-source-dirs: . hs-source-dirs: .
other-modules: PagerHints
default-language: Haskell2010 default-language: Haskell2010

@ -1 +1 @@
Subproject commit 63bb0e76e667f25e693e8f772187ec462e7598bd Subproject commit 2bc6ff9f77dbcd63c8434e7dca8b519a2783e060

@ -1 +1 @@
Subproject commit 23dd08c984b5337c6d2f520d1822a82ea2032348 Subproject commit 5371021eed4c46d0cd0a5f9f52969eea539b712b

View File

@ -30,7 +30,7 @@ import Data.Typeable
import Foreign.C.Types import Foreign.C.Types
import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.ExtraTypes.XF86
import Network.HostName import Network.HostName
import PagerHints import XMonad.Util.TaffybarPagerHints
import Safe import Safe
import System.Directory import System.Directory
import System.Environment.XDG.DesktopEntry import System.Environment.XDG.DesktopEntry