From afc2d1ed565910b372f65eaf77ea90878ac3ab2b Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Sat, 5 Feb 2022 02:49:22 +0000
Subject: swaybar-protocol: support for clickable Action

---
 src/Xmobar/Text/Loop.hs          |  2 +-
 src/Xmobar/Text/Output.hs        |  4 +--
 src/Xmobar/Text/Swaybar.hs       | 11 ++++++--
 src/Xmobar/Text/SwaybarClicks.hs | 60 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 71 insertions(+), 6 deletions(-)
 create mode 100644 src/Xmobar/Text/SwaybarClicks.hs

(limited to 'src/Xmobar/Text')

diff --git a/src/Xmobar/Text/Loop.hs b/src/Xmobar/Text/Loop.hs
index 89295fd..05379cd 100644
--- a/src/Xmobar/Text/Loop.hs
+++ b/src/Xmobar/Text/Loop.hs
@@ -17,7 +17,7 @@
 module Xmobar.Text.Loop (textLoop) where
 
 import Prelude hiding (lookup)
-import System.IO
+import System.IO (hSetBuffering, stdin, stdout, BufferMode(LineBuffering))
 
 import Control.Concurrent.STM
 
diff --git a/src/Xmobar/Text/Output.hs b/src/Xmobar/Text/Output.hs
index 6aa1d56..134dfed 100644
--- a/src/Xmobar/Text/Output.hs
+++ b/src/Xmobar/Text/Output.hs
@@ -24,11 +24,11 @@ import Xmobar.Run.Parsers ( Segment
 
 import Xmobar.Text.Ansi (withAnsiColor)
 import Xmobar.Text.Pango (withPangoColor)
-import Xmobar.Text.Swaybar (formatSwaybar, preamble)
+import Xmobar.Text.Swaybar (formatSwaybar, prepare)
 
 initLoop :: Config -> IO ()
 initLoop conf = case textOutputFormat conf of
-  Swaybar -> putStrLn preamble
+  Swaybar -> prepare
   _ -> return ()
 
 withColor :: TextOutputFormat -> (String, String) -> String -> String
diff --git a/src/Xmobar/Text/Swaybar.hs b/src/Xmobar/Text/Swaybar.hs
index 0a7b8af..69739ed 100644
--- a/src/Xmobar/Text/Swaybar.hs
+++ b/src/Xmobar/Text/Swaybar.hs
@@ -16,9 +16,10 @@
 --
 ------------------------------------------------------------------------------
 
-module Xmobar.Text.Swaybar (preamble, formatSwaybar) where
+module Xmobar.Text.Swaybar (prepare, formatSwaybar) where
 
 import Data.Aeson
+
 import Data.ByteString.Lazy.UTF8 (toString)
 
 import GHC.Generics
@@ -28,8 +29,9 @@ import Xmobar.Config.Types (Config)
 import Xmobar.Run.Parsers ( Segment
                           , Widget(..)
                           , tColorsString
-                          , colorComponents
-                          )
+                          , colorComponents)
+
+import Xmobar.Text.SwaybarClicks (startHandler)
 
 data Preamble =
   Preamble {version :: !Int, click_events :: Bool} deriving (Eq,Show,Generic)
@@ -71,3 +73,6 @@ formatSwaybar' _ _ = defaultBlock
 formatSwaybar :: Config -> [Segment] -> String
 formatSwaybar conf segs = asString elems ++ ","
   where elems = filter (not . null . full_text) (map (formatSwaybar' conf) segs)
+
+prepare :: IO ()
+prepare = startHandler >> putStrLn preamble
diff --git a/src/Xmobar/Text/SwaybarClicks.hs b/src/Xmobar/Text/SwaybarClicks.hs
new file mode 100644
index 0000000..c829e65
--- /dev/null
+++ b/src/Xmobar/Text/SwaybarClicks.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+------------------------------------------------------------------------------
+-- |
+-- Module: Xmobar.Text.SwaybarClicks
+-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
+-- License: BSD3-style (see LICENSE)
+--
+-- Maintainer: jao@gnu.org
+-- Stability: unstable
+-- Portability: portable
+-- Created: Fri Feb 4, 2022 03:58
+--
+--
+-- Handling of "click" events sent by swaybar via stdin
+--
+------------------------------------------------------------------------------
+
+
+module Xmobar.Text.SwaybarClicks (startHandler) where
+
+import Control.Monad (when)
+
+
+import Data.Aeson
+
+-- import qualified Data.ByteString.Lazy as BL
+
+import GHC.Generics
+
+import Xmobar.System.Utils (forkThread)
+import Xmobar.Run.Actions (Action (..), runAction')
+
+import Data.ByteString.Lazy.UTF8 (fromString)
+
+data Click =
+  Click { name :: String , button :: Int } deriving (Eq,Show,Generic)
+
+instance FromJSON Click
+
+runClickAction :: Int -> Action -> IO ()
+runClickAction b a@(Spawn bs _) =
+  when (fromIntegral b `elem` bs) (runAction' a)
+
+handleClick :: Maybe Click -> IO ()
+handleClick Nothing = return ()
+handleClick (Just click) = do
+  let mas = read (name click) :: Maybe [Action]
+      b = button click
+  maybe (return ()) (mapM_ (runClickAction b)) mas
+
+toClick :: String -> Maybe Click
+toClick (',':s) = toClick s
+toClick s = decode (fromString s)
+
+readClicks :: IO ()
+readClicks = getLine >>= handleClick . toClick >> readClicks
+
+startHandler :: IO ()
+startHandler = forkThread "Swaybar event handler" readClicks
-- 
cgit v1.2.3