1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.Main
-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Nov 25, 2018 21:53
--
--
-- Support for creating executable main functions
--
------------------------------------------------------------------------------
module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where
import Control.Concurrent.Async (Async, cancel)
import Control.Concurrent.STM (newEmptyTMVarIO)
import Control.Exception (bracket)
import Control.Monad (unless)
import Data.Foldable (for_)
import qualified Data.Map as Map
import Data.List (intercalate)
import Data.Maybe (isJust)
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 Graphics.X11.Xlib
import Xmobar.Config.Types
import Xmobar.Config.Parse
import Xmobar.System.Signal (setupSignalHandler, withDeferSignals)
import Xmobar.Run.Template
import Xmobar.X11.Types
import Xmobar.X11.Text
import Xmobar.X11.Window
import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
import Xmobar.App.CommandThreads (startCommand, newRefreshLock, refreshLock)
import Xmobar.App.EventLoop (startLoop)
import Xmobar.App.TextEventLoop (startTextLoop)
import Xmobar.App.Compile (recompile, trace)
import Xmobar.App.Config
import Xmobar.App.Timer (withTimer)
xXmobar :: Config -> IO ()
xXmobar conf = withDeferSignals $ do
initThreads
d <- openDisplay ""
fs <- initFont d (font conf)
fl <- mapM (initFont d) (additionalFonts conf)
cls <- mapM (parseTemplate (commands conf) (sepChar conf))
(splitTemplate (alignSep conf) (template conf))
let confSig = unSignalChan (signal conf)
sig <- maybe newEmptyTMVarIO pure confSig
unless (isJust confSig) $ setupSignalHandler sig
refLock <- newRefreshLock
withTimer (refreshLock refLock) $
bracket (mapM (mapM $ startCommand sig) cls)
cleanupThreads
$ \vars -> do
(r,w) <- createWin d fs conf
let ic = Map.empty
to = textOffset conf
ts = textOffsets conf ++ replicate (length fl) (-1)
startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig refLock vars
textXmobar :: Config -> IO ()
textXmobar conf = withDeferSignals $ do
initThreads
cls <- mapM (parseTemplate (commands conf) (sepChar conf))
(splitTemplate (alignSep conf) (template conf))
let confSig = unSignalChan (signal conf)
sig <- maybe newEmptyTMVarIO pure confSig
unless (isJust confSig) $ setupSignalHandler sig
refLock <- newRefreshLock
withTimer (refreshLock refLock) $
bracket (mapM (mapM $ startCommand sig) cls)
cleanupThreads
$ \vars -> do
startTextLoop conf sig refLock vars
xmobar :: Config -> IO ()
xmobar cfg = if textOutput cfg then textXmobar cfg else xXmobar cfg
configFromArgs :: Config -> IO Config
configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
cleanupThreads :: [[([Async ()], a)]] -> IO ()
cleanupThreads vars =
for_ (concat vars) $ \(asyncs, _) ->
for_ asyncs cancel
buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO ()
buildLaunch args verb force p e = do
let exec = takeBaseName p
confDir = takeDirectory p
ext = takeExtension p
if ext `elem` [".hs", ".hsc", ".lhs"]
then xmobarDataDir >>= \dd -> recompile confDir dd exec force verb >>
executeFile (confDir </> exec) False args Nothing
else trace True ("Invalid configuration file: " ++ show e) >>
trace True "\n(No compilation attempted: \
\only .hs, .hsc or .lhs files are compiled)"
xmobar' :: [String] -> Config -> IO ()
xmobar' defs cfg = do
unless (null defs || not (verbose cfg)) $ putStrLn $
"Fields missing from config defaulted: " ++ intercalate "," defs
xmobar cfg
xmobarMain :: IO ()
xmobarMain = do
args <- getArgs
(flags, rest) <- getOpts args
cf <- case rest of
[c] -> return (Just c)
[] -> xmobarConfigFile
_ -> error $ "Too many arguments: " ++ show rest
case cf of
Nothing -> case rest of
(c:_) -> error $ c ++ ": file not found"
_ -> doOpts defaultConfig flags >>= xmobar
Just p -> do r <- readConfig defaultConfig p
case r of
Left e ->
buildLaunch (filter (/= p) args) (verboseFlag flags)
(recompileFlag flags) p e
Right (c, defs) -> doOpts c flags >>= xmobar' defs
|
