summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/App/Main.hs36
-rw-r--r--src/Xmobar/App/TextEventLoop.hs19
-rw-r--r--src/Xmobar/App/X11EventLoop.hs (renamed from src/Xmobar/App/EventLoop.hs)41
3 files changed, 45 insertions, 51 deletions
diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs
index 7bcf3bd..6b20158 100644
--- a/src/Xmobar/App/Main.hs
+++ b/src/Xmobar/App/Main.hs
@@ -17,49 +17,25 @@
module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where
-import qualified Data.Map as Map
+
import Data.List (intercalate)
import System.Posix.Process (executeFile)
import System.Environment (getArgs)
import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension)
import Text.Parsec.Error (ParseError)
-import Data.List.NonEmpty (NonEmpty(..))
-import Control.Monad (unless)
-import Graphics.X11.Xlib
+import Control.Monad (unless)
+import Xmobar.App.Config
import Xmobar.Config.Types
import Xmobar.Config.Parse
-import Xmobar.System.Signal (withDeferSignals)
-
-import Xmobar.X11.Types
-import Xmobar.X11.Text
-import Xmobar.X11.Window
import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
-import Xmobar.App.CommandThreads (loop)
-import Xmobar.App.EventLoop (startLoop)
-import Xmobar.App.TextEventLoop (startTextLoop)
+import Xmobar.App.X11EventLoop (x11Loop)
+import Xmobar.App.TextEventLoop (textLoop)
import Xmobar.App.Compile (recompile, trace)
-import Xmobar.App.Config
-
-xXmobar :: Config -> IO ()
-xXmobar conf = withDeferSignals $ do
- initThreads
- d <- openDisplay ""
- fs <- initFont d (font conf)
- fl <- mapM (initFont d) (additionalFonts conf)
- let ic = Map.empty
- to = textOffset conf
- ts = textOffsets conf ++ replicate (length fl) (-1)
- loop conf $ \sig lock vars -> do
- (r,w) <- createWin d fs conf
- startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig lock vars
-
-textXmobar :: Config -> IO ()
-textXmobar conf = loop conf (startTextLoop conf)
xmobar :: Config -> IO ()
-xmobar cfg = if textOutput cfg then textXmobar cfg else xXmobar cfg
+xmobar cfg = if textOutput cfg then textLoop cfg else x11Loop cfg
configFromArgs :: Config -> IO Config
configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
diff --git a/src/Xmobar/App/TextEventLoop.hs b/src/Xmobar/App/TextEventLoop.hs
index 6135554..4980bf1 100644
--- a/src/Xmobar/App/TextEventLoop.hs
+++ b/src/Xmobar/App/TextEventLoop.hs
@@ -14,7 +14,7 @@
--
------------------------------------------------------------------------------
-module Xmobar.App.TextEventLoop (startTextLoop) where
+module Xmobar.App.TextEventLoop (textLoop) where
import Prelude hiding (lookup)
@@ -26,15 +26,18 @@ import Control.Concurrent.STM
import Xmobar.System.Signal
import Xmobar.Config.Types (Config)
import Xmobar.X11.Parsers (Segment, Widget(..), parseString)
-import Xmobar.App.CommandThreads (initLoop)
+import Xmobar.App.CommandThreads (initLoop, loop)
-- | Starts the main event loop and threads
-startTextLoop :: Config
- -> TMVar SignalType
- -> TMVar ()
- -> [[([Async ()], TVar String)]]
- -> IO ()
-startTextLoop cfg sig pauser vs = do
+textLoop :: Config -> IO ()
+textLoop conf = loop conf (startTextLoop' conf)
+
+startTextLoop' :: Config
+ -> TMVar SignalType
+ -> TMVar ()
+ -> [[([Async ()], TVar String)]]
+ -> IO ()
+startTextLoop' cfg sig pauser vs = do
tv <- initLoop sig pauser vs
eventLoop cfg tv sig
diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/X11EventLoop.hs
index b1bd3ff..7021b21 100644
--- a/src/Xmobar/App/EventLoop.hs
+++ b/src/Xmobar/App/X11EventLoop.hs
@@ -2,7 +2,7 @@
------------------------------------------------------------------------------
-- |
--- Module: Xmobar.App.EventLoop
+-- Module: Xmobar.App.X11EventLoop
-- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
@@ -16,10 +16,10 @@
--
------------------------------------------------------------------------------
-module Xmobar.App.EventLoop (startLoop) where
+module Xmobar.App.X11EventLoop (x11Loop) where
import Prelude hiding (lookup)
-import Graphics.X11.Xlib hiding (textExtents, textWidth)
+import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
import Graphics.X11.Xrandr
@@ -32,11 +32,18 @@ import Control.Concurrent.STM
import Control.Exception (handle, SomeException(..))
import Data.Bits
import Data.Map hiding (foldr, map, filter)
+import qualified Data.Map as Map
+import Data.List.NonEmpty (NonEmpty(..))
+
import Data.Maybe (fromJust, isJust)
import qualified Data.List.NonEmpty as NE
import Xmobar.System.Signal
-import Xmobar.Config.Types (persistent
+import Xmobar.Config.Types ( persistent
+ , font
+ , additionalFonts
+ , textOffset
+ , textOffsets
, position
, iconRoot
, Config
@@ -52,7 +59,7 @@ import Xmobar.X11.Bitmap as Bitmap
import Xmobar.X11.Types
import Xmobar.System.Utils (safeIndex)
-import Xmobar.App.CommandThreads (initLoop)
+import Xmobar.App.CommandThreads (initLoop, loop)
#ifndef THREADED_RUNTIME
import Xmobar.X11.Events(nextEvent')
@@ -66,6 +73,19 @@ runX :: XConf -> X () -> IO ()
runX xc f = runReaderT f xc
-- | Starts the main event loop and threads
+x11Loop :: Config -> IO ()
+x11Loop conf = do
+ initThreads
+ d <- openDisplay ""
+ fs <- initFont d (font conf)
+ fl <- mapM (initFont d) (additionalFonts conf)
+ let ic = Map.empty
+ to = textOffset conf
+ ts = textOffsets conf ++ replicate (length fl) (-1)
+ loop conf $ \sig lock vars -> do
+ (r,w) <- createWin d fs conf
+ startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig lock vars
+
startLoop :: XConf
-> TMVar SignalType
-> TMVar ()
@@ -187,22 +207,17 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do
filter (\(_, from, to) -> x >= from && x <= to) as
eventLoop tv xc as signal
-updateString :: Config
- -> TVar [String]
- -> IO [[(Widget, TextRenderInfo, Int, Maybe [Action])]]
+updateString :: Config -> TVar [String] -> IO [[Segment]]
updateString conf v = do
s <- readTVarIO v
let l:c:r:_ = s ++ repeat ""
liftIO $ mapM (parseString conf) [l, c, r]
-updateActions :: XConf
- -> Rectangle
- -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]]
+updateActions :: XConf -> Rectangle -> [[Segment]]
-> IO [([Action], Position, Position)]
updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do
let (d,fs) = (display &&& fontListS) conf
- strLn :: [(Widget, TextRenderInfo, Int, Maybe [Action])]
- -> IO [(Maybe [Action], Position, Position)]
+ strLn :: [Segment] -> IO [(Maybe [Action], Position, Position)]
strLn = liftIO . mapM getCoords
iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf)
getCoords (Text s,_,i,a) =
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-31 15:19:47 +0000