dotfiles/oni/home/services/stumpwm.scm

195 lines
7.1 KiB
Scheme

(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.")))