Use dbus toggle monitor support

This commit is contained in:
Ivan Malison 2017-04-08 02:50:49 -07:00
parent a712ac777e
commit 077c6680ec
No known key found for this signature in database
GPG Key ID: 62530EFBE99DC2F8
3 changed files with 12 additions and 78 deletions

View File

@ -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

View File

@ -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")

View File

@ -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