GNU bug report logs - #72714
[PATCH] home: services: Add 'home-sway-service-type'.

Previous Next

Package: guix-patches;

Reported by: Arnaud Daby-Seesaram <ds-ac <at> nanein.fr>

Date: Mon, 19 Aug 2024 15:33:02 UTC

Severity: normal

Tags: patch

Done: "pelzflorian (Florian Pelz)" <pelzflorian <at> pelzflorian.de>

Bug is archived. No further changes may be made.

Full log


View this message in rfc822 format

From: help-debbugs <at> gnu.org (GNU bug Tracking System)
To: "pelzflorian (Florian Pelz)" <pelzflorian <at> pelzflorian.de>
Cc: tracker <at> debbugs.gnu.org
Subject: bug#72714: closed ([PATCH] home: services: Add 'home-sway-service-type'.)
Date: Sat, 12 Oct 2024 13:13:02 +0000
[Message part 1 (text/plain, inline)]
Your message dated Sat, 12 Oct 2024 15:11:56 +0200
with message-id <87iktx79er.fsf <at> pelzflorian.de>
and subject line Re: [PATCH v8] home: services: Add 'home-sway-service-type'.
has caused the debbugs.gnu.org bug report #72714,
regarding [PATCH] home: services: Add 'home-sway-service-type'.
to be marked as done.

(If you believe you have received this mail in error, please contact
help-debbugs <at> gnu.org.)


-- 
72714: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=72714
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
From: Arnaud Daby-Seesaram <ds-ac <at> nanein.fr>
To: guix-patches <at> gnu.org
Cc: Arnaud Daby-Seesaram <ds-ac <at> nanein.fr>
Subject: [PATCH] home: services: Add 'home-sway-service-type'.
Date: Mon, 19 Aug 2024 17:30:42 +0200
* gnu/home/services/sway.scm (home-sway-service-type): New variable.
  (sway-configuration): New configuration record.
  (sway-bar): New configuration record.
  (sway-output): New configuration record.
  (sway-input): New configuration record.
  (point): New configuration record.
  (sway-color): New configuration record.
  (sway-border-color): New configuration record.
  (flatten): New procedure.

Change-Id: Ia29a4173ce3a887d5fac3f57ba3819a52f9624d3
---
This patch provides an *experimental* home service to configure sway.

It defines a configuration record that contains fields for common
options of sway (an extra-contents field that can be used for
additional settings).  The service also adds packages to the user
profile (notably sway).

Feedback is welcome !

Please note that (1) I only use Guile for Guix, so my code might be
clumsy and non-idiomatic¹ and (2) the patch is experimental, and will
need polishing before being merged.  For example, I am not sure when I
should allow G-expressions in the configuration.
                              ¹: feel free to share your opinions on
                                 how to improve the code.

I have not written any documentation at the time (even documentation
strings in the configuration records are not well defined).  I am
waiting for the code structure and configuration records to be
stable-ish to take the time to write a documentation.

 gnu/home/services/sway.scm | 622 +++++++++++++++++++++++++++++++++++++
 1 file changed, 622 insertions(+)
 create mode 100644 gnu/home/services/sway.scm

diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..3f978d0bf0
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,622 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac <at> nanein.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services sway)
+  #:use-module (guix monads)
+  #:use-module (guix modules)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (guix packages)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu home services)
+  #:use-module (gnu packages freedesktop)
+  #:use-module (gnu packages xdisorg)
+  #:use-module (gnu packages image)
+  #:use-module (gnu packages gnome)
+  #:use-module (gnu packages wm)
+  #:use-module (gnu packages emacs)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages suckless)
+  #:use-module (gnu packages glib)
+  #:export (;; Accessors and predicates do not need to be exported.
+            sway-configuration
+            sway-bar
+            sway-output
+            sway-input
+            point
+            sway-color
+            sway-border-color
+            home-sway-service-type))
+
+;; Helper function.
+(define (flatten l)
+  (let loop ((lst l) (acc '()))
+    (match lst
+      (() acc)
+      ((head . tail)
+       (loop tail (append acc head))))))
+
+
+;;;
+;;; Default settings.
+;;;
+
+(define %sway-default-variables
+  `((mod   . "Mod4")
+    (left  . "h")
+    (down  . "j")
+    (up    . "k")
+    (right . "l")
+    (term  . ,#~(string-append #$st "/bin/st"))
+    (menu  . ,#~(string-append #$dmenu "/bin/dmenu_run"))))
+
+(define %sway-default-gestures
+  `((swipe:3:right . "workspace next_on_output")
+    (swipe:3:left  . "workspace prev_on_output")
+    (swipe:3:down  . "move to scratchpad")
+    (swipe:3:up    . "scratchpad show")
+    (pinch:2:clockwise
+     . "move container to workspace prev_on_output")
+    (pinch:2:counterclockwise
+     . "move container to workspace next_on_output")
+    (swipe:4:left  . "exec alacritty")
+    (swipe:4:right . "exec qutebrowser")
+    (swipe:4:down . "exec st")
+    (swipe:4:up
+     . ,#~(string-append
+           "exec " #$emacs "/bin/emacsclient -a '"
+           #$libnotify "/bin/notify-send Oups \"emacs not loaded :/\"' -c"))
+    (pinch:inward+right . "resize shrink width")
+    (pinch:inward+left . "resize grow width")
+    (pinch:inward+down . "resize shrink height")
+    (pinch:inward+up . "resize grow height")
+    (pinch:outward+up . "move up")
+    (pinch:outward+down . "move down")
+    (pinch:outward+left . "move left")
+    (pinch:outward+right . "move right")))
+
+(define %sway-default-keybindings
+  `(($mod+Shift+e
+     . ,#~(string-append
+           "exec " #$emacs
+           "/bin/emacsclient -a '"
+           #$libnotify "/bin/notify-send Oups \"emacs not loaded :/\"' -c"))
+    ($mod+Return . "exec $term")
+    ($mod+Shift+c . "kill")
+    ($mod+p . "exec $menu")
+    ($mod+Shift+r . "reload")
+    ($mod+Shift+q
+     . ,#~(string-append
+           "exec " #$sway "/bin/swaynag -t warning "
+           "-m 'You pressed the exit shortcut. Do you really want to exit sway?"
+           " This will end your Wayland session.'"
+           " -B 'Yes, exit sway' 'swaymsg exit'"))
+    ($mod+$left . "focus left")
+    ($mod+$right . "focus right")
+    ($mod+$up . "focus up")
+    ($mod+$down . "focus down")
+    ($mod+Shift+$left . "move left")
+    ($mod+Shift+$right . "move right")
+    ($mod+Shift+$up . "move up")
+    ($mod+Shift+$down . "move down")
+    ($mod+ampersand . "workspace number 1")
+    ($mod+eacute . "workspace number 2")
+    ($mod+quotedbl . "workspace number 3")
+    ($mod+apostrophe . "workspace number 4")
+    ($mod+parenleft . "workspace number 5")
+    ($mod+minus . "workspace number 6")
+    ($mod+egrave . "workspace number 7")
+    ($mod+underscore . "workspace number 8")
+    ($mod+ccedilla . "workspace number 9")
+    ($mod+agrave . "workspace number 10")
+    ($mod+Shift+ampersand . "move container to workspace number 1")
+    ($mod+Shift+eacute . "move container to workspace number 2")
+    ($mod+Shift+quotedbl . "move container to workspace number 3")
+    ($mod+Shift+apostrophe . "move container to workspace number 4")
+    ($mod+Shift+parenleft . "move container to workspace number 5")
+    ($mod+Shift+minus . "move container to workspace number 6")
+    ($mod+Shift+egrave . "move container to workspace number 7")
+    ($mod+Shift+underscore . "move container to workspace number 8")
+    ($mod+Shift+ccedilla . "move container to workspace number 9")
+    ($mod+Shift+agrave . "move container to workspace number 10")
+    ($mod+b . "splith")
+    ($mod+v . "splitv")
+    ($mod+s . "layout stacking")
+    ($mod+w . "layout tabbed")
+    ($mod+e . "layout toggle split")
+    ($mod+f . "fullscreen")
+    ($mod+Shift+space . "floating toggle")
+    ($mod+space . "focus mode_toggle")
+    ($mod+z . "focus parent")
+    ($mod+Shift+o . "move scratchpad")
+    ($mod+o . "scratchpad show")
+    ($mod+r . "mode \"resize\"")
+    ($mod+Shift+n . "bar mode toggle")
+    ($mod+Shift+b . "border toggle")
+    ($mod+tab . "workspace back_and_forth")))
+
+
+;;;
+;;; Definition of configurations.
+;;;
+
+(define (list-of-string-or-gexp? lst)
+  (every (lambda (elt)
+           (or (string? elt)
+               (gexp? elt)))
+         lst))
+
+(define (list-of-packages? lst)
+  (every package? lst))
+
+(define (bar-position? p)
+  (member p '(top bottom)))
+
+(define (hidden-state? st)
+  (member st '(hide show)))
+
+(define (string-or-symbol? s)
+  (or (string? s)
+      (symbol? s)))
+
+(define (strings? lst)
+  (every string? lst))
+
+(define-maybe string (no-serialization))
+(define-maybe strings (no-serialization))
+
+(define-configuration/no-serialization sway-input
+  (identifier
+   (string-or-symbol '*)
+   "Identifier of the input.")
+  (xkb-layout
+   maybe-string
+   "Keyboard layout.")
+  (xkb-model
+   maybe-string
+   "Keyboard model.")
+  (xkb-options
+   maybe-strings
+   "Keyboard options.")
+  (xkb-variant
+   maybe-string
+   "Keyboard layout variant.")
+  (extra-content
+   (list-of-string-or-gexp '())
+   "Lines to add at the end of the configuration file."))
+
+(define (sway-inputs? lst)
+  (every sway-input? lst))
+
+(define-configuration/no-serialization sway-border-color
+  (border
+   string
+   "Border color.")
+  (background
+   string
+   "Background color.")
+  (text
+   string
+   "Text color."))
+
+(define-maybe sway-border-color (no-serialization))
+
+(define-configuration/no-serialization sway-color
+  (background
+   maybe-string
+   "Background color of the bar.")
+  (statusline
+   maybe-string
+   "Text color of the separator.")
+  (focused-background
+   maybe-string
+   "Background color of the bar on the currently focused monitor.")
+  (focused-statusline
+   maybe-string
+   "Text color of the statusline on the currently focused monitor.")
+  (focused-workspace
+   maybe-sway-border-color
+   "...")
+  (active-workspace
+   maybe-sway-border-color
+   "...")
+  (inactive-workspace
+   maybe-sway-border-color
+   "...")
+  (urgent-workspace
+   maybe-sway-border-color
+   "...")
+  (binding-mode
+   maybe-sway-border-color
+   "..."))
+
+(define-maybe sway-color (no-serialization))
+
+(define-configuration/no-serialization sway-bar
+  (identifier
+   (symbol 'bar0)
+   "Identifier of the bar.")
+  (position
+   (bar-position 'top)
+   "Position of the bar.")
+  (hidden-state
+   (hidden-state 'hide)
+   "Hidden state.")
+  (binding-mode-indicator
+   (boolean #t)
+   "Binding indicator.")
+  (colors
+   maybe-sway-color
+   "Color palette of the bar.")
+  (status-command
+   (file-like
+    (program-file
+     "sway-bar-status"
+     (with-imported-modules
+         (source-module-closure
+          '((ice-9 textual-ports) (ice-9 regex) (ice-9 popen) (ice-9 format)
+            (srfi srfi-19)))
+       #~(begin
+           (use-modules (ice-9 textual-ports)
+                        (ice-9 format)
+                        (ice-9 popen)
+                        (ice-9 regex)
+                        (srfi srfi-19))
+           (let loop ()
+             (let* ((date (date->string (current-date) "~a ~D ~H:~M:~S"))
+                    (batline (let* ((p (open-pipe*
+                                        OPEN_READ
+                                        #$(file-append acpi "/bin/acpi") "-b"))
+                                    (bat (get-line p)))
+                               (close-pipe p)
+                               bat))
+                    (bat (match:substring (string-match "[0-9]+%" batline))))
+               (format #t "~a - ~a~%~!" bat date)
+               (sleep 1)
+               (loop)))))))
+    "Status command.  It must be file-like."))
+
+(define-configuration/no-serialization point
+  (x integer "X coordinate.")
+  (y integer "Y coordinate."))
+
+(define-maybe point (no-serialization))
+(define-maybe file-like (no-serialization))
+
+(define-configuration/no-serialization sway-output
+  (identifier
+   (string-or-symbol '*)
+   "Identifier of the output.")
+  (resolution
+   maybe-string
+   "Mode of the monitor.")
+  (position
+   maybe-point
+   "Position of the monitor.")
+  (bg
+   maybe-file-like
+   "Background image.")
+  (extra-content
+   (list-of-string-or-gexp '())
+   "Extra lines."))
+
+(define (sway-outputs? lst)
+  (every sway-output? lst))
+
+(define-configuration/no-serialization sway-configuration
+  (keybindings
+   (alist %sway-default-keybindings)
+   "Keybindings.")
+  (gestures
+   (alist %sway-default-gestures)
+   "Gestures.")
+  (packages
+   (list-of-packages
+    (list sway swaylock waybar swaybg slurp grim dmenu bemenu
+          dbus xdg-desktop-portal-wlr xdg-desktop-portal))
+   "List of packages to add to the profile.")
+  (variables
+   (alist %sway-default-variables)
+   "Variables declared at the beginning of the file.")
+  (inputs
+   (sway-inputs (list (sway-input)))
+   "Inputs.")
+  (outputs
+   (sway-outputs '())
+   "Outputs.")
+  (bar
+   (sway-bar (sway-bar))
+   "Bar configuration.")
+  (execs
+   (list-of-string-or-gexp '())
+   "Programs to execute at startup time.")
+  (extra-content
+   (list-of-string-or-gexp '())
+   "Lines to add at the end of the configuration file."))
+
+
+;;;
+;;; Serialization functions.
+;;;
+
+(define (serialize-keybinding var)
+  (let ((name (symbol->string (car var)))
+        (value (cdr var)))
+    #~(string-append "bindsym " #$name " " #$value)))
+
+(define (serialize-gesture var)
+  (let ((name (symbol->string (car var)))
+        (value (cdr var)))
+    #~(string-append "bindgesture " #$name " " #$value)))
+
+(define (serialize-variable var)
+  (let ((name (symbol->string (car var)))
+        (value (cdr var)))
+    #~(string-append "set $" #$name " " #$value)))
+
+(define (serialize-exec exe)
+  #~(string-append "exec " #$exe))
+
+(define (serialize-output out)
+  (let* ((pre-ident (sway-output-identifier out))
+         (ident (if (symbol? pre-ident)
+                    (symbol->string pre-ident)
+                    (string-append "\"" pre-ident "\"")))
+         (bg (sway-output-bg out))
+         (resolution (sway-output-resolution out))
+         (position (sway-output-position out))
+         (extra-content (sway-output-extra-content out)))
+    (append
+     (filter
+      (lambda (elt) (not (eq? elt %unset-value)))
+      (list
+       ;; Beginning of the block.
+       #~(string-append "output " #$ident " {")
+       ;; Optional elements.
+       (if (eq? %unset-value bg)
+           %unset-value
+           #~(string-append "    bg " #$bg " fill"))
+       (if (eq? %unset-value resolution)
+           %unset-value
+           (string-append "    resolution " resolution))
+       (if (eq? %unset-value position)
+           %unset-value
+           (string-append "    position " (number->string (point-x position))
+                          " " (number->string (point-y position))))))
+       extra-content
+       ;; End of the block.
+       '("}"))))
+
+(define-inlinable (add-line-if prefix value)
+  (if (eq? %unset-value value)
+      %unset-value
+      (string-append prefix " " value)))
+
+(define (serialize-input input)
+  (let* ((pre-ident (sway-input-identifier input))
+         (ident (if (symbol? pre-ident)
+                    (symbol->string pre-ident)
+                    (string-append "\"" pre-ident "\"")))
+         (xkb-layout (sway-input-xkb-layout input))
+         (xkb-model (sway-input-xkb-model input))
+         (xkb-variant (sway-input-xkb-variant input))
+         (xkb-options (sway-input-xkb-options input)))
+    (append
+     (filter
+      (lambda (elt) (not (eq? elt %unset-value)))
+      (list
+       (string-append "input " ident " {")
+       ;; Optional.
+       (add-line-if "    xkb_layout" xkb-layout)
+       (add-line-if "    xkb_model" xkb-model)
+       (add-line-if "    xkb_variant" xkb-variant)
+       (if (eq? %unset-value xkb-options)
+           %unset-value
+           (string-concatenate (cons "    xkb_options " xkb-options)))))
+     (map (lambda (s)
+            (string-append (string-pad "" 4) s))
+          (sway-input-extra-content input))
+     '("}"))))
+
+(define (serialize-colors colors)
+  (define (add-border-color-if name val)
+    (if (eq? %unset-value val)
+        %unset-value
+        (string-append
+         name
+         " " (sway-border-color-border val)
+         " " (sway-border-color-background val)
+         " " (sway-border-color-text val))))
+  (let ((background (sway-color-background colors))
+        (statusline (sway-color-statusline colors))
+        (focused-background (sway-color-focused-background colors))
+        (focused-statusline (sway-color-focused-statusline colors))
+        (focused-workspace (sway-color-focused-workspace colors))
+        (active-workspace (sway-color-active-workspace colors))
+        (inactive-workspace (sway-color-inactive-workspace colors))
+        (urgent-workspace (sway-color-urgent-workspace colors))
+        (binding-mode (sway-color-binding-mode colors)))
+    (filter
+     (lambda (elt) (not (eq? elt %unset-value)))
+     (list
+      (add-line-if "background" background)
+      (add-line-if "statusline" statusline)
+      (add-line-if "focused_background" focused-background)
+      (add-line-if "focused_statusline" focused-statusline)
+      (add-border-color-if "focused_workspace" focused-workspace)
+      (add-border-color-if "active_workspace" active-workspace)
+      (add-border-color-if "inactive_workspace" inactive-workspace)
+      (add-border-color-if "urgent_workspace" urgent-workspace)
+      (add-border-color-if "binding_mode" binding-mode)))))
+
+(define (make-sway-config conf)
+  (let* ((extra (sway-configuration-extra-content conf))
+         (bar (sway-configuration-bar conf)))
+
+    (with-imported-modules
+        (source-module-closure
+         '((ice-9 popen) (ice-9 match) (ice-9 format) (guix monads)))
+      (computed-file
+       "sway-config"
+       #~(begin
+           (use-modules (ice-9 format) (ice-9 popen) (ice-9 match)
+                        (guix monads))
+           ;; Helper functions to pretty-print the configuration file.
+           (define (line s)
+             (lambda (port)
+               (lambda (i)
+                 (format port "~a~a~%" (string-pad "" i) s)
+                 (values port i))))
+           (define (lines lst)
+             (lambda (port)
+               (lambda (i)
+                 (let loop ((l lst))
+                   (match l
+                     (() #t)
+                     ((head . tail)
+                      (format port "~a~a~%" (string-pad "" i)
+                              (if (list? head)
+                                  (string-concatenate head)
+                                  head))
+                      (loop tail))))
+                 (values port i))))
+           (define-syntax line*
+             (syntax-rules ()
+               ((line* elt ...)
+                (lines (list elt ...)))))
+           (define-syntax line2
+             (syntax-rules ()
+               ((line2 a b)
+                (line (string-append a b)))))
+           (define (indent k)
+             (lambda (port)
+               (lambda (i)
+                 (values port (+ i k)))))
+           (define (begin-block name)
+             (lambda (port)
+               (lambda (i)
+                 (format port "~a~a {~%" (string-pad "" i) name)
+                 (values port (+ i 4)))))
+           (define (end-block)
+             (lambda (port)
+               (lambda (i)
+                 (let ((i (- i 4)))
+                   (format port "~a}~%" (string-pad "" i))
+                   (values port i)))))
+
+           (let* ((file #$output)
+                  (port (open-output-file #$output)))
+             ;; The previous iteration of this work computed the content of the
+             ;; configuration file as a string.  The state monad was used to
+             ;; keep track of the state during the computation.
+             ;; However, this first approach was too expensive.  Now that I use
+             ;; `computed-file', the "computed value" is the constant port to
+             ;; which I write.  Thus, using the state monad is overkill here.
+             ;; It can be replaced by the identity monad, where the value being
+             ;; passed around is the pair of `port' and the indentation level.
+             (run-with-state
+                 (with-monad
+                     %state-monad
+                   (>>= (return port)
+                        ;; Header of the configuration file.
+                        (line*
+                         "#####################################"
+                         "### Auto-generated configuration. ###"
+                         "#####################################"
+                         "# DO NOT EDIT MANUALLY." "")
+                        (line*
+                         "# Variables."
+                         "# =========="
+                         #$@(map serialize-variable
+                                 (sway-configuration-variables conf)) "")
+                        (line*
+                         "# Outputs."
+                         "# ========"
+                         #$@(flatten
+                             (map serialize-output
+                                  (sway-configuration-outputs conf))) "")
+                        (line*
+                         "# Inputs."
+                         "# ======="
+                         #$@(flatten
+                             (map serialize-input
+                                  (sway-configuration-inputs conf))) "")
+                        (line* "# Bar configuration."
+                               "# ==================")
+                        (begin-block
+                         (string-append
+                          "bar " #$(symbol->string
+                                    (sway-bar-identifier bar))))
+                        (line2 "position " #$(symbol->string
+                                              (sway-bar-position bar)))
+                        (line2 "hidden_state "
+                               #$(symbol->string
+                                  (sway-bar-hidden-state bar)))
+                        (line2 "status_command "
+                               #$(sway-bar-status-command bar))
+                        (line2 "binding_mode_indicator "
+                               #$(if (sway-bar-binding-mode-indicator bar)
+                                     "true" "false"))
+                        (begin-block "colors")
+                        (line*
+                         #$@(serialize-colors (sway-bar-colors bar)))
+                        (end-block) ;; colors
+                        (end-block) ;; bar
+                        (line*
+                         "" "# Extra configuration content."
+                         "# ============================"
+                         #$@extra "")
+                        (line*
+                         "# Keybindings."
+                         "# ============"
+                         #$@(map serialize-keybinding
+                                 (sway-configuration-keybindings conf))
+                         "")
+                        (line*
+                         "# Gestures."
+                         "# ========="
+                         #$@(map serialize-gesture
+                                 (sway-configuration-gestures conf)) "")
+                        (line*
+                         "# Programs to execute."
+                         "# ===================="
+                         #$@(map serialize-exec
+                                 (sway-configuration-execs conf)))))
+               0)))))))
+
+(define (sway-configuration->file sway-conf)
+  `((".config/sway/config"
+     ,(make-sway-config
+       sway-conf))))
+
+(define home-sway-service-type
+  (service-type
+   (name 'home-sway-config)
+   (extensions
+    (list (service-extension home-files-service-type
+                             sway-configuration->file)
+          (service-extension home-profile-service-type
+                             sway-configuration-packages)))
+   (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+   (default-value (sway-configuration))))

base-commit: d3832de763777759eb1f56e20731cb39da4c7b5b
-- 
2.45.2



[Message part 3 (message/rfc822, inline)]
From: "pelzflorian (Florian Pelz)" <pelzflorian <at> pelzflorian.de>
To: Arnaud Daby-Seesaram <ds-ac <at> nanein.fr>
Cc: Hilton Chain <hako <at> ultrarare.space>,
 Ludovic Courtès <ludo <at> gnu.org>, 72714-done <at> debbugs.gnu.org
Subject: Re: [PATCH v8] home: services: Add 'home-sway-service-type'.
Date: Sat, 12 Oct 2024 15:11:56 +0200
[Message part 4 (text/plain, inline)]
Pushed as b64f7984a5e2aba04df72a92f0044e423efe77c6,
Change-Id: I880261570c5afdb795f2ce18bac2b9a5c898677f
with tiny changes.

[diff (text/plain, inline)]
---
 doc/guix.texi              | 16 ++++++++--------
 gnu/home/services/sway.scm | 24 ++++++++----------------
 2 files changed, 16 insertions(+), 24 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 0f45ef3b15..ddbff8bc23 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47170,13 +47170,13 @@ Sway window manager
 want to do so, you might be interested in using
 @code{greetd-wlgreet-sway-session} instead.
 
-The function @code{sway-configuration->file} defined below can be used
+The proceedure @code{sway-configuration->file} defined below can be used
 to provide the value for the @emph{optional} @code{sway-configuration}
 field of @code{greetd-wlgreet-sway-session}.
 @end quotation
 
 @deffn {Procedure} sway-configuration->file config
-This function takes one argument @code{config}, which must be a
+This procedure takes one argument @code{config}, which must be a
 @code{sway-configuration} record (defined below), and returns a
 file-like object representing the serialized configuration.
 @end deffn
@@ -47263,11 +47263,11 @@ Sway window manager
 @item @code{startup+reload-programs} (default: @code{'()})
 Programs to execute at startup time @emph{and} after every configuration
 reload.  The value of this field is a list of strings, G-expressions or
-file-append objects (@pxref{G-Expressions}).
+file-like objects (@pxref{G-Expressions}).
 
 @item @code{startup-programs} (default: @code{%sway-default-execs})
 Programs to execute at startup time.  As above, values of this field are
-a list of strings, G-expressions or file-append objects.
+a list of strings, G-expressions or file-like objects.
 
 The default value, @code{%sway-default-execs}, executes @code{swayidle}
 in order to lock the screen after 5@ minutes of inactivity (displaying a
@@ -47283,7 +47283,7 @@ Sway window manager
 @deftp {Data Type} sway-input
 @code{sway-input} records describe input blocks (see@
 @cite{sway-input(5)}).  For example, the following snippet makes all
-keyboards use a french layout, in which @kbd{capslock} has been remaped
+keyboards use a French layout, in which @kbd{capslock} has been remapped
 to @kbd{ctrl}:
 @lisp
 (sway-input (identifier "type:keyboard")
@@ -47365,8 +47365,8 @@ Sway window manager
 the wallpaper will be displayed.  It must be a symbol among
 @code{stretch}, @code{fill}, @code{fit}, @code{center} and @code{tile}.
 
-If the second element is not specified (@i{i.e.}@: when the value not a
-pair), the @code{fill} mode will be used.
+If the second element is not specified (@i{i.e.}@: when the value is not
+a pair), the @code{fill} mode will be used.
 @end itemize
 
 @quotation Note
@@ -47444,7 +47444,7 @@ Sway window manager
 @item @code{colors} (optional)
 An optional @code{sway-color} configuration record.
 
-@item @code{status-command} (default: @code{%sway-status-command})
+@item @code{status-command} (optional)
 This field accept strings, G-expressions and executable file-like
 values.  The default value is a command (string) that prints the date
 and time every second.
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
index 9401c80400..0e1a2d57b2 100644
--- a/gnu/home/services/sway.scm
+++ b/gnu/home/services/sway.scm
@@ -20,9 +20,6 @@ (define-module (gnu home services sway)
   #:use-module (guix modules)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 popen)
-  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (guix packages)
   #:use-module (gnu system keyboard)
@@ -52,7 +49,6 @@ (define-module (gnu home services sway)
             %sway-default-gestures
             %sway-default-modes
             %sway-default-keybindings
-            %sway-default-status-command
             %sway-default-startup-programs
             %sway-default-packages))
 
@@ -221,7 +217,7 @@ (define-configuration/no-serialization sway-bar
    "Color palette of the bar.")
   (status-command
    maybe-status-command
-   "Status command.  It must be file-like.")
+   "Status command.")
   (mouse-bindings
    (mouse-bindings '())
    "Actions triggered by mouse events.")
@@ -275,7 +271,6 @@ (define-configuration/no-serialization sway-mode
   (mouse-bindings
    (mouse-bindings '())
    "Mouse bindings."))
-;; TODO (not necessary for 72714): switch bindings.
 
 (define (sway-modes? lst)
   (every sway-mode? lst))
@@ -327,10 +322,10 @@ (define sway-menu
    (with-imported-modules
        (source-module-closure '((guix build utils)))
      #~(begin
-         (use-modules (ice-9 popen)
+         (use-modules (ice-9 ftw)
+                      (ice-9 popen)
                       (ice-9 receive)
                       (ice-9 rdelim)
-                      (ice-9 ftw)
                       (guix build utils)
                       (srfi srfi-1))
 
@@ -351,7 +346,7 @@ (define sway-menu
                                     "/.guix-home/profile/bin"))
                (wmenu #$(file-append wmenu "/bin/wmenu"))
                (swaymsg #$(file-append sway "/bin/swaymsg")))
-           (receive (from to pid)
+           (receive (from to pids)
                (pipeline `((,wmenu)))
              (for-each
               (lambda (c) (format to "~a~%" c))
@@ -359,8 +354,8 @@ (define sway-menu
              (close to)
              (let ((choice (read-line from)))
                (close from)
-               (waitpid (first pid))
-               (when (string? choice) ;do not attempty to launch if no choice
+               (waitpid (first pids))
+               (when (string? choice) ;do not attempt to launch if no choice
                                       ;was given (e.g. if Escape is pressed in
                                       ;wmenu).
                  (execl swaymsg swaymsg "exec" "--"
@@ -464,9 +459,6 @@ (define %sway-default-keybindings
     ($mod+minus . "scratchpad show")
     ($mod+r . "mode \"resize\"")))
 
-(define %sway-default-status-command
-  "while date +'%Y-%m-%d %X'; do sleep 1; done")
-
 (define %sway-default-startup-programs
   (list
    #~(string-append
@@ -751,7 +743,7 @@ (define (sway-configuration->file conf)
     (computed-file
      "sway-config"
      #~(begin
-         (use-modules (ice-9 format) (ice-9 popen) (ice-9 match)
+         (use-modules (ice-9 format) (ice-9 match) 
                       (srfi srfi-1))
 
          (call-with-output-file #$output
@@ -859,7 +851,7 @@ (define (sway-configuration->file conf)
 
 
 ;;;
-;;; Definition of th Home Service.
+;;; Definition of the Home Service.
 ;;;
 
 (define (sway-configuration->files sway-conf)

-- 
2.45.2

[Message part 6 (text/plain, inline)]
I also reindented the commit message and put a line break because the
last line did not fit on my terminal.

Thank you greatly!

Regards,
Florian

This bug report was last modified 280 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.