config.phundrak.com/docs/stumpwm/utilities.org

10 KiB
Raw Permalink Blame History

Utilities

Utilities

Utilities

Part of my configuration is not really related to StumpWM itself, or rather it adds new behaviour StumpWM doesnt have. utilities.lisp stores all this code in one place.

Bluetooth

Although there is a Bluetooth module for the modeline, this is about the extent to which StumpWM can interact with the systems 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 lets quickload it.

(ql:quickload :cl-ppcre)

Lets indicate which command well be using.

(defvar *bluetooth-command* "bluetoothctl"
  "Base command for interacting with bluetooth.")
Utilities

Well need a couple of functions that will take care of stuff for us, so we dont 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)))))

Pinentry

Out with GTK2s pinentry program! Lets use StumpWMs! At least thats what Id 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 cant 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 doesnt provide auto-completion or stuff like that.

The first thing to do is load slynk, SLYs server:

(ql:quickload :slynk)

Now we can define a command to launch the server. I dont 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))))

Systemd

Im currently in the process of writing functions to interact with Systemd directly through StumpWM. For now, not much work is done, but its 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
services 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))))))