diff options
Diffstat (limited to 'src/lib/Xmobar/System')
| -rw-r--r-- | src/lib/Xmobar/System/DBus.hs | 73 | ||||
| -rw-r--r-- | src/lib/Xmobar/System/Environment.hs | 49 | ||||
| -rw-r--r-- | src/lib/Xmobar/System/Kbd.hsc | 321 | ||||
| -rw-r--r-- | src/lib/Xmobar/System/Localize.hsc | 89 | ||||
| -rw-r--r-- | src/lib/Xmobar/System/Signal.hs | 134 | ||||
| -rw-r--r-- | src/lib/Xmobar/System/StatFS.hsc | 83 | 
6 files changed, 0 insertions, 749 deletions
| diff --git a/src/lib/Xmobar/System/DBus.hs b/src/lib/Xmobar/System/DBus.hs deleted file mode 100644 index 103a5a9..0000000 --- a/src/lib/Xmobar/System/DBus.hs +++ /dev/null @@ -1,73 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module      :  DBus --- Copyright   :  (c) Jochen Keil --- License     :  BSD-style (see LICENSE) --- --- Maintainer  :  Jochen Keil <jochen dot keil at gmail dot com> --- 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/Environment.hs b/src/lib/Xmobar/System/Environment.hs deleted file mode 100644 index 86197db..0000000 --- a/src/lib/Xmobar/System/Environment.hs +++ /dev/null @@ -1,49 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module      :  XMobar.Environment --- Copyright   :  (c) William Song --- License     :  BSD-style (see LICENSE) --- --- Maintainer  :  Will Song <incertia@incertia.net> --- Stability   :  stable --- Portability :  portable --- --- A function to expand environment variables in strings --- ------------------------------------------------------------------------------ -module Xmobar.System.Environment(expandEnv) where - -import Control.Applicative  ((<$>)) -import Data.Maybe (fromMaybe) -import System.Environment   (lookupEnv) - -expandEnv :: String -> IO String -expandEnv "" = return "" -expandEnv (c:s) = case c of -  '$'       -> do -    envVar <- fromMaybe "" <$> lookupEnv e -    remainder <- expandEnv s' -    return $ envVar ++ remainder -    where (e, s') = getVar s -          getVar "" = ("", "") -          getVar ('{':s'') = (takeUntil "}" s'', drop 1 . dropUntil "}" $ s'') -          getVar s'' = (takeUntil filterstr s'', dropUntil filterstr s'') -          filterstr = ",./? \t;:\"'~`!@#$%^&*()<>-+=\\|" -          takeUntil f = takeWhile (not . flip elem f) -          dropUntil f = dropWhile (not . flip elem f) - -  '\\' -> case s == "" of -    True  -> return "\\" -    False -> do -      remainder <- expandEnv $ drop 1 s -      return $ escString s ++ remainder -      where escString s' = let (cc:_) = s' in -              case cc of -                't' -> "\t" -                'n' -> "\n" -                '$' -> "$" -                _   -> [cc] - -  _    -> do -    remainder <- expandEnv s -    return $ c : remainder diff --git a/src/lib/Xmobar/System/Kbd.hsc b/src/lib/Xmobar/System/Kbd.hsc deleted file mode 100644 index b9e1d57..0000000 --- a/src/lib/Xmobar/System/Kbd.hsc +++ /dev/null @@ -1,321 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} ------------------------------------------------------------------------------ --- | --- Module      :  Plugins.Kbd --- Copyright   :  (c) Martin Perner --- License     :  BSD-style (see LICENSE) --- --- Maintainer  :  Martin Perner <martin@perner.cc> --- Stability   :  unstable --- Portability :  unportable --- --- A keyboard layout indicator for Xmobar --- ------------------------------------------------------------------------------ - -module Xmobar.System.Kbd where - -import Foreign -import Foreign.C.Types -import Foreign.C.String - -import Graphics.X11.Xlib - -#include <X11/XKBlib.h> -#include <X11/extensions/XKB.h> -#include <X11/extensions/XKBstr.h> - --- --- Definition for XkbStaceRec and getKbdLayout taken from --- XMonad.Layout.XKBLayout --- -data XkbStateRec = XkbStateRec { -    group :: CUChar, -    locked_group :: CUChar, -    base_group :: CUShort, -    latched_group :: CUShort, -    mods :: CUChar, -    base_mods :: CUChar, -    latched_mods :: CUChar, -    locked_mods :: CUChar, -    compat_state :: CUChar, -    grab_mods :: CUChar, -    compat_grab_mods :: CUChar, -    lookup_mods :: CUChar, -    compat_lookup_mods :: CUChar, -    ptr_buttons :: CUShort -} - -instance Storable XkbStateRec where -    sizeOf _ = (#size XkbStateRec) -    alignment _ = alignment (undefined :: CUShort) -    poke _ _ = undefined -    peek ptr = do -        r_group <- (#peek XkbStateRec, group) ptr -        r_locked_group <- (#peek XkbStateRec, locked_group) ptr -        r_base_group <- (#peek XkbStateRec, base_group) ptr -        r_latched_group <- (#peek XkbStateRec, latched_group) ptr -        r_mods <- (#peek XkbStateRec, mods) ptr -        r_base_mods <- (#peek XkbStateRec, base_mods) ptr -        r_latched_mods <- (#peek XkbStateRec, latched_mods) ptr -        r_locked_mods <- (#peek XkbStateRec, locked_mods) ptr -        r_compat_state <- (#peek XkbStateRec, compat_state) ptr -        r_grab_mods <- (#peek XkbStateRec, grab_mods) ptr -        r_compat_grab_mods <- (#peek XkbStateRec, compat_grab_mods) ptr -        r_lookup_mods <- (#peek XkbStateRec, lookup_mods) ptr -        r_compat_lookup_mods <- (#peek XkbStateRec, compat_lookup_mods) ptr -        r_ptr_buttons <- (#peek XkbStateRec, ptr_buttons) ptr -        return XkbStateRec { -            group = r_group, -            locked_group = r_locked_group, -            base_group = r_base_group, -            latched_group = r_latched_group, -            mods = r_mods, -            base_mods = r_base_mods, -            latched_mods = r_latched_mods, -            locked_mods = r_locked_mods, -            compat_state = r_compat_state, -            grab_mods = r_grab_mods, -            compat_grab_mods = r_compat_grab_mods, -            lookup_mods = r_lookup_mods, -            compat_lookup_mods = r_compat_lookup_mods, -            ptr_buttons = r_ptr_buttons -        } - -foreign import ccall unsafe "X11/XKBlib.h XkbGetState" -    xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt - - -getKbdLayout :: Display -> IO Int -getKbdLayout d = alloca $ \stRecPtr -> do -    xkbGetState d 0x100 stRecPtr -    st <- peek stRecPtr -    return $ fromIntegral (group st) - -data XkbKeyNameRec = XkbKeyNameRec { -    name :: Ptr CChar -- array -} - --- --- the t_ before alias is just because of name collisions --- -data XkbKeyAliasRec = XkbKeyAliasRec { -    real  :: Ptr CChar, -- array -    t_alias :: Ptr CChar  -- array -} - --- --- the t_ before geometry is just because of name collisions --- -data XkbNamesRec = XkbNamesRec { -    keycodes :: Atom, -    t_geometry :: Atom, -    symbols :: Atom, -    types :: Atom, -    compat :: Atom, -    vmods :: Ptr Atom, -    indicators :: Ptr Atom, -- array -    groups :: Ptr Atom, -- array -    keys :: Ptr XkbKeyNameRec, -    key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec, -    radio_groups :: Ptr Atom, -    phys_symbols :: Atom, -    num_keys :: CUChar, -    num_key_aliases :: CUChar, -    num_rg :: CUShort -} - --- --- the t_ before map, indicators and compat are just because of name collisions --- -data XkbDescRec = XkbDescRec { -    t_dpy :: Ptr CChar, -- struct _XDisplay* ; don't care -    flags :: CUShort, -    device_spec :: CUShort, -    min_key_code :: KeyCode, -    max_key_code :: KeyCode, -    ctrls :: Ptr CChar, -- XkbControlsPtr ;  dont' care -    server :: Ptr CChar, -- XkbServerMapPtr ;  dont' care -    t_map :: Ptr CChar, --XkbClientMapPtr ;  dont' care -    t_indicators :: Ptr CChar, -- XkbIndicatorPtr ;  dont' care -    names :: Ptr XkbNamesRec, -- array -    t_compat :: Ptr CChar, -- XkbCompatMap ;  dont' care -    geom :: Ptr CChar -- XkbGeometryPtr ;  dont' care - -} - -instance Storable XkbKeyNameRec where -    sizeOf _ = (#size XkbKeyNameRec) -    alignment _ = alignment (undefined :: CUShort) -    poke _ _ = undefined -    peek ptr = do -        r_name <- (#peek XkbKeyNameRec, name) ptr - -        return XkbKeyNameRec { -            name = r_name -        } - -instance Storable XkbKeyAliasRec where -    sizeOf _ = (#size XkbKeyAliasRec) -    alignment _ = alignment (undefined :: CUShort) -    poke _ _ = undefined -    peek ptr = do -        r_real <- (#peek XkbKeyAliasRec, real) ptr -        r_alias <- (#peek XkbKeyAliasRec, alias) ptr - -        return XkbKeyAliasRec { -            real = r_real, -            t_alias = r_alias -        } - -instance Storable XkbNamesRec where -    sizeOf _ = (#size XkbNamesRec) -    alignment _ = alignment (undefined :: CUShort) -    poke _ _ = undefined -    peek ptr = do -        r_keycodes <- (#peek XkbNamesRec, keycodes) ptr -        r_geometry <- (#peek XkbNamesRec, geometry) ptr -        r_symbols <- (#peek XkbNamesRec, symbols ) ptr -        r_types <- (#peek XkbNamesRec, types ) ptr -        r_compat <- (#peek XkbNamesRec, compat ) ptr -        r_vmods <- (#peek XkbNamesRec,  vmods ) ptr -        r_indicators <- (#peek XkbNamesRec, indicators ) ptr -        r_groups <- (#peek XkbNamesRec, groups ) ptr -        r_keys <- (#peek XkbNamesRec, keys ) ptr -        r_key_aliases <- (#peek XkbNamesRec, key_aliases  ) ptr -        r_radio_groups <- (#peek XkbNamesRec, radio_groups  ) ptr -        r_phys_symbols <- (#peek XkbNamesRec, phys_symbols ) ptr -        r_num_keys <- (#peek XkbNamesRec,num_keys  ) ptr -        r_num_key_aliases <- (#peek XkbNamesRec, num_key_aliases  ) ptr -        r_num_rg <- (#peek XkbNamesRec, num_rg ) ptr - -        return XkbNamesRec { -            keycodes = r_keycodes, -            t_geometry = r_geometry, -            symbols = r_symbols, -            types = r_types, -            compat = r_compat, -            vmods = r_vmods, -            indicators = r_indicators, -            groups = r_groups, -            keys = r_keys, -            key_aliases = r_key_aliases, -            radio_groups = r_radio_groups, -            phys_symbols = r_phys_symbols, -            num_keys = r_num_keys, -            num_key_aliases = r_num_key_aliases, -            num_rg = r_num_rg -       } - -instance Storable XkbDescRec where -    sizeOf _ = (#size XkbDescRec) -    alignment _ = alignment (undefined :: CUShort) -    poke _ _ = undefined -    peek ptr = do -        r_dpy <- (#peek XkbDescRec, dpy) ptr -        r_flags <- (#peek XkbDescRec, flags) ptr -        r_device_spec <- (#peek XkbDescRec, device_spec) ptr -        r_min_key_code <- (#peek XkbDescRec, min_key_code) ptr -        r_max_key_code <- (#peek XkbDescRec, max_key_code) ptr -        r_ctrls <- (#peek XkbDescRec, ctrls) ptr -        r_server <- (#peek XkbDescRec, server) ptr -        r_map <- (#peek XkbDescRec, map) ptr -        r_indicators <- (#peek XkbDescRec, indicators) ptr -        r_names <- (#peek XkbDescRec, names) ptr -        r_compat <- (#peek XkbDescRec, compat) ptr -        r_geom <- (#peek XkbDescRec, geom) ptr - -        return XkbDescRec { -            t_dpy = r_dpy, -            flags = r_flags, -            device_spec = r_device_spec, -            min_key_code = r_min_key_code, -            max_key_code = r_max_key_code, -            ctrls = r_ctrls, -            server = r_server, -            t_map = r_map, -            t_indicators = r_indicators, -            names = r_names, -            t_compat = r_compat, -            geom = r_geom -        } - --- --- C bindings --- - -foreign import ccall unsafe "X11/XKBlib.h XkbAllocKeyboard" -    xkbAllocKeyboard :: IO (Ptr XkbDescRec) - -foreign import ccall unsafe "X11/XKBlib.h XkbGetNames" -    xkbGetNames :: Display -> CUInt -> (Ptr XkbDescRec)  -> IO Status - -foreign import ccall unsafe "X11/XKBlib.h XGetAtomName" -    xGetAtomName :: Display -> Atom -> IO CString - -foreign import ccall unsafe "X11/XKBlib.h XkbFreeNames" -    xkbFreeNames :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO () - -foreign import ccall unsafe "X11/XKBlib.h XkbFreeKeyboard" -    xkbFreeKeyboard :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO () - -foreign import ccall unsafe "X11/XKBlib.h XkbSelectEventDetails" -    xkbSelectEventDetails :: Display -> CUInt -> CUInt -> CULong -> CULong -> IO CUInt - -foreign import ccall unsafe "X11/XKBlib.h XkbSelectEvents" -    xkbSelectEvents :: Display -> CUInt -> CUInt -> CUInt -> IO CUInt - - -xkbUseCoreKbd :: CUInt -xkbUseCoreKbd = #const XkbUseCoreKbd - -xkbStateNotify :: CUInt -xkbStateNotify = #const XkbStateNotify - -xkbIndicatorStateNotify :: CUInt -xkbIndicatorStateNotify = #const XkbIndicatorStateNotify - -xkbMapNotify :: CUInt -xkbMapNotify = #const XkbMapNotify - -xkbMapNotifyMask :: CUInt -xkbMapNotifyMask = #const XkbMapNotifyMask - -xkbNewKeyboardNotifyMask :: CUInt -xkbNewKeyboardNotifyMask  = #const XkbNewKeyboardNotifyMask - -xkbAllStateComponentsMask :: CULong -xkbAllStateComponentsMask = #const XkbAllStateComponentsMask - -xkbGroupStateMask :: CULong -xkbGroupStateMask = #const XkbGroupStateMask - -xkbSymbolsNameMask :: CUInt -xkbSymbolsNameMask = #const XkbSymbolsNameMask - -xkbGroupNamesMask :: CUInt -xkbGroupNamesMask = #const XkbGroupNamesMask - -type KbdOpts = [(String, String)] - -getLayoutStr :: Display -> IO String -getLayoutStr dpy =  do -        kbdDescPtr <- xkbAllocKeyboard -        status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr -        str <- getLayoutStr' status dpy kbdDescPtr -        xkbFreeNames kbdDescPtr xkbGroupNamesMask 1 -        xkbFreeKeyboard kbdDescPtr 0 1 -        return str - -getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String -getLayoutStr' st dpy kbdDescPtr = -        if st == 0 then -- Success -            do -            kbdDesc <- peek kbdDescPtr -            nameArray <- peek (names kbdDesc) -            atom <- xGetAtomName dpy (symbols nameArray) -            str <- peekCString atom -            return str -        else -- Behaviour on error -            do -                return "Error while requesting layout!" diff --git a/src/lib/Xmobar/System/Localize.hsc b/src/lib/Xmobar/System/Localize.hsc deleted file mode 100644 index eec5e3b..0000000 --- a/src/lib/Xmobar/System/Localize.hsc +++ /dev/null @@ -1,89 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} ------------------------------------------------------------------------------ --- | --- Module      :  Localize --- Copyright   :  (C) 2011, 2018 Martin Perner --- License     :  BSD-style (see LICENSE) --- --- Maintainer  :  Martin Perner <martin@perner.cc> --- 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 <langinfo.h> -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 <locale.h> -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 deleted file mode 100644 index ce39e10..0000000 --- a/src/lib/Xmobar/System/Signal.hs +++ /dev/null @@ -1,134 +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 <jao@gnu.org> --- 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 deleted file mode 100644 index 529b16a..0000000 --- a/src/lib/Xmobar/System/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 <jao@gnu.org> --- 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 <sys/param.h> -# include <sys/mount.h> -#else -# include <sys/vfs.h> -#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 -                       } | 
