summaryrefslogtreecommitdiffhomepage
path: root/src/lib/Xmobar/System
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-11-25 15:10:29 +0000
committerjao <jao@gnu.org>2018-11-25 15:10:29 +0000
commit77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch)
tree647a4eb67ff1c293a5c530538ee88fc0093b577a /src/lib/Xmobar/System
parente0d6da82de8d0d1cef98896164c6016b84e47068 (diff)
downloadxmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz
xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/lib/Xmobar/System')
-rw-r--r--src/lib/Xmobar/System/DBus.hs73
-rw-r--r--src/lib/Xmobar/System/Environment.hs49
-rw-r--r--src/lib/Xmobar/System/Kbd.hsc321
-rw-r--r--src/lib/Xmobar/System/Localize.hsc89
-rw-r--r--src/lib/Xmobar/System/Signal.hs134
-rw-r--r--src/lib/Xmobar/System/StatFS.hsc83
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
- }