From 5ef9f46a0a11bb9e05cc59f633fb6c1de338f909 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 20 Jun 2021 20:54:23 -0400 Subject: [PATCH] ENH check for intel backlight before adding controls --- bin/xmonad.hs | 38 +++++----- lib/XMonad/Internal/Command/Desktop.hs | 21 +----- lib/XMonad/Internal/DBus/Common.hs | 4 +- lib/XMonad/Internal/DBus/Control.hs | 9 +-- lib/XMonad/Internal/DBus/IntelBacklight.hs | 81 +++++++++++++++++++--- lib/XMonad/Internal/Shell.hs | 4 +- 6 files changed, 102 insertions(+), 55 deletions(-) diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 3f1ab3d..a2cf6c9 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -45,6 +45,7 @@ import XMonad.Internal.Concurrent.ClientMessage import XMonad.Internal.Concurrent.DynamicWorkspaces import XMonad.Internal.Concurrent.Removable import XMonad.Internal.DBus.Control +import XMonad.Internal.DBus.IntelBacklight import XMonad.Internal.Process import XMonad.Internal.Shell import qualified XMonad.Internal.Theme as T @@ -64,7 +65,7 @@ import XMonad.Util.WorkspaceCompare main :: IO () main = do - cl <- startXMonadService + (cl, bc) <- startXMonadService (h, p) <- spawnPipe "xmobar" _ <- forkIO runPowermon _ <- forkIO runRemovableMon @@ -74,13 +75,10 @@ main = do , childPIDs = [p] , childHandles = [h] } - (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings ts - -- TODO this seems really dumb but I can't print outside the launch function; - -- this seems like a buffering problem since I can print something here and - -- then print from the launch function (eg in the X monad) and both messages - -- will print. However, trying to flush the print output from here makes - -- xmonad bootloop - let missingErrs = warnMissing <$> missing + (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc ts + mapM_ warnMissing missing + -- IDK why this is necessary; nothing prior to this line will print if missing + hFlush stdout launch $ ewmh $ addKeymap ekbs @@ -89,7 +87,7 @@ main = do , layoutHook = myLayouts , manageHook = myManageHook , handleEventHook = myEventHook - , startupHook = myStartupHook missingErrs + , startupHook = myStartupHook , workspaces = myWorkspaces , logHook = myLoghook h , clickJustFocuses = False @@ -120,9 +118,8 @@ runCleanup ts = io $ do -- problem) outside the 'launch' function so pass them here to be printed. -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED? -myStartupHook :: [String] -> X () -myStartupHook msgs = setDefaultCursor xC_left_ptr - <+> io (mapM_ print msgs) +myStartupHook :: X () +myStartupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook <+> startupHook def @@ -485,8 +482,8 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs' Ignore -> (Nothing, []) flagMissing s = "[!!!]" ++ s -externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)] -externalBindings ts = +externalBindings :: Maybe BacklightControls -> ThreadState -> [KeyGroup (IO MaybeX)] +externalBindings bc ts = [ KeyGroup "Launchers" [ KeyBinding "" "select/launch app" runAppMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu @@ -524,10 +521,10 @@ externalBindings ts = ] , KeyGroup "System" - [ KeyBinding "M-." "backlight up" $ noCheck runIncBacklight - , KeyBinding "M-," "backlight down" $ noCheck runDecBacklight - , KeyBinding "M-M1-," "backlight min" $ noCheck runMinBacklight - , KeyBinding "M-M1-." "backlight max" $ noCheck runMaxBacklight + [ KeyBinding "M-." "backlight up" $ runMaybe bc backlightUp + , KeyBinding "M-," "backlight down" $ runMaybe bc backlightDown + , KeyBinding "M-M1-," "backlight min" $ runMaybe bc backlightMin + , KeyBinding "M-M1-." "backlight max" $ runMaybe bc backlightMax , KeyBinding "M-" "power menu" $ noCheck runPowerPrompt , KeyBinding "M-" "quit xmonad" $ noCheck runQuitPrompt , KeyBinding "M-" "lock screen" runScreenLock @@ -543,3 +540,8 @@ externalBindings ts = , KeyBinding "M-" "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 + diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index deb8faf..93daaea 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -17,10 +17,6 @@ module XMonad.Internal.Command.Desktop , runVolumeUp , runVolumeMute , runToggleBluetooth - , runIncBacklight - , runDecBacklight - , runMinBacklight - , runMaxBacklight , runToggleDPMS , runToggleEthernet , runRestart @@ -33,7 +29,7 @@ module XMonad.Internal.Command.Desktop , runStartISyncService ) where -import Control.Monad (void) +import Control.Monad (void) import System.Directory ( createDirectoryIfMissing @@ -43,8 +39,7 @@ import System.Environment import System.FilePath import XMonad.Actions.Volume -import XMonad.Core hiding (spawn) -import XMonad.Internal.DBus.IntelBacklight +import XMonad.Core hiding (spawn) import XMonad.Internal.DBus.Screensaver import XMonad.Internal.Notify import XMonad.Internal.Process @@ -151,18 +146,6 @@ runToggleBluetooth = runIfInstalled [exe myBluetooth] $ spawn #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"] #!&& 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 = io $ void callToggle diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs index 032c6d2..855e56c 100644 --- a/lib/XMonad/Internal/DBus/Common.hs +++ b/lib/XMonad/Internal/DBus/Common.hs @@ -28,4 +28,6 @@ callMethod mc = do addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler addMatchCallback rule cb = do client <- connectSession - addMatch client rule $ cb . signalBody + s <- addMatch client rule $ cb . signalBody + disconnect client + return s diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index eb48390..b84e144 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -14,19 +14,20 @@ import DBus.Client import XMonad.Internal.DBus.IntelBacklight import XMonad.Internal.DBus.Screensaver -startXMonadService :: IO Client +startXMonadService :: IO (Client, Maybe BacklightControls) startXMonadService = do client <- connectSession requestResult <- requestName client "org.xmonad" [] -- TODO if the client is not released on shutdown the owner will be -- different - if requestResult /= NamePrimaryOwner then + if requestResult /= NamePrimaryOwner then do putStrLn "Another service owns \"org.xmonad\"" + return (client, Nothing) else do putStrLn "Started xmonad dbus client" - exportIntelBacklight client + bc <- exportIntelBacklight client exportScreensaver client - return client + return (client, bc) stopXMonadService :: Client -> IO () stopXMonadService client = do diff --git a/lib/XMonad/Internal/DBus/IntelBacklight.hs b/lib/XMonad/Internal/DBus/IntelBacklight.hs index 02d02f7..6322dc9 100644 --- a/lib/XMonad/Internal/DBus/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/IntelBacklight.hs @@ -11,11 +11,14 @@ module XMonad.Internal.DBus.IntelBacklight , callMinBrightness , exportIntelBacklight , matchSignal + , hasBacklight + , BacklightControls(..) ) where import Control.Monad (void) import Data.Char +import Data.Either import Data.Int (Int16, Int32) import Data.Text (pack, unpack) import Data.Text.IO as T (readFile, writeFile) @@ -23,6 +26,10 @@ import Data.Text.IO as T (readFile, writeFile) import DBus import DBus.Client +import System.Directory +import System.FilePath.Posix +import System.IO.Error + import XMonad.Internal.DBus.Common -------------------------------------------------------------------------------- @@ -52,11 +59,11 @@ steps = 16 backlightDir :: FilePath backlightDir = "/sys/class/backlight/intel_backlight/" -maxFile :: String -maxFile = backlightDir ++ "max_brightness" +maxFile :: FilePath +maxFile = backlightDir "max_brightness" -curFile :: String -curFile = backlightDir ++ "brightness" +curFile :: FilePath +curFile = backlightDir "brightness" readFileInt :: FilePath -> IO RawBrightness readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file @@ -91,7 +98,7 @@ getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness changeBrightness :: RawBrightness -> Brightness -> IO Brightness changeBrightness maxRaw delta = setBrightness maxRaw - =<< (+ delta) <$> getBrightness maxRaw + . (+ delta) =<< getBrightness maxRaw setBrightness :: RawBrightness -> Brightness -> IO Brightness setBrightness maxRaw newNorm = do @@ -99,6 +106,41 @@ setBrightness maxRaw newNorm = do setRawBrightness $ normToRaw maxRaw 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 -- @@ -122,8 +164,8 @@ memGetBrightness = "GetBrightness" memMaxBrightness :: MemberName memMaxBrightness = "MaxBrightness" -memMinnBrightness :: MemberName -memMinnBrightness = "MinBrightness" +memMinBrightness :: MemberName +memMinBrightness = "MinBrightness" memIncBrightness :: MemberName memIncBrightness = "IncBrightness" @@ -142,7 +184,6 @@ brMatcher = matchAny , matchMember = Just memCurrentBrightness } - callBacklight :: MemberName -> IO () callBacklight method = void $ callMethod $ methodCall path interface method @@ -153,8 +194,20 @@ bodyGetBrightness _ = Nothing -------------------------------------------------------------------------------- -- | 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 + 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 let stepsize = maxBrightness `div` steps let emit' = emitBrightness client @@ -162,12 +215,18 @@ exportIntelBacklight client = do { interfaceName = interface , interfaceMethods = [ 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 memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize) , autoMethod memGetBrightness $ getBrightness maxval ] } + return $ BacklightControls + { backlightMax = callMaxBrightness + , backlightMin = callMinBrightness + , backlightUp = callIncBrightness + , backlightDown = callDecBrightness + } emitBrightness :: Client -> Brightness -> IO () emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] } @@ -176,7 +235,7 @@ callMaxBrightness :: IO () callMaxBrightness = callBacklight memMaxBrightness callMinBrightness :: IO () -callMinBrightness = callBacklight memMinnBrightness +callMinBrightness = callBacklight memMinBrightness callIncBrightness :: IO () callIncBrightness = callBacklight memIncBrightness diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index d30204d..6a4479c 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/lib/XMonad/Internal/Shell.hs @@ -80,9 +80,9 @@ type MaybeX = MaybeExe X type IOMaybeX = IO MaybeX -warnMissing :: Dependency -> String +warnMissing :: Dependency -> IO () warnMissing Dependency {depRequired = r, depName = n, depType = t } = - "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n + putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n where fmtType Executable = "executable" fmtType (Systemd u) =