summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/Run/Actions.hs13
-rw-r--r--src/Xmobar/Text/Loop.hs2
-rw-r--r--src/Xmobar/Text/Output.hs4
-rw-r--r--src/Xmobar/Text/Swaybar.hs11
-rw-r--r--src/Xmobar/Text/SwaybarClicks.hs60
5 files changed, 81 insertions, 9 deletions
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