forked from colonelpanic/dotfiles
[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:
parent
0b4c39ed81
commit
3d7049e2b5
83
dotfiles/config/xmonad/src/PagerHints.hs
Normal file
83
dotfiles/config/xmonad/src/PagerHints.hs
Normal 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
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user