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 xinit)
  #:use-module (oni gexp)
  #:use-module (oni kbd)
  #: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")
  (key-bindings
   (alist '())
   "Key bindings")
  (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) zsh))

(define (build-keybindings bindings)
  (append
   (list "herbstclient keyunbind --all\n")
   (map (lambda (binding)
          (format #f "herbstclient keybind ~a ~a\n"
                  (kbd (car binding)) (cdr binding)))
        bindings)))

(define (home-herbstluftwm-autostart-file config)
  (apply mixed-executable-file
         "autostart"
         "#!" zsh "/bin/zsh\n"
         "herbstclient emit_hook reload\n"
         (let ((tags (home-herbstluftwm-configuration-tags config)))
           (append (build-keybindings
                    (home-herbstluftwm-configuration-key-bindings config))

                   (list "herbstclient mouseunbind --all\n")
                   (map (lambda (binding)
                          (format #f "herbstclient mousebind ~a ~a\n"
                                  (kbd (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 (format #f "herbstclient use ~s\nherbstclient merge_tag default ~s\n" (car tags) (car tags)))
                       '())
                   (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-xinit-extension
   (wm
    (list
     (mixed-text-file
      "xinitrc"
      "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-xinit-service-type
           add-herbstluftwm-executable)))
   (compose identity)
   (default-value (home-herbstluftwm-configuration))
   (description "Install and configure herbstluftwm.")))