[XMonad] Add pager hints from taffybar as source file

This avoids adding taffybar and all of dependencies as a dependency for my
xmonad config.
This commit is contained in:
Ivan Malison 2018-05-08 11:42:40 -07:00
parent 0b4c39ed81
commit 3d7049e2b5
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8
3 changed files with 84 additions and 28 deletions

View File

@ -0,0 +1,83 @@
module PagerHints (
-- * Usage
-- $usage
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

@ -6,33 +6,6 @@ packages:
extra-dep: true extra-dep: true
- location: ./xmonad-contrib - location: ./xmonad-contrib
extra-dep: true extra-dep: true
- location: ./taffybar
extra-dep: true
extra-deps: extra-deps:
- X11-xft-0.3.1 - X11-xft-0.3.1
- alsa-mixer-0.2.0.3
- dbus-1.0.1
- dbus-hslogger-0.1.0.1
- gi-dbusmenu-0.4.1
- gi-dbusmenugtk3-0.4.1
- gi-gdk-3.0.15
- gi-gdkpixbuf-2.0.16
- gi-gdkx11-3.0.2
- gi-gio-2.0.18
- gi-gtk-3.0.22
- gi-pango-1.0.16
- gi-xlib-2.0.2
- gio-0.13.5.0
- gtk-sni-tray-0.1.2.0
- gtk-strut-0.1.2.0
- gtk-traymanager-1.0.1
- gtk3-0.14.9
- haskell-gi-0.21.2
- haskell-gi-base-0.21.1
- libxml-sax-0.7.5
- rate-limit-1.1.1
- spool-0.1
- status-notifier-item-0.2.1.0
- time-units-1.0.0
- xml-helpers-1.0.0
resolver: lts-11.7 resolver: lts-11.7

View File

@ -24,7 +24,7 @@ import Network.HostName
import System.Directory import System.Directory
import System.FilePath.Posix import System.FilePath.Posix
import System.Process import System.Process
import System.Taffybar.Hooks.PagerHints import PagerHints
import Text.Printf import Text.Printf
import Unsafe.Coerce import Unsafe.Coerce