Compare commits

..

10 Commits

21 changed files with 163 additions and 48 deletions

View File

@ -14,6 +14,7 @@ import Data.Internal.XIO
import GHC.Enum (enumFrom) import GHC.Enum (enumFrom)
import Options.Applicative import Options.Applicative
import RIO hiding (hFlush) import RIO hiding (hFlush)
import RIO.FilePath
import RIO.List import RIO.List
import qualified RIO.NonEmpty as NE import qualified RIO.NonEmpty as NE
import qualified RIO.Text as T import qualified RIO.Text as T
@ -163,7 +164,7 @@ config bf ifs ios br confDir =
, pickBroadest = False , pickBroadest = False
, persistent = True , persistent = True
, -- store the icons with the xmonad/xmobar stack project , -- store the icons with the xmonad/xmobar stack project
iconRoot = confDir ++ "/icons" iconRoot = confDir </> "assets" </> "icons"
, commands = csRunnable <$> concatRegions br , commands = csRunnable <$> concatRegions br
} }

View File

@ -832,8 +832,9 @@ externalBindings runIO cleanup db =
, -- M-<F1> reserved for showing the keymap , -- M-<F1> reserved for showing the keymap
KeyBinding "M-<F2>" "restart xmonad" restartf KeyBinding "M-<F2>" "restart xmonad" restartf
, KeyBinding "M-<F3>" "recompile xmonad" recompilef , KeyBinding "M-<F3>" "recompile xmonad" recompilef
, KeyBinding "M-<F8>" "select autorandr profile" $ Left $ toX runAutorandrMenu , KeyBinding "M-<F7>" "select autorandr profile" $ Left $ toX runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet , KeyBinding "M-<F8>" "toggle wifi" $ Left $ toX runToggleWifi
, KeyBinding "M-<F9>" "toggle network" $ Left $ toX runToggleNetworking
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses
, KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt

View File

@ -468,6 +468,8 @@ data XPFeatures = XPFeatures
, xpfIntelBacklight :: Bool , xpfIntelBacklight :: Bool
, xpfClevoBacklight :: Bool , xpfClevoBacklight :: Bool
, xpfBattery :: Bool , xpfBattery :: Bool
, xpfEthPrefix :: Maybe Text
, xpfWifiPrefix :: Maybe Text
} }
instance FromJSON XPFeatures where instance FromJSON XPFeatures where
@ -493,6 +495,10 @@ instance FromJSON XPFeatures where
.:+ "clevo_backlight" .:+ "clevo_backlight"
<*> o <*> o
.:+ "battery" .:+ "battery"
<*> o
.:? "ethPrefix"
<*> o
.:? "wifiPrefix"
defParams :: XParams defParams :: XParams
defParams = defParams =
@ -515,6 +521,8 @@ defXPFeatures =
, xpfIntelBacklight = False , xpfIntelBacklight = False
, xpfClevoBacklight = False , xpfClevoBacklight = False
, xpfBattery = False , xpfBattery = False
, xpfEthPrefix = Nothing
, xpfWifiPrefix = Nothing
} }
type XPQuery = XPFeatures -> Bool type XPQuery = XPFeatures -> Bool
@ -825,16 +833,16 @@ testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
-- start with "en" and wireless interfaces always start with "wl" -- start with "en" and wireless interfaces always start with "wl"
readEthernet :: IODependency T.Text readEthernet :: IODependency T.Text
readEthernet = readInterface "get ethernet interface" isEthernet readEthernet = readInterface "get ethernet interface" (fromMaybe "en" . xpfEthPrefix)
readWireless :: IODependency T.Text readWireless :: IODependency T.Text
readWireless = readInterface "get wireless interface" isWireless readWireless = readInterface "get wireless interface" (fromMaybe "wl" . xpfWifiPrefix)
isWireless :: T.Text -> Bool -- isWireless :: T.Text -> Bool
isWireless = T.isPrefixOf "wl" -- isWireless = T.isPrefixOf "wl"
isEthernet :: T.Text -> Bool -- isEthernet :: T.Text -> Bool
isEthernet = T.isPrefixOf "en" -- isEthernet = T.isPrefixOf "en"
listInterfaces :: MonadUnliftIO m => m [T.Text] listInterfaces :: MonadUnliftIO m => m [T.Text]
listInterfaces = listInterfaces =
@ -846,11 +854,12 @@ sysfsNet = "/sys/class/net"
-- ASSUME there are no (non-base) packages required to make these interfaces -- ASSUME there are no (non-base) packages required to make these interfaces
-- work (all at the kernel level) -- work (all at the kernel level)
readInterface :: T.Text -> (T.Text -> Bool) -> IODependency T.Text readInterface :: T.Text -> (XPFeatures -> Text) -> IODependency T.Text
readInterface n f = IORead n [] go readInterface n f = IORead n [] go
where where
go = io $ do go = do
ns <- filter f <$> listInterfaces p <- asks (f . xpFeatures . xParams)
ns <- filter (T.isPrefixOf p) <$> listInterfaces
case ns of case ns of
[] -> return $ Left [Msg LevelError "no interfaces found"] [] -> return $ Left [Msg LevelError "no interfaces found"]
(x : xs) -> do (x : xs) -> do

