ADD module to monitor removable drives and play super mario sounds
This commit is contained in:
parent
2b698f609f
commit
c89bae26c1
|
@ -44,6 +44,7 @@ import XMonad.Internal.Command.Power
|
||||||
import XMonad.Internal.Concurrent.ACPIEvent
|
import XMonad.Internal.Concurrent.ACPIEvent
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
import XMonad.Internal.Concurrent.ClientMessage
|
||||||
import XMonad.Internal.Concurrent.DynamicWorkspaces
|
import XMonad.Internal.Concurrent.DynamicWorkspaces
|
||||||
|
import XMonad.Internal.Concurrent.Removable
|
||||||
import XMonad.Internal.DBus.Control
|
import XMonad.Internal.DBus.Control
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
@ -66,6 +67,7 @@ main = do
|
||||||
cl <- startXMonadService
|
cl <- startXMonadService
|
||||||
(h, p) <- spawnPipe "xmobar"
|
(h, p) <- spawnPipe "xmobar"
|
||||||
_ <- forkIO runPowermon
|
_ <- forkIO runPowermon
|
||||||
|
_ <- forkIO runRemovableMon
|
||||||
_ <- forkIO $ runWorkspaceMon allDWs
|
_ <- forkIO $ runWorkspaceMon allDWs
|
||||||
let ts = ThreadState
|
let ts = ThreadState
|
||||||
{ client = cl
|
{ client = cl
|
||||||
|
|
|
@ -0,0 +1,70 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Module for monitoring removable drive events
|
||||||
|
--
|
||||||
|
-- Currently, its only purpose is to play Super Mario sounds when a drive is
|
||||||
|
-- inserted or removed. Why? Because I can.
|
||||||
|
|
||||||
|
module XMonad.Internal.Concurrent.Removable (runRemovableMon) where
|
||||||
|
|
||||||
|
import Control.Concurrent
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Map.Lazy (Map, member)
|
||||||
|
import Data.Maybe (maybe)
|
||||||
|
|
||||||
|
import DBus
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
|
path :: ObjectPath
|
||||||
|
path = "/org/freedesktop/UDisks2"
|
||||||
|
|
||||||
|
interface :: InterfaceName
|
||||||
|
interface = "org.freedesktop.DBus.ObjectManager"
|
||||||
|
|
||||||
|
memAdded :: MemberName
|
||||||
|
memAdded = "InterfacesAdded"
|
||||||
|
|
||||||
|
memRemoved :: MemberName
|
||||||
|
memRemoved = "InterfacesRemoved"
|
||||||
|
|
||||||
|
driveInsertedSound :: FilePath
|
||||||
|
driveInsertedSound = "smb_powerup.wav"
|
||||||
|
|
||||||
|
driveRemovedSound :: FilePath
|
||||||
|
driveRemovedSound = "smb_pipe.wav"
|
||||||
|
|
||||||
|
ruleUdisks :: MatchRule
|
||||||
|
ruleUdisks = matchAny
|
||||||
|
{ matchPath = Just path
|
||||||
|
, matchInterface = Just interface
|
||||||
|
}
|
||||||
|
|
||||||
|
driveFlag :: String
|
||||||
|
driveFlag = "org.freedesktop.UDisks2.Drive"
|
||||||
|
|
||||||
|
addedHasDrive :: [Variant] -> Bool
|
||||||
|
addedHasDrive [_, a] = maybe False (member driveFlag)
|
||||||
|
(fromVariant a :: Maybe (Map String (Map String Variant)))
|
||||||
|
addedHasDrive _ = False
|
||||||
|
|
||||||
|
removedHasDrive :: [Variant] -> Bool
|
||||||
|
removedHasDrive [_, a] = maybe False (driveFlag `elem`)
|
||||||
|
(fromVariant a :: Maybe [String])
|
||||||
|
removedHasDrive _ = False
|
||||||
|
|
||||||
|
playSoundMaybe :: FilePath -> Bool -> IO ()
|
||||||
|
playSoundMaybe p b = when b $ spawnSound p
|
||||||
|
|
||||||
|
runRemovableMon :: IO ()
|
||||||
|
runRemovableMon = do
|
||||||
|
client <- connectSystem
|
||||||
|
_ <- addMatch' client memAdded driveInsertedSound addedHasDrive
|
||||||
|
_ <- addMatch' client memRemoved driveRemovedSound removedHasDrive
|
||||||
|
forever (threadDelay 5000000)
|
||||||
|
where
|
||||||
|
addMatch' client m p f = addMatch client ruleUdisks { matchMember = Just m }
|
||||||
|
$ playSoundMaybe p . f . signalBody
|
|
@ -13,7 +13,6 @@ import DBus.Client
|
||||||
|
|
||||||
import XMonad.Internal.DBus.IntelBacklight
|
import XMonad.Internal.DBus.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
-- import XMonad.Internal.DBus.Workspaces
|
|
||||||
|
|
||||||
startXMonadService :: IO Client
|
startXMonadService :: IO Client
|
||||||
startXMonadService = do
|
startXMonadService = do
|
||||||
|
@ -27,7 +26,6 @@ startXMonadService = do
|
||||||
putStrLn "Started xmonad dbus client"
|
putStrLn "Started xmonad dbus client"
|
||||||
exportIntelBacklight client
|
exportIntelBacklight client
|
||||||
exportScreensaver client
|
exportScreensaver client
|
||||||
-- exportWorkspaces client
|
|
||||||
return client
|
return client
|
||||||
|
|
||||||
stopXMonadService :: Client -> IO ()
|
stopXMonadService :: Client -> IO ()
|
||||||
|
|
|
@ -16,6 +16,7 @@ module XMonad.Internal.Process
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
|
@ -64,10 +65,10 @@ shell' = addGroupSession . shell
|
||||||
proc' :: FilePath -> [String] -> CreateProcess
|
proc' :: FilePath -> [String] -> CreateProcess
|
||||||
proc' cmd args = addGroupSession $ proc cmd args
|
proc' cmd args = addGroupSession $ proc cmd args
|
||||||
|
|
||||||
spawn :: String -> X ()
|
spawn :: MonadIO m => String -> m ()
|
||||||
spawn = io . void . createProcess' . shell'
|
spawn = io . void . createProcess' . shell'
|
||||||
|
|
||||||
spawnAt :: FilePath -> String -> X ()
|
spawnAt :: MonadIO m => FilePath -> String -> m ()
|
||||||
spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
|
spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp }
|
||||||
|
|
||||||
spawnPipe :: String -> IO (Handle, ProcessHandle)
|
spawnPipe :: String -> IO (Handle, ProcessHandle)
|
||||||
|
|
|
@ -10,15 +10,17 @@ module XMonad.Internal.Shell
|
||||||
, (#!>>)
|
, (#!>>)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import System.FilePath.Posix
|
import System.FilePath.Posix
|
||||||
|
|
||||||
import XMonad.Core (X, getXMonadDir)
|
import XMonad.Core (getXMonadDir)
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Opening subshell
|
-- | Opening subshell
|
||||||
|
|
||||||
spawnCmd :: String -> [String] -> X ()
|
spawnCmd :: MonadIO m => String -> [String] -> m ()
|
||||||
spawnCmd cmd args = spawn $ fmtCmd cmd args
|
spawnCmd cmd args = spawn $ fmtCmd cmd args
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -27,7 +29,7 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args
|
||||||
soundDir :: FilePath
|
soundDir :: FilePath
|
||||||
soundDir = "sound"
|
soundDir = "sound"
|
||||||
|
|
||||||
spawnSound :: FilePath -> X ()
|
spawnSound :: MonadIO m => FilePath -> m ()
|
||||||
spawnSound file = do
|
spawnSound file = do
|
||||||
path <- (</> soundDir </> file) <$> getXMonadDir
|
path <- (</> soundDir </> file) <$> getXMonadDir
|
||||||
-- paplay seems to have less latency than aplay
|
-- paplay seems to have less latency than aplay
|
||||||
|
|
|
@ -8,6 +8,7 @@ library
|
||||||
exposed-modules: XMonad.Internal.Concurrent.ClientMessage
|
exposed-modules: XMonad.Internal.Concurrent.ClientMessage
|
||||||
, XMonad.Internal.Concurrent.ACPIEvent
|
, XMonad.Internal.Concurrent.ACPIEvent
|
||||||
, XMonad.Internal.Concurrent.DynamicWorkspaces
|
, XMonad.Internal.Concurrent.DynamicWorkspaces
|
||||||
|
, XMonad.Internal.Concurrent.Removable
|
||||||
, XMonad.Internal.Theme
|
, XMonad.Internal.Theme
|
||||||
, XMonad.Internal.Notify
|
, XMonad.Internal.Notify
|
||||||
, XMonad.Internal.Shell
|
, XMonad.Internal.Shell
|
||||||
|
@ -18,7 +19,6 @@ library
|
||||||
, XMonad.Internal.DBus.IntelBacklight
|
, XMonad.Internal.DBus.IntelBacklight
|
||||||
, XMonad.Internal.DBus.Control
|
, XMonad.Internal.DBus.Control
|
||||||
, XMonad.Internal.DBus.Screensaver
|
, XMonad.Internal.DBus.Screensaver
|
||||||
, XMonad.Internal.DBus.Workspaces
|
|
||||||
, XMonad.Internal.Process
|
, XMonad.Internal.Process
|
||||||
, Xmobar.Plugins.Bluetooth
|
, Xmobar.Plugins.Bluetooth
|
||||||
, Xmobar.Plugins.Device
|
, Xmobar.Plugins.Device
|
||||||
|
|
Binary file not shown.
Binary file not shown.
Loading…
Reference in New Issue