dotfiles/oni/home/services/herbstluftwm.scm

(define-module (oni home services herbstluftwm)
  #:use-module (gnu services configuration)
  #:use-module (gnu packages wm)
  #:use-module (gnu packages shells)
  #:use-module (gnu home services)
  #:use-module (gnu home services utils)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (oni home services xsession)
  #:use-module (srfi srfi-1)

  #:export (home-herbstluftwm-service-type
            home-herbstluftwm-configuration))

(define-configuration/no-serialization home-herbstluftwm-configuration
  (package
   (package herbstluftwm)
   "Package use for setting herbstluftwm")
  (mouse-bindings
   (alist '())
   "Mouse bindings")
  (settings
   (alist '())
   "Settings")
  (tags
   (list '(1 2 3 4 5 6 7 8 9 0))
   "Tags")
  (tag-keys
   (list '(1 2 3 4 5 6 7 8 9 0))
   "Keys for the tags")
  (attributes
   (alist '())
   "Attributes to set")
  (rules
   (list '())
   "Rules to apply")
  (padding
   (list '(0 0 0 0 0))
   "Padding to apply to the monitor")
  (layouts
   (alist '())
   "Layouts to load for tags")
  (extra
   (list '())
   "Extra commands"))

(define (add-herbstluftwm-packages config)
  (list (home-herbstluftwm-configuration-package config)))

(define* (mixed-executable-file name #:key guile #:rest text)
  "Return an object representing store file NAME containing TEXT.  TEXT is a
sequence of strings and file-like objects, as in:

  (mixed-text-file \"profile\"
                   \"export PATH=\" coreutils \"/bin:\" grep \"/bin\")

This is the declarative counterpart of 'text-file*'."
  (define build
    (let ((text (if guile (drop text 2) text)))
      (gexp (call-with-output-file (ungexp output "out")
              (lambda (port)
                (set-port-encoding! port "UTF-8")
                (display (string-append (ungexp-splicing text)) port)
                (chmod port #o555))))))

  (computed-file name build #:guile guile))

(define (home-herbstluftwm-autostart-file config)
  (apply mixed-executable-file
         "autostart"
         "#!" zsh "/bin/zsh\n"
         "herbstclient emit_hook reload\n"
         "herbstclient keyunbind --all\n"
         (let ((tags (home-herbstluftwm-configuration-tags config)))
           (append (list "herbstclient mouseunbind --all\n")
                   (map (lambda (binding)
                          (format #f "herbstclient mousebind ~a ~a\n"
                                  (car binding) (cdr binding)))
                        (home-herbstluftwm-configuration-mouse-bindings config))
                   (map (lambda (setting)
                          (format #f "herbstclient set ~s ~s\n"
                                  (car setting) (cdr setting)))
                        (home-herbstluftwm-configuration-settings config))
                   (map (lambda (tag)
                          (format #f "herbstclient add ~s\n" tag))
                        tags)
                   (map (lambda (key tag)
                          (format #f "herbstclient keybind Mod4-~a use ~s\n" key tag))
                        (take (home-herbstluftwm-configuration-tag-keys config)
                              (length tags))
                        tags)
                   (if (> (length tags) 0)
                       (list "herbstclient merge_tag default\n")
                       '())
                   (map (lambda (attribute-pair)
                          (format #f "herbstclient attr ~a ~s\n"
                                  (string-join (map symbol->string (car attribute-pair)) ".")
                                  (cdr attribute-pair)))
                        (home-herbstluftwm-configuration-attributes config))
                   (list "herbstclient unrule -F\n")
                   (map (lambda (rule)
                          (format #f "herbstclient rule ~a\n"
                                  (string-join rule " ")))
                        (home-herbstluftwm-configuration-rules config))
                   (list "herbstclient unlock\n"
                         (format #f "herbstclient pad ~a\n"
                                 (string-join (map number->string (home-herbstluftwm-configuration-padding config)) " ")))
                   (map (lambda (layout-pair)
                          (format #f "herbstclient load ~s '~s'\n"
                                  (car layout-pair)
                                  (cdr layout-pair)))
                        (home-herbstluftwm-configuration-layouts config))
                   (map (lambda (line)
                          (format #f "herbstclient ~a\n" line))
                        (home-herbstluftwm-configuration-extra config))))))

(define (add-herbstluftwm-executable config)
  (home-xsession-extension
   (wm
    (list
     (mixed-text-file
      "xsession"
      "exec " herbstluftwm "/bin/herbstluftwm --autostart " (home-herbstluftwm-autostart-file config))))))

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