View File

@ -19,7 +19,8 @@ module XMonad.Internal.Command.Desktop
, runVolumeUp , runVolumeUp
, runVolumeMute , runVolumeMute
, runToggleBluetooth , runToggleBluetooth
, runToggleEthernet , runToggleNetworking
, runToggleWifi
, runRestart , runRestart
, runRecompile , runRecompile
, runAreaCapture , runAreaCapture
@ -58,13 +59,13 @@ import XMonad.Operations
-- My Executables -- My Executables
myTerm :: FilePath myTerm :: FilePath
myTerm = "urxvt" myTerm = "alacritty"
myCalc :: FilePath myCalc :: FilePath
myCalc = "bc" myCalc = "bc"
myBrowser :: FilePath myBrowser :: FilePath
myBrowser = "brave" myBrowser = "firefox"
myEditor :: FilePath myEditor :: FilePath
myEditor = "emacsclient" myEditor = "emacsclient"
@ -92,8 +93,7 @@ myNotificationCtrl = "dunstctl"
myTermPkgs :: [Fulfillment] myTermPkgs :: [Fulfillment]
myTermPkgs = myTermPkgs =
[ Package Official "rxvt-unicode" [ Package Official "alacritty"
, Package Official "urxvt-perls"
] ]
myEditorPkgs :: [Fulfillment] myEditorPkgs :: [Fulfillment]
@ -108,6 +108,9 @@ bluetoothPkgs = [Package Official "bluez-utils"]
networkManagerPkgs :: [Fulfillment] networkManagerPkgs :: [Fulfillment]
networkManagerPkgs = [Package Official "networkmanager"] networkManagerPkgs = [Package Official "networkmanager"]
nmcli :: IODependency_
nmcli = sysExe networkManagerPkgs "nmcli"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Misc constants -- Misc constants
@ -118,7 +121,7 @@ volumeChangeSound = "smb_fireball.wav"
-- Some nice apps -- Some nice apps
runTerm :: MonadUnliftIO m => Sometimes (m ()) runTerm :: MonadUnliftIO m => Sometimes (m ())
runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm runTerm = sometimesExe "terminal" "alacritty" myTermPkgs True myTerm
runTMux :: MonadUnliftIO m => Sometimes (m ()) runTMux :: MonadUnliftIO m => Sometimes (m ())
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
@ -206,7 +209,7 @@ runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
-- Volume Commands -- Volume Commands
soundDir :: FilePath soundDir :: FilePath
soundDir = "sound" soundDir = "assets" </> "sound"
playSound :: MonadIO m => FilePath -> m () playSound :: MonadIO m => FilePath -> m ()
playSound file = do playSound file = do
@ -276,12 +279,12 @@ runNotificationContext =
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- System commands -- System commands
-- this is required for some vpn's to work properly with network-manager -- needed to lookup/prompt for passwords/keys for wifi connections and some VPNs
runNetAppDaemon :: Maybe NamedSysConnection -> Sometimes (XIO (P.Process () () ())) runNetAppDaemon :: Maybe NamedSysConnection -> Sometimes (XIO (P.Process () () ()))
runNetAppDaemon cl = runNetAppDaemon cl =
Sometimes Sometimes
"network applet" "network applet"
xpfVPN (\x -> xpfVPN x || xpfWireless x)
[Subfeature (DBusRoot_ cmd tree cl) "NM-applet"] [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
where where
tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
@ -305,27 +308,35 @@ runToggleBluetooth cl =
#!>> 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"}
runToggleEthernet :: MonadUnliftIO m => Sometimes (m ()) runToggleNetworking :: MonadUnliftIO m => Sometimes (m ())
runToggleEthernet = runToggleNetworking =
Sometimes Sometimes
"ethernet toggle" "network toggle"
xpfEthernet (\x -> xpfEthernet x || xpfWireless x)
[Subfeature root "nmcli"] [Subfeature root "nmcli"]
where where
root = root = IORoot_ cmd $ Only_ nmcli
IORoot cmd $ cmd =
And1 (Only readEthernet) $
Only_ $
sysExe networkManagerPkgs "nmcli"
-- TODO make this less noisy
cmd iface =
S.spawn $ S.spawn $
fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface] fmtCmd "nmcli" ["networking"]
#!| "grep -q disconnected" #!| "grep -q enabled"
#!&& "a=connect" #!&& "a=off"
#!|| "a=disconnect" #!|| "a=on"
#!>> fmtCmd "nmcli" ["device", "$a", iface] #!>> fmtCmd "nmcli" ["networking", "$a"]
#!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "ethernet \"$a\"ed"} #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "networking switched $a"}
runToggleWifi :: MonadUnliftIO m => Sometimes (m ())
runToggleWifi = Sometimes "wifi toggle" xpfWireless [Subfeature root "nmcli"]
where
root = IORoot_ cmd $ Only_ nmcli
cmd =
S.spawn $
fmtCmd "nmcli" ["radio", "wifi"]
#!| "grep -q enabled"
#!&& "a=off"
#!|| "a=on"
#!>> fmtCmd "nmcli" ["radio", "wifi", "$a"]
#!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "wifi switched $a"}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Configuration commands -- Configuration commands

