taffybar 5.0.0 → 5.1.0

raw patch · 6 files changed

+696/−3 lines, 6 filesdep ~dbus-menudep ~gtk-sni-trayPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: dbus-menu, gtk-sni-tray

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• src/System/Taffybar/Information/ScreenLock.hs +38/−0
• src/System/Taffybar/Information/Wlsunset.hs +217/−0
• src/System/Taffybar/Widget/ScreenLock.hs +181/−0
• src/System/Taffybar/Widget/Wlsunset.hs +241/−0
• taffybar.cabal +7/−3

@@ -1,5 +1,17 @@ # Unreleased +# 5.1.0++## New Widgets++ * **ScreenLock** — Screen lock indicator and toggle via DBus.+ * **Wlsunset** — Wlsunset (blue light filter) status and toggle.++## Dependency Bumps++ * Bump `dbus-menu` lower bound to 0.1.1.0.+ * Bump `gtk-sni-tray` lower bound to 0.1.13.0.+ # 5.0.0  ## Wayland Support

@@ -0,0 +1,38 @@+-----------------------------------------------------------------------------+-- |+-- Module      : System.Taffybar.Information.ScreenLock+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- This module provides screen lock functionality as a thin wrapper around+-- "System.Taffybar.Information.Inhibitor". It re-exports the inhibitor+-- management functions and adds a 'lockScreen' action that spawns hyprlock.+-----------------------------------------------------------------------------+module System.Taffybar.Information.ScreenLock+  ( -- * Re-exports from Inhibitor+    getInhibitorChan+  , getInhibitorState+  , toggleInhibitor+    -- * Screen Lock+  , lockScreen+  ) where++import Control.Monad (void)+import Control.Monad.IO.Class+import System.Process (spawnCommand)++import System.Taffybar.Information.Inhibitor+  ( getInhibitorChan+  , getInhibitorState+  , toggleInhibitor+  )++-- | Lock the screen by spawning hyprlock. Output is redirected to+-- @\/dev\/null@ to avoid flooding taffybar's log with hyprlock's+-- verbose Wayland messages.+lockScreen :: MonadIO m => m ()+lockScreen = liftIO $ void $ spawnCommand "hyprlock >/dev/null 2>&1"

