ENH check for intel backlight before adding controls

This commit is contained in:
Nathan Dwarshuis 2021-06-20 20:54:23 -04:00
parent d1c398b3c3
commit 5ef9f46a0a
6 changed files with 102 additions and 55 deletions

View File

@ -45,6 +45,7 @@ import XMonad.Internal.Concurrent.ClientMessage
import XMonad.Internal.Concurrent.DynamicWorkspaces import XMonad.Internal.Concurrent.DynamicWorkspaces
import XMonad.Internal.Concurrent.Removable import XMonad.Internal.Concurrent.Removable
import XMonad.Internal.DBus.Control import XMonad.Internal.DBus.Control
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.Process import XMonad.Internal.Process
import XMonad.Internal.Shell import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T import qualified XMonad.Internal.Theme as T
@ -64,7 +65,7 @@ import XMonad.Util.WorkspaceCompare
main :: IO () main :: IO ()
main = do main = do
cl <- startXMonadService (cl, bc) <- startXMonadService
(h, p) <- spawnPipe "xmobar" (h, p) <- spawnPipe "xmobar"
_ <- forkIO runPowermon _ <- forkIO runPowermon
_ <- forkIO runRemovableMon _ <- forkIO runRemovableMon
@ -74,13 +75,10 @@ main = do
, childPIDs = [p] , childPIDs = [p]
, childHandles = [h] , childHandles = [h]
} }
(ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings ts (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc ts
-- TODO this seems really dumb but I can't print outside the launch function; mapM_ warnMissing missing
-- this seems like a buffering problem since I can print something here and -- IDK why this is necessary; nothing prior to this line will print if missing
-- then print from the launch function (eg in the X monad) and both messages hFlush stdout
-- will print. However, trying to flush the print output from here makes
-- xmonad bootloop
let missingErrs = warnMissing <$> missing
launch launch
$ ewmh $ ewmh
$ addKeymap ekbs $ addKeymap ekbs
@ -89,7 +87,7 @@ main = do
, layoutHook = myLayouts , layoutHook = myLayouts
, manageHook = myManageHook , manageHook = myManageHook
, handleEventHook = myEventHook , handleEventHook = myEventHook
, startupHook = myStartupHook missingErrs , startupHook = myStartupHook
, workspaces = myWorkspaces , workspaces = myWorkspaces
, logHook = myLoghook h , logHook = myLoghook h
, clickJustFocuses = False , clickJustFocuses = False
@ -120,9 +118,8 @@ runCleanup ts = io $ do
-- problem) outside the 'launch' function so pass them here to be printed. -- problem) outside the 'launch' function so pass them here to be printed.
-- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED? -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
myStartupHook :: [String] -> X () myStartupHook :: X ()
myStartupHook msgs = setDefaultCursor xC_left_ptr myStartupHook = setDefaultCursor xC_left_ptr
<+> io (mapM_ print msgs)
<+> docksStartupHook <+> docksStartupHook
<+> startupHook def <+> startupHook def
@ -485,8 +482,8 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
Ignore -> (Nothing, []) Ignore -> (Nothing, [])
flagMissing s = "[!!!]" ++ s flagMissing s = "[!!!]" ++ s
externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)] externalBindings :: Maybe BacklightControls -> ThreadState -> [KeyGroup (IO MaybeX)]
externalBindings ts = externalBindings bc ts =
[ KeyGroup "Launchers" [ KeyGroup "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
, KeyBinding "M-g" "launch clipboard manager" runClipMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@ -524,10 +521,10 @@ externalBindings ts =
] ]
, KeyGroup "System" , KeyGroup "System"
[ KeyBinding "M-." "backlight up" $ noCheck runIncBacklight [ KeyBinding "M-." "backlight up" $ runMaybe bc backlightUp
, KeyBinding "M-," "backlight down" $ noCheck runDecBacklight , KeyBinding "M-," "backlight down" $ runMaybe bc backlightDown
, KeyBinding "M-M1-," "backlight min" $ noCheck runMinBacklight , KeyBinding "M-M1-," "backlight min" $ runMaybe bc backlightMin
, KeyBinding "M-M1-." "backlight max" $ noCheck runMaxBacklight , KeyBinding "M-M1-." "backlight max" $ runMaybe bc backlightMax
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt , KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt , KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
, KeyBinding "M-<Delete>" "lock screen" runScreenLock , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@ -543,3 +540,8 @@ externalBindings ts =
, KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
] ]
] ]
where
-- TODO this is hacky, I shouldn't really need this data structure for
-- something that doesn't depend on executables
runMaybe c f = return $ maybe Ignore (\x -> Installed (io $ f x) []) c

View File

