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/Run/Actions.hs        | 13 +++++++--
 src/Xmobar/Text/Loop.hs          |  2 +-
 src/Xmobar/Text/Output.hs        |  4 +--
 src/Xmobar/Text/Swaybar.hs       | 11 ++++++--
 src/Xmobar/Text/SwaybarClicks.hs | 60 ++++++++++++++++++++++++++++++++++++++++
 xmobar.cabal                     |  1 +
 6 files changed, 82 insertions(+), 9 deletions(-)
 create mode 100644 src/Xmobar/Text/SwaybarClicks.hs

diff --git a/src/Xmobar/Run/Actions.hs b/src/Xmobar/Run/Actions.hs
index f7d0e45..2a49312 100644
--- a/src/Xmobar/Run/Actions.hs
+++ b/src/Xmobar/Run/Actions.hs
@@ -10,7 +10,11 @@
 --
 -----------------------------------------------------------------------------
 
-module Xmobar.Run.Actions (Button, Action(..), runAction, stripActions) where
+module Xmobar.Run.Actions ( Button
+                          , Action(..)
+                          , runAction
+                          , runAction'
+                          , stripActions) where
 
 import System.Process (system)
 import Control.Monad (void)
@@ -19,12 +23,15 @@ import Data.Word (Word32)
 
 type Button = Word32
 
-data Action = Spawn [Button] String
-                deriving (Eq, Show)
+data Action = Spawn [Button] String deriving (Eq, Read, Show)
 
 runAction :: Action -> IO ()
 runAction (Spawn _ s) = void $ system (s ++ "&")
 
+-- | Run action with stdout redirected to stderr
+runAction' :: Action -> IO ()
+runAction' (Spawn _ s) = void $ system (s ++ " 1>&2 &")
+
 stripActions :: String -> String
 stripActions s = case matchRegex actionRegex s of
   Nothing -> s
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
diff --git a/xmobar.cabal b/xmobar.cabal
index 69de4e8..f37f931 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -131,6 +131,7 @@ library
                    Xmobar.Text.Loop,
                    Xmobar.Text.Pango,
                    Xmobar.Text.Swaybar,
+                   Xmobar.Text.SwaybarClicks,
                    Xmobar.Text.Output,
                    Xmobar.X11.Events,
                    Xmobar.X11.Loop,
-- 
cgit v1.2.3