dotfiles/oni/home/services/stumpwm.scm

(define-module (oni home services stumpwm)
  #:use-module ((srfi srfi-1) #:select (every))
  #:use-module ((gnu services configuration)
                #:select (serialize-package
                          define-configuration
                          define-configuration/no-serialization
                          text-config?
                          serialize-text-config))
  #:use-module ((gnu packages lisp)
                #:select (sbcl))
  #:use-module ((gnu packages wm)
                #:select (stumpwm
                          stumpish
                          sbcl-stumpwm-swm-gaps
                          sbcl-stumpwm-stumptray))
  #:use-module ((gnu home services)
                #:select (service-type
                          service-extension
                          home-profile-service-type
                          home-xdg-configuration-files-service-type
                          home-run-on-change-service-type))
  #:use-module ((gnu home services shepherd)
                #:select (home-shepherd-service-type
                          shepherd-service))
  #:use-module ((guix gexp)
                #:select (local-file
                          gexp
                          file-append
                          mixed-text-file))
  #:use-module ((guix packages)
                #:select (package?))

  #:export (home-stumpwm-service-type
            home-stumpwm-configuration
            home-stumpwm-extension

            home-stumpwm-gaps-service-type
            home-stumpwm-gaps-configuration

            home-stumpwm-stumptray-service-type
            home-stumpwm-stumptray-configuration))

(define (serialize-integer field value)
  "")

(define-configuration/no-serialization home-stumpwm-extension
  (configurations
   (text-config '())
   "The configuration for the extension."))

(define-configuration home-stumpwm-configuration
  (package
    (package stumpwm)
    "Package to use for setting Stumpwm")
  (configurations
   (text-config '())
   "The configuration to apply.")
  (startup-delay
   (integer 10)
   "The number of seconds to wait for stumpwm to start up.")
  (stumpish-package
   (package stumpish)
   "Package to use for setting Stumpish"))

(define (add-stumpwm-packages config)
  (append (list sbcl
                (home-stumpwm-configuration-package config)
                (home-stumpwm-configuration-stumpish-package config))))

(define (home-stumpwm-extensions original-config extension-configs)
  (home-stumpwm-configuration
   (inherit original-config)
   (configurations
    (apply append (home-stumpwm-configuration-configurations original-config)
           (map home-stumpwm-extension-configurations extension-configs)))))

(define (home-stumpwm-config-files config)
  `(("stumpwm/config"
     ,(mixed-text-file
       "config"
       (serialize-text-config config (home-stumpwm-configuration-configurations config))))))

(define (reload-stumpwm-config-gexp _)
  `(("files/.config/stumpwm/config"
     ,#~(system* #$(file-append stumpish "/bin/stumpish") "reload"))))

;; (define (stumpwm-mode-line-service config)
;;   (list (shepherd-service
;;          (documentation "Try and find out if the stumpwm mode line is enabled.")
;;          (provision '(stumpwm-mode-line statusbar))
;;          (modules '((ice-9 textual-ports)
;;                     (srfi srfi-1)))
;;          (start
;;           #~(lambda ()
;;               (let loop ((attempts #$(home-stumpwm-configuration-startup-delay config)))
;;                 (let* ((input+output (pipe))
;;                        ;; Use the timeout command here to stop it.
;;                        (pid (spawn "timeout" '("timeout" "1" "stumpish" "eval" "(print (let ((ml (stumpwm::head-mode-line (current-head)))) (and ml (not (eq (stumpwm::mode-line-mode ml) :hidden)))))")
;;                                    #:output (cdr input+output))))
;;                   (let ((result (string= "T" (string-trim-right (get-string-all (car input+output))))))
;;                     (close-port (car input+output))
;;                     (close-port (cdr input+output))
;;                     (waitpid pid)
;;                     (if result
;;                         result
;;                         (if (zero? attempts)
;;                             (begin
;;                               (format (current-error-port)
;;                                       "Stumpwm mode line did not show up; giving up.\n")
;;                               #f)
;;                             (begin
;;                               (sleep 1)
;;                               (loop (- attemps 1))))))))))
;;          (stop #~(lambda (_) #f))
;;          (respawn? #f))))

(define home-stumpwm-service-type
  (service-type
   (name 'home-stumpwm)
   (extensions
    (list (service-extension
           home-profile-service-type
           add-stumpwm-packages)
          (service-extension
           home-xdg-configuration-files-service-type
           home-stumpwm-config-files)
          (service-extension
           home-run-on-change-service-type
           reload-stumpwm-config-gexp)
          ;; (service-extension
          ;;  home-shepherd-service-type
          ;;  stumpwm-mode-line-service)
          ))
   (compose identity)
   (extend home-stumpwm-extensions)
   (default-value (home-stumpwm-configuration))
   (description "Install and configure stumpwm.")))

(define-configuration/no-serialization home-stumpwm-gaps-configuration
  (package
    (package sbcl-stumpwm-swm-gaps)
    "Package to use for setting stumpwm-gaps.")
  (configurations
   (text-config '())
   "Configuration for stumpwm gaps"))

(define (add-stumpwm-gaps config)
  (home-stumpwm-extension
   (configurations (home-stumpwm-gaps-configuration-configurations config))))

(define (add-stumpwm-gaps-packages config)
  (list (home-stumpwm-gaps-configuration-package config)))

(define home-stumpwm-gaps-service-type
  (service-type
   (name 'home-stumpwm-gaps)
   (extensions
    (list (service-extension
           home-stumpwm-service-type
           add-stumpwm-gaps)
          (service-extension
           home-profile-service-type
           add-stumpwm-gaps-packages)))
   (compose identity)
   (default-value (home-stumpwm-gaps-configuration))
   (description "Install and configure stumpwm-gaps.")))

(define-configuration/no-serialization home-stumpwm-stumptray-configuration
  (package
    (package sbcl-stumpwm-stumptray)
    "Package to use for setting stumpwm-stumptray.")
  (configurations
   (text-config '())
   "Configuration for stumpwm gaps"))

(define (add-stumpwm-stumptray config)
  (home-stumpwm-extension
   (configurations (home-stumpwm-stumptray-configuration-configurations config))))

(define (add-stumpwm-stumptray-packages config)
  (list (home-stumpwm-stumptray-configuration-package config)))

(define home-stumpwm-stumptray-service-type
  (service-type
   (name 'home-stumpwm-stumptray)
   (extensions
    (list (service-extension
           home-stumpwm-service-type
           add-stumpwm-stumptray)
          (service-extension
           home-profile-service-type
           add-stumpwm-stumptray-packages)))
   (compose identity)
   (default-value (home-stumpwm-stumptray-configuration))
   (description "Install and configure stumpwm-stumptray.")))