View File

@ -110,14 +110,18 @@ withDBusClientConnection cb n logfile f =
logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
withLogFunc logOpts $ \lf -> do withLogFunc logOpts $ \lf -> do
env <- mkSimpleApp lf Nothing env <- mkSimpleApp lf Nothing
runRIO env $ runRIO env $ displayMaybe' cb f =<< getDBusClient n
bracket (getDBusClient n) (mapM (liftIO . disconnect . ncClient)) $
displayMaybe' cb f
-- | Run a plugin action with a new DBus client and logfile path. -- | Run a plugin action with a new DBus client and logfile path. This is
-- This is necessary for DBus callbacks which run in separate threads, which -- necessary for DBus callbacks which run in separate threads, which will
-- will usually fire when the parent thread already exited and killed off its -- usually fire when the parent thread already exited and killed off its DBus
-- DBus connection and closed its logfile. -- connection and closed its logfile. NOTE: unlike 'withDBusClientConnection'
-- this function will open and new logfile and client connection and close both
-- on completion. 'withDBusClientConnection' will only close the log file but
-- keep the client connection active upon termination; this client will only be
-- killed when the entire process is killed. This distinction is important
-- because callbacks only need ephemeral connections, while listeners (started
-- with 'withDBusClientConnection') need long-lasting connections.
withNestedDBusClientConnection withNestedDBusClientConnection
:: (MonadUnliftIO m, SafeClient c, MonadReader (PluginEnv s c) m) :: (MonadUnliftIO m, SafeClient c, MonadReader (PluginEnv s c) m)
=> Maybe BusName => Maybe BusName
@ -128,4 +132,9 @@ withNestedDBusClientConnection n logfile f = do
dpy <- asks plugDisplay dpy <- asks plugDisplay
s <- asks plugState s <- asks plugState
cb <- asks plugCallback cb <- asks plugCallback
withDBusClientConnection cb n logfile $ \c -> mapRIO (PluginEnv c s dpy cb) f let run h = do
logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
withLogFunc logOpts $ \lf -> do
env <- mkSimpleApp lf Nothing
runRIO env $ withDBusClient_ n $ \cl -> mapRIO (PluginEnv cl s dpy cb) f
maybe (run stderr) (`withLogFile` run) logfile

