Use dbus toggle monitor support
This commit is contained in:
parent
a712ac777e
commit
077c6680ec
@ -1,66 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module ToggleMonitor (
|
||||
handleToggleRequests,
|
||||
toggleableMonitors
|
||||
) where
|
||||
|
||||
import Control.Concurrent
|
||||
import qualified Control.Concurrent.MVar as MV
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.Trans.Maybe
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import qualified Graphics.UI.Gtk as Gtk
|
||||
import Graphics.UI.Gtk.Gdk.Screen
|
||||
import System.Mem.StableName
|
||||
import System.Taffybar
|
||||
import Text.Read hiding (get, lift)
|
||||
import Web.Scotty
|
||||
import XMonad.Core ( whenJust )
|
||||
|
||||
toggleableMonitors :: MV.MVar (M.Map Int Bool)
|
||||
-> TaffybarConfigEQ -> IO (Int -> (Maybe TaffybarConfigEQ))
|
||||
toggleableMonitors enabledVar cfg = do
|
||||
numToEnabled <- MV.readMVar enabledVar
|
||||
let fn monNumber =
|
||||
if fromMaybe True $ M.lookup monNumber numToEnabled
|
||||
then Just cfg
|
||||
else Nothing
|
||||
return fn
|
||||
|
||||
getActiveScreenNumber :: MaybeT IO Int
|
||||
getActiveScreenNumber = do
|
||||
screen <- MaybeT screenGetDefault
|
||||
window <- MaybeT $ screenGetActiveWindow screen
|
||||
lift $ screenGetMonitorAtWindow screen window
|
||||
|
||||
handleToggleRequests :: MV.MVar (M.Map Int Bool) -> IO () -> IO ()
|
||||
handleToggleRequests enabledVar refreshTaffyWindows = do
|
||||
let toggleTaffyOnMon fn mon = do
|
||||
MV.modifyMVar_ enabledVar $ \numToEnabled -> do
|
||||
let current = fromMaybe True $ M.lookup mon numToEnabled
|
||||
return $ M.insert mon (fn current) numToEnabled
|
||||
refreshTaffyWindows
|
||||
toggleTaffy = do
|
||||
num <- liftIO $ runMaybeT getActiveScreenNumber
|
||||
liftIO $ toggleTaffyOnMon not $ fromMaybe 0 num
|
||||
runScotty =
|
||||
scotty 3000 $ do
|
||||
get "/toggle/:monNum" $ do
|
||||
num <- param "monNum"
|
||||
liftIO $
|
||||
whenJust (readMaybe num :: Maybe Int) $ toggleTaffyOnMon not
|
||||
get "/on/:monNum" $ do
|
||||
num <- param "monNum"
|
||||
liftIO $
|
||||
whenJust (readMaybe num :: Maybe Int) $
|
||||
toggleTaffyOnMon $ const True
|
||||
get "/off/:monNum" $ do
|
||||
num <- param "monNum"
|
||||
liftIO $
|
||||
whenJust (readMaybe num :: Maybe Int) $
|
||||
toggleTaffyOnMon $ const False
|
||||
get "/toggleCurrent" $ do
|
||||
liftIO $ Gtk.postGUIAsync toggleTaffy
|
||||
void $ forkIO runScotty
|
@ -28,7 +28,7 @@ import System.Taffybar.WindowSwitcher
|
||||
import System.Taffybar.WorkspaceHUD
|
||||
import Text.Printf
|
||||
import Text.Read hiding (get)
|
||||
import ToggleMonitor
|
||||
import System.Taffybar.ToggleMonitor
|
||||
import XMonad.Core ( whenJust )
|
||||
|
||||
|
||||
@ -74,6 +74,7 @@ movableWidget builder =
|
||||
Gtk.widgetReparent wid hbox
|
||||
else
|
||||
Gtk.containerAdd hbox wid
|
||||
Gtk.widgetShowAll hbox
|
||||
return $ Gtk.toWidget hbox
|
||||
return moveWidget
|
||||
|
||||
@ -114,12 +115,13 @@ main = do
|
||||
mem = pollingGraphNew memCfg 1 memCallback
|
||||
cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
|
||||
tray = do
|
||||
tray <- systrayNew
|
||||
container <- Gtk.eventBoxNew
|
||||
Gtk.containerAdd container tray
|
||||
Gtk.widgetSetName container "Taffytray"
|
||||
Gtk.widgetSetName tray "Taffytray"
|
||||
return $ Gtk.toWidget container
|
||||
theTray <- systrayNew
|
||||
cont <- Gtk.eventBoxNew
|
||||
Gtk.containerAdd cont theTray
|
||||
Gtk.widgetSetName cont "Taffytray"
|
||||
Gtk.widgetSetName theTray "Taffytray"
|
||||
Gtk.widgetShowAll cont
|
||||
return $ Gtk.toWidget cont
|
||||
hudConfig =
|
||||
defaultWorkspaceHUDConfig
|
||||
{ underlineHeight = 3
|
||||
@ -144,8 +146,8 @@ main = do
|
||||
pager = taffyPagerNew pagerConfig
|
||||
makeUnderline = underlineWidget hudConfig
|
||||
pgr <- pagerNew pagerConfig
|
||||
enabledVar <- MV.newMVar M.empty
|
||||
tray2 <- movableWidget tray
|
||||
|
||||
let hud = buildWorkspaceHUD hudConfig pgr
|
||||
los = makeUnderline (layoutSwitcherNew pgr) "red"
|
||||
wnd = makeUnderline (windowSwitcherNew pgr) "teal"
|
||||
@ -164,11 +166,9 @@ main = do
|
||||
, barPosition = Top
|
||||
, barHeight = 50
|
||||
, widgetSpacing = 5
|
||||
, startRefresher = handleToggleRequests enabledVar
|
||||
, getMonitorConfig = toggleableMonitors enabledVar
|
||||
}
|
||||
|
||||
defaultTaffybar taffyConfig
|
||||
withToggleSupport taffyConfig
|
||||
|
||||
-- Local Variables:
|
||||
-- flycheck-ghc-args: ("-Wno-missing-signatures")
|
||||
|
@ -1,3 +1,3 @@
|
||||
#!/usr/bin/env sh
|
||||
|
||||
curl localhost:3000/toggleCurrent
|
||||
dbus-send --print-reply=literal --dest=taffybar.toggle /taffybar/toggle taffybar.toggle.toggleCurrent
|
||||
|
Loading…
Reference in New Issue
Block a user