[XMonad] Use taffybar pager hints from xmonad-contrib
This commit is contained in:
parent
5f113c0476
commit
ef41b4ec04
@ -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
|
@ -31,5 +31,4 @@ executable imalison-xmonad
|
||||
, xmonad-contrib
|
||||
, xmonad
|
||||
hs-source-dirs: .
|
||||
other-modules: PagerHints
|
||||
default-language: Haskell2010
|
||||
|
@ -1 +1 @@
|
||||
Subproject commit 63bb0e76e667f25e693e8f772187ec462e7598bd
|
||||
Subproject commit 2bc6ff9f77dbcd63c8434e7dca8b519a2783e060
|
@ -1 +1 @@
|
||||
Subproject commit 23dd08c984b5337c6d2f520d1822a82ea2032348
|
||||
Subproject commit 5371021eed4c46d0cd0a5f9f52969eea539b712b
|
@ -30,7 +30,7 @@ import Data.Typeable
|
||||
import Foreign.C.Types
|
||||
import Graphics.X11.ExtraTypes.XF86
|
||||
import Network.HostName
|
||||
import PagerHints
|
||||
import XMonad.Util.TaffybarPagerHints
|
||||
import Safe
|
||||
import System.Directory
|
||||
import System.Environment.XDG.DesktopEntry
|
||||
|
Loading…
Reference in New Issue
Block a user