summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/App
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/App')
-rw-r--r--src/Xmobar/App/Compile.hs30
-rw-r--r--src/Xmobar/App/Config.hs1
-rw-r--r--src/Xmobar/App/Opts.hs8
3 files changed, 12 insertions, 27 deletions
diff --git a/src/Xmobar/App/Compile.hs b/src/Xmobar/App/Compile.hs
index 80dbac7..5d1f48d 100644
--- a/src/Xmobar/App/Compile.hs
+++ b/src/Xmobar/App/Compile.hs
@@ -20,20 +20,17 @@
module Xmobar.App.Compile(recompile, trace, xmessage) where
import Control.Monad.IO.Class
-import Control.Monad.Fix (fix)
-import Control.Exception.Extensible (try, bracket, SomeException(..))
+import Control.Exception.Extensible (bracket, SomeException(..))
import qualified Control.Exception.Extensible as E
import Control.Monad (filterM, when)
import Data.List ((\\))
-import Data.Maybe (isJust)
import System.FilePath((</>), takeExtension)
import System.IO
import System.Directory
import System.Process
import System.Exit
-import System.Posix.Process(executeFile, forkProcess, getAnyProcessStatus)
+import System.Posix.Process(executeFile, forkProcess)
import System.Posix.Types(ProcessID)
-import System.Posix.Signals
isExecutable :: FilePath -> IO Bool
isExecutable f =
@@ -144,14 +141,12 @@ recompile confDir dataDir execName force verb = liftIO $ do
else shouldRecompile verb src bin lib
if sc
then do
- uninstallSignalHandlers
status <- bracket (openFile err WriteMode) hClose $
\errHandle ->
waitForProcess =<<
if useScript
then runScript script bin confDir errHandle
else runGHC bin confDir errHandle
- installSignalHandlers
if status == ExitSuccess
then trace verb "Xmobar recompilation process exited with success!"
else do
@@ -168,24 +163,9 @@ recompile confDir dataDir execName force verb = liftIO $ do
#ifdef RTSOPTS
++ ["-rtsopts", "-with-rtsopts", "-V0"]
#endif
+#ifdef SHARED_LIBRARIES
+ ++ ["-dynamic"]
+#endif
++ ["-o", bin]
runGHC bin = runProc "ghc" (opts bin)
runScript script bin = runProc script [bin]
-
--- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
--- avoid zombie processes, and clean up any extant zombie processes.
-installSignalHandlers :: MonadIO m => m ()
-installSignalHandlers = liftIO $ do
- installHandler openEndedPipe Ignore Nothing
- installHandler sigCHLD Ignore Nothing
- (try :: IO a -> IO (Either SomeException a))
- $ fix $ \more -> do
- x <- getAnyProcessStatus False False
- when (isJust x) more
- return ()
-
-uninstallSignalHandlers :: MonadIO m => m ()
-uninstallSignalHandlers = liftIO $ do
- installHandler openEndedPipe Default Nothing
- installHandler sigCHLD Default Nothing
- return ()
diff --git a/src/Xmobar/App/Config.hs b/src/Xmobar/App/Config.hs
index a284973..5c2f362 100644
--- a/src/Xmobar/App/Config.hs
+++ b/src/Xmobar/App/Config.hs
@@ -67,6 +67,7 @@ defaultConfig =
, signal = SignalChan Nothing
, textOutput = False
, textOutputFormat = Plain
+ , dpi = 96.0
}
-- | Return the path to the xmobar data directory. This directory is
diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs
index 3a6b4e7..36da745 100644
--- a/src/Xmobar/App/Opts.hs
+++ b/src/Xmobar/App/Opts.hs
@@ -1,7 +1,7 @@
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.Opts
--- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2018, 2019, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
@@ -52,6 +52,7 @@ data Opts = Help
| Position String
| WmClass String
| WmName String
+ | Dpi String
deriving (Show, Eq)
options :: [OptDescr Opts]
@@ -95,6 +96,8 @@ options =
"On which X screen number to start"
, Option "p" ["position"] (ReqArg Position "position")
"Specify position of xmobar. Same syntax as in config file"
+ , Option "D" ["dpi"] (ReqArg Dpi "dpi")
+ "The DPI scaling factor. Default 96.0"
]
getOpts :: [String] -> IO ([Opts], [String])
@@ -113,7 +116,7 @@ usage = usageInfo header options ++ footer
info :: String
info = "xmobar " ++ showVersion version
- ++ "\n (C) 2010 - 2022 Jose A Ortega Ruiz"
+ ++ "\n (C) 2010 - 2024 Jose A Ortega Ruiz"
++ "\n (C) 2007 - 2010 Andrea Rossato\n "
++ mail ++ "\n" ++ license ++ "\n"
@@ -161,6 +164,7 @@ doOpts conf (o:oo) =
Right x -> doOpts' (conf {commands = commands conf ++ x})
Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1)
Position s -> readPosition s
+ Dpi d -> doOpts' (conf {dpi = read d})
where readCom c str =
case readStr str of
[x] -> Right x