@@ -0,0 +1,217 @@+-----------------------------------------------------------------------------+-- |+-- Module      : System.Taffybar.Information.Wlsunset+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- This module provides process-level management of @wlsunset@, a+-- Wayland day\/night gamma adjustor. It polls for the running state of+-- the process and tracks mode cycling (auto → forced-warm → forced-cool+-- → auto) via @SIGUSR1@.+-----------------------------------------------------------------------------+module System.Taffybar.Information.Wlsunset+  ( -- * Types+    WlsunsetMode(..)+  , WlsunsetState(..)+  , WlsunsetConfig(..)+    -- * State access+  , getWlsunsetChan+  , getWlsunsetState+    -- * Actions+  , cycleWlsunsetMode+  , startWlsunset+  , stopWlsunset+  , toggleWlsunset+  ) where++import           Control.Concurrent (threadDelay)+import           Control.Concurrent.MVar+import           Control.Concurrent.STM.TChan+import           Control.Exception.Enclosed (catchAny)+import           Control.Monad (void, when)+import           Control.Monad.IO.Class+import           Control.Monad.STM (atomically)+import           Control.Monad.Trans.Class+import           Data.Default (Default(..))+import           System.Log.Logger+import           System.Posix.Signals (signalProcess, sigUSR1)+import           System.Posix.Types (CPid(..))+import           System.Process (readProcess, spawnCommand)+import           System.Taffybar.Context+import           System.Taffybar.Util (logPrintF)+import           Text.Read (readMaybe)++-- | The three operating modes that wlsunset cycles through when it+-- receives @SIGUSR1@.+data WlsunsetMode+  = WlsunsetAuto        -- ^ Normal day/night schedule+  | WlsunsetForcedWarm  -- ^ Forced warm (night) temperature+  | WlsunsetForcedCool  -- ^ Forced cool (day) temperature+  deriving (Eq, Show, Ord, Enum, Bounded)++-- | Observable state of the wlsunset process.+data WlsunsetState = WlsunsetState+  { wlsunsetRunning :: Bool+  , wlsunsetMode    :: WlsunsetMode+  } deriving (Eq, Show)++-- | Configuration for the wlsunset monitor.+data WlsunsetConfig = WlsunsetConfig+  { -- | Full shell command used to start wlsunset (e.g.+    -- @\"wlsunset -l 38.9 -L -77.0\"@).+    wlsunsetCommand        :: String+    -- | How often (in seconds) to poll for process status.+  , wlsunsetPollIntervalSec :: Int+  } deriving (Eq, Show)++instance Default WlsunsetConfig where+  def = WlsunsetConfig+    { wlsunsetCommand         = "wlsunset"+    , wlsunsetPollIntervalSec = 2+    }++-- | Internal state bundle stored in 'contextState' via 'getStateDefault'.+newtype WlsunsetChanVar =+  WlsunsetChanVar (TChan WlsunsetState, MVar WlsunsetState, WlsunsetConfig)++wlsunsetLogPath :: String+wlsunsetLogPath = "System.Taffybar.Information.Wlsunset"++wlsunsetLog :: MonadIO m => Priority -> String -> m ()+wlsunsetLog priority = liftIO . logM wlsunsetLogPath priority++wlsunsetLogF :: (MonadIO m, Show t) => Priority -> String -> t -> m ()+wlsunsetLogF = logPrintF wlsunsetLogPath++-- ---------------------------------------------------------------------------+-- Process helpers+-- ---------------------------------------------------------------------------++-- | Check whether wlsunset is running by calling @pgrep -x wlsunset@.+-- Returns a list of matching PIDs (empty when not running).+pgrepWlsunset :: IO [CPid]+pgrepWlsunset =+  (parsePids <$> readProcess "pgrep" ["-x", "wlsunset"] "")+    `catchAny` (\_ -> return [])+  where+    parsePids = map (CPid . fromIntegral) . concatMap toList . lines+    toList s = case (readMaybe s :: Maybe Int) of+      Just n  -> [n]+      Nothing -> []++-- | Send @SIGUSR1@ to a wlsunset process to cycle its mode.+sendUSR1 :: CPid -> IO ()+sendUSR1 = signalProcess sigUSR1++-- ---------------------------------------------------------------------------+-- State management+-- ---------------------------------------------------------------------------++getWlsunsetChanVar :: WlsunsetConfig -> TaffyIO WlsunsetChanVar+getWlsunsetChanVar cfg =+  getStateDefault $ WlsunsetChanVar <$> monitorWlsunset cfg++-- | Get a broadcast channel that receives 'WlsunsetState' updates.+getWlsunsetChan :: WlsunsetConfig -> TaffyIO (TChan WlsunsetState)+getWlsunsetChan cfg = do+  WlsunsetChanVar (chan, _, _) <- getWlsunsetChanVar cfg+  return chan++-- | Get the current 'WlsunsetState'.+getWlsunsetState :: WlsunsetConfig -> TaffyIO WlsunsetState+getWlsunsetState cfg = do+  WlsunsetChanVar (_, var, _) <- getWlsunsetChanVar cfg+  lift $ readMVar var++-- | Start the polling loop that monitors wlsunset.+monitorWlsunset+  :: WlsunsetConfig+  -> TaffyIO (TChan WlsunsetState, MVar WlsunsetState, WlsunsetConfig)+monitorWlsunset cfg = do+  let initialState = WlsunsetState { wlsunsetRunning = False+                                   , wlsunsetMode    = WlsunsetAuto+                                   }+  stateVar <- liftIO $ newMVar initialState+  chan     <- liftIO newBroadcastTChanIO+  taffyFork $ do+    wlsunsetLog DEBUG "Starting wlsunset polling loop"+    let loop = do+          liftIO $ pollWlsunset chan stateVar+          liftIO $ threadDelay (wlsunsetPollIntervalSec cfg * 1000000)+          loop+    loop+  return (chan, stateVar, cfg)++-- | A single poll iteration: check process status, update state, and+-- broadcast if changed.+pollWlsunset :: TChan WlsunsetState -> MVar WlsunsetState -> IO ()+pollWlsunset chan var = do+  pids <- pgrepWlsunset+  let isRunning = not (null pids)+  modifyMVar_ var $ \old -> do+    let wasRunning = wlsunsetRunning old+        -- When the process freshly appears, reset mode to Auto.+        newMode+          | not wasRunning && isRunning = WlsunsetAuto+          | not isRunning              = WlsunsetAuto+          | otherwise                  = wlsunsetMode old+        new = WlsunsetState { wlsunsetRunning = isRunning+                             , wlsunsetMode    = newMode+                             }+    when (new /= old) $ do+      wlsunsetLogF DEBUG "Wlsunset state changed: %s" new+      atomically $ writeTChan chan new+    return new++-- ---------------------------------------------------------------------------+-- Actions+-- ---------------------------------------------------------------------------++-- | Cycle wlsunset mode by sending @SIGUSR1@ to the process.+-- The mode cycles: Auto → ForcedWarm → ForcedCool → Auto.+cycleWlsunsetMode :: WlsunsetConfig -> TaffyIO ()+cycleWlsunsetMode cfg = do+  WlsunsetChanVar (chan, var, _) <- getWlsunsetChanVar cfg+  liftIO $ do+    pids <- pgrepWlsunset+    case pids of+      [] -> wlsunsetLog DEBUG "cycleWlsunsetMode: wlsunset not running"+      _  -> do+        mapM_ sendUSR1 pids+        modifyMVar_ var $ \old -> do+          let newMode = case wlsunsetMode old of+                WlsunsetAuto       -> WlsunsetForcedWarm+                WlsunsetForcedWarm -> WlsunsetForcedCool+                WlsunsetForcedCool -> WlsunsetAuto+              new = old { wlsunsetMode = newMode }+          wlsunsetLogF DEBUG "Cycled wlsunset mode: %s" newMode+          atomically $ writeTChan chan new+          return new++-- | Start the wlsunset process using the configured command.+startWlsunset :: WlsunsetConfig -> TaffyIO ()+startWlsunset cfg = liftIO $ do+  wlsunsetLog DEBUG $ "Starting wlsunset: " ++ wlsunsetCommand cfg+  void $ spawnCommand (wlsunsetCommand cfg)++-- | Stop wlsunset by sending @SIGTERM@ (signal 15) to all instances.+stopWlsunset :: WlsunsetConfig -> TaffyIO ()+stopWlsunset _cfg = liftIO $ do+  pids <- pgrepWlsunset+  case pids of+    [] -> wlsunsetLog DEBUG "stopWlsunset: wlsunset not running"+    _  -> do+      wlsunsetLog DEBUG "Stopping wlsunset (SIGTERM)"+      mapM_ (signalProcess 15) pids++-- | Toggle wlsunset: stop it if running, start it if not.+toggleWlsunset :: WlsunsetConfig -> TaffyIO ()+toggleWlsunset cfg = do+  st <- getWlsunsetState cfg+  if wlsunsetRunning st+    then stopWlsunset cfg+    else startWlsunset cfg

@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : System.Taffybar.Widget.ScreenLock+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- This module provides a screen-lock widget that displays a lock icon and+-- provides quick access to locking the screen and toggling idle inhibition.+--+-- The widget responds to mouse clicks:+--+--   * __Left-click__: Opens a popup menu with "Lock Screen" and an "Idle+--     Inhibitor" toggle.+--   * __Right-click__: Instantly locks the screen by spawning hyprlock.+--+-- The widget applies CSS class @screen-lock-inhibited@ when the idle+-- inhibitor is active, allowing visual differentiation via stylesheets.+--+-- Example usage:+--+-- > import System.Taffybar.Widget.ScreenLock+-- >+-- > -- Simple usage with defaults+-- > let lockWidget = screenLockNew+-- >+-- > -- Custom icon and inhibit types+-- > let custom = screenLockNewWithConfig defaultScreenLockConfig+-- >       { screenLockIcon = "\xF023"+-- >       , screenLockInhibitTypes = [InhibitIdle, InhibitSleep]+-- >       }+-----------------------------------------------------------------------------+module System.Taffybar.Widget.ScreenLock+  ( screenLockNew+  , screenLockNewWithConfig+  , ScreenLockConfig(..)+  , defaultScreenLockConfig+  ) where++import           Control.Monad+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Reader+import           Data.Default (Default(..))+import qualified Data.Text as T+import qualified GI.Gdk as Gdk+import qualified GI.GLib as GLib+import qualified GI.Gtk as Gtk+import           System.Log.Logger+import           System.Taffybar.Context+import           System.Taffybar.Information.Inhibitor (InhibitType(..), InhibitorState(..))+import           System.Taffybar.Information.ScreenLock+import           System.Taffybar.Util (postGUIASync)+import           System.Taffybar.Widget.Generic.ChannelWidget+import           System.Taffybar.Widget.Util (widgetSetClassGI, addClassIfMissing, removeClassIfPresent)++-- | Configuration for the screen lock widget.+data ScreenLockConfig = ScreenLockConfig+  { -- | Icon text to display (default: U+F023, nf-fa-lock).+    screenLockIcon :: T.Text+    -- | What types of inhibitors to manage (default: @[InhibitIdle]@).+  , screenLockInhibitTypes :: [InhibitType]+  } deriving (Eq, Show)++-- | Default configuration for the screen lock widget.+defaultScreenLockConfig :: ScreenLockConfig+defaultScreenLockConfig = ScreenLockConfig+  { screenLockIcon = T.pack "\xF023"+  , screenLockInhibitTypes = [InhibitIdle]+  }++instance Default ScreenLockConfig where+  def = defaultScreenLockConfig++screenLockLogPath :: String+screenLockLogPath = "System.Taffybar.Widget.ScreenLock"++screenLockLog :: MonadIO m => Priority -> String -> m ()+screenLockLog priority = liftIO . logM screenLockLogPath priority++-- | Create a screen lock widget with default configuration.+screenLockNew :: TaffyIO Gtk.Widget+screenLockNew = screenLockNewWithConfig defaultScreenLockConfig++-- | Create a screen lock widget with custom configuration.+--+-- The widget displays a lock icon inside an event box. Left-clicking opens+-- a popup menu with a "Lock Screen" action and an "Idle Inhibitor" toggle.+-- Right-clicking immediately locks the screen.+--+-- CSS class @screen-lock@ is always applied to the event box. When the idle+-- inhibitor is active, @screen-lock-inhibited@ is added.+screenLockNewWithConfig :: ScreenLockConfig -> TaffyIO Gtk.Widget+screenLockNewWithConfig config = do+  let types = screenLockInhibitTypes config+  chan <- getInhibitorChan types+  ctx <- ask++  liftIO $ do+    label <- Gtk.labelNew Nothing+    Gtk.labelSetText label (screenLockIcon config)++    ebox <- Gtk.eventBoxNew+    Gtk.containerAdd ebox label+    _ <- widgetSetClassGI ebox "screen-lock"++    let updateWidget state = postGUIASync $ do+          let active = inhibitorActive state+          if active+            then addClassIfMissing "screen-lock-inhibited" ebox+            else removeClassIfPresent "screen-lock-inhibited" ebox+          let tooltipText =+                if active+                then "Screen Lock (idle inhibitor active)"+                else "Screen Lock"+          Gtk.widgetSetTooltipText ebox (Just tooltipText)++    -- Set initial state on realize+    void $ Gtk.onWidgetRealize ebox $ do+      initialState <- runReaderT (getInhibitorState types) ctx+      updateWidget initialState++    -- Click handler+    void $ Gtk.onWidgetButtonPressEvent ebox $ \event -> do+      eventType <- Gdk.getEventButtonType event+      button <- Gdk.getEventButtonButton event+      if eventType /= Gdk.EventTypeButtonPress+        then return False+        else case button of+          1 -> do+            showScreenLockMenu ctx config ebox+            return True+          3 -> do+            screenLockLog DEBUG "Right-click: locking screen"+            lockScreen+            return True+          _ -> return False++    Gtk.widgetShowAll ebox+    Gtk.toWidget =<< channelWidgetNew ebox chan updateWidget++-- | Build and show the popup menu for the screen lock widget.+showScreenLockMenu :: Context -> ScreenLockConfig -> Gtk.EventBox -> IO ()+showScreenLockMenu ctx config ebox = do+  let types = screenLockInhibitTypes config+  currentEvent <- Gtk.getCurrentEvent++  menu <- Gtk.menuNew+  Gtk.menuAttachToWidget menu ebox Nothing++  -- "Lock Screen" item+  lockItem <- Gtk.menuItemNewWithLabel ("Lock Screen" :: T.Text)+  void $ Gtk.onMenuItemActivate lockItem $ do+    screenLockLog DEBUG "Menu: locking screen"+    lockScreen+  Gtk.menuShellAppend menu lockItem++  -- Separator+  sep <- Gtk.separatorMenuItemNew+  Gtk.menuShellAppend menu sep++  -- "Idle Inhibitor" check menu item+  inhibitItem <- Gtk.checkMenuItemNewWithLabel ("Idle Inhibitor" :: T.Text)+  currentState <- runReaderT (getInhibitorState types) ctx+  Gtk.checkMenuItemSetActive inhibitItem (inhibitorActive currentState)+  void $ Gtk.onCheckMenuItemToggled inhibitItem $ do+    screenLockLog DEBUG "Menu: toggling idle inhibitor"+    runReaderT (toggleInhibitor types) ctx+  Gtk.menuShellAppend menu inhibitItem++  -- Destroy menu when hidden (same pattern as SNIMenu)+  void $ Gtk.onWidgetHide menu $+    void $ GLib.idleAdd GLib.PRIORITY_LOW $ do+      Gtk.widgetDestroy menu+      return False++  Gtk.widgetShowAll menu+  Gtk.menuPopupAtPointer menu currentEvent

@@ -0,0 +1,241 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module      : System.Taffybar.Widget.Wlsunset+-- Copyright   : (c) Ivan A. Malison+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Ivan A. Malison+-- Stability   : unstable+-- Portability : unportable+--+-- This module provides a clickable widget for controlling @wlsunset@, a+-- Wayland day\/night gamma adjustor.+--+-- The widget displays a sun icon whose CSS class reflects the current+-- wlsunset state:+--+--   * @wlsunset-warm@ -- forced warm (night) temperature+--   * @wlsunset-cool@ -- forced cool (day) temperature+--   * @wlsunset-off@  -- process stopped+--   * (no extra class) -- automatic\/running normally+--+-- Left-clicking opens a popup menu for mode selection and start\/stop.+-- Right-clicking quick-toggles the process on\/off.+-----------------------------------------------------------------------------+module System.Taffybar.Widget.Wlsunset+  ( wlsunsetNew+  , wlsunsetNewWithConfig+  , WlsunsetWidgetConfig(..)+  , defaultWlsunsetWidgetConfig+  ) where++import           Control.Monad (void, forM_, replicateM_)+import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.Trans.Reader (ask, runReaderT)+import           Data.Default (Default(..))+import qualified Data.Text as T+import qualified GI.Gdk as Gdk+import qualified GI.GLib as GLib+import qualified GI.Gtk as Gtk+import           System.Taffybar.Context (Context, TaffyIO)+import           System.Taffybar.Information.Wlsunset+import           System.Taffybar.Util (postGUIASync)+import           System.Taffybar.Widget.Generic.ChannelWidget (channelWidgetNew)++-- | Widget-level configuration for the wlsunset widget. Wraps the+-- underlying 'WlsunsetConfig' from the Information layer.+data WlsunsetWidgetConfig = WlsunsetWidgetConfig+  { -- | The underlying information-layer config.+    wlsunsetWidgetInfoConfig :: WlsunsetConfig+    -- | Text icon to display (default: sun icon U+F0599, nf-md-white_balance_sunny).+  , wlsunsetWidgetIcon       :: T.Text+  } deriving (Eq, Show)++-- | Default widget configuration.+defaultWlsunsetWidgetConfig :: WlsunsetWidgetConfig+defaultWlsunsetWidgetConfig = WlsunsetWidgetConfig+  { wlsunsetWidgetInfoConfig = def+  , wlsunsetWidgetIcon       = T.pack "\xF0599"+  }++instance Default WlsunsetWidgetConfig where+  def = defaultWlsunsetWidgetConfig++-- | All CSS classes that the widget may toggle based on state.+allStateClasses :: [T.Text]+allStateClasses = ["wlsunset-warm", "wlsunset-cool", "wlsunset-off"]++-- | Create a wlsunset widget with the default configuration.+wlsunsetNew :: TaffyIO Gtk.Widget+wlsunsetNew = wlsunsetNewWithConfig defaultWlsunsetWidgetConfig++-- | Create a wlsunset widget with a custom configuration.+--+-- The widget is a clickable event box containing a nerd-font sun icon.+-- CSS classes are updated reactively via a broadcast channel from the+-- Information layer. Left-click opens a popup menu; right-click toggles+-- the process.+wlsunsetNewWithConfig :: WlsunsetWidgetConfig -> TaffyIO Gtk.Widget+wlsunsetNewWithConfig widgetCfg = do+  let infoCfg = wlsunsetWidgetInfoConfig widgetCfg+  chan <- getWlsunsetChan infoCfg+  ctx <- ask++  liftIO $ do+    label <- Gtk.labelNew (Just (wlsunsetWidgetIcon widgetCfg))++    ebox <- Gtk.eventBoxNew+    Gtk.containerAdd ebox label++    styleCtx <- Gtk.widgetGetStyleContext ebox+    Gtk.styleContextAddClass styleCtx "wlsunset"++    let updateWidget st = postGUIASync $ do+          updateStateClasses ebox st+          updateTooltip ebox st++    void $ Gtk.onWidgetRealize ebox $ do+      initialState <- runReaderT (getWlsunsetState infoCfg) ctx+      updateWidget initialState++    setupClickHandler ctx ebox infoCfg+    Gtk.widgetShowAll ebox+    Gtk.toWidget =<< channelWidgetNew ebox chan updateWidget++-- ---------------------------------------------------------------------------+-- CSS class management+-- ---------------------------------------------------------------------------++-- | Update CSS classes on a widget based on the current wlsunset state.+updateStateClasses :: Gtk.IsWidget w => w -> WlsunsetState -> IO ()+updateStateClasses widget st = do+  styleCtx <- Gtk.widgetGetStyleContext widget+  -- Remove all state classes first+  mapM_ (Gtk.styleContextRemoveClass styleCtx) allStateClasses+  -- Add the appropriate class+  case stateToClass st of+    Just cls -> Gtk.styleContextAddClass styleCtx cls+    Nothing  -> return ()++-- | Map a 'WlsunsetState' to its CSS class, or 'Nothing' for auto/running.+stateToClass :: WlsunsetState -> Maybe T.Text+stateToClass st+  | not (wlsunsetRunning st) = Just "wlsunset-off"+  | otherwise = case wlsunsetMode st of+      WlsunsetAuto       -> Nothing+      WlsunsetForcedWarm -> Just "wlsunset-warm"+      WlsunsetForcedCool -> Just "wlsunset-cool"++-- ---------------------------------------------------------------------------+-- Tooltip+-- ---------------------------------------------------------------------------++-- | Update the tooltip text to reflect the current state.+updateTooltip :: Gtk.IsWidget w => w -> WlsunsetState -> IO ()+updateTooltip widget st = do+  let text = case (wlsunsetRunning st, wlsunsetMode st) of+        (False, _)                -> "wlsunset: stopped"+        (True, WlsunsetAuto)       -> "wlsunset: automatic"+        (True, WlsunsetForcedWarm) -> "wlsunset: forced warm"+        (True, WlsunsetForcedCool) -> "wlsunset: forced cool"+  Gtk.widgetSetTooltipText widget (Just text)++-- ---------------------------------------------------------------------------+-- Click handling+-- ---------------------------------------------------------------------------++-- | Set up button-press handlers on the event box.+-- Left-click (button 1) opens a popup menu.+-- Right-click (button 3) quick-toggles the process.+setupClickHandler :: Context -> Gtk.EventBox -> WlsunsetConfig -> IO ()+setupClickHandler ctx ebox infoCfg =+  void $ Gtk.onWidgetButtonPressEvent ebox $ \event -> do+    eventType <- Gdk.getEventButtonType event+    button <- Gdk.getEventButtonButton event+    if eventType /= Gdk.EventTypeButtonPress+      then return False+      else case button of+        1 -> do+          showPopupMenu ctx ebox infoCfg+          return True+        3 -> do+          runReaderT (toggleWlsunset infoCfg) ctx+          return True+        _ -> return False++-- ---------------------------------------------------------------------------+-- Popup menu+-- ---------------------------------------------------------------------------++-- | Build and show a popup menu attached to the event box.+showPopupMenu :: Context -> Gtk.EventBox -> WlsunsetConfig -> IO ()+showPopupMenu ctx ebox infoCfg = do+  currentEvent <- Gtk.getCurrentEvent+  st <- runReaderT (getWlsunsetState infoCfg) ctx++  menu <- Gtk.menuNew+  Gtk.menuAttachToWidget menu ebox Nothing++  -- Mode items (disabled when not running)+  let running = wlsunsetRunning st+      currentMode = wlsunsetMode st+      modes = [ ("Automatic",  WlsunsetAuto)+              , ("Force Warm", WlsunsetForcedWarm)+              , ("Force Cool", WlsunsetForcedCool)+              ]++  forM_ modes $ \(labelText, targetMode) -> do+    let prefix = if running && currentMode == targetMode+                   then "\x2713 " :: T.Text  -- checkmark+                   else "   "+    item <- Gtk.menuItemNewWithLabel (prefix <> labelText)+    Gtk.widgetSetSensitive item running+    void $ Gtk.onMenuItemActivate item $+      runReaderT (cycleToMode infoCfg currentMode targetMode) ctx+    Gtk.menuShellAppend menu item++  -- Separator+  sep <- Gtk.separatorMenuItemNew+  Gtk.menuShellAppend menu sep++  -- Start/Stop item+  let toggleLabel = if running then "Stop wlsunset" :: T.Text+                               else "Start wlsunset"+  toggleItem <- Gtk.menuItemNewWithLabel toggleLabel+  void $ Gtk.onMenuItemActivate toggleItem $+    runReaderT (toggleWlsunset infoCfg) ctx+  Gtk.menuShellAppend menu toggleItem++  -- Cleanup: destroy menu after it hides+  void $ Gtk.onWidgetHide menu $+    void $ GLib.idleAdd GLib.PRIORITY_LOW $ do+      Gtk.widgetDestroy menu+      return False++  Gtk.widgetShowAll menu+  Gtk.menuPopupAtPointer menu currentEvent++-- ---------------------------------------------------------------------------+-- Mode cycling helper+-- ---------------------------------------------------------------------------++-- | Cycle from the current mode to a target mode. The mode ring is:+-- Auto -> ForcedWarm -> ForcedCool -> Auto. We calculate the number of+-- SIGUSR1 signals needed and send them.+cycleToMode :: WlsunsetConfig -> WlsunsetMode -> WlsunsetMode -> TaffyIO ()+cycleToMode infoCfg currentMode targetMode = do+  let cyclesNeeded = cyclesToReach currentMode targetMode+  replicateM_ cyclesNeeded (cycleWlsunsetMode infoCfg)++-- | Calculate how many SIGUSR1 cycles are needed to go from one mode+-- to another in the ring Auto -> ForcedWarm -> ForcedCool -> Auto.+cyclesToReach :: WlsunsetMode -> WlsunsetMode -> Int+cyclesToReach from to+  | from == to = 0+  | otherwise  = (toOrd to - toOrd from) `mod` 3+  where+    toOrd :: WlsunsetMode -> Int+    toOrd WlsunsetAuto       = 0+    toOrd WlsunsetForcedWarm = 1+    toOrd WlsunsetForcedCool = 2

@@ -1,6 +1,6 @@ cabal-version: 3.4 name: taffybar-version: 5.0.0+version: 5.1.0 synopsis: A desktop bar similar to xmobar, but with more GUI license: BSD-3-Clause license-file: LICENSE@@ -66,7 +66,7 @@                , data-default                , dbus >= 1.2.11 && < 2.0.0                , dbus-hslogger >= 0.1.1.0 && < 0.2.0.0-               , dbus-menu >= 0.1.0.0+               , dbus-menu >= 0.1.1.0                , directory                , disk-free-space >= 0.1.0.1                , dyre >= 0.9.0 && < 0.10@@ -85,7 +85,7 @@                , gi-gtk3 >= 3.0.44 && < 4                , gi-gtk-hs >= 0.3.17 && < 0.4                , gi-pango-               , gtk-sni-tray >= 0.1.8.0+               , gtk-sni-tray >= 0.1.13.0                , gtk-strut >= 0.1.2.1                , haskell-gi-base >= 0.24                , hslogger@@ -154,9 +154,11 @@                  , System.Taffybar.Information.NetworkManager                  , System.Taffybar.Information.PowerProfiles                  , System.Taffybar.Information.Privacy+                 , System.Taffybar.Information.ScreenLock                  , System.Taffybar.Information.SafeX11                  , System.Taffybar.Information.Systemd                  , System.Taffybar.Information.StreamInfo+                 , System.Taffybar.Information.Wlsunset                  , System.Taffybar.Information.X11DesktopInfo                  , System.Taffybar.Information.XDG.Protocol                  , System.Taffybar.LogFormatter@@ -199,6 +201,7 @@                  , System.Taffybar.Widget.NetworkManager                  , System.Taffybar.Widget.PowerProfiles                  , System.Taffybar.Widget.Privacy+                 , System.Taffybar.Widget.ScreenLock                  , System.Taffybar.Widget.SNIMenu                  , System.Taffybar.Widget.SNITray                  , System.Taffybar.Widget.SimpleClock@@ -215,6 +218,7 @@                  , System.Taffybar.Widget.Workspaces                  , System.Taffybar.Widget.Workspaces.Shared                  , System.Taffybar.Widget.WirePlumber+                 , System.Taffybar.Widget.Wlsunset                  , System.Taffybar.Widget.WttrIn                  , System.Taffybar.Widget.XDGMenu.Menu                  , System.Taffybar.Widget.XDGMenu.MenuWidget