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 |