Lucien Cartier-Tilet
87b3deeed3
14 KiB
Utilities
Utilities
Utilities
Part of my configuration is not really related to StumpWM itself, or
rather it adds new behaviour StumpWM doesn’t have. utilities.lisp
stores all this code in one place.
Binwarp
Binwarp allows the user to control their mouse from the keyboard, basically eliminating the need for a physical mouse in daily usage of the workstation (though a physical mouse stays useful for games and such).
(load-module "binwarp")
Next, I’ll define my keybinds for when using Binwarp for emulating
mouse clicks as well as bépo-compatible mouse movements. This new
Binwarp mode is now available from the keybind s-m at top level.
(binwarp:define-binwarp-mode my-binwarp-mode "s-m" (:map *top-map*)
((my/kbd "SPC") "ratclick 1")
((my/kbd "RET") "ratclick 3")
((my/kbd "c") "binwarp left")
((my/kbd "t") "binwarp down")
((my/kbd "s") "binwarp up")
((my/kbd "r") "binwarp right")
((my/kbd "i") "init-binwarp")
((my/kbd "q") "exit-binwarp"))Bluetooth
Although there is a Bluetooth module for the modeline, this is about the extent to which StumpWM can interact with the system’s Bluetooth. However, I wish for some more interactivity, like powering on and off Bluetooth, connecting to devices and so on.
Firstly, our code relies on cl-ppcre, so let’s quickload it.
(ql:quickload :cl-ppcre)Let’s indicate which command we’ll be using.
(defvar *bluetooth-command* "bluetoothctl"
"Base command for interacting with bluetooth.")Utilities
We’ll need a couple of functions that will take care of stuff for us,
so we don’t have to repeat ourselves. The first one is a way for us to
share a message. The function bluetooth-message will first display
Bluetooth: in green, then it will display the message we want it to
display.
(defun bluetooth-message (&rest message)
(message (format nil
"^2Bluetooth:^7 ~{~A~^ ~}"
message)))
This function is a builder function which will create our commands.
For instance, src_lisp[:exports code]{(bluetooth-make-command "power"
"on")} will return "bluetoothctl power on" with *bluetooth-ctl* set as
"bluetoothctl" — simply put, it joins *bluetooth-command* with args
with a space as their separator.
(defun bluetooth-make-command (&rest args)
(format nil
"~a ~{~A~^ ~}"
,*bluetooth-command*
args))
Now we can put bluetooth-make-command to use with bluetooth-command
which will actually run the result of the former. As you can see, it
also collects the output, so we can display it later in another
function.
(defmacro bluetooth-command (&rest args)
`(run-shell-command (bluetooth-make-command ,@args) t))
Finally, bluetooth-message-command is the function that both executes
and also displays the result of the bluetooth command we wanted to see
executed. Each argument of the command is a separate string. For
instance, if we want to power on the bluetooth on our device, we can
call src_lisp[:exports code]{(bluetooth-message-command "power"
"on")}.
(defmacro bluetooth-message-command (&rest args)
`(bluetooth-message (bluetooth-command ,@args)))Toggle Bluetooth On and Off
This part is easy. Now that we can call our Bluetooth commands easily, we can easily define how to turn on Bluetooth.
(defcommand bluetooth-turn-on () ()
"Turn on bluetooth."
(bluetooth-message-command "power" "on"))And how to power it off.
(defcommand bluetooth-turn-off () ()
"Turn off bluetooth."
(bluetooth-message-command "power" "off"))Bluetooth Devices
In order to manipulate Bluetooth device, which we can represent as a
MAC address and a name, we can create a structure that will make use
of a constructor for simpler use. The constructor
make-bluetooth-device-from-command expects an entry such as Device
00:00:00:00:00:00 Home Speaker. The constructor discards the term
Device and stores the MAC address separately from the rest of the
string which is assumed to be the full name of the device.
(defstruct (bluetooth-device
(:constructor
make-bluetooth-device (&key (address "")
(name nil)))
(:constructor
make-bluetooth-device-from-command
(&key (raw-name "")
&aux (address (cadr (cl-ppcre:split " " raw-name)))
(full-name (format nil "~{~A~^ ~}" (cddr (cl-ppcre:split " " raw-name)))))))
address
(full-name (progn
(format nil "~{~A~^ ~}" name))))We can now collect our devices easily.
(defun bluetooth-get-devices ()
(let ((literal-devices (bluetooth-command "devices")))
(mapcar (lambda (device)
(make-bluetooth-device-from-command :raw-name device))
(cl-ppcre:split "\\n" literal-devices))))Connect to a device
When we want to connect to a Bluetooth device, we always need
Bluetooth turned on, so bluetooth-turn-on will always be called. Then
the function will attempt to connect to the device specified by the
device argument, whether the argument is a Bluetooth structure as
defined above or a plain MAC address.
(defun bluetooth-connect-device (device)
(progn
(bluetooth-turn-on)
(cond ((bluetooth-device-p device) ;; it is a bluetooth-device structure
(bluetooth-message-command "connect"
(bluetooth-device-address device)))
((stringp device) ;; assume it is a MAC address
(bluetooth-message-command "connect" device))
(t (message (format nil "Cannot work with device ~a" device))))))The command to connect to a device displays a choice between the collected Bluetooth device and the user only has to select it. It will then attempt to connect to it.
(defcommand bluetooth-connect () ()
(sb-thread:make-thread
(lambda ()
(let* ((devices (bluetooth-get-devices))
(choice (cadr (stumpwm:select-from-menu
(stumpwm:current-screen)
(mapcar (lambda (device)
`(,(bluetooth-device-full-name device) ,device))
devices)))))
(bluetooth-connect-device choice)))))Keybinds
It’s all nice and all, but typing manually the commands with s-SPC ;
is a bit tiring, so let’s define our Bluetooth keymap which we will
bind to s-SPC B.
| Keychord | Command |
|---|---|
c |
bluetooth-connect |
o |
bluetooth-turn-on |
O |
bluetooth-turn-off |
(defvar *my-bluetooth-keymap*
(let ((m (make-sparse-keymap)))
<<keybinds-gen(map="m", keybinds=bluetooth-keymap)>>
m))
(define-key *root-map* (my/kbd "B") '*my-bluetooth-keymap*)NetworkManager integration
It is possible to have some kind of integration between StumpWM and NetworkManager. To do so, we have to load the related module, then create the two keybinds described in /phundrak/config.phundrak.com/src/commit/9c1fe06d26b69d851930052da68ec1dd3920b3b2/docs/stumpwm/nm-keybinds.
| Keychord | Command |
|---|---|
W |
nm-list-wireless-networks |
*my-nm-keybinds*
A call to
(ql:quickload :dbus)dbus module in turn requires the
library libfixposix installed on the user’s machine. On Arch, you can
install it like so using paru:
paru -S libfixposix --noconfirm(ql:quickload :dbus)
(load-module "stump-nm")
<<keybinds-gen(map="*root-map*", keybinds=nm-keybinds)>>Pinentry
Out with GTK2’s pinentry program! Let’s use StumpWM’s! At least that’s what I’d like to say, but unfortunately there is a bug in the text reading devices of StumpWM that prevent the user from using modifiers when entering a password such as AltGr, so I can’t use it : /
;; (load-module "pinentry")Sly
Sly is a fork of SLIME with which I can connect StumpWM and Emacs
together. Technically this is already done to some level with
stumpwm-mode, but the latter doesn’t provide auto-completion or stuff
like that.
The first thing to do is load slynk, SLY’s server:
(ql:quickload :slynk)Now we can define a command to launch the server. I don’t want it to run all the time, just when I need it.
(stumpwm:defcommand sly-start-server () ()
"Start a slynk server for sly."
(sb-thread:make-thread (lambda () (slynk:create-server :dont-close t))))
(stumpwm:defcommand sly-stop-server () ()
"Stop current slynk server for sly."
(sb-thread:make-thread (lambda () (slynk:stop-server 4005))))
swm-ssh
This module from the contrib repository scans the user’s ssh configuration file and offers them a quick way of connecting to their remote hosts.
(load-module "swm-ssh")
The default terminal needs to be set, otherwise the module will try to
call urxvtc which is not installed on my system.
(setq swm-ssh:*swm-ssh-default-term* "kitty")Now, to call the main command of this module we can define the following keybind.
(define-key *root-map* (my/kbd "s") "swm-ssh-menu")Systemd
I’m currently in the process of writing functions to interact with Systemd directly through StumpWM. For now, not much work is done, but it’s a start.
Firstly, I have the following function that lists all the system or user services.
(defun systemd-get-services (&key user-p)
"Collect all systemd services running.
If USER-P is t, collect user services, otherwise collect system
services.
The value returned is a list of lists. The first element is the
service’s name, the second is its load state, the third the high-level
activation state of the service, and the fourth its low-level
activation state."
(mapcar (lambda (elt)
(multiple-value-bind (_ result)
(ppcre:scan-to-strings "(.*\\.service) *([^ ]+) *([^ ]+) *([^ ]+).*"
elt)
result))
(ppcre:split
" *\\n●? *"
(ppcre:regex-replace
"^ *"
(run-shell-command (concat "systemctl list-units --type service --all -q"
(if user-p " --user" ""))
t)
""))))
The only command I have right now is for listing the system or user
services with message. Unfortunately, if there are too many services,
the list will overflow the screen. I do not know how to fix that yet.
I set the timeout to 600 seconds in order to have all the time in the
world to read the services list. It goes away as soon as something
else appears, such as a s-SPC C-g since I have which-key-mode enabled.
(defcommand systemd-list-services (user-p) ((:y-or-n "User services? "))
(let ((stumpwm::*timeout-wait* 600))
(message (format nil "~{~a~^~&~}"
(mapcar (lambda (service)
(let ((name (aref service 0))
(load (aref service 1))
(active (aref service 2))
(sub (aref service 3)))
(cond ((member load '("not-found" "bad-setting"
"error" "masked")
:test #'string=)
(format nil
"^~A~A^0 ^> Load: ~12@A"
(if (string= "masked" load) 4 1)
name load))
((member active '("failed" "reloading" "activating"
"deactivating" "inactive")
:test #'string=)
(format nil "^~A~A^0 ^>Active: ~12@A"
(case active
("failed" 1)
("inactive" 0)
(t 3))
name
active))
(t (format nil "^2~A^0 ^> Sub: ~12@A" name sub)))))
(systemd-get-services :user-p user-p))))))