diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar/Run/Actions.hs | 13 | ||||
| -rw-r--r-- | src/Xmobar/Text/Loop.hs | 2 | ||||
| -rw-r--r-- | src/Xmobar/Text/Output.hs | 4 | ||||
| -rw-r--r-- | src/Xmobar/Text/Swaybar.hs | 11 | ||||
| -rw-r--r-- | src/Xmobar/Text/SwaybarClicks.hs | 60 | 
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 | 
