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.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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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) =
|
||||||
|
|
Loading…
Reference in New Issue