forked from colonelpanic/dotfiles
[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-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
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user