Compare commits
10 Commits
Author | SHA1 | Date |
---|---|---|
Nathan Dwarshuis | 51ebf01786 | |
Nathan Dwarshuis | c35be51dd4 | |
Nathan Dwarshuis | 24430eaeb7 | |
Nathan Dwarshuis | 8a1345ae4b | |
Nathan Dwarshuis | a65cd669dc | |
Nathan Dwarshuis | 3ab6ccf45b | |
Nathan Dwarshuis | 8064b01c90 | |
Nathan Dwarshuis | 80c3d33010 | |
Nathan Dwarshuis | d9b1886db6 | |
Nathan Dwarshuis | 841bf0b5c8 |
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue