From 0691071716e6cfa6040044be0ca782771fe6104c Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 25 Nov 2018 03:40:55 +0000 Subject: Refactoring: Xmobar.System --- src/lib/Xmobar.hs | 2 +- src/lib/Xmobar/Commands.hs | 2 +- src/lib/Xmobar/IPC/DBus.hs | 73 --------------- src/lib/Xmobar/Localize.hsc | 89 ------------------ src/lib/Xmobar/Plugins/BufferedPipeReader.hs | 2 +- src/lib/Xmobar/Plugins/DateZone.hs | 3 +- src/lib/Xmobar/Plugins/Monitors/Disk.hs | 4 +- src/lib/Xmobar/Signal.hs | 132 -------------------------- src/lib/Xmobar/StatFS.hsc | 83 ----------------- src/lib/Xmobar/System/DBus.hs | 73 +++++++++++++++ src/lib/Xmobar/System/Localize.hsc | 89 ++++++++++++++++++ src/lib/Xmobar/System/Signal.hs | 134 +++++++++++++++++++++++++++ src/lib/Xmobar/System/StatFS.hsc | 83 +++++++++++++++++ src/lib/Xmobar/X11/EventLoop.hs | 8 +- xmobar.cabal | 10 +- 15 files changed, 395 insertions(+), 392 deletions(-) delete mode 100644 src/lib/Xmobar/IPC/DBus.hs delete mode 100644 src/lib/Xmobar/Localize.hsc delete mode 100644 src/lib/Xmobar/Signal.hs delete mode 100644 src/lib/Xmobar/StatFS.hsc create mode 100644 src/lib/Xmobar/System/DBus.hs create mode 100644 src/lib/Xmobar/System/Localize.hsc create mode 100644 src/lib/Xmobar/System/Signal.hs create mode 100644 src/lib/Xmobar/System/StatFS.hsc diff --git a/src/lib/Xmobar.hs b/src/lib/Xmobar.hs index 2b160a1..3ab779d 100644 --- a/src/lib/Xmobar.hs +++ b/src/lib/Xmobar.hs @@ -27,7 +27,7 @@ import Control.Exception (bracket) import Xmobar.Config import Xmobar.Runnable import Xmobar.Parsers -import Xmobar.Signal (setupSignalHandler, withDeferSignals) +import Xmobar.System.Signal (setupSignalHandler, withDeferSignals) import Xmobar.X11.Types import Xmobar.X11.EventLoop (startLoop, startCommand) import Xmobar.X11.XUtil diff --git a/src/lib/Xmobar/Commands.hs b/src/lib/Xmobar/Commands.hs index 9c92de0..93a9590 100644 --- a/src/lib/Xmobar/Commands.hs +++ b/src/lib/Xmobar/Commands.hs @@ -31,7 +31,7 @@ import System.Process import System.Exit import System.IO (hClose) -import Xmobar.Signal +import Xmobar.System.Signal import Xmobar.Utils (hGetLineSafe) class Show e => Exec e where diff --git a/src/lib/Xmobar/IPC/DBus.hs b/src/lib/Xmobar/IPC/DBus.hs deleted file mode 100644 index 894637b..0000000 --- a/src/lib/Xmobar/IPC/DBus.hs +++ /dev/null @@ -1,73 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : DBus --- Copyright : (c) Jochen Keil --- License : BSD-style (see LICENSE) --- --- Maintainer : Jochen Keil --- Stability : unstable --- Portability : unportable --- --- DBus IPC module for Xmobar --- ------------------------------------------------------------------------------ - -module Xmobar.IPC.DBus (runIPC) where - -import DBus -import DBus.Client hiding (interfaceName) -import qualified DBus.Client as DC -import Data.Maybe (isNothing) -import Control.Concurrent.STM -import Control.Exception (handle) -import System.IO (stderr, hPutStrLn) -import Control.Monad.IO.Class (liftIO) - -import Xmobar.Signal - -busName :: BusName -busName = busName_ "org.Xmobar.Control" - -objectPath :: ObjectPath -objectPath = objectPath_ "/org/Xmobar/Control" - -interfaceName :: InterfaceName -interfaceName = interfaceName_ "org.Xmobar.Control" - -runIPC :: TMVar SignalType -> IO () -runIPC mvst = handle printException exportConnection - where - printException :: ClientError -> IO () - printException = hPutStrLn stderr . clientErrorMessage - exportConnection = do - client <- connectSession - requestName client busName [ nameDoNotQueue ] - export client objectPath defaultInterface - { DC.interfaceName = interfaceName - , DC.interfaceMethods = [ sendSignalMethod mvst ] - } - -sendSignalMethod :: TMVar SignalType -> Method -sendSignalMethod mvst = makeMethod sendSignalName - (signature_ [variantType $ toVariant (undefined :: SignalType)]) - (signature_ []) - sendSignalMethodCall - where - sendSignalName :: MemberName - sendSignalName = memberName_ "SendSignal" - - sendSignalMethodCall :: MethodCall -> DBusR Reply - sendSignalMethodCall mc = liftIO $ - if methodCallMember mc == sendSignalName - then do - let signals :: [Maybe SignalType] - signals = map fromVariant (methodCallBody mc) - mapM_ sendSignal signals - if any isNothing signals - then return ( ReplyError errorInvalidParameters [] ) - else return ( ReplyReturn [] ) - else - return ( ReplyError errorUnknownMethod [] ) - - sendSignal :: Maybe SignalType -> IO () - sendSignal = maybe (return ()) (atomically . putTMVar mvst) diff --git a/src/lib/Xmobar/Localize.hsc b/src/lib/Xmobar/Localize.hsc deleted file mode 100644 index 984aa2b..0000000 --- a/src/lib/Xmobar/Localize.hsc +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} ------------------------------------------------------------------------------ --- | --- Module : Localize --- Copyright : (C) 2011 Martin Perner --- License : BSD-style (see LICENSE) --- --- Maintainer : Martin Perner --- Stability : unstable --- Portability : unportable --- --- This module provides an interface to locale information e.g. for DateL --- ------------------------------------------------------------------------------ - -module Xmobar.Localize - ( setupTimeLocale, - getTimeLocale - ) where - -import Foreign.C -#if ! MIN_VERSION_time(1,5,0) -import qualified System.Locale as L -#else -import qualified Data.Time.Format as L -#endif - -#ifdef UTF8 -import Codec.Binary.UTF8.String -#endif - --- get localized strings -type NlItem = CInt - -#include -foreign import ccall unsafe "langinfo.h nl_langinfo" - nl_langinfo :: NlItem -> IO CString - -#{enum NlItem, - , AM_STR , PM_STR \ - , D_T_FMT , D_FMT , T_FMT , T_FMT_AMPM \ - , ABDAY_1, ABDAY_7 \ - , DAY_1, DAY_7 \ - , ABMON_1, ABMON_12 \ - , MON_1, MON_12\ - } - -getLangInfo :: NlItem -> IO String -getLangInfo item = do - itemStr <- nl_langinfo item -#ifdef UTF8 - str <- peekCString itemStr - return $ if isUTF8Encoded str then decodeString str else str -#else - peekCString itemStr -#endif - -#include -foreign import ccall unsafe "locale.h setlocale" - setlocale :: CInt -> CString -> IO CString - -setupTimeLocale :: String -> IO () -setupTimeLocale l = withCString l (setlocale #const LC_TIME) >> return () - -getTimeLocale :: IO L.TimeLocale -getTimeLocale = do - -- assumes that the defined values are increasing by exactly one. - -- as they are defined consecutive in an enum this is reasonable - days <- mapM getLangInfo [day1 .. day7] - abdays <- mapM getLangInfo [abday1 .. abday7] - - mons <- mapM getLangInfo [mon1 .. mon12] - abmons <- mapM getLangInfo [abmon1 .. abmon12] - - amstr <- getLangInfo amStr - pmstr <- getLangInfo pmStr - dtfmt <- getLangInfo dTFmt - dfmt <- getLangInfo dFmt - tfmt <- getLangInfo tFmt - tfmta <- getLangInfo tFmtAmpm - - let t = L.defaultTimeLocale {L.wDays = zip days abdays - ,L.months = zip mons abmons - ,L.amPm = (amstr, pmstr) - ,L.dateTimeFmt = dtfmt - ,L.dateFmt = dfmt - ,L.timeFmt = tfmt - ,L.time12Fmt = tfmta} - return t diff --git a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs index 4bb80db..ce6a783 100644 --- a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs +++ b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs @@ -22,8 +22,8 @@ import System.IO.Unsafe(unsafePerformIO) import Xmobar.Environment import Xmobar.Plugins -import Xmobar.Signal import Xmobar.Utils(hGetLineSafe) +import Xmobar.System.Signal data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)] deriving (Read, Show) diff --git a/src/lib/Xmobar/Plugins/DateZone.hs b/src/lib/Xmobar/Plugins/DateZone.hs index 753f530..f386202 100644 --- a/src/lib/Xmobar/Plugins/DateZone.hs +++ b/src/lib/Xmobar/Plugins/DateZone.hs @@ -30,12 +30,13 @@ import Control.Concurrent.STM import System.IO.Unsafe -import Xmobar.Localize import Data.Time.Format import Data.Time.LocalTime import Data.Time.LocalTime.TimeZone.Olson import Data.Time.LocalTime.TimeZone.Series +import Xmobar.System.Localize + #if ! MIN_VERSION_time(1,5,0) import System.Locale (TimeLocale) #endif diff --git a/src/lib/Xmobar/Plugins/Monitors/Disk.hs b/src/lib/Xmobar/Plugins/Monitors/Disk.hs index aedad75..3f89629 100644 --- a/src/lib/Xmobar/Plugins/Monitors/Disk.hs +++ b/src/lib/Xmobar/Plugins/Monitors/Disk.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk --- Copyright : (c) 2010, 2011, 2012, 2014 Jose A Ortega Ruiz +-- Copyright : (c) 2010, 2011, 2012, 2014, 2018 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz @@ -15,7 +15,7 @@ module Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where import Xmobar.Plugins.Monitors.Common -import Xmobar.StatFS +import Xmobar.System.StatFS import Data.IORef (IORef, newIORef, readIORef, writeIORef) diff --git a/src/lib/Xmobar/Signal.hs b/src/lib/Xmobar/Signal.hs deleted file mode 100644 index fd68e80..0000000 --- a/src/lib/Xmobar/Signal.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, CPP #-} - ------------------------------------------------------------------------------ --- | --- Module : Signal --- Copyright : (c) Andrea Rosatto --- : (c) Jose A. Ortega Ruiz --- : (c) Jochen Keil --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- Signal handling, including DBUS when available --- ------------------------------------------------------------------------------ - -module Xmobar.Signal where - -import Data.Foldable (for_) -import Data.Typeable (Typeable) -import Control.Concurrent -import Control.Concurrent.STM -import Control.Exception -import System.Posix.Signals -import Graphics.X11.Types (Button) -import Graphics.X11.Xlib.Types (Position) -import System.IO - -#ifdef DBUS -import DBus (IsVariant(..)) -import Control.Monad ((>=>)) -#endif - -import Xmobar.Utils (safeHead) - -data WakeUp = WakeUp deriving (Show,Typeable) -instance Exception WakeUp - -data SignalType = Wakeup - | Reposition - | ChangeScreen - | Hide Int - | Reveal Int - | Toggle Int - | TogglePersistent - | Action Button Position - deriving (Read, Show) - -#ifdef DBUS -instance IsVariant SignalType where - toVariant = toVariant . show - fromVariant = fromVariant >=> parseSignalType -#endif - -parseSignalType :: String -> Maybe SignalType -parseSignalType = fmap fst . safeHead . reads - --- | Signal handling -setupSignalHandler :: IO (TMVar SignalType) -setupSignalHandler = do - tid <- newEmptyTMVarIO - installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing - installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing - return tid - -updatePosHandler :: TMVar SignalType -> IO () -updatePosHandler sig = do - atomically $ putTMVar sig Reposition - return () - -changeScreenHandler :: TMVar SignalType -> IO () -changeScreenHandler sig = do - atomically $ putTMVar sig ChangeScreen - return () - - --- | Ensures that the given IO action runs its cleanup actions ('bracket' etc.), --- even if a signal is caught. --- --- An exception will be thrown on the thread that called this function when a --- signal is caught. -withDeferSignals :: IO a -> IO a -withDeferSignals thing = do - threadId <- myThreadId - caughtSignal <- newEmptyMVar - - let signals = - filter (not . flip inSignalSet reservedSignals) - [ sigQUIT - , sigTERM - --, sigINT -- Handler already installed by GHC - --, sigPIPE -- Handler already installed by GHC - --, sigUSR1 -- Handled by setupSignalHandler - --, sigUSR2 -- Handled by setupSignalHandler - - -- One of the following appears to cause instability, see #360 - --, sigHUP - --, sigILL - --, sigABRT - --, sigFPE - --, sigSEGV - --, sigALRM - --, sigBUS - --, sigPOLL - --, sigPROF - --, sigSYS - --, sigTRAP - --, sigVTALRM - --, sigXCPU - --, sigXFSZ - ] - - for_ signals $ \s -> - - installHandler s - (Catch $ do - tryPutMVar caughtSignal s - hPutStrLn stderr ("xmobar: Caught signal "++show s++"; exiting...") - throwTo threadId ThreadKilled) - Nothing - - thing `finally` do - s0 <- tryReadMVar caughtSignal - case s0 of - Nothing -> pure () - Just s -> do - -- Run the default handler for the signal - -- hPutStrLn stderr ("xmobar: Running default handler for signal "++show s) - installHandler s Default Nothing - raiseSignal s diff --git a/src/lib/Xmobar/StatFS.hsc b/src/lib/Xmobar/StatFS.hsc deleted file mode 100644 index 25de0df..0000000 --- a/src/lib/Xmobar/StatFS.hsc +++ /dev/null @@ -1,83 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : StatFS --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- A binding to C's statvfs(2) --- ------------------------------------------------------------------------------ - -{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} - - -module Xmobar.StatFS ( FileSystemStats(..), getFileSystemStats ) where - -import Foreign -import Foreign.C.Types -import Foreign.C.String -import Data.ByteString (useAsCString) -import Data.ByteString.Char8 (pack) - -#if defined (__FreeBSD__) || defined (__OpenBSD__) || defined (__APPLE__) || defined (__DragonFly__) -#define IS_BSD_SYSTEM -#endif - -#ifdef IS_BSD_SYSTEM -# include -# include -#else -# include -#endif - -data FileSystemStats = FileSystemStats { - fsStatBlockSize :: Integer - -- ^ Optimal transfer block size. - , fsStatBlockCount :: Integer - -- ^ Total data blocks in file system. - , fsStatByteCount :: Integer - -- ^ Total bytes in file system. - , fsStatBytesFree :: Integer - -- ^ Free bytes in file system. - , fsStatBytesAvailable :: Integer - -- ^ Free bytes available to non-superusers. - , fsStatBytesUsed :: Integer - -- ^ Bytes used. - } deriving (Show, Eq) - -data CStatfs - -#ifdef IS_BSD_SYSTEM -foreign import ccall unsafe "sys/mount.h statfs" -#else -foreign import ccall unsafe "sys/vfs.h statvfs" -#endif - c_statfs :: CString -> Ptr CStatfs -> IO CInt - -toI :: CULong -> Integer -toI = toInteger - -getFileSystemStats :: String -> IO (Maybe FileSystemStats) -getFileSystemStats path = - allocaBytes (#size struct statfs) $ \vfs -> - useAsCString (pack path) $ \cpath -> do - res <- c_statfs cpath vfs - if res /= 0 then return Nothing - else do - bsize <- (#peek struct statfs, f_bsize) vfs - bcount <- (#peek struct statfs, f_blocks) vfs - bfree <- (#peek struct statfs, f_bfree) vfs - bavail <- (#peek struct statfs, f_bavail) vfs - let bpb = toI bsize - return $ Just FileSystemStats - { fsStatBlockSize = bpb - , fsStatBlockCount = toI bcount - , fsStatByteCount = toI bcount * bpb - , fsStatBytesFree = toI bfree * bpb - , fsStatBytesAvailable = toI bavail * bpb - , fsStatBytesUsed = toI (bcount - bfree) * bpb - } diff --git a/src/lib/Xmobar/System/DBus.hs b/src/lib/Xmobar/System/DBus.hs new file mode 100644 index 0000000..103a5a9 --- /dev/null +++ b/src/lib/Xmobar/System/DBus.hs @@ -0,0 +1,73 @@ +----------------------------------------------------------------------------- +-- | +-- Module : DBus +-- Copyright : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jochen Keil +-- Stability : unstable +-- Portability : unportable +-- +-- DBus IPC module for Xmobar +-- +----------------------------------------------------------------------------- + +module Xmobar.System.DBus (runIPC) where + +import DBus +import DBus.Client hiding (interfaceName) +import qualified DBus.Client as DC +import Data.Maybe (isNothing) +import Control.Concurrent.STM +import Control.Exception (handle) +import System.IO (stderr, hPutStrLn) +import Control.Monad.IO.Class (liftIO) + +import Xmobar.System.Signal + +busName :: BusName +busName = busName_ "org.Xmobar.Control" + +objectPath :: ObjectPath +objectPath = objectPath_ "/org/Xmobar/Control" + +interfaceName :: InterfaceName +interfaceName = interfaceName_ "org.Xmobar.Control" + +runIPC :: TMVar SignalType -> IO () +runIPC mvst = handle printException exportConnection + where + printException :: ClientError -> IO () + printException = hPutStrLn stderr . clientErrorMessage + exportConnection = do + client <- connectSession + requestName client busName [ nameDoNotQueue ] + export client objectPath defaultInterface + { DC.interfaceName = interfaceName + , DC.interfaceMethods = [ sendSignalMethod mvst ] + } + +sendSignalMethod :: TMVar SignalType -> Method +sendSignalMethod mvst = makeMethod sendSignalName + (signature_ [variantType $ toVariant (undefined :: SignalType)]) + (signature_ []) + sendSignalMethodCall + where + sendSignalName :: MemberName + sendSignalName = memberName_ "SendSignal" + + sendSignalMethodCall :: MethodCall -> DBusR Reply + sendSignalMethodCall mc = liftIO $ + if methodCallMember mc == sendSignalName + then do + let signals :: [Maybe SignalType] + signals = map fromVariant (methodCallBody mc) + mapM_ sendSignal signals + if any isNothing signals + then return ( ReplyError errorInvalidParameters [] ) + else return ( ReplyReturn [] ) + else + return ( ReplyError errorUnknownMethod [] ) + + sendSignal :: Maybe SignalType -> IO () + sendSignal = maybe (return ()) (atomically . putTMVar mvst) diff --git a/src/lib/Xmobar/System/Localize.hsc b/src/lib/Xmobar/System/Localize.hsc new file mode 100644 index 0000000..eec5e3b --- /dev/null +++ b/src/lib/Xmobar/System/Localize.hsc @@ -0,0 +1,89 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +----------------------------------------------------------------------------- +-- | +-- Module : Localize +-- Copyright : (C) 2011, 2018 Martin Perner +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Martin Perner +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides an interface to locale information e.g. for DateL +-- +----------------------------------------------------------------------------- + +module Xmobar.System.Localize + ( setupTimeLocale, + getTimeLocale + ) where + +import Foreign.C +#if ! MIN_VERSION_time(1,5,0) +import qualified System.Locale as L +#else +import qualified Data.Time.Format as L +#endif + +#ifdef UTF8 +import Codec.Binary.UTF8.String +#endif + +-- get localized strings +type NlItem = CInt + +#include +foreign import ccall unsafe "langinfo.h nl_langinfo" + nl_langinfo :: NlItem -> IO CString + +#{enum NlItem, + , AM_STR , PM_STR \ + , D_T_FMT , D_FMT , T_FMT , T_FMT_AMPM \ + , ABDAY_1, ABDAY_7 \ + , DAY_1, DAY_7 \ + , ABMON_1, ABMON_12 \ + , MON_1, MON_12\ + } + +getLangInfo :: NlItem -> IO String +getLangInfo item = do + itemStr <- nl_langinfo item +#ifdef UTF8 + str <- peekCString itemStr + return $ if isUTF8Encoded str then decodeString str else str +#else + peekCString itemStr +#endif + +#include +foreign import ccall unsafe "locale.h setlocale" + setlocale :: CInt -> CString -> IO CString + +setupTimeLocale :: String -> IO () +setupTimeLocale l = withCString l (setlocale #const LC_TIME) >> return () + +getTimeLocale :: IO L.TimeLocale +getTimeLocale = do + -- assumes that the defined values are increasing by exactly one. + -- as they are defined consecutive in an enum this is reasonable + days <- mapM getLangInfo [day1 .. day7] + abdays <- mapM getLangInfo [abday1 .. abday7] + + mons <- mapM getLangInfo [mon1 .. mon12] + abmons <- mapM getLangInfo [abmon1 .. abmon12] + + amstr <- getLangInfo amStr + pmstr <- getLangInfo pmStr + dtfmt <- getLangInfo dTFmt + dfmt <- getLangInfo dFmt + tfmt <- getLangInfo tFmt + tfmta <- getLangInfo tFmtAmpm + + let t = L.defaultTimeLocale {L.wDays = zip days abdays + ,L.months = zip mons abmons + ,L.amPm = (amstr, pmstr) + ,L.dateTimeFmt = dtfmt + ,L.dateFmt = dfmt + ,L.timeFmt = tfmt + ,L.time12Fmt = tfmta} + return t diff --git a/src/lib/Xmobar/System/Signal.hs b/src/lib/Xmobar/System/Signal.hs new file mode 100644 index 0000000..ce39e10 --- /dev/null +++ b/src/lib/Xmobar/System/Signal.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE DeriveDataTypeable, CPP #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Signal +-- Copyright : (c) Andrea Rosatto +-- : (c) Jose A. Ortega Ruiz +-- : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Signal handling, including DBUS when available +-- +----------------------------------------------------------------------------- + +module Xmobar.System.Signal where + +import Data.Foldable (for_) +import Data.Typeable (Typeable) +import Control.Concurrent +import Control.Concurrent.STM +import Control.Exception +import System.Posix.Signals +import Graphics.X11.Types (Button) +import Graphics.X11.Xlib.Types (Position) +import System.IO + +#ifdef DBUS +import DBus (IsVariant(..)) +import Control.Monad ((>=>)) +#endif + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (x:_) = Just x + +data WakeUp = WakeUp deriving (Show,Typeable) +instance Exception WakeUp + +data SignalType = Wakeup + | Reposition + | ChangeScreen + | Hide Int + | Reveal Int + | Toggle Int + | TogglePersistent + | Action Button Position + deriving (Read, Show) + +#ifdef DBUS +instance IsVariant SignalType where + toVariant = toVariant . show + fromVariant = fromVariant >=> parseSignalType +#endif + +parseSignalType :: String -> Maybe SignalType +parseSignalType = fmap fst . safeHead . reads + +-- | Signal handling +setupSignalHandler :: IO (TMVar SignalType) +setupSignalHandler = do + tid <- newEmptyTMVarIO + installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing + installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing + return tid + +updatePosHandler :: TMVar SignalType -> IO () +updatePosHandler sig = do + atomically $ putTMVar sig Reposition + return () + +changeScreenHandler :: TMVar SignalType -> IO () +changeScreenHandler sig = do + atomically $ putTMVar sig ChangeScreen + return () + + +-- | Ensures that the given IO action runs its cleanup actions ('bracket' etc.), +-- even if a signal is caught. +-- +-- An exception will be thrown on the thread that called this function when a +-- signal is caught. +withDeferSignals :: IO a -> IO a +withDeferSignals thing = do + threadId <- myThreadId + caughtSignal <- newEmptyMVar + + let signals = + filter (not . flip inSignalSet reservedSignals) + [ sigQUIT + , sigTERM + --, sigINT -- Handler already installed by GHC + --, sigPIPE -- Handler already installed by GHC + --, sigUSR1 -- Handled by setupSignalHandler + --, sigUSR2 -- Handled by setupSignalHandler + + -- One of the following appears to cause instability, see #360 + --, sigHUP + --, sigILL + --, sigABRT + --, sigFPE + --, sigSEGV + --, sigALRM + --, sigBUS + --, sigPOLL + --, sigPROF + --, sigSYS + --, sigTRAP + --, sigVTALRM + --, sigXCPU + --, sigXFSZ + ] + + for_ signals $ \s -> + + installHandler s + (Catch $ do + tryPutMVar caughtSignal s + hPutStrLn stderr ("xmobar: Caught signal "++show s++"; exiting...") + throwTo threadId ThreadKilled) + Nothing + + thing `finally` do + s0 <- tryReadMVar caughtSignal + case s0 of + Nothing -> pure () + Just s -> do + -- Run the default handler for the signal + -- hPutStrLn stderr ("xmobar: Running default handler for signal "++show s) + installHandler s Default Nothing + raiseSignal s diff --git a/src/lib/Xmobar/System/StatFS.hsc b/src/lib/Xmobar/System/StatFS.hsc new file mode 100644 index 0000000..529b16a --- /dev/null +++ b/src/lib/Xmobar/System/StatFS.hsc @@ -0,0 +1,83 @@ +----------------------------------------------------------------------------- +-- | +-- Module : StatFS +-- Copyright : (c) Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- A binding to C's statvfs(2) +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} + + +module Xmobar.System.StatFS ( FileSystemStats(..), getFileSystemStats ) where + +import Foreign +import Foreign.C.Types +import Foreign.C.String +import Data.ByteString (useAsCString) +import Data.ByteString.Char8 (pack) + +#if defined (__FreeBSD__) || defined (__OpenBSD__) || defined (__APPLE__) || defined (__DragonFly__) +#define IS_BSD_SYSTEM +#endif + +#ifdef IS_BSD_SYSTEM +# include +# include +#else +# include +#endif + +data FileSystemStats = FileSystemStats { + fsStatBlockSize :: Integer + -- ^ Optimal transfer block size. + , fsStatBlockCount :: Integer + -- ^ Total data blocks in file system. + , fsStatByteCount :: Integer + -- ^ Total bytes in file system. + , fsStatBytesFree :: Integer + -- ^ Free bytes in file system. + , fsStatBytesAvailable :: Integer + -- ^ Free bytes available to non-superusers. + , fsStatBytesUsed :: Integer + -- ^ Bytes used. + } deriving (Show, Eq) + +data CStatfs + +#ifdef IS_BSD_SYSTEM +foreign import ccall unsafe "sys/mount.h statfs" +#else +foreign import ccall unsafe "sys/vfs.h statvfs" +#endif + c_statfs :: CString -> Ptr CStatfs -> IO CInt + +toI :: CULong -> Integer +toI = toInteger + +getFileSystemStats :: String -> IO (Maybe FileSystemStats) +getFileSystemStats path = + allocaBytes (#size struct statfs) $ \vfs -> + useAsCString (pack path) $ \cpath -> do + res <- c_statfs cpath vfs + if res /= 0 then return Nothing + else do + bsize <- (#peek struct statfs, f_bsize) vfs + bcount <- (#peek struct statfs, f_blocks) vfs + bfree <- (#peek struct statfs, f_bfree) vfs + bavail <- (#peek struct statfs, f_bavail) vfs + let bpb = toI bsize + return $ Just FileSystemStats + { fsStatBlockSize = bpb + , fsStatBlockCount = toI bcount + , fsStatByteCount = toI bcount * bpb + , fsStatBytesFree = toI bfree * bpb + , fsStatBytesAvailable = toI bavail * bpb + , fsStatBytesUsed = toI (bcount - bfree) * bpb + } diff --git a/src/lib/Xmobar/X11/EventLoop.hs b/src/lib/Xmobar/X11/EventLoop.hs index 1c864c3..231d953 100644 --- a/src/lib/Xmobar/X11/EventLoop.hs +++ b/src/lib/Xmobar/X11/EventLoop.hs @@ -36,25 +36,25 @@ import Data.Bits import Data.Map hiding (foldr, map, filter) import Data.Maybe (fromJust, isJust) -import Xmobar.X11.Bitmap as Bitmap -import Xmobar.X11.Types import Xmobar.Config import Xmobar.Parsers import Xmobar.Commands import Xmobar.Actions import Xmobar.Runnable -import Xmobar.Signal +import Xmobar.System.Signal import Xmobar.X11.Window import Xmobar.X11.XUtil import Xmobar.Utils import Xmobar.X11.Draw +import Xmobar.X11.Bitmap as Bitmap +import Xmobar.X11.Types #ifdef XFT import Graphics.X11.Xft #endif #ifdef DBUS -import Xmobar.IPC.DBus +import Xmobar.System.DBus #endif runX :: XConf -> X () -> IO () diff --git a/xmobar.cabal b/xmobar.cabal index f250dfd..e0cc2e8 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -129,10 +129,11 @@ library Xmobar.Plugins.Monitors.Bright, Xmobar.Plugins.Monitors.CatInt - other-modules: Xmobar.Localize, - Xmobar.Parsers, + other-modules: Xmobar.Parsers, Xmobar.Utils, - Xmobar.StatFS, + Xmobar.System.StatFS, + Xmobar.System.Localize, + Xmobar.System.Signal, Xmobar.X11.Types, Xmobar.X11.XUtil, Xmobar.X11.Bitmap, @@ -140,7 +141,6 @@ library Xmobar.X11.ColorCache, Xmobar.X11.Window, Xmobar.X11.Draw, - Xmobar.Signal, Xmobar.Environment extra-libraries: Xrandr Xrender @@ -224,7 +224,7 @@ library if flag(with_dbus) || flag(all_extensions) build-depends: dbus >= 1 - other-modules: Xmobar.IPC.DBus + other-modules: Xmobar.System.DBus cpp-options: -DDBUS if flag(with_xpm) || flag(all_extensions) -- cgit v1.2.3