diff --git a/dotfiles/config/xmonad/src/PagerHints.hs b/dotfiles/config/xmonad/src/PagerHints.hs new file mode 100644 index 00000000..8126cd72 --- /dev/null +++ b/dotfiles/config/xmonad/src/PagerHints.hs @@ -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 diff --git a/dotfiles/config/xmonad/stack.yaml b/dotfiles/config/xmonad/stack.yaml index 1e804ff3..045170ce 100644 --- a/dotfiles/config/xmonad/stack.yaml +++ b/dotfiles/config/xmonad/stack.yaml @@ -6,33 +6,6 @@ packages: extra-dep: true - location: ./xmonad-contrib extra-dep: true -- location: ./taffybar - extra-dep: true extra-deps: - 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 diff --git a/dotfiles/config/xmonad/xmonad.hs b/dotfiles/config/xmonad/xmonad.hs index 75a17a44..faca85c5 100644 --- a/dotfiles/config/xmonad/xmonad.hs +++ b/dotfiles/config/xmonad/xmonad.hs @@ -24,7 +24,7 @@ import Network.HostName import System.Directory import System.FilePath.Posix import System.Process -import System.Taffybar.Hooks.PagerHints +import PagerHints import Text.Printf import Unsafe.Coerce