View File

@ -9,9 +9,10 @@ extra-source-files:
- README.md - README.md
- fourmolu.yaml - fourmolu.yaml
- make_pkgs - make_pkgs
- icons/* - runtime_pkgs
- assets/icons/*
- assets/sound/*
- scripts/* - scripts/*
- sound/*
default-extensions: default-extensions:
- OverloadedStrings - OverloadedStrings

22
scripts/screencap Executable file
View File

@ -0,0 +1,22 @@
#! /bin/bash
## capture a screenshot using scrot
SS_DIR="$XDG_CACHE_HOME/screenshots"
while getopts ":sw" opt; do
case ${opt} in
s)
scrot "$SS_DIR/desktop/%Y-%m-%d-%H:%M:%S_desktop.png"
notify-send "Screen captured"
;;
w)
scrot -u "$SS_DIR/window/%Y-%m-%d-%H:%M:%S-\$wx\$h.png"
notify-send "Window captured"
;;
\?)
echo "invalid option, read the code"
;;
esac
done

61
scripts/screenlock Executable file
View File

@ -0,0 +1,61 @@
#! /bin/bash
## lock the screen using i3lock (and maybe suspend)
## usage: screenlock [SUSPEND]
# WORKAROUND make the date show up in the right place on 2+ monitor setups
# I want it to only show up on the primary screen, so use xrandr to get the
# dimensions and position of the primary monitor and calculate the date position
# from that
geometry=$(xrandr | sed -n 's/^.*primary \([0-9]*\)x[0-9]*+\([0-9]\)*+[0-9]* .*/\1 \2/p')
width=$(echo "$geometry" | cut -f1 -d" ")
xpos=$(echo "$geometry" | cut -f2 -d" ")
xoffset=$(("$xpos" + "$width" / 2))
datepos="$xoffset:600"
# lock and fork so we can suspend with the screen locked
i3lock --color=000000 \
--pass-media-keys \
--nofork \
--ignore-empty-password \
--screen=0 \
--indicator \
--inside-color=00000055 \
--insidever-color=00000055 \
--insidewrong-color=00000055 \
--ring-color=555555ff \
--ringwrong-color=ff3333ff \
--ringver-color=99ceffff \
--keyhl-color=99ceffff \
--bshl-color=9523ffff \
--line-color=00000000 \
--separator-color=00000000 \
--clock \
--verif-color=99ceffff \
--wrong-color=ff8282ff \
--time-color=ffffffff \
--time-size=72 \
--time-str="%H:%M" \
--date-color=ffffffff \
--date-size=42 \
--date-str="%b %d, %Y" \
--date-align 0 \
--date-pos="$datepos" \
--wrong-size=72 \
--verif-size=72 \
--radius=300 \
--ring-width=25 &
# suspend if we want, and if this machine is currently using a battery
batpath=/sys/class/power_supply/BAT0/status
if [ -f "$batpath" ] && \
[ "$(cat $batpath)" == "Discharging" ] && \
[ "$1" == "true" ]; then
systemctl suspend
fi
# block until the screen is unlocked (since xss-lock expects the locker to exit
# only when unlocked)
wait