From af4c5b3ffdbceface86441c8c4e19e52040ae7c7 Mon Sep 17 00:00:00 2001
From: Tom Willemse
Date: Fri, 15 Apr 2022 00:48:15 -0700
Subject: Add configuration for herbstluftwm

---
 oni/home/services/herbstluftwm.scm | 100 ++++++++++++++++++++++++++++++++++++-
 1 file changed, 98 insertions(+), 2 deletions(-)

(limited to 'oni/home/services/herbstluftwm.scm')

diff --git a/oni/home/services/herbstluftwm.scm b/oni/home/services/herbstluftwm.scm
index 6b68b2c..e69a17c 100644
--- a/oni/home/services/herbstluftwm.scm
+++ b/oni/home/services/herbstluftwm.scm
@@ -1,11 +1,13 @@
 (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))
@@ -13,18 +15,112 @@
 (define-configuration/no-serialization home-herbstluftwm-configuration
   (package
    (package herbstluftwm)
-   "Package use for setting 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")))))
+      "exec " herbstluftwm "/bin/herbstluftwm --autostart " (home-herbstluftwm-autostart-file config))))))
 
 (define home-herbstluftwm-service-type
   (service-type
-- 
cgit v1.2.3-54-g00ecf