forked from colonelpanic/dotfiles
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 System.Taffybar.WorkspaceHUD
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import Text.Read hiding (get)
|
import Text.Read hiding (get)
|
||||||
import ToggleMonitor
|
import System.Taffybar.ToggleMonitor
|
||||||
import XMonad.Core ( whenJust )
|
import XMonad.Core ( whenJust )
|
||||||
|
|
||||||
|
|
||||||
@ -74,6 +74,7 @@ movableWidget builder =
|
|||||||
Gtk.widgetReparent wid hbox
|
Gtk.widgetReparent wid hbox
|
||||||
else
|
else
|
||||||
Gtk.containerAdd hbox wid
|
Gtk.containerAdd hbox wid
|
||||||
|
Gtk.widgetShowAll hbox
|
||||||
return $ Gtk.toWidget hbox
|
return $ Gtk.toWidget hbox
|
||||||
return moveWidget
|
return moveWidget
|
||||||
|
|
||||||
@ -114,12 +115,13 @@ main = do
|
|||||||
mem = pollingGraphNew memCfg 1 memCallback
|
mem = pollingGraphNew memCfg 1 memCallback
|
||||||
cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
|
cpu = pollingGraphNew cpuCfg 0.5 cpuCallback
|
||||||
tray = do
|
tray = do
|
||||||
tray <- systrayNew
|
theTray <- systrayNew
|
||||||
container <- Gtk.eventBoxNew
|
cont <- Gtk.eventBoxNew
|
||||||
Gtk.containerAdd container tray
|
Gtk.containerAdd cont theTray
|
||||||
Gtk.widgetSetName container "Taffytray"
|
Gtk.widgetSetName cont "Taffytray"
|
||||||
Gtk.widgetSetName tray "Taffytray"
|
Gtk.widgetSetName theTray "Taffytray"
|
||||||
return $ Gtk.toWidget container
|
Gtk.widgetShowAll cont
|
||||||
|
return $ Gtk.toWidget cont
|
||||||
hudConfig =
|
hudConfig =
|
||||||
defaultWorkspaceHUDConfig
|
defaultWorkspaceHUDConfig
|
||||||
{ underlineHeight = 3
|
{ underlineHeight = 3
|
||||||
@ -144,8 +146,8 @@ main = do
|
|||||||
pager = taffyPagerNew pagerConfig
|
pager = taffyPagerNew pagerConfig
|
||||||
makeUnderline = underlineWidget hudConfig
|
makeUnderline = underlineWidget hudConfig
|
||||||
pgr <- pagerNew pagerConfig
|
pgr <- pagerNew pagerConfig
|
||||||
enabledVar <- MV.newMVar M.empty
|
|
||||||
tray2 <- movableWidget tray
|
tray2 <- movableWidget tray
|
||||||
|
|
||||||
let hud = buildWorkspaceHUD hudConfig pgr
|
let hud = buildWorkspaceHUD hudConfig pgr
|
||||||
los = makeUnderline (layoutSwitcherNew pgr) "red"
|
los = makeUnderline (layoutSwitcherNew pgr) "red"
|
||||||
wnd = makeUnderline (windowSwitcherNew pgr) "teal"
|
wnd = makeUnderline (windowSwitcherNew pgr) "teal"
|
||||||
@ -164,11 +166,9 @@ main = do
|
|||||||
, barPosition = Top
|
, barPosition = Top
|
||||||
, barHeight = 50
|
, barHeight = 50
|
||||||
, widgetSpacing = 5
|
, widgetSpacing = 5
|
||||||
, startRefresher = handleToggleRequests enabledVar
|
|
||||||
, getMonitorConfig = toggleableMonitors enabledVar
|
|
||||||
}
|
}
|
||||||
|
|
||||||
defaultTaffybar taffyConfig
|
withToggleSupport taffyConfig
|
||||||
|
|
||||||
-- Local Variables:
|
-- Local Variables:
|
||||||
-- flycheck-ghc-args: ("-Wno-missing-signatures")
|
-- flycheck-ghc-args: ("-Wno-missing-signatures")
|
||||||
|
@ -1,3 +1,3 @@
|
|||||||
#!/usr/bin/env sh
|
#!/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