ENH check for intel backlight before adding controls
This commit is contained in:
parent
d1c398b3c3
commit
5ef9f46a0a
|
|
@ -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 "<XF86Search>" "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-<End>" "power menu" $ noCheck runPowerPrompt
|
||||
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
||||
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
||||
|
|
@ -543,3 +540,8 @@ externalBindings ts =
|
|||
, 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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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) =
|
||||
|
|
|
|||
Loading…
Reference in New Issue