@ -17,10 +17,6 @@ module XMonad.Internal.Command.Desktop
, runVolumeUp , runVolumeUp
, runVolumeMute , runVolumeMute
, runToggleBluetooth , runToggleBluetooth
, runIncBacklight
, runDecBacklight
, runMinBacklight
, runMaxBacklight
, runToggleDPMS , runToggleDPMS
, runToggleEthernet , runToggleEthernet
, runRestart , runRestart
@ -33,7 +29,7 @@ module XMonad.Internal.Command.Desktop
, runStartISyncService , runStartISyncService
) where ) where
import Control.Monad (void) import Control.Monad (void)
import System.Directory import System.Directory
( createDirectoryIfMissing ( createDirectoryIfMissing
@ -43,8 +39,7 @@ import System.Environment
import System.FilePath import System.FilePath
import XMonad.Actions.Volume import XMonad.Actions.Volume
import XMonad.Core hiding (spawn) import XMonad.Core hiding (spawn)
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
import XMonad.Internal.Notify import XMonad.Internal.Notify
import XMonad.Internal.Process import XMonad.Internal.Process
@ -151,18 +146,6 @@ runToggleBluetooth = runIfInstalled [exe myBluetooth] $ spawn
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"] #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" } #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
runIncBacklight :: X ()
runIncBacklight = io $ void callIncBrightness
runDecBacklight :: X ()
runDecBacklight = io $ void callDecBrightness
runMinBacklight :: X ()
runMinBacklight = io $ void callMinBrightness
runMaxBacklight :: X ()
runMaxBacklight = io $ void callMaxBrightness
runToggleDPMS :: X () runToggleDPMS :: X ()
runToggleDPMS = io $ void callToggle runToggleDPMS = io $ void callToggle

View File

@ -28,4 +28,6 @@ callMethod mc = do
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
addMatchCallback rule cb = do addMatchCallback rule cb = do
client <- connectSession client <- connectSession
addMatch client rule $ cb . signalBody s <- addMatch client rule $ cb . signalBody
disconnect client
return s

View File

@ -14,19 +14,20 @@ import DBus.Client
import XMonad.Internal.DBus.IntelBacklight import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
startXMonadService :: IO Client startXMonadService :: IO (Client, Maybe BacklightControls)
startXMonadService = do startXMonadService = do
client <- connectSession client <- connectSession
requestResult <- requestName client "org.xmonad" [] requestResult <- requestName client "org.xmonad" []
-- TODO if the client is not released on shutdown the owner will be -- TODO if the client is not released on shutdown the owner will be
-- different -- different
if requestResult /= NamePrimaryOwner then if requestResult /= NamePrimaryOwner then do
putStrLn "Another service owns \"org.xmonad\"" putStrLn "Another service owns \"org.xmonad\""
return (client, Nothing)
else do else do
putStrLn "Started xmonad dbus client" putStrLn "Started xmonad dbus client"
exportIntelBacklight client bc <- exportIntelBacklight client
exportScreensaver client exportScreensaver client
return client return (client, bc)
stopXMonadService :: Client -> IO () stopXMonadService :: Client -> IO ()
stopXMonadService client = do stopXMonadService client = do

View File

@ -11,11 +11,14 @@ module XMonad.Internal.DBus.IntelBacklight
, callMinBrightness , callMinBrightness
, exportIntelBacklight , exportIntelBacklight
, matchSignal , matchSignal
, hasBacklight
, BacklightControls(..)
) where ) where
import Control.Monad (void) import Control.Monad (void)
import Data.Char import Data.Char
import Data.Either
import Data.Int (Int16, Int32) import Data.Int (Int16, Int32)
import Data.Text (pack, unpack) import Data.Text (pack, unpack)
import Data.Text.IO as T (readFile, writeFile) import Data.Text.IO as T (readFile, writeFile)
@ -23,6 +26,10 @@ import Data.Text.IO as T (readFile, writeFile)
import DBus import DBus
import DBus.Client import DBus.Client
import System.Directory
import System.FilePath.Posix
import System.IO.Error
import XMonad.Internal.DBus.Common import XMonad.Internal.DBus.Common
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -52,11 +59,11 @@ steps = 16
backlightDir :: FilePath backlightDir :: FilePath
backlightDir = "/sys/class/backlight/intel_backlight/" backlightDir = "/sys/class/backlight/intel_backlight/"
maxFile :: String maxFile :: FilePath
maxFile = backlightDir ++ "max_brightness" maxFile = backlightDir </> "max_brightness"
curFile :: String curFile :: FilePath
curFile = backlightDir ++ "brightness" curFile = backlightDir </> "brightness"
readFileInt :: FilePath -> IO RawBrightness readFileInt :: FilePath -> IO RawBrightness
readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
@ -91,7 +98,7 @@ getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
changeBrightness :: RawBrightness -> Brightness -> IO Brightness changeBrightness :: RawBrightness -> Brightness -> IO Brightness
changeBrightness maxRaw delta = setBrightness maxRaw changeBrightness maxRaw delta = setBrightness maxRaw
=<< (+ delta) <$> getBrightness maxRaw . (+ delta) =<< getBrightness maxRaw
setBrightness :: RawBrightness -> Brightness -> IO Brightness setBrightness :: RawBrightness -> Brightness -> IO Brightness
setBrightness maxRaw newNorm = do setBrightness maxRaw newNorm = do
@ -99,6 +106,41 @@ setBrightness maxRaw newNorm = do
setRawBrightness $ normToRaw maxRaw newNorm' setRawBrightness $ normToRaw maxRaw newNorm'
return newNorm' return newNorm'
--------------------------------------------------------------------------------
-- | Access checks
-- | determine if backlight is accessible/present
-- Right True -> backlight accessible and present
-- Right False -> backlight not present
-- Left x -> backlight present but could not access (x explaining why)
hasBacklight' :: IO (Either String Bool)
hasBacklight' = do
mx <- doesFileExist maxFile
cx <- doesFileExist curFile
if not $ mx || cx
then return $ Right False
else do
mp <- tryIOError $ readable <$> getPermissions maxFile
cp <- tryIOError $ (\p -> writable p && readable p) <$> getPermissions curFile
return $ case (mp, cp) of
(Right True, Right True) -> Right True
(Right _, Right _) -> Left "Insufficient permissions for backlight files"
_ -> Left "Could not determine backlight file permissions"
msg :: Either String Bool -> IO ()
msg (Right True) = return ()
msg (Right False) = print ("No backlight detected. Controls disabled" :: String)
msg (Left m) = print ("WARNING: " ++ m)
hasBacklightMsg :: IO Bool
hasBacklightMsg = do
b <- hasBacklight'
msg b
return $ fromRight False b
hasBacklight :: IO Bool
hasBacklight = fromRight False <$> hasBacklight'
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | DBus interface -- | DBus interface
-- --
@ -122,8 +164,8 @@ memGetBrightness = "GetBrightness"
memMaxBrightness :: MemberName memMaxBrightness :: MemberName
memMaxBrightness = "MaxBrightness" memMaxBrightness = "MaxBrightness"
memMinnBrightness :: MemberName memMinBrightness :: MemberName
memMinnBrightness = "MinBrightness" memMinBrightness = "MinBrightness"
memIncBrightness :: MemberName memIncBrightness :: MemberName
memIncBrightness = "IncBrightness" memIncBrightness = "IncBrightness"
@ -142,7 +184,6 @@ brMatcher = matchAny
, matchMember = Just memCurrentBrightness , matchMember = Just memCurrentBrightness
} }
callBacklight :: MemberName -> IO () callBacklight :: MemberName -> IO ()
callBacklight method = void $ callMethod $ methodCall path interface method callBacklight method = void $ callMethod $ methodCall path interface method
@ -153,8 +194,20 @@ bodyGetBrightness _ = Nothing
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Exported haskell API -- | Exported haskell API
exportIntelBacklight :: Client -> IO () data BacklightControls = BacklightControls
{ backlightMax :: IO ()
, backlightMin :: IO ()
, backlightUp :: IO ()
, backlightDown :: IO ()
}
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
exportIntelBacklight client = do exportIntelBacklight client = do
b <- hasBacklightMsg
if b then Just <$> exportIntelBacklight' client else return Nothing
exportIntelBacklight' :: Client -> IO BacklightControls
exportIntelBacklight' client = do
maxval <- getMaxRawBrightness -- assume the max value will never change maxval <- getMaxRawBrightness -- assume the max value will never change
let stepsize = maxBrightness `div` steps let stepsize = maxBrightness `div` steps
let emit' = emitBrightness client let emit' = emitBrightness client
@ -162,12 +215,18 @@ exportIntelBacklight client = do
{ interfaceName = interface { interfaceName = interface
, interfaceMethods = , interfaceMethods =
[ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness [ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
, autoMethod memMinnBrightness $ emit' =<< setBrightness maxval 0 , autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
, autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize , autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
, autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize) , autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
, autoMethod memGetBrightness $ getBrightness maxval , autoMethod memGetBrightness $ getBrightness maxval
] ]
} }
return $ BacklightControls
{ backlightMax = callMaxBrightness
, backlightMin = callMinBrightness
, backlightUp = callIncBrightness
, backlightDown = callDecBrightness
}
emitBrightness :: Client -> Brightness -> IO () emitBrightness :: Client -> Brightness -> IO ()
emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] } emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] }
@ -176,7 +235,7 @@ callMaxBrightness :: IO ()
callMaxBrightness = callBacklight memMaxBrightness callMaxBrightness = callBacklight memMaxBrightness
callMinBrightness :: IO () callMinBrightness :: IO ()
callMinBrightness = callBacklight memMinnBrightness callMinBrightness = callBacklight memMinBrightness
callIncBrightness :: IO () callIncBrightness :: IO ()
callIncBrightness = callBacklight memIncBrightness callIncBrightness = callBacklight memIncBrightness

View File

@ -80,9 +80,9 @@ type MaybeX = MaybeExe X
type IOMaybeX = IO MaybeX type IOMaybeX = IO MaybeX
warnMissing :: Dependency -> String warnMissing :: Dependency -> IO ()
warnMissing Dependency {depRequired = r, depName = n, depType = t } = warnMissing Dependency {depRequired = r, depName = n, depType = t } =
"WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
where where
fmtType Executable = "executable" fmtType Executable = "executable"
fmtType (Systemd u) = fmtType (Systemd u) =