From f48c4fead04c6bfdbd4a08f116f71d8cf46b3bb3 Mon Sep 17 00:00:00 2001
From: Tom Willemse
Date: Tue, 7 Mar 2023 23:05:58 -0800
Subject: Rewrite picom configuration

The previous version of the configuration was complaining that my ‘config’
section was not a valid value for the ‘package’ section. I didn't quite
understand why it would complain about that, so I decided to use my now improved
Guix Home knowledge (compared to when I copied the previous version) to just
rewrite the service in a way that matches my other services.
---
 oni/home/config/data.scm      |  17 ++--
 oni/home/services/compton.scm | 195 +++++++++++++++++++++++++++---------------
 2 files changed, 135 insertions(+), 77 deletions(-)

diff --git a/oni/home/config/data.scm b/oni/home/config/data.scm
index 11628f3..0126299 100644
--- a/oni/home/config/data.scm
+++ b/oni/home/config/data.scm
@@ -32,15 +32,14 @@
 (define data-picom-service
   (service home-picom-service-type
            (home-picom-configuration
-            (config
-             '((detect-transient . #t)
-               (shadow . #t)
-               (wintypes ((dnd ((shadow . #f)))
-                          (dock ((shadow . #f)))))
-               (shadow-radius . 10)
-               (shadow-exclude ("name = 'mowedline'"
-                                "class_g = 'trayer'"
-                                "bounding_shaped")))))))
+            (detect-transient #t)
+            (shadow #t)
+            (wintypes '((dnd (shadow . #f))
+                        (dock (shadow . #f))))
+            (shadow-radius 10)
+            (shadow-exclude '("name = 'mowedline'"
+                              "class_g = 'trayer'"
+                              "bounding_shaped")))))
 
 (home-environment
  (packages (list (specification->package+output "glibc-locales")
diff --git a/oni/home/services/compton.scm b/oni/home/services/compton.scm
index 1097ec6..3a8e690 100644
--- a/oni/home/services/compton.scm
+++ b/oni/home/services/compton.scm
@@ -18,71 +18,142 @@
   #:export (home-picom-service-type
             home-picom-configuration))
 
-;;; This module has been copied from
-;;; https://github.com/nouun/jayu/blob/92ff6629da686f0ddc96a4d6cb2a657c76795bc6/jayu/home/services/xdisorg.scm
-;;; With some slight modifications to make my configuration work.
+(define (serialize-alist field value)
+  (string-append
+   (symbol->string field)
+   ": {\n"
+   (apply string-append
+          (map (lambda (type)
+                 (string-append
+                  "  "
+                  (symbol->string (car type))
+                  " = "
+                  (cond
+                   ((list? (cdr type))
+                    (string-append
+                     "{ "
+                     (apply string-append
+                            (map (lambda (option)
+                                   (string-append (symbol->string (car option)) " = " (if (cdr option) "true" "false")))
+                                 (cdr type)))
+                     " },"))
+                   ((string? (cdr type))
+                    (string-append "\"" (cdr type) "\";"))
+                   ((number? (cdr type))
+                    (string-append (number->string (cdr type)) ";")))
+                  "\n"))
+               value))
+   "}\n"))
 
-(define-configuration/no-serialization home-picom-configuration
-  (package
-   (package picom)
-   "Package to use for setting Picom")
-  (config
-   (alist '())
-   ""))
+(define (serialize-boolean field value)
+  (string-append (symbol->string field) " = " (if value "true" "false") ";\n"))
 
-(define (format-picom-list vals depth)
-  (if (not (eq? vals '()))
-      (let ((is-pair? (pair? (car vals))))
-        (string-append
-         (if is-pair? "{" "[")
-         "\n  "
-         (string-join
-          (map (lambda (val)
-                (if (pair? val)
-                    (string-append
-                     (maybe-object->string (car val))
-                     " = " (format-picom-value (cdr val) (+ depth 1))
-                     (if (> depth 0) "," ";"))
-                    (format-picom-value val (+ depth 1))))
-               vals)
-          (string-append
-           (if is-pair? "" ",")
-           "\n  "))
-         "\n"
-         (if is-pair? "}" "]")))
-      "[]"))
+(define (serialize-list field value)
+  (string-append (symbol->string field) " = [\n"
+                 (apply string-append (map (lambda (item)
+                                             (string-append "  \"" item "\",\n"))
+                                           value))
+                 "];\n"))
+
+(define (serialize-number field value)
+  (string-append (symbol->string field) " = " (number->string value) ";\n"))
 
-(define (format-picom-value val depth)
-  (cond
-   ((list? val)
-    (format-picom-list (car val) (+ depth 1)))
-   ((pair? val)
-    (format-picom-value `(,(car val)) (+ depth 1)))
-   ((boolean? val)
-    (if val "true" "false"))
-   ((or (symbol? val) (number? val))
-    (maybe-object->string val))
-   ((string? val)
-    (string-append "\"" val "\""))
-   (else val)))
+(define (serialize-percentage field value)
+  (serialize-number field (/ value 100.0)))
 
-(define (format-picom-config key val)
-  (list (string-append (maybe-object->string key)
-                       " = "
-                       (format-picom-value val 0)
-                       ";\n")))
+(define (serialize-string field value)
+  (string-append (symbol->string field) " = \"" value "\";\n"))
 
-(define (serialize-picom-config config)
-  (generic-serialize-alist append format-picom-config config))
+(define (percentage? value)
+  (and (number? value)
+       (<= 0 value 100)))
+
+(define-configuration home-picom-configuration
+  (package
+    (package picom)
+    "Package to use for setting Picom")
+  (backend
+   (string "xrender")
+   "Specify the backend to use: xrender, glx, or xr_glx_hybrid")
+  (glx-no-stencil
+   (boolean #f)
+   "GLX backend: avoid using stencil buffer, useful if you don’t have a stencil buffer")
+  (detect-transient
+   (boolean #f)
+   "Use WM_TRANSIENT_FOR to group windows, and consider windows in the same group focused at the same time")
+  (shadow
+   (boolean #f)
+   "Enabled client-side shadows on windows")
+  (shadow-radius
+   (number 12)
+   "The blur radius for shadows, in pixels")
+  (shadow-opacity
+   (percentage 75)
+   "The opacity of shadows")
+  (shadow-offset-x
+   (number -15)
+   "The left offset for shadows, in pixels")
+  (shadow-offset-y
+   (number -15)
+   "The top offset for shadows, in pixels")
+  (shadow-exclude
+   (list '())
+   "Specify a list of conditions of windows that should have no shadow")
+  (wintypes
+   (alist '())
+   "Window-type-specific settings")
+  (corner-radius
+   (number 0)
+   "Sets the radius of rounded window corners")
+  (inactive-opacity
+   (percentage 100)
+   "Opacity of inactive windows")
+  (active-opacity
+   (percentage 100)
+   "Default opacity for active windows")
+  (frame-opacity
+   (percentage 100)
+   "Opacity of window titlebars and borders")
+  (inactive-opacity-override
+   (boolean #f)
+   "Let inactive opacity set by -i override the _NET_WM_WINDOW_OPACITY values of windows")
+  (blur-background
+   (boolean #f)
+   "Blur background of semi-transparent / ARGB windows")
+  (blur-background-frame
+   (boolean #f)
+   "Blur background of windows when the window frame is not opaque")
+  (blur-background-fixed
+   (boolean #f)
+   "Use fixed blur strength rather than adjusting according to window opacity")
+  (blur
+   (alist '())
+   "Configure how the window background is blurred")
+  (blur-background-exclude
+   (list '())
+   "Exclude conditions for background blur")
+  (focus-exclude
+   (list '())
+   "Specify a list of conditions of windows that should always be considered focused")
+  (fading
+   (boolean #f)
+   "Fade windows in/out when opening/closing and when opacity changes, unless no-fading-openclose is set")
+  (fade-in-step
+   (percentage 2.8)
+   "Opacity change between steps while fading in")
+  (fade-out-step
+   (percentage 3)
+   "Opacity change between steps while fading out"))
 
 (define (home-picom-config-file config)
-  (apply mixed-text-file
-     "picom.conf"
-     (serialize-picom-config
-       (home-picom-configuration-config config))))
+  (computed-file
+   "picom.conf"
+   #~(call-with-output-file #$output
+       (lambda (port)
+         (display #$(serialize-configuration config home-picom-configuration-fields) port)))))
 
 (define (home-picom-files-service config)
-  `(("picom/picom.conf"
+  `(("picom.conf"
      ,(home-picom-config-file config))))
 
 (define (home-picom-profile-service config)
@@ -93,8 +164,6 @@
     (shepherd-service
       (documentation "Start Picom")
       (provision '(picom))
-      ;; TODO: Figure out how to start when x starts
-      ;(requirement '(xorg-server))
       (auto-start? #t)
       (start
        #~(make-forkexec-constructor
@@ -103,15 +172,6 @@
           #:log-file (format #f "~a/.local/var/log/picom.log" (getenv "HOME"))))
       (stop #~(make-kill-destructor)))))
 
-(define (home-picom-extension old-config extension-configs)
-  (match old-config
-    (($ <home-picom-configuration> _ package* config*)
-     (home-picom-configuration
-      (package package*)
-      (config (append config*
-                      (append-map home-picom-configuration-config
-                                  extension-configs)))))))
-
 (define home-picom-service-type
   (service-type (name 'home-picom)
                 (extensions
@@ -125,7 +185,6 @@
                         home-shepherd-service-type
                         home-picom-shepherd-service)))
                 (compose concatenate)
-                (extend home-picom-extension)
                 (default-value (home-picom-configuration))
                 (description "Configure Picom")))
 
-- 
cgit v1.2.3-54-g00ecf