* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
@ 2024-08-19 15:30 Arnaud Daby-Seesaram via Guix-patches via
2024-08-24 15:32 ` [bug#72714] [PATCH v2] " Arnaud Daby-Seesaram via Guix-patches via
` (4 more replies)
0 siblings, 5 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-08-19 15:30 UTC (permalink / raw)
To: 72714; +Cc: Arnaud Daby-Seesaram
* 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@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))))))
+
+\f
+;;;
+;;; 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")))
+
+\f
+;;;
+;;; 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."))
+
+\f
+;;;
+;;; 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
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v2] home: services: Add 'home-sway-service-type'.
2024-08-19 15:30 [bug#72714] [PATCH] home: services: Add 'home-sway-service-type' Arnaud Daby-Seesaram via Guix-patches via
@ 2024-08-24 15:32 ` Arnaud Daby-Seesaram via Guix-patches via
2024-08-26 10:38 ` [bug#72714] [PATCH v3] " Arnaud Daby-Seesaram via Guix-patches via
` (3 subsequent siblings)
4 siblings, 0 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-08-24 15:32 UTC (permalink / raw)
To: 72714; +Cc: Arnaud Daby-Seesaram
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
Change-Id: Iad4fee02d1c243eb051245277f2e2643523e6d27
---
This V2 slightly improves my code and adds a TeXinfo documentation. (I also
modified local.mk, which I forgot last time).
doc/guix.texi | 255 +++++++++++++++
gnu/home/services/sway.scm | 630 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 886 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index fcaf6b3fbb..c69a021a77 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -129,6 +129,7 @@
Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -45161,6 +45162,7 @@ Home Services
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
* Networking: Networking Home Services. Networking services.
+* Sway: Sway window manager. Setting up the sway configuration.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@c In addition to that Home Services can provide
@@ -47074,6 +47076,259 @@ Media Home Services
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+@cindex Sway, Home service
+
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure sway in a
+declarative way.
+
+@quotation Note
+This home service only sets up configuration file and profile packages
+for sway. It does @i{not} start sway in any way. If you 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
+to provide the value for the @code{sway-configuration} field of
+@code{greetd-wlgreet-sway-session}.
+@end quotation
+
+@defvar sway-configuration->file
+This function takes a @code{sway-configuration} record (defined below),
+and returns a file-like object represented the serialized configuration.
+@end defvar
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding sway-related packages to your profile.
+@end itemize
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(define bg-file
+ (computed-file
+ "background.png"
+ #~(let* ((insvg (string-append
+ #$guix-backgrounds
+ "/share/backgrounds/guix/guix-checkered-16-9.svg"))
+ (out #$output)
+ (cmd (string-append
+ #$librsvg "/bin/rsvg-convert " insvg " -o " out)))
+ (system cmd))))
+
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg bg-file))))))
+@end lisp
+
+The above example describes a sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.svg} is provided by
+the @code{guix-background} package;
+@item
+swiping down (resp.@ up) with three fingers moves the active window to
+the scratchpad (resp.@ shows/hides the scratchpad).
+@end itemize
+@end defvar
+
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are strings.
+
+Example: @code{'(mod . "Mod4")}.
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+The value of this field is an association list in which keys are symbols
+and values are strings or G-expressions (@pxref{G-Expressions}).
+
+Examples using:
+@itemize
+@item
+a string: @code{'($mod+Return . "exec $term")}
+@item
+a G-exp: @code{`($mod+t . ,#~(string-append #$st "/bin/st"))}
+@end itemize
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+This value of this field is an association list, as for keybindings.
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile.
+
+@item @code{inputs} (default: @code{(list (sway-input))})
+List of @code{sway-input} configuration records.
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records.
+
+@item @code{bar} (default: @code{(sway-bar)})
+Bar configuration.
+
+@item @code{always-execs} (default: @code{'()})
+Programs to execute at startup time @i{and} after every configuration
+reload. The value of this field is a list of strings or G-expressions.
+
+@item @code{execs} (default: @code{'()})
+Programs to execute at startup time. The value of this field is a list
+of strings or G-expressions.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+
+@end table
+@end deftp
+
+@deftp {Data Type} sway-input
+@code{sway-input} records describe input blocks
+(see@ @cite{sway-input(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If a
+string is used, it will be quoted in the generated configuration file.
+
+@item @code{xkb-layout} (optional)
+Keyboard specific option. Comma-separated keyboard layout(s) to use.
+
+@item @code{xkb-model} (optional)
+Keyboard specific option. String providing the keyboard model.
+
+@item @code{xkb-options} (optional)
+Keyboard specific option. Additional xkb options for the keyboard.
+
+@item @code{xkb-variant} (optional)
+Keyboard specific option. String specifying the variant of the layout.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list of
+strings or G-expressions.
+
+@end table
+
+For example, the following snippet makes all keyboards use a french
+layout, in which @kbd{capslock} has been remaped to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (xkb-layout "fr")
+ (xkb-options '("ctrl:nocaps")))
+@end lisp
+@end deftp
+
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+@item @code{resolution} (optional)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{bg} (optional)
+This field accepts a file-like value representing the wallpaper to use
+on this monitor. It will be used with the @code{fill} option.
+
+@item @code{extra-content} (default: @code{'()})
+Any additional lines to be added to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-border-color
+
+@table @asis
+@item @code{border} Color of the border.
+@item @code{background} Color of the background.
+@item @code{text} Color of the text.
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background}
+@item @code{statusline}
+@item @code{focused-background}
+@item @code{focused-statusline}
+@item @code{focused-workspace}
+@item @code{active-workspace}
+@item @code{inactive-workspace}
+@item @code{urgent-workspace}
+@item @code{binding-mode}
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a string.
+
+@item @code{position} (default: @code{'top})
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (default: @code{'hide})
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{show}.
+
+@item @code{binding-mode-indicator} (default: @code{#t})
+Enable or disable the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+This field accept executable file-like values. The default value is a
+script that prints the battery information (retrieved using
+@code{acpi}), date and time every second.
+
+Each line printed on @code{stdout} by this script will be displayed on
+the status area of the bar.
+
+@end table
+@end deftp
+
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..dc399015ed
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,630 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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
+ sway-configuration->file
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ ))
+
+;; Helper function.
+(define (flatten l)
+ (let loop ((lst l) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (loop tail (append acc head))))))
+
+\f
+;;;
+;;; 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")))
+
+(define %sway-default-status-command
+ (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)))))))
+
+\f
+;;;
+;;; 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 %sway-default-status-command)
+ "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.")
+ (always-execs
+ (list-of-string-or-gexp '())
+ "Programs to execute at startup time.")
+ (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."))
+
+\f
+;;;
+;;; 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 b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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 (sway-configuration->file 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))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Helper functions to pretty-print the configuration file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (string-pad "" i) s)
+ i))
+ (define (lines lst)
+ (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))))
+ 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 (i)
+ (+ i k)))
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (string-pad "" i) name)
+ (+ i 4)))
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (string-pad "" i))
+ i)))
+
+ ;; The value that is threaded in the following block is the
+ ;; indentation level.
+ (with-monad %identity-monad
+ (>>=
+ ;; We start with no indentation at all.
+ (return 0)
+ ;; 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. (at startup & after reloads)"
+ "# ===================="
+ #$@(map (serialize-exec #t)
+ (sway-configuration-always-execs conf)))
+ (line*
+ "# Programs to execute. (at startup)"
+ "# ===================="
+ #$@(map (serialize-exec #f)
+ (sway-configuration-execs conf)))))))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index ad5494fe95..15788b2fb0 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -112,6 +112,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
base-commit: f10cbebd7b6cfeb66e91851616fdc75f9a0bbe69
--
2.45.2
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v3] home: services: Add 'home-sway-service-type'.
2024-08-19 15:30 [bug#72714] [PATCH] home: services: Add 'home-sway-service-type' Arnaud Daby-Seesaram via Guix-patches via
2024-08-24 15:32 ` [bug#72714] [PATCH v2] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-08-26 10:38 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-03 7:27 ` [bug#72714] [PATCH v4] " Arnaud Daby-Seesaram via Guix-patches via
` (2 subsequent siblings)
4 siblings, 0 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-08-26 10:38 UTC (permalink / raw)
To: 72714; +Cc: Arnaud Daby-Seesaram
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
Change-Id: Iad4fee02d1c243eb051245277f2e2643523e6d27
---
Minor fix: do not attempt to serialise bar colours if none are specified.
doc/guix.texi | 255 +++++++++++++++
gnu/home/services/sway.scm | 632 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 888 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index fcaf6b3fbb..c69a021a77 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -129,6 +129,7 @@
Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -45161,6 +45162,7 @@ Home Services
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
* Networking: Networking Home Services. Networking services.
+* Sway: Sway window manager. Setting up the sway configuration.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@c In addition to that Home Services can provide
@@ -47074,6 +47076,259 @@ Media Home Services
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+@cindex Sway, Home service
+
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure sway in a
+declarative way.
+
+@quotation Note
+This home service only sets up configuration file and profile packages
+for sway. It does @i{not} start sway in any way. If you 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
+to provide the value for the @code{sway-configuration} field of
+@code{greetd-wlgreet-sway-session}.
+@end quotation
+
+@defvar sway-configuration->file
+This function takes a @code{sway-configuration} record (defined below),
+and returns a file-like object represented the serialized configuration.
+@end defvar
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding sway-related packages to your profile.
+@end itemize
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(define bg-file
+ (computed-file
+ "background.png"
+ #~(let* ((insvg (string-append
+ #$guix-backgrounds
+ "/share/backgrounds/guix/guix-checkered-16-9.svg"))
+ (out #$output)
+ (cmd (string-append
+ #$librsvg "/bin/rsvg-convert " insvg " -o " out)))
+ (system cmd))))
+
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg bg-file))))))
+@end lisp
+
+The above example describes a sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.svg} is provided by
+the @code{guix-background} package;
+@item
+swiping down (resp.@ up) with three fingers moves the active window to
+the scratchpad (resp.@ shows/hides the scratchpad).
+@end itemize
+@end defvar
+
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are strings.
+
+Example: @code{'(mod . "Mod4")}.
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+The value of this field is an association list in which keys are symbols
+and values are strings or G-expressions (@pxref{G-Expressions}).
+
+Examples using:
+@itemize
+@item
+a string: @code{'($mod+Return . "exec $term")}
+@item
+a G-exp: @code{`($mod+t . ,#~(string-append #$st "/bin/st"))}
+@end itemize
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+This value of this field is an association list, as for keybindings.
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile.
+
+@item @code{inputs} (default: @code{(list (sway-input))})
+List of @code{sway-input} configuration records.
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records.
+
+@item @code{bar} (default: @code{(sway-bar)})
+Bar configuration.
+
+@item @code{always-execs} (default: @code{'()})
+Programs to execute at startup time @i{and} after every configuration
+reload. The value of this field is a list of strings or G-expressions.
+
+@item @code{execs} (default: @code{'()})
+Programs to execute at startup time. The value of this field is a list
+of strings or G-expressions.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+
+@end table
+@end deftp
+
+@deftp {Data Type} sway-input
+@code{sway-input} records describe input blocks
+(see@ @cite{sway-input(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If a
+string is used, it will be quoted in the generated configuration file.
+
+@item @code{xkb-layout} (optional)
+Keyboard specific option. Comma-separated keyboard layout(s) to use.
+
+@item @code{xkb-model} (optional)
+Keyboard specific option. String providing the keyboard model.
+
+@item @code{xkb-options} (optional)
+Keyboard specific option. Additional xkb options for the keyboard.
+
+@item @code{xkb-variant} (optional)
+Keyboard specific option. String specifying the variant of the layout.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list of
+strings or G-expressions.
+
+@end table
+
+For example, the following snippet makes all keyboards use a french
+layout, in which @kbd{capslock} has been remaped to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (xkb-layout "fr")
+ (xkb-options '("ctrl:nocaps")))
+@end lisp
+@end deftp
+
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+@item @code{resolution} (optional)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{bg} (optional)
+This field accepts a file-like value representing the wallpaper to use
+on this monitor. It will be used with the @code{fill} option.
+
+@item @code{extra-content} (default: @code{'()})
+Any additional lines to be added to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-border-color
+
+@table @asis
+@item @code{border} Color of the border.
+@item @code{background} Color of the background.
+@item @code{text} Color of the text.
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background}
+@item @code{statusline}
+@item @code{focused-background}
+@item @code{focused-statusline}
+@item @code{focused-workspace}
+@item @code{active-workspace}
+@item @code{inactive-workspace}
+@item @code{urgent-workspace}
+@item @code{binding-mode}
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a string.
+
+@item @code{position} (default: @code{'top})
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (default: @code{'hide})
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{show}.
+
+@item @code{binding-mode-indicator} (default: @code{#t})
+Enable or disable the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+This field accept executable file-like values. The default value is a
+script that prints the battery information (retrieved using
+@code{acpi}), date and time every second.
+
+Each line printed on @code{stdout} by this script will be displayed on
+the status area of the bar.
+
+@end table
+@end deftp
+
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..91d01f6eb4
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,632 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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
+ sway-configuration->file
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ ))
+
+;; Helper function.
+(define (flatten l)
+ (let loop ((lst l) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (loop tail (append acc head))))))
+
+\f
+;;;
+;;; 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")))
+
+(define %sway-default-status-command
+ (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)))))))
+
+\f
+;;;
+;;; 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 %sway-default-status-command)
+ "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.")
+ (always-execs
+ (list-of-string-or-gexp '())
+ "Programs to execute at startup time.")
+ (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."))
+
+\f
+;;;
+;;; 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 b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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))))
+ (if (eq? %unset-value colors)
+ '()
+ (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 (sway-configuration->file 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))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Helper functions to pretty-print the configuration file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (string-pad "" i) s)
+ i))
+ (define (lines lst)
+ (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))))
+ 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 (i)
+ (+ i k)))
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (string-pad "" i) name)
+ (+ i 4)))
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (string-pad "" i))
+ i)))
+
+ ;; The value that is threaded in the following block is the
+ ;; indentation level.
+ (with-monad %identity-monad
+ (>>=
+ ;; We start with no indentation at all.
+ (return 0)
+ ;; 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. (at startup & after reloads)"
+ "# ===================="
+ #$@(map (serialize-exec #t)
+ (sway-configuration-always-execs conf)))
+ (line*
+ "# Programs to execute. (at startup)"
+ "# ===================="
+ #$@(map (serialize-exec #f)
+ (sway-configuration-execs conf)))))))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index ad5494fe95..15788b2fb0 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -112,6 +112,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
base-commit: f10cbebd7b6cfeb66e91851616fdc75f9a0bbe69
--
2.45.2
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-08-19 15:30 [bug#72714] [PATCH] home: services: Add 'home-sway-service-type' Arnaud Daby-Seesaram via Guix-patches via
2024-08-24 15:32 ` [bug#72714] [PATCH v2] " Arnaud Daby-Seesaram via Guix-patches via
2024-08-26 10:38 ` [bug#72714] [PATCH v3] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-03 7:27 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-14 13:28 ` pelzflorian (Florian Pelz)
2024-09-18 8:15 ` [bug#72714] [PATCH v5] " Arnaud Daby-Seesaram via Guix-patches via
2024-09-25 8:00 ` [bug#72714] [PATCH v6] " Arnaud Daby-Seesaram via Guix-patches via
4 siblings, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-03 7:27 UTC (permalink / raw)
To: 72714; +Cc: Arnaud Daby-Seesaram
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
---
This version is rebased on master and brings default values closer to those of
the default sway configuration (e.g. the status command).
doc/guix.texi | 271 ++++++++++++++
gnu/home/services/sway.scm | 703 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 975 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 144adf327e..8e17643b7f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -130,6 +130,7 @@ Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
Copyright @copyright{} 2024 Fabio Natali@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -460,6 +461,7 @@ Home Services
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@@ -45175,6 +45177,7 @@ services)}.
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@@ -47089,6 +47092,274 @@ kodi} for more information.
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+
+@cindex sway, configuration
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure sway in a
+declarative way.
+
+@quotation Note
+This home service only sets up configuration file and profile packages
+for sway. It does @i{not} start sway in any way. If you 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
+to provide the value for the @code{sway-configuration} field of
+@code{greetd-wlgreet-sway-session}.
+@end quotation
+
+@defvar sway-configuration->file
+This function takes a @code{sway-configuration} record (defined below),
+and returns a file-like object represented the serialized configuration.
+@end defvar
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding sway-related packages to your profile.
+@end itemize
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(define bg-file
+ (computed-file
+ "background.png"
+ #~(let* ((insvg (string-append
+ #$guix-backgrounds
+ "/share/backgrounds/guix/guix-checkered-16-9.svg"))
+ (out #$output)
+ (cmd (string-append
+ #$librsvg "/bin/rsvg-convert " insvg " -o " out)))
+ (system cmd))))
+
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg bg-file))))))
+@end lisp
+
+The above example describes a sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.svg} is provided by
+the @code{guix-background} package;
+@item
+swiping down (resp.@ up) with three fingers moves the active window to
+the scratchpad (resp.@ shows/hides the scratchpad).
+@end itemize
+@end defvar
+
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are strings or G-expressions (@pxref{G-Expressions}).
+
+Example: @code{'(mod . "Mod4")}.
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+This field describes keybindings for the @emph{default} mode. As above,
+the value is an association list: keys are symbols and values are either
+strings or G-expressions.
+
+@c @example
+Examples using:
+@itemize
+@item
+a string: @code{'($mod+Return . "exec $term")}
+@item
+a G-exp: @code{`($mod+t . ,#~(string-append #$st "/bin/st"))}
+@end itemize
+@c @end example
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+Similar to the previous field, but for finger-gestures.
+
+@c @example
+The following snippet allows to navigate through workspaces by swiping
+right and left with three fingers:
+@lisp
+`((swipe:3:right . "workspace next_on_output")
+ (swipe:3:left . "workspace prev_on_output"))
+@end lisp
+@c @end example
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile.
+
+@item @code{inputs} (default: @code{(list (sway-input))})
+List of @code{sway-input} configuration records.
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records.
+
+@item @code{bar} (default: @code{(sway-bar)})
+Bar configuration.
+
+@item @code{always-execs} (default: @code{'()})
+Programs to execute at startup time @i{and} after every configuration
+reload. The value of this field is a list of strings or G-expressions.
+
+@item @code{execs} (default: @code{%sway-default-execs})
+Programs to execute at startup time. The value of this field is a list
+of strings or G-expressions.
+
+The default value, @code{%sway-default-execs}, executes @code{swayidle}
+in order to lock the screen after 5@ minutes of inactivity (displaying a
+background distributed with Sway) and turn of the screen after
+10@ minutes of inactivity.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+
+@end table
+@end deftp
+
+@deftp {Data Type} sway-input
+@code{sway-input} records describe input blocks
+(see@ @cite{sway-input(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If a
+string is used, it will be quoted in the generated configuration file.
+
+@item @code{xkb-layout} (optional)
+Keyboard specific option. Comma-separated keyboard layout(s) to use.
+
+@item @code{xkb-model} (optional)
+Keyboard specific option. String providing the keyboard model.
+
+@item @code{xkb-options} (optional)
+Keyboard specific option. Additional xkb options for the keyboard.
+
+@item @code{xkb-variant} (optional)
+Keyboard specific option. String specifying the variant of the layout.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list of
+strings or G-expressions.
+
+@end table
+
+For example, the following snippet makes all keyboards use a french
+layout, in which @kbd{capslock} has been remaped to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (xkb-layout "fr")
+ (xkb-options '("ctrl:nocaps")))
+@end lisp
+@end deftp
+
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+@item @code{resolution} (optional)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{bg} (optional)
+This field accepts a file-like value representing the wallpaper to use
+on this monitor. It will be used with the @code{fill} option.
+
+@item @code{extra-content} (default: @code{'()})
+Any additional lines to be added to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-border-color
+
+@table @asis
+@item @code{border} Color of the border.
+@item @code{background} Color of the background.
+@item @code{text} Color of the text.
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background}
+@item @code{statusline}
+@item @code{focused-background}
+@item @code{focused-statusline}
+@item @code{focused-workspace}
+@item @code{active-workspace}
+@item @code{inactive-workspace}
+@item @code{urgent-workspace}
+@item @code{binding-mode}
+@end table
+@end deftp
+
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a string.
+
+@item @code{position} (default: @code{'top})
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (default: @code{'hide})
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{show}.
+
+@item @code{binding-mode-indicator} (default: @code{#t})
+Enable or disable the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+This field accept strings and executable file-like values. The default
+value is a script that prints the date and time every second.
+
+Each line printed on @code{stdout} by this script will be displayed on
+the status area of the bar.
+
+@end table
+@end deftp
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..bfec0fcdcf
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,703 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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 (;; Event codes
+ %ev-code-mouse-left
+ %ev-code-mouse-right
+ %ev-code-mouse-scroll-click
+
+ ;; Configuration records.
+ sway-configuration
+ sway-bar
+ sway-output
+ sway-input
+ point
+ sway-color
+ sway-border-color
+ home-sway-service-type
+ sway-configuration->file
+ sway-mode
+
+ ;; Default values.
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ %sway-default-execs))
+
+;; Helper function.
+(define (flatten l)
+ (let loop ((lst (reverse l)) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (loop tail (append head acc))))))
+
+\f
+;;;
+;;; Default settings and useful constants.
+;;;
+
+(define %ev-code-mouse-left 272)
+(define %ev-code-mouse-right 273)
+(define %ev-code-mouse-scroll-click 274)
+
+(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_path | "
+ #$wmenu "/bin/wmenu | "
+ #$findutils "/bin/xargs "
+ #$sway "/bin/swaymsg exec --"))))
+
+(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")))
+
+(define %sway-default-keybindings
+ `(($mod+Return . "exec $term")
+ ($mod+Shift+q . "kill")
+ ($mod+d . "exec $menu")
+ ($mod+Shift+c . "reload")
+ ($mod+Shift+e
+ . ,#~(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' '"
+ #$sway "/bin/swaymsg exit'"))
+ ($mod+$left . "focus left")
+ ($mod+$down . "focus down")
+ ($mod+$up . "focus up")
+ ($mod+$right . "focus right")
+ ($mod+Left . "focus left")
+ ($mod+Down . "focus down")
+ ($mod+Up . "focus up")
+ ($mod+Right . "focus right")
+ ($mod+Shift+$left . "move left")
+ ($mod+Shift+$down . "move down")
+ ($mod+Shift+$up . "move up")
+ ($mod+Shift+$right . "move right")
+ ($mod+Shift+Left . "move left")
+ ($mod+Shift+Down . "move down")
+ ($mod+Shift+Up . "move up")
+ ($mod+Shift+Right . "move right")
+ ($mod+1 . "workspace number 1")
+ ($mod+2 . "workspace number 2")
+ ($mod+3 . "workspace number 3")
+ ($mod+4 . "workspace number 4")
+ ($mod+5 . "workspace number 5")
+ ($mod+6 . "workspace number 6")
+ ($mod+7 . "workspace number 7")
+ ($mod+8 . "workspace number 8")
+ ($mod+9 . "workspace number 9")
+ ($mod+0 . "workspace number 10")
+ ($mod+Shift+1 . "move container to workspace number 1")
+ ($mod+Shift+2 . "move container to workspace number 2")
+ ($mod+Shift+3 . "move container to workspace number 3")
+ ($mod+Shift+4 . "move container to workspace number 4")
+ ($mod+Shift+5 . "move container to workspace number 5")
+ ($mod+Shift+6 . "move container to workspace number 6")
+ ($mod+Shift+7 . "move container to workspace number 7")
+ ($mod+Shift+8 . "move container to workspace number 8")
+ ($mod+Shift+9 . "move container to workspace number 9")
+ ($mod+Shift+0 . "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+a . "focus parent")
+ ($mod+Shift+minus . "move scratchpad")
+ ($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-execs
+ (list
+ #~(string-append
+ #$swayidle "/bin/swayidle -w \\\n"
+ ;; 300: lock screen.
+ " timeout 300 '" #$swaylock "/bin/swaylock "
+ "--indicator-radius 75 "
+ "-i " #$sway "/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png"
+ " -f -c 000000' \\\n"
+ ;; 600: lock + screen off.
+ " timeout 600 '" #$sway "/bin/swaymsg \"output * power off\"' \\\n"
+ ;; Resume + sleep.
+ " resume '" #$sway "/bin/swaymsg \"output * power on\"' \\\n"
+ " before-sleep '" #$swaylock "/bin/swaylock -f -c 000000'")))
+
+\f
+;;;
+;;; 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 (make-alist-predicate key? val?)
+ (lambda (lst)
+ (every
+ (lambda (item)
+ (match item
+ ((k . v)
+ (and (key? k)
+ (val? v)))
+ (_ #f)))
+ lst)))
+
+(define (string-or-gexp? s)
+ (or (string? s)
+ (gexp? s)))
+
+(define bindings?
+ (make-alist-predicate symbol? string-or-gexp?))
+(define mouse-bindings?
+ (make-alist-predicate integer? string-or-gexp?))
+
+(define (file-like-or-string? f)
+ (or (file-like? f)
+ (string? f)))
+
+(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-or-string %sway-default-status-command)
+ "Status command. It must be file-like.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Actions triggered by mouse events.")
+ (extra-content
+ (list-of-string-or-gexp '())
+ "Extra configuration lines."))
+
+(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-mode
+ (mode-name
+ (string "default")
+ "Name of the mode.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Mouse bindings."))
+;; TODO: switch bindings.
+
+(define (sway-modes? lst)
+ (every sway-mode? lst))
+
+(define-configuration/no-serialization sway-configuration
+ (keybindings
+ (bindings %sway-default-keybindings)
+ "Keybindings.")
+ (gestures
+ (bindings %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.")
+ (modes
+ (sway-modes '())
+ "Additional modes.")
+ (always-execs
+ (list-of-string-or-gexp '())
+ "Programs to execute at startup time.")
+ (execs
+ (list-of-string-or-gexp %sway-default-execs)
+ "Programs to execute at startup time.")
+ (extra-content
+ (list-of-string-or-gexp '())
+ "Lines to add at the end of the configuration file."))
+
+\f
+;;;
+;;; Serialization functions.
+;;;
+
+(define (serialize-mouse-binding var)
+ (let ((ev-code (number->string (car var)))
+ (command (cdr var)))
+ #~(string-append "bindcode " #$ev-code " " #$command)))
+
+(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 b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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))))
+ (if (eq? %unset-value colors)
+ '()
+ (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 (serialize-sway-mode mode)
+ (let ((name (sway-mode-mode-name mode))
+ (keys (sway-mode-keybindings mode))
+ (clicks (sway-mode-mouse-bindings mode))
+ (serialize-keybinding
+ (lambda (kbd)
+ #~(string-append " " #$(serialize-keybinding kbd))))
+ (serialize-mouse-binding
+ (lambda (kbd)
+ #~(string-append " " #$(serialize-mouse-binding kbd)))))
+ (append
+ (list (string-append "mode \"" name "\" {"))
+ (map serialize-keybinding keys)
+ (map serialize-mouse-binding clicks)
+ '("}"))))
+
+(define (sway-configuration->file 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))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Helper functions to pretty-print the configuration file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (string-pad "" i) s)
+ i))
+ (define (lines lst)
+ (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))))
+ 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 (i)
+ (+ i k)))
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (string-pad "" i) name)
+ (+ i 4)))
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (string-pad "" i))
+ i)))
+
+ ;; The value that is threaded in the following block is the
+ ;; indentation level.
+ (with-monad %identity-monad
+ (>>=
+ ;; We start with no indentation at all.
+ (return 0)
+ ;; 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
+ (line*
+ #$@(map serialize-keybinding (sway-bar-keybindings bar)))
+ (line*
+ #$@(map serialize-mouse-binding (sway-bar-mouse-bindings bar)))
+ (line*
+ #$@(sway-bar-extra-content bar))
+ (end-block) ;; bar
+ (line*
+ "" "# Modes." "# ======"
+ #$@(flatten
+ (map serialize-sway-mode
+ (sway-configuration-modes conf))))
+ (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. (at startup & after reloads)"
+ "# ===================="
+ #$@(map (serialize-exec #t)
+ (sway-configuration-always-execs conf)))
+ (line*
+ "" "# Programs to execute. (at startup)"
+ "# ===================="
+ #$@(map (serialize-exec #f)
+ (sway-configuration-execs conf)))))))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 0c4ab96bf3..225e2d5502 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -114,6 +114,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
--
2.45.2
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-03 7:27 ` [bug#72714] [PATCH v4] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-14 13:28 ` pelzflorian (Florian Pelz)
2024-09-14 14:06 ` pelzflorian (Florian Pelz)
2024-09-17 6:52 ` Arnaud Daby-Seesaram via Guix-patches via
0 siblings, 2 replies; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-09-14 13:28 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: 72714
Thank you Arnaud for this well-written home-sway-service!
Some comments for you or the one who pushes your patch. I would
rather not take any responsibility for sway myself.
> @quotation Note
> This home service only sets up configuration file and profile packages
Typo: Please add 'the': sets up the configuration file and profile packages
> The function @code{sway-configuration->file} defined below can be used
> to provide the value for the @code{sway-configuration} field of
> @code{greetd-wlgreet-sway-session}.
Good. Even though it is a little strange that one would add a home
module (gnu home services sway) to the operating-system configuration,
I know no better place for this `sway-configuration->file' procedure,
since the record is for Guix Home and being able to use it for greetd
is just an extra feature.
> @lisp
> (define bg-file
> (computed-file
> "background.png"
> #~(let* ((insvg (string-append
> #$guix-backgrounds
> "/share/backgrounds/guix/guix-checkered-16-9.svg"))
> (out #$output)
> (cmd (string-append
> #$librsvg "/bin/rsvg-convert " insvg " -o " out)))
> (system cmd))))
>
> (service home-sway-service-type
> (sway-configuration
> (gestures
> '((swipe:3:down . "move to scratchpad")
> (swipe:3:up . "scratchpad show")))
> (outputs
> (list (sway-output
> (identifier '*)
> (bg bg-file))))))
> @end lisp
Why not (bg #~(file-append #$guix-backgrounds
"\
/share/backgrounds/guix/guix-checkered-16-9.svg"))
? This does not work right now, but could you change bg and
perhaps status-command to accept gexps?
> swiping down (resp.@ up) with three fingers moves the active window to
> the scratchpad (resp.@ shows/hides the scratchpad).
Should be with a colon: resp.@: up
You should run untabify on all of gnu/home/services/sway.scm
to get rid of nasty tabs.
Otherwise looks really good to me (although I have not cross-checked
the man pages).
Regards,
Florian
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-14 13:28 ` pelzflorian (Florian Pelz)
@ 2024-09-14 14:06 ` pelzflorian (Florian Pelz)
2024-09-17 6:52 ` Arnaud Daby-Seesaram via Guix-patches via
1 sibling, 0 replies; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-09-14 14:06 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: 72714
One more thing,
> (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)))))
this does not put a comma between each element of xkb-options.
Could you make it join the xkb-options with a comma in between?
Regards,
Florian
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-14 13:28 ` pelzflorian (Florian Pelz)
2024-09-14 14:06 ` pelzflorian (Florian Pelz)
@ 2024-09-17 6:52 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-20 16:45 ` pelzflorian (Florian Pelz)
1 sibling, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-17 6:52 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: 72714
[-- Attachment #1: Type: text/plain, Size: 868 bytes --]
Hi Florian,
Thank you for your review. I will submit a v5 soon to take your remarks
into account and add an additional configuration field (to easily add
modes, e.g. the resize mode).
>> The function @code{sway-configuration->file} defined below can be used
>> to provide the value for the @code{sway-configuration} field of
>> @code{greetd-wlgreet-sway-session}.
>
> Good. Even though it is a little strange that one would add a home
> module (gnu home services sway) to the operating-system configuration,
> I know no better place for this `sway-configuration->file' procedure,
> since the record is for Guix Home and being able to use it for greetd
> is just an extra feature.
Yes, I agree; I could not find a better place for this function either.
Do you think that this note is helpful, or should I remove it?
Best regards,
--
Arnaud
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v5] home: services: Add 'home-sway-service-type'.
2024-08-19 15:30 [bug#72714] [PATCH] home: services: Add 'home-sway-service-type' Arnaud Daby-Seesaram via Guix-patches via
` (2 preceding siblings ...)
2024-09-03 7:27 ` [bug#72714] [PATCH v4] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-18 8:15 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-18 18:56 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-22 8:14 ` Hilton Chain via Guix-patches via
2024-09-25 8:00 ` [bug#72714] [PATCH v6] " Arnaud Daby-Seesaram via Guix-patches via
4 siblings, 2 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-18 8:15 UTC (permalink / raw)
To: 72714; +Cc: Arnaud Daby-Seesaram
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
---
doc/guix.texi | 329 +++++++++++++++++
gnu/home/services/sway.scm | 711 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 1041 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index bdaefe3802..07598a2a7e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -130,6 +130,7 @@ Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
Copyright @copyright{} 2024 Fabio Natali@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -460,6 +461,7 @@ Home Services
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@@ -45190,6 +45192,7 @@ services)}.
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@@ -47104,6 +47107,332 @@ kodi} for more information.
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+
+@cindex sway, Home Service
+@cindex sway, configuration
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure sway in a
+declarative way.
+
+@quotation Note
+This home service only sets up the configuration file and profile
+packages for sway. It does @i{not} start sway in any way. If you 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
+to provide the value for the @code{sway-configuration} field of
+@code{greetd-wlgreet-sway-session}.
+@end quotation
+
+@defvar sway-configuration->file
+This function takes a @code{sway-configuration} record (defined below),
+and returns a file-like object represented the serialized configuration.
+@end defvar
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding sway-related packages to your profile.
+@end itemize
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg (file-append guix-backgrounds
+ "\
+/share/backgrounds/guix/guix-checkered-16-9.svg")))))))
+@end lisp
+
+The above example describes a sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.svg} is provided by
+the @code{guix-background} package;
+@item
+swiping down (resp.@: up) with three fingers moves the active window to
+the scratchpad (resp.@: shows/hides the scratchpad).
+@end itemize
+@end defvar
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are strings or G-expressions (@pxref{G-Expressions}).
+
+Example: @code{'(mod . "Mod4")}.
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+This field describes keybindings for the @emph{default} mode. As above,
+the value is an association list: keys are symbols and values are either
+strings, G-expressions or file-append objects.
+
+Examples using:
+@itemize
+@item
+a string: @code{'($mod+Return . "exec $term")}
+@item
+a G-exp: @code{`($mod+t . ,#~(string-append #$st "/bin/st"))}
+@item
+a file-append: @code{`($mod+t . ,(file-append st "/bin/st"))}
+@end itemize
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+Similar to the previous field, but for finger-gestures.
+
+The following snippet allows to navigate through workspaces by swiping
+right and left with three fingers:
+@lisp
+'((swipe:3:right . "workspace next_on_output")
+ (swipe:3:left . "workspace prev_on_output"))
+@end lisp
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile.
+
+@item @code{inputs} (default: @code{(list (sway-input))})
+List of @code{sway-input} configuration records.
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records.
+
+@item @code{bar} (default: @code{(sway-bar)})
+Bar configuration.
+
+@item @code{modes} (default: @code{'()})
+Optional list of @code{sway-mode} records (described below).
+
+@item @code{always-execs} (default: @code{'()})
+Programs to execute at startup time @i{and} after every configuration
+reload. The value of this field is a list of strings or G-expressions.
+
+@item @code{execs} (default: @code{%sway-default-execs})
+Programs to execute at startup time. The value of this field is a list
+of strings or G-expressions.
+
+The default value, @code{%sway-default-execs}, executes @code{swayidle}
+in order to lock the screen after 5@ minutes of inactivity (displaying a
+background distributed with Sway) and turn of the screen after
+10@ minutes of inactivity.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-input
+@code{sway-input} records describe input blocks
+(see@ @cite{sway-input(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If a
+string is used, it will be quoted in the generated configuration file.
+
+@item @code{xkb-layout} (optional)
+Keyboard specific option. Comma-separated keyboard layout(s) to use.
+
+@item @code{xkb-model} (optional)
+Keyboard specific option. String providing the keyboard model.
+
+@item @code{xkb-options} (optional)
+Keyboard specific option. Additional xkb options for the keyboard.
+
+@item @code{xkb-variant} (optional)
+Keyboard specific option. String specifying the variant of the layout.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list of
+strings.
+@end table
+
+For example, the following snippet makes all keyboards use a french
+layout, in which @kbd{capslock} has been remaped to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (xkb-layout "fr")
+ (xkb-options '("ctrl:nocaps")))
+@end lisp
+@end deftp
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+@item @code{resolution} (optional)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{bg} (optional)
+This field accepts a file-like value representing the wallpaper to use
+on this monitor. It will be used with the @code{fill} option.
+
+@item @code{extra-content} (default: @code{'()})
+Any additional lines to be added to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-border-color
+
+@table @code
+@item border
+Color of the border.
+@item background
+Color of the background.
+@item text
+Color of the text.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background} (optional string)
+Background color of the bar.
+@item @code{statusline} (optional string)
+Text color of the separator.
+@item @code{focused-background} (optional string)
+Background color of the bar on the currently focused monitor.
+@item @code{focused-statusline} (optional string)
+Text color of the statusline on the currently focused monitor.
+@item @code{focused-workspace} (optional @code{sway-border-color})
+Color scheme for focused workspaces.
+@item @code{active-workspace} (optional @code{sway-border-color})
+Colour scheme for active workspaces.
+@item @code{inactive-workspace} (optional @code{sway-border-color})
+Colour scheme for inactive workspaces.
+@item @code{urgent-workspace} (optional @code{sway-border-color})
+Colour scheme for workspaces containing `urgent' windows.
+@item @code{binding-mode} (optional @code{sway-border-color})
+Colour scheme for the binding mode indicator.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a string.
+
+@item @code{position} (default: @code{'top})
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (default: @code{'hide})
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{show}.
+
+@item @code{binding-mode-indicator} (default: @code{#t})
+Enable or disable the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+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.
+
+Each line printed on @code{stdout} by this command (or script) will be
+displayed on the status area of the bar.
+
+Below are a few examples using:
+@itemize
+@item
+a string: @code{"while date +'%Y-%m-%d %X'; do sleep 1; done"},
+@item
+a G-exp:
+@lisp
+#~(string-append "while "
+ #$coreutils "/bin/date"
+ " +'%Y-%m-%d %X'; do sleep 1; done")
+@end lisp
+@item
+an executable file:
+@lisp
+(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 format)
+ (srfi srfi-19))
+ (let loop ()
+ (let* ((date (date->string
+ (current-date)
+ "~d/~m/~Y (~a) ~H:~M:~S")))
+ (format #t "~a~%~!" date)
+ (sleep 1)
+ (loop))))))
+@end lisp
+@end itemize
+@end table
+@end deftp
+
+@deftp {Data Type} sway-mode
+Describes a Sway mode.
+
+Here is a mockup of the resize mode of the default Sway configuration:
+@example
+(sway-mode
+ (mode-name "resize")
+ (keybindings
+ '(($left . "resize shrink width 10px")
+ ($right . "resize grow width 10px")
+ ($down . "resize grow height 10px")
+ ($up . "resize shrink height 10px")
+ (Return . "mode \"default\"")
+ (Escape . "mode \"default\""))))
+@end example
+
+@table @asis
+@item @code{mode-name} (default @code{"default"})
+Name of the mode.
+@item @code{keybindings} (default @code{'()})
+This field describes keybindings. The value is an association list:
+keys are symbols and values are either strings or G-expressions.
+@item @code{mouse-bindings} (default @code{'()})
+Ditto, but keys are mouse events.
+@end table
+@end deftp
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..7d665e7280
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,711 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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 (;; Event codes
+ %ev-code-mouse-left
+ %ev-code-mouse-right
+ %ev-code-mouse-scroll-click
+
+ ;; Configuration records.
+ sway-configuration
+ sway-bar
+ sway-output
+ sway-input
+ point
+ sway-color
+ sway-border-color
+ home-sway-service-type
+ sway-configuration->file
+ sway-mode
+
+ ;; Default values.
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ %sway-default-execs))
+
+;; Helper function.
+(define (flatten l)
+ (let loop ((lst (reverse l)) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (loop tail (append head acc))))))
+
+\f
+;;;
+;;; Default settings and useful constants.
+;;;
+
+(define %ev-code-mouse-left 272)
+(define %ev-code-mouse-right 273)
+(define %ev-code-mouse-scroll-click 274)
+
+(define %sway-default-variables
+ `((mod . "Mod4")
+ (left . "h")
+ (down . "j")
+ (up . "k")
+ (right . "l")
+ (term . ,(file-append st "/bin/st"))
+ (menu . ,#~(string-append
+ #$dmenu "/bin/dmenu_path | "
+ #$wmenu "/bin/wmenu | "
+ #$findutils "/bin/xargs "
+ #$sway "/bin/swaymsg exec --"))))
+
+(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")))
+
+(define %sway-default-keybindings
+ `(($mod+Return . "exec $term")
+ ($mod+Shift+q . "kill")
+ ($mod+d . "exec $menu")
+ ($mod+Shift+c . "reload")
+ ($mod+Shift+e
+ . ,#~(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' '"
+ #$sway "/bin/swaymsg exit'"))
+ ($mod+$left . "focus left")
+ ($mod+$down . "focus down")
+ ($mod+$up . "focus up")
+ ($mod+$right . "focus right")
+ ($mod+Left . "focus left")
+ ($mod+Down . "focus down")
+ ($mod+Up . "focus up")
+ ($mod+Right . "focus right")
+ ($mod+Shift+$left . "move left")
+ ($mod+Shift+$down . "move down")
+ ($mod+Shift+$up . "move up")
+ ($mod+Shift+$right . "move right")
+ ($mod+Shift+Left . "move left")
+ ($mod+Shift+Down . "move down")
+ ($mod+Shift+Up . "move up")
+ ($mod+Shift+Right . "move right")
+ ($mod+1 . "workspace number 1")
+ ($mod+2 . "workspace number 2")
+ ($mod+3 . "workspace number 3")
+ ($mod+4 . "workspace number 4")
+ ($mod+5 . "workspace number 5")
+ ($mod+6 . "workspace number 6")
+ ($mod+7 . "workspace number 7")
+ ($mod+8 . "workspace number 8")
+ ($mod+9 . "workspace number 9")
+ ($mod+0 . "workspace number 10")
+ ($mod+Shift+1 . "move container to workspace number 1")
+ ($mod+Shift+2 . "move container to workspace number 2")
+ ($mod+Shift+3 . "move container to workspace number 3")
+ ($mod+Shift+4 . "move container to workspace number 4")
+ ($mod+Shift+5 . "move container to workspace number 5")
+ ($mod+Shift+6 . "move container to workspace number 6")
+ ($mod+Shift+7 . "move container to workspace number 7")
+ ($mod+Shift+8 . "move container to workspace number 8")
+ ($mod+Shift+9 . "move container to workspace number 9")
+ ($mod+Shift+0 . "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+a . "focus parent")
+ ($mod+Shift+minus . "move scratchpad")
+ ($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-execs
+ (list
+ #~(string-append
+ #$swayidle "/bin/swayidle -w \\\n"
+ ;; 300: lock screen.
+ " timeout 300 '" #$swaylock "/bin/swaylock "
+ "--indicator-radius 75 "
+ "-i " #$sway "/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png"
+ " -f -c 000000' \\\n"
+ ;; 600: lock + screen off.
+ " timeout 600 '" #$sway "/bin/swaymsg \"output * power off\"' \\\n"
+ ;; Resume + sleep.
+ " resume '" #$sway "/bin/swaymsg \"output * power on\"' \\\n"
+ " before-sleep '" #$swaylock "/bin/swaylock -f -c 000000'")))
+
+\f
+;;;
+;;; Definition of configurations.
+;;;
+
+(define (string-ish? s)
+ (or (gexp? s)
+ (file-append? s)
+ (string? s)))
+
+(define (list-of-string-ish? lst)
+ (every string-ish? 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 (make-alist-predicate key? val?)
+ (lambda (lst)
+ (every
+ (lambda (item)
+ (match item
+ ((k . v)
+ (and (key? k)
+ (val? v)))
+ (_ #f)))
+ lst)))
+
+(define bindings?
+ (make-alist-predicate symbol? string-ish?))
+
+(define mouse-bindings?
+ (make-alist-predicate integer? string-ish?))
+
+(define (variables? lst)
+ (make-alist-predicate symbol? string-ish?))
+
+(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
+ (strings '())
+ "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
+ "Colour scheme for focused workspaces.")
+ (active-workspace
+ maybe-sway-border-color
+ "Colour scheme for active workspaces.")
+ (inactive-workspace
+ maybe-sway-border-color
+ "Colour scheme for inactive workspaces.")
+ (urgent-workspace
+ maybe-sway-border-color
+ "Colour scheme for workspaces containing `urgent' windows.")
+ (binding-mode
+ maybe-sway-border-color
+ "Colour scheme for the binding mode indicator."))
+
+(define-maybe sway-color (no-serialization))
+
+(define (status-command? c)
+ (or (string? c)
+ (file-like? c)
+ (gexp? c)))
+
+(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
+ (status-command %sway-default-status-command)
+ "Status command. It must be file-like.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Actions triggered by mouse events.")
+ (extra-content
+ (list-of-string-ish '())
+ "Extra configuration lines."))
+
+(define-configuration/no-serialization point
+ (x integer "X coordinate.")
+ (y integer "Y coordinate."))
+
+(define (file-like-or-gexp? f)
+ (or (file-like? f)
+ (gexp? f)))
+
+(define-maybe point (no-serialization))
+(define-maybe file-like-or-gexp (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-or-gexp
+ "Background image.")
+ (extra-content
+ (list-of-string-ish '())
+ "Extra lines."))
+
+(define (sway-outputs? lst)
+ (every sway-output? lst))
+
+(define-configuration/no-serialization sway-mode
+ (mode-name
+ (string "default")
+ "Name of the mode.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Mouse bindings."))
+;; TODO: switch bindings.
+
+(define (sway-modes? lst)
+ (every sway-mode? lst))
+
+(define-configuration/no-serialization sway-configuration
+ (keybindings
+ (bindings %sway-default-keybindings)
+ "Keybindings.")
+ (gestures
+ (bindings %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
+ (variables %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.")
+ (modes
+ (sway-modes '())
+ "Additional modes.")
+ (always-execs
+ (list-of-string-ish '())
+ "Programs to execute at startup time.")
+ (execs
+ (list-of-string-ish %sway-default-execs)
+ "Programs to execute at startup time.")
+ (extra-content
+ (list-of-string-ish '())
+ "Lines to add at the end of the configuration file."))
+
+\f
+;;;
+;;; Serialization functions.
+;;;
+
+(define (serialize-mouse-binding var)
+ (let ((ev-code (number->string (car var)))
+ (command (cdr var)))
+ #~(string-append "bindcode " #$ev-code " " #$command)))
+
+(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 b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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))))))
+ (map
+ (lambda (s)
+ #~(string-append " " #$s))
+ 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-append " xkb_options "
+ (string-join 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))))
+ (if (eq? %unset-value colors)
+ '()
+ (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 (serialize-sway-mode mode)
+ (let ((name (sway-mode-mode-name mode))
+ (keys (sway-mode-keybindings mode))
+ (clicks (sway-mode-mouse-bindings mode))
+ (serialize-keybinding
+ (lambda (kbd)
+ #~(string-append " " #$(serialize-keybinding kbd))))
+ (serialize-mouse-binding
+ (lambda (kbd)
+ #~(string-append " " #$(serialize-mouse-binding kbd)))))
+ (append
+ (list (string-append "mode \"" name "\" {"))
+ (map serialize-keybinding keys)
+ (map serialize-mouse-binding clicks)
+ '("}"))))
+
+(define (sway-configuration->file 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))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Helper functions to pretty-print the configuration file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (string-pad "" i) s)
+ i))
+ (define (lines lst)
+ (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))))
+ 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 (i)
+ (+ i k)))
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (string-pad "" i) name)
+ (+ i 4)))
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (string-pad "" i))
+ i)))
+
+ ;; The value that is threaded in the following block is the
+ ;; indentation level.
+ (with-monad %identity-monad
+ (>>=
+ ;; We start with no indentation at all.
+ (return 0)
+ ;; 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
+ (line*
+ #$@(map serialize-keybinding
+ (sway-bar-keybindings bar)))
+ (line*
+ #$@(map serialize-mouse-binding
+ (sway-bar-mouse-bindings bar)))
+ (line*
+ #$@(sway-bar-extra-content bar))
+ (end-block) ;; bar
+ (line*
+ "" "# Modes." "# ======"
+ #$@(flatten
+ (map serialize-sway-mode
+ (sway-configuration-modes conf))))
+ (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. (at startup & after reloads)"
+ "# ===================="
+ #$@(map (serialize-exec #t)
+ (sway-configuration-always-execs conf)))
+ (line*
+ "" "# Programs to execute. (at startup)"
+ "# ===================="
+ #$@(map (serialize-exec #f)
+ (sway-configuration-execs conf)))))))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index fcdf174099..fc877ebfaf 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -114,6 +114,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
--
2.46.0
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v5] home: services: Add 'home-sway-service-type'.
2024-09-18 8:15 ` [bug#72714] [PATCH v5] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-18 18:56 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-22 8:14 ` Hilton Chain via Guix-patches via
1 sibling, 0 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-18 18:56 UTC (permalink / raw)
To: 72714
[-- Attachment #1: Type: text/plain, Size: 157 bytes --]
Apologies for the noise.
I just realised that I forgot one line in the commit message:
(sway-mode): New configuration record.
Best,
--
Arnaud
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-17 6:52 ` Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-20 16:45 ` pelzflorian (Florian Pelz)
2024-09-22 13:43 ` Arnaud Daby-Seesaram via Guix-patches via
0 siblings, 1 reply; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-09-20 16:45 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: 72714
Hello Arnaud. I’m still looking at the details of sway, so I could
myself push your patch with confidence to guix.git, but would also be
happy if others pushed it. I am already using it on my family’s media
PC now [1]. Thank you for it!
Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
>>> The function @code{sway-configuration->file} defined below can be used
>>> to provide the value for the @code{sway-configuration} field of
>>> @code{greetd-wlgreet-sway-session}.
>>
>> Good. Even though it is a little strange that one would add a home
>> module (gnu home services sway) to the operating-system configuration,
>> I know no better place for this `sway-configuration->file' procedure,
>> since the record is for Guix Home and being able to use it for greetd
>> is just an extra feature.
> Yes, I agree; I could not find a better place for this function either.
> Do you think that this note is helpful, or should I remove it?
>
> Best regards,
That one can use your `sway-configuration' enables one to configure the
inputs field declaratively to use another keyboard layout in the
greeter. It is a good feature. But perhaps add the word “optionally”
to make clear users do not have to provide a sway-configuration to the
greeter.
> @lisp
> (service home-sway-service-type
> (sway-configuration
> (gestures
> '((swipe:3:down . "move to scratchpad")
> (swipe:3:up . "scratchpad show")))
> (outputs
> (list (sway-output
> (identifier '*)
> (bg (file-append guix-backgrounds
> "\
> /share/backgrounds/guix/guix-checkered-16-9.svg")))))))
> @end lisp
Now that I tested this code, I notice that SVG backgrounds work only
if and only if librsvg is found. Still, I think it is better this way
with file-append. Perhaps add a note to doc/guix.texi here that this
librsvg must be installed or propagated in the packages field.
> @table @asis
> @item @code{mode-name} (default @code{"default"})
> Name of the mode.
> @item @code{keybindings} (default @code{'()})
These fields are missing a colon “default: ”. In other places you
correctly write “default: ”.
Regards,
Florian
[1] https://lists.gnu.org/archive/html/guile-user/2024-09/msg00041.html
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v5] home: services: Add 'home-sway-service-type'.
2024-09-18 8:15 ` [bug#72714] [PATCH v5] " Arnaud Daby-Seesaram via Guix-patches via
2024-09-18 18:56 ` Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-22 8:14 ` Hilton Chain via Guix-patches via
1 sibling, 0 replies; 24+ messages in thread
From: Hilton Chain via Guix-patches via @ 2024-09-22 8:14 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: 72714
Hi Arnaud,
On Wed, 18 Sep 2024 16:15:40 +0800,
Arnaud Daby-Seesaram via Guix-patches via wrote:
>
> * gnu/home/services/sway.scm: New file.
> (home-sway-service-type): New variable.
> (sway-configuration->file): New procedure.
> (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.
> * gnu/local.mk: Add gnu/home/services/sway.scm.
> * doc/guix.texi (Sway window manager): New node to document the above changes.
> ---
> doc/guix.texi | 329 +++++++++++++++++
> gnu/home/services/sway.scm | 711 +++++++++++++++++++++++++++++++++++++
> gnu/local.mk | 1 +
> 3 files changed, 1041 insertions(+)
> create mode 100644 gnu/home/services/sway.scm
Thank you for the sway service! Tried to convert my config and the resulted
code looks much clearer :)
Can `sway-configuration-bar' be optional? In my case it's not used.
Thanks
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-20 16:45 ` pelzflorian (Florian Pelz)
@ 2024-09-22 13:43 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-25 6:58 ` pelzflorian (Florian Pelz)
0 siblings, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-22 13:43 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: Hilton Chain, 72714
[-- Attachment #1: Type: text/plain, Size: 4054 bytes --]
Hello Florian and Hilton,
Thank you for your words and reviews! It is nice to know that a few
people are interested :).
> I’m still looking at the details of sway, so I could myself push your
> patch with confidence to guix.git, but would also be happy if others
> pushed it
Nice, NB: it is also fine
Upon reading the code again, one point is still unclear: the list of
packages that I include in user profiles seems a bit random :/.
- sway, swaylock and swaybg: useful to launch some commands manually
(including swaymsg).
- waybar, dmenu and bemenu: do not seem necessary. I will probably
remove them.
- dbus, xdg-desktop-portal and xdg-desktop-portal-wlr: may be
interesting to have. On my laptop, screen sharing¹ only works when
xdg-desktop-portal and xdg-desktop-portal-wlr are in the same profile²
(associated executable files end up in ~/.guix-home/profile/libexec/).
¹: I do not have a fully functional setup
for screen sharing yet (it does not work
in all web browsers). I (or someone else)
should probably add elements in the
default `execs' / `always-execs' fields
if/when they have a working setup later.
NB: this should not be a road blocker for
the current patch IMHO.
²: I do not know if that is a hard
requirement or if my issues are related to
something else.
- slurp and grim: screenshots (+ screen selection when screen sharing).
I will probably define a new variable `%sway-default-packages'
containing the above packages (minus waybar, ...). WDYT?
Hilton Chain <hako@ultrarare.space> writes:
> Can `sway-configuration-bar' be optional? In my case it's not used.
Yes indeed. In the v6, I will try to make a few fields optional, and
also avoid empty groups in produced configuration file.
> Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
>>>> The function @code{sway-configuration->file} defined below can be used
>>>> to provide the value for the @code{sway-configuration} field of
>>>> @code{greetd-wlgreet-sway-session}.
[...]
> That one can use your `sway-configuration' enables one to configure the
> inputs field declaratively to use another keyboard layout in the
> greeter. It is a good feature. But perhaps add the word “optionally”
> to make clear users do not have to provide a sway-configuration to the
> greeter.
Indeed; I will try to phrase this properly.
>> @lisp
>> (service home-sway-service-type
>> (sway-configuration
>> (gestures
>> '((swipe:3:down . "move to scratchpad")
>> (swipe:3:up . "scratchpad show")))
>> (outputs
>> (list (sway-output
>> (identifier '*)
>> (bg (file-append guix-backgrounds
>> "\
>> /share/backgrounds/guix/guix-checkered-16-9.svg")))))))
>> @end lisp
>
> Now that I tested this code, I notice that SVG backgrounds work only
> if and only if librsvg is found. Still, I think it is better this way
> with file-append. Perhaps add a note to doc/guix.texi here that this
> librsvg must be installed or propagated in the packages field.
I will add a note in the next version of the doc, to hint towards the
two solutions to use a svg file: adding librsvg to the profile, or
computing the png and put it in the store using a "computed-file" in the
configuration (as in the second version of the patch).
>> @table @asis
>> @item @code{mode-name} (default @code{"default"})
>> Name of the mode.
>> @item @code{keybindings} (default @code{'()})
>
> These fields are missing a colon “default: ”. In other places you
> correctly write “default: ”.
Got it, thx!
Best regards,
--
Arnaud
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-22 13:43 ` Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-25 6:58 ` pelzflorian (Florian Pelz)
2024-09-25 7:52 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-25 11:42 ` pelzflorian (Florian Pelz)
0 siblings, 2 replies; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-09-25 6:58 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: Hilton Chain, 72714
Hello Arnaud.
Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
> I will probably define a new variable `%sway-default-packages'
> containing the above packages (minus waybar, ...). WDYT?
Yes, good idea.
Though some of these commands like dbus and xdg portals are unnecessary
because noone will run them manually from within sway.
Also note that the menu should default to wmenu instead of dmenu
according to swaywm.org release notes for current sway 1.9. Both are in
$(guix build sway)/etc/sway/config, but dmenu got used, but probably for
compatibility only.
wmenu should be the only menu.
Do we have an API stability guarantee that `%sway-default-packages' will
remain the same? I guess we better try not to remove packages from it
in the future but get it right from the start.
> I will add a note in the next version of the doc, to hint towards the
> two solutions to use a svg file: adding librsvg to the profile, or
> computing the png and put it in the store using a "computed-file" in the
> configuration (as in the second version of the patch).
Do we need a computed-file example? Sway’s default background
$(guix build sway)/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png
is a .png file already. We need not use guix-backgrounds. Rationale:
In the computed-file version, note that librsvg needs rust and rust does
not build on i686-linux nor armhf. I tested in an i686-linux VM and the
rest of your home-sway-service-type works great there (using elogind and
manually running sway, because greetd would need rust). Using
imagemagick’s convert just gives a bogus pure black .png file.
I still have not found the time to look at `sway-bar' and `point' and
`sway-color' and such details.
Regards,
Florian
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-25 6:58 ` pelzflorian (Florian Pelz)
@ 2024-09-25 7:52 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-25 11:42 ` pelzflorian (Florian Pelz)
1 sibling, 0 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-25 7:52 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: Hilton Chain, 72714
[-- Attachment #1: Type: text/plain, Size: 3199 bytes --]
Hello Florian,
> "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
>> I’m still looking at the details of sway, so I could myself push your
>> patch with confidence to guix.git, but would also be happy if others
>> pushed it
> Nice, NB: it is also fine
I meant: it is also fine if you prefer to wait a few weeks for someone
else with commit access to comment/push this patch (as I do not want to
put pressure on you, and you said that you preferred not to take
responsibility for sway in a previous email).
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> I still have not found the time to look at `sway-bar' and `point' and
> `sway-color' and such details.
As I have changed these configuration records and the serialisation
function (hopefully making it easier to read and modify) in the v6, I
will send it today. I will not address your comments from today, but
should contain improvements over the previous code.
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
>> I will probably define a new variable `%sway-default-packages'
>> containing the above packages (minus waybar, ...). WDYT?
>
> Yes, good idea.
>
> Though some of these commands like dbus and xdg portals are unnecessary
> because noone will run them manually from within sway.
Yes, indeed. This week, I will test sway with only (list sway) and
(list sway swaybg) to see what works and what fails in each case. Then,
I will try to minimise the list of v5 (as users can always provide their
own lists if they want more packages to be available).
> Also note that the menu should default to wmenu instead of dmenu
> according to swaywm.org release notes for current sway 1.9. Both are in
> $(guix build sway)/etc/sway/config, but dmenu got used, but probably for
> compatibility only.
>
> wmenu should be the only menu.
Noted. I used an outdated default sway configuration when defining
default variables, my bad.
This will not be modified in the v6 (as I send it right away), but
should be done later; I have added a comment in the code to remind me of
that.
> Do we have an API stability guarantee that `%sway-default-packages' will
> remain the same? I guess we better try not to remove packages from it
> in the future but get it right from the start.
Indeed, this would be better. As mentioned above, I will try to
minimise this list and only keep packages that are necessary for using
sway. I will try to report on that within the week.
>> I will add a note in the next version of the doc, to hint towards the
>> two solutions to use a svg file: adding librsvg to the profile, or
>> computing the png and put it in the store using a "computed-file" in the
>> configuration (as in the second version of the patch).
>
> Do we need a computed-file example? [...] Rationale: [...]
Thank you for this thorough testing and associated explanation.
I agree with you and have removed this example from the documentation
(only leaving the note that librsvg is needed in the profile in order to
use svg files).
Best,
--
Arnaud
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v6] home: services: Add 'home-sway-service-type'.
2024-08-19 15:30 [bug#72714] [PATCH] home: services: Add 'home-sway-service-type' Arnaud Daby-Seesaram via Guix-patches via
` (3 preceding siblings ...)
2024-09-18 8:15 ` [bug#72714] [PATCH v5] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-25 8:00 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-30 20:07 ` Ludovic Courtès
4 siblings, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-09-25 8:00 UTC (permalink / raw)
To: 72714; +Cc: Arnaud Daby-Seesaram
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
(sway-mode): New configuration record.
(flatten): New procedure.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
---
I only send this version of the patch to provide the latest version of
my code.
I have checked that a few produced configuration files were valid sway
files (with "sway -c"), but have not yet performed further testing on
this version.
Note: I have not proof-read the documentation; it might be a little
behind on the code or contain misspellings.
doc/guix.texi | 361 ++++++++++++++++++
gnu/home/services/sway.scm | 755 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 1117 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 52e36e4354..dc7ab5884f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -130,6 +130,7 @@ Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
Copyright @copyright{} 2024 Fabio Natali@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -460,6 +461,7 @@ Home Services
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@@ -45196,6 +45198,7 @@ services)}.
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@@ -47110,6 +47113,364 @@ kodi} for more information.
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+
+@cindex sway, Home Service
+@cindex sway, configuration
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure sway in a
+declarative way.
+
+@quotation Note
+This home service only sets up the configuration file and profile
+packages for sway. It does @i{not} start sway in any way. If you 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
+to provide the value for the @emph{optional} @code{sway-configuration}
+field of @code{greetd-wlgreet-sway-session}.
+@end quotation
+
+@defvar sway-configuration->file
+This function takes a @code{sway-configuration} record (defined below),
+and returns a file-like object represented the serialized configuration.
+@end defvar
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding sway-related packages to your profile.
+@end itemize
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg (file-append sway
+ "\
+/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png")))))))
+@end lisp
+
+The above example describes a sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.png} is provided by
+the @code{sway} package;
+@item
+swiping down (resp.@: up) with three fingers moves the active window to
+the scratchpad (resp.@: shows/hides the scratchpad).
+@end itemize
+@end defvar
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are strings or G-expressions (@pxref{G-Expressions}).
+
+Example: @code{'(mod . "Mod4")}.
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+This field describes keybindings for the @emph{default} mode. As above,
+the value is an association list: keys are symbols and values are either
+strings, G-expressions or file-append objects.
+
+Examples using:
+@itemize
+@item
+a string: @code{'($mod+Return . "exec $term")}
+@item
+a G-exp: @code{`($mod+t . ,#~(string-append #$st "/bin/st"))}
+@item
+a file-append: @code{`($mod+t . ,(file-append st "/bin/st"))}
+@end itemize
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+Similar to the previous field, but for finger-gestures.
+
+The following snippet allows to navigate through workspaces by swiping
+right and left with three fingers:
+@lisp
+'((swipe:3:right . "workspace next_on_output")
+ (swipe:3:left . "workspace prev_on_output"))
+@end lisp
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile.
+
+@item @code{inputs} (default: @code{'()})
+List of @code{sway-input} configuration records.
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records.
+
+@item @code{bar} (optional)
+Optional @code{sway-bar} configuration record to declare the sway-bar
+configuration.
+
+@item @code{modes} (default: @code{'()})
+Optional list of @code{sway-mode} records (described below).
+
+@item @code{always-execs} (default: @code{'()})
+Programs to execute at startup time @i{and} after every configuration
+reload. The value of this field is a list of strings or G-expressions.
+
+@item @code{execs} (default: @code{%sway-default-execs})
+Programs to execute at startup time. The value of this field is a list
+of strings or G-expressions.
+
+The default value, @code{%sway-default-execs}, executes @code{swayidle}
+in order to lock the screen after 5@ minutes of inactivity (displaying a
+background distributed with Sway) and turn of the screen after
+10@ minutes of inactivity.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+@end table
+@end deftp
+
+@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
+to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (xkb-layout "fr")
+ (xkb-options '("ctrl:nocaps")))
+@end lisp
+
+Available fields for @code{sway-input} configuration records are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If a
+string is used, it will be quoted in the generated configuration file.
+
+@item @code{xkb-layout} (optional)
+Keyboard specific option. String providing a comma-separated keyboard
+layout(s) to use.
+
+@item @code{xkb-model} (optional)
+Keyboard specific option. String providing the keyboard model.
+
+@item @code{xkb-options} (optional)
+Keyboard specific option. List of strings specifying additional xkb
+options for the keyboard.
+
+@item @code{xkb-variant} (optional)
+Keyboard specific option. String specifying the variant of the layout.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list of
+strings.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+@item @code{resolution} (optional)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{bg} (optional)
+This field accepts a file-like value representing the wallpaper to use
+on this monitor. It will be used with the @code{fill} option.
+
+@quotation Note
+If you have @code{librsvg} in your profile, it is possible to specify
+the path to an SVG file.
+@end quotation
+
+@item @code{extra-content} (default: @code{'()})
+List defining additional lines to add to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-border-color
+
+@table @code
+@item border
+Color of the border.
+@item background
+Color of the background.
+@item text
+Color of the text.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background} (optional string)
+Background color of the bar.
+
+@item @code{statusline} (optional string)
+Text color of the status line.
+
+@item @code{focused-background} (optional string)
+Background color of the bar on the currently focused monitor.
+
+@item @code{focused-statusline} (optional string)
+Text color of the statusline on the currently focused monitor.
+
+@item @code{focused-workspace} (optional @code{sway-border-color})
+Color scheme for focused workspaces.
+
+@item @code{active-workspace} (optional @code{sway-border-color})
+Colour scheme for active workspaces.
+
+@item @code{inactive-workspace} (optional @code{sway-border-color})
+Colour scheme for inactive workspaces.
+
+@item @code{urgent-workspace} (optional @code{sway-border-color})
+Colour scheme for workspaces containing ``urgent'' windows.
+
+@item @code{binding-mode} (optional @code{sway-border-color})
+Colour scheme for the binding mode indicator.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a symbol.
+
+@item @code{position} (optional)
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (optional)
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{show}.
+
+@item @code{binding-mode-indicator} (optional)
+Boolean enabling or disabling the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+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.
+
+Each line printed on @code{stdout} by this command (or script) will be
+displayed on the status area of the bar.
+
+Below are a few examples using:
+@itemize
+@item
+a string: @code{"while date +'%Y-%m-%d %X'; do sleep 1; done"},
+@item
+a G-exp:
+@lisp
+#~(string-append "while "
+ #$coreutils "/bin/date"
+ " +'%Y-%m-%d %X'; do sleep 1; done")
+@end lisp
+@item
+an executable file:
+@lisp
+(program-file
+ "sway-bar-status"
+ (with-imported-modules
+ (source-module-closure
+ '((ice-9 format) (srfi srfi-19)))
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-19))
+ (let loop ()
+ (let* ((date (date->string
+ (current-date)
+ "~d/~m/~Y (~a) ~H:~M:~S")))
+ (format #t "~a~%~!" date)
+ (sleep 1)
+ (loop))))))
+@end lisp
+@end itemize
+
+@item @code{mouse-bindings} (default: @code{'()})
+This field accepts an associative list. Keys are integers describing
+mouse events. Values can be either strings, G-expressions or
+file-append objects.
+
+The module @code{(gnu home services sway)} exports constants
+@code{%ev-code-mouse-left}, @code{%ev-code-mouse-right} and
+@code{%ev-code-mouse-scroll-click} whose values are integers
+corresponding to left, right and scroll click respectively. For
+example, with the @code{`((,%ev-code-mouse-left . ,(file-append st
+"/bin/st")))}, left clicks in the status bar open the @code{st}
+terminal.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-mode
+Describes a Sway mode. For example, the following snippet defines a
+mockup of the resize mode of the default Sway configuration:
+@example
+(sway-mode
+ (mode-name "resize")
+ (keybindings
+ '(($left . "resize shrink width 10px")
+ ($right . "resize grow width 10px")
+ ($down . "resize grow height 10px")
+ ($up . "resize shrink height 10px")
+ (Return . "mode \"default\"")
+ (Escape . "mode \"default\""))))
+@end example
+
+@table @asis
+@item @code{mode-name} (default: @code{"default"})
+Name of the mode. This field accepts strings.
+
+@item @code{keybindings} (default: @code{'()})
+This field describes keybindings. The value is an association list:
+keys are symbols and values are either strings or G-expressions, as
+above.
+
+@item @code{mouse-bindings} (default: @code{'()})
+Ditto, but keys are mouse events (integers). Constants
+@code{%ev-code-mouse-*} described above can be used as helpers to define
+mouse bindings.
+@end table
+@end deftp
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..6e55fda5fc
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,755 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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 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 (;; Event codes
+ %ev-code-mouse-left
+ %ev-code-mouse-right
+ %ev-code-mouse-scroll-click
+
+ ;; Configuration records.
+ sway-configuration
+ sway-bar
+ sway-output
+ sway-input
+ point
+ sway-color
+ sway-border-color
+ home-sway-service-type
+ sway-configuration->file
+ sway-mode
+
+ ;; Default values.
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ %sway-default-execs
+ %sway-default-packages))
+
+;; Helper function.
+(define (flatten l)
+ (let loop ((lst (reverse l)) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (loop tail (append head acc))))))
+
+\f
+;;;
+;;; Default settings and useful constants.
+;;;
+
+(define %ev-code-mouse-left 272)
+(define %ev-code-mouse-right 273)
+(define %ev-code-mouse-scroll-click 274)
+
+;; TODO: reduce this list to a minimal, and make sure that sway behaves well.
+(define %sway-default-packages
+ (list sway swaybg))
+
+;; TODO: Update default values to match current default configuration files of
+;; sway.
+(define %sway-default-variables
+ `((mod . "Mod4")
+ (left . "h")
+ (down . "j")
+ (up . "k")
+ (right . "l")
+ (term . ,(file-append st "/bin/st"))
+ (menu . ,#~(string-append
+ #$dmenu "/bin/dmenu_path | "
+ #$wmenu "/bin/wmenu | "
+ #$findutils "/bin/xargs "
+ #$sway "/bin/swaymsg exec --"))))
+
+(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")))
+
+(define %sway-default-keybindings
+ `(($mod+Return . "exec $term")
+ ($mod+Shift+q . "kill")
+ ($mod+d . "exec $menu")
+ ($mod+Shift+c . "reload")
+ ($mod+Shift+e
+ . ,#~(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' '"
+ #$sway "/bin/swaymsg exit'"))
+ ($mod+$left . "focus left")
+ ($mod+$down . "focus down")
+ ($mod+$up . "focus up")
+ ($mod+$right . "focus right")
+ ($mod+Left . "focus left")
+ ($mod+Down . "focus down")
+ ($mod+Up . "focus up")
+ ($mod+Right . "focus right")
+ ($mod+Shift+$left . "move left")
+ ($mod+Shift+$down . "move down")
+ ($mod+Shift+$up . "move up")
+ ($mod+Shift+$right . "move right")
+ ($mod+Shift+Left . "move left")
+ ($mod+Shift+Down . "move down")
+ ($mod+Shift+Up . "move up")
+ ($mod+Shift+Right . "move right")
+ ($mod+1 . "workspace number 1")
+ ($mod+2 . "workspace number 2")
+ ($mod+3 . "workspace number 3")
+ ($mod+4 . "workspace number 4")
+ ($mod+5 . "workspace number 5")
+ ($mod+6 . "workspace number 6")
+ ($mod+7 . "workspace number 7")
+ ($mod+8 . "workspace number 8")
+ ($mod+9 . "workspace number 9")
+ ($mod+0 . "workspace number 10")
+ ($mod+Shift+1 . "move container to workspace number 1")
+ ($mod+Shift+2 . "move container to workspace number 2")
+ ($mod+Shift+3 . "move container to workspace number 3")
+ ($mod+Shift+4 . "move container to workspace number 4")
+ ($mod+Shift+5 . "move container to workspace number 5")
+ ($mod+Shift+6 . "move container to workspace number 6")
+ ($mod+Shift+7 . "move container to workspace number 7")
+ ($mod+Shift+8 . "move container to workspace number 8")
+ ($mod+Shift+9 . "move container to workspace number 9")
+ ($mod+Shift+0 . "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+a . "focus parent")
+ ($mod+Shift+minus . "move scratchpad")
+ ($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-execs
+ (list
+ #~(string-append
+ #$swayidle "/bin/swayidle -w \\\n"
+ ;; 300: lock screen.
+ " timeout 300 '" #$swaylock "/bin/swaylock "
+ "--indicator-radius 75 "
+ "-i " #$sway "/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png"
+ " -f -c 000000' \\\n"
+ ;; 600: lock + screen off.
+ " timeout 600 '" #$sway "/bin/swaymsg \"output * power off\"' \\\n"
+ ;; Resume + sleep.
+ " resume '" #$sway "/bin/swaymsg \"output * power on\"' \\\n"
+ " before-sleep '" #$swaylock "/bin/swaylock -f -c 000000'")))
+
+\f
+;;;
+;;; Definition of configurations.
+;;;
+
+(define (string-ish? s)
+ (or (gexp? s)
+ (file-append? s)
+ (string? s)))
+
+(define (list-of-string-ish? lst)
+ (every string-ish? 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 (make-alist-predicate key? val?)
+ (lambda (lst)
+ (every
+ (lambda (item)
+ (match item
+ ((k . v)
+ (and (key? k)
+ (val? v)))
+ (_ #f)))
+ lst)))
+
+(define bindings?
+ (make-alist-predicate symbol? string-ish?))
+
+(define mouse-bindings?
+ (make-alist-predicate integer? string-ish?))
+
+(define (variables? lst)
+ (make-alist-predicate symbol? string-ish?))
+
+(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
+ (strings '())
+ "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 status line.")
+ (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
+ "Color scheme for focused workspaces.")
+ (active-workspace
+ maybe-sway-border-color
+ "Color scheme for active workspaces.")
+ (inactive-workspace
+ maybe-sway-border-color
+ "Color scheme for inactive workspaces.")
+ (urgent-workspace
+ maybe-sway-border-color
+ "Color scheme for workspaces containing `urgent' windows.")
+ (binding-mode
+ maybe-sway-border-color
+ "Color scheme for the binding mode indicator."))
+
+(define-maybe sway-color (no-serialization))
+
+(define (status-command? c)
+ (or (string? c)
+ (file-like? c)
+ (gexp? c)))
+
+(define-maybe bar-position (no-serialization))
+(define-maybe hidden-state (no-serialization))
+(define-maybe status-command (no-serialization))
+(define-maybe boolean (no-serialization))
+
+(define-configuration/no-serialization sway-bar
+ (identifier
+ (symbol 'bar0)
+ "Identifier of the bar.")
+ (position
+ maybe-bar-position
+ "Position of the bar.")
+ (hidden-state
+ maybe-hidden-state
+ "Hidden state.")
+ (binding-mode-indicator
+ maybe-boolean
+ "Binding indicator.")
+ (colors
+ maybe-sway-color
+ "Color palette of the bar.")
+ (status-command
+ maybe-status-command
+ "Status command. It must be file-like.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Actions triggered by mouse events.")
+ (extra-content
+ (list-of-string-ish '())
+ "Extra configuration lines."))
+
+(define-maybe sway-bar (no-serialization))
+
+(define-configuration/no-serialization point
+ (x integer "X coordinate.")
+ (y integer "Y coordinate."))
+
+(define (file-like-or-gexp? f)
+ (or (file-like? f)
+ (gexp? f)))
+
+(define-maybe point (no-serialization))
+(define-maybe file-like-or-gexp (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-or-gexp
+ "Background image.")
+ (extra-content
+ (list-of-string-ish '())
+ "Extra lines."))
+
+(define (sway-outputs? lst)
+ (every sway-output? lst))
+
+(define-configuration/no-serialization sway-mode
+ (mode-name
+ (string "default")
+ "Name of the mode.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Mouse bindings."))
+;; TODO (not necessary for 72714): switch bindings.
+
+(define (sway-modes? lst)
+ (every sway-mode? lst))
+
+(define-configuration/no-serialization sway-configuration
+ (keybindings
+ (bindings %sway-default-keybindings)
+ "Keybindings.")
+ (gestures
+ (bindings %sway-default-gestures)
+ "Gestures.")
+ (packages
+ (list-of-packages
+ %sway-default-packages)
+ "List of packages to add to the profile.")
+ (variables
+ (variables %sway-default-variables)
+ "Variables declared at the beginning of the file.")
+ (inputs
+ (sway-inputs '())
+ "Inputs.")
+ (outputs
+ (sway-outputs '())
+ "Outputs.")
+ (bar
+ maybe-sway-bar
+ "Bar configuration.")
+ (modes
+ (sway-modes '())
+ "Additional modes.")
+ (always-execs
+ (list-of-string-ish '())
+ "Programs to execute at startup time.")
+ (execs
+ (list-of-string-ish %sway-default-execs)
+ "Programs to execute at startup time.")
+ (extra-content
+ (list-of-string-ish '())
+ "Lines to add at the end of the configuration file."))
+
+\f
+;;;
+;;; Serialization functions.
+;;;
+
+;; Helper functions.
+(define* (add-line-if field value
+ #:key (serializer %unset-value)
+ (suffix %unset-value))
+ (if (eq? %unset-value value)
+ %unset-value
+ #~(string-append #$field " "
+ #$(if (eq? serializer %unset-value)
+ value
+ (serializer value))
+ #$(if (eq? suffix %unset-value)
+ ""
+ suffix))))
+
+(define (add-block name content)
+ (let ((content (filter
+ (lambda (elt) (not (eq? elt %unset-value)))
+ content)))
+ (if (equal? content '())
+ '()
+ (append
+ (list #~(cons 'begin-block #$name))
+ content
+ (list #~'end-block)))))
+
+(define-syntax add-block*
+ (syntax-rules ()
+ ((add-block* name elt ...)
+ (add-block name (append elt ...)))))
+
+(define (box str)
+ (let* ((len (string-length str))
+ (line (make-string (+ 4 len) #\#)))
+ (list
+ line
+ (string-append "# " str " #")
+ line)))
+
+(define (heading str)
+ (let* ((len (string-length str))
+ (line (make-string (+ 2 len) #\#)))
+ (list
+ ""
+ (string-append "# " str)
+ line)))
+
+(define-inlinable (serialize-binding binder key value)
+ #~(string-append #$binder #$key " " #$value))
+
+(define (serialize-mouse-binding var)
+ (let* ((ev (car var))
+ (ev-code (number->string ev))
+ (command (cdr var)))
+ (serialize-binding "bindcode " ev-code command)))
+
+(define (serialize-keybinding var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "bindsym " name value)))
+
+(define (serialize-gesture var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "bindgesture " name value)))
+
+(define (serialize-variable var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "set $" name value)))
+
+(define (serialize-exec b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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)))
+ (add-block
+ (string-append "output " ident)
+ (cons*
+ ;; Optional elements.
+ (add-line-if "bg" bg #:suffix " fill")
+ (add-line-if "resolution" resolution)
+ (add-line-if "position" position
+ #:serializer
+ (lambda (p)
+ (string-append (number->string (point-x p))
+ " "
+ (number->string (point-x p)))))
+ ;; Extra-content: inlined as-is.
+ extra-content))))
+
+(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))
+ (extra-content (sway-input-extra-content input)))
+ (add-block
+ (string-append "input " ident)
+ (cons*
+ ;; Optional.
+ (add-line-if "xkb_layout" xkb-layout)
+ (add-line-if "xkb_model" xkb-model)
+ (add-line-if "xkb_variant" xkb-variant)
+ (add-line-if "xkb_options" xkb-options
+ #:serializer (lambda (l) (string-join l ",")))
+ ;; extra-content inlined as-is.
+ extra-content))))
+
+(define (serialize-colors colors)
+ (define (border-serializer val)
+ (string-append (sway-border-color-border val)
+ " " (sway-border-color-background val)
+ " " (sway-border-color-text val)))
+ (if (eq? %unset-value colors)
+ '()
+ (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)))
+ (add-block
+ "colors"
+ (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-line-if "focused_workspace" focused-workspace
+ #:serializer border-serializer)
+ (add-line-if "active_workspace" active-workspace
+ #:serializer border-serializer)
+ (add-line-if "inactive_workspace" inactive-workspace
+ #:serializer border-serializer)
+ (add-line-if "urgent_workspace" urgent-workspace
+ #:serializer border-serializer)
+ (add-line-if "binding_mode" binding-mode
+ #:serializer border-serializer))))))
+
+(define (serialize-mode mode)
+ (let ((name (sway-mode-mode-name mode))
+ (keys (sway-mode-keybindings mode))
+ (clicks (sway-mode-mouse-bindings mode)))
+ (add-block*
+ (string-append "mode \"" name "\"")
+ (map serialize-keybinding keys)
+ (map serialize-mouse-binding clicks))))
+
+(define (serialize-bar bar)
+ (define serialize-symbol
+ symbol->string)
+ (define (serialize-mode-indicator mi)
+ (if mi "yes" "no"))
+
+ (let ((identifier (symbol->string (sway-bar-identifier bar)))
+ (position (sway-bar-position bar))
+ (hidden-state (sway-bar-hidden-state bar))
+ (status-command (sway-bar-status-command bar))
+ (binding-mode-indicator (sway-bar-binding-mode-indicator bar))
+ (mouse-bindings (sway-bar-mouse-bindings bar))
+ (extra-content (sway-bar-extra-content bar))
+ (colors (sway-bar-colors bar)))
+ (add-block*
+ (string-append "bar " identifier)
+
+ (if (eq? colors %unset-value)
+ '()
+ (serialize-colors colors))
+ (list
+ (add-line-if "position" position
+ #:serializer serialize-symbol)
+ (add-line-if "hidden_state" hidden-state
+ #:serializer serialize-symbol)
+ (add-line-if "status_command" status-command)
+ (add-line-if "binding_mode_indicator" binding-mode-indicator
+ #:serializer serialize-mode-indicator))
+ ;; Key- and mouse-bindings and extra-content
+ (map serialize-mouse-binding mouse-bindings)
+ extra-content)))
+
+(define (sway-configuration->file 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) (srfi srfi-1)))
+ (computed-file
+ "sway-config"
+ #~(begin
+ (use-modules (ice-9 format) (ice-9 popen) (ice-9 match)
+ (srfi srfi-1))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Add the (indented) line "s" to the output file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (make-string i #\ ) s)
+ i))
+
+ ;; Increase the indentation level by `i'.
+ ;; (define (indent i)
+ ;; (lambda (j)
+ ;; (+ i j)))
+
+ ;; Begin a block "name" and adjust the indentation.
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (make-string i #\ ) name)
+ (+ i 4)))
+
+ ;; Ends an open block and adjust the indentation.
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (make-string i #\ ))
+ i)))
+
+ ;; Helper function. The configuration is represented as a list
+ ;; of actions (alter the indentation level, add a line, ...).
+ ;; This function recognises the action and calls the right
+ ;; function among those defined above.
+ (define (serializer-dispatch-m arg)
+ (match arg
+ ;; Special cases:
+ ;; unused: ((? integer? arg) (indent arg))
+ (('begin-block . str) (begin-block str))
+ ('end-block (end-block))
+ ;; Default case: `arg' is assumed to be a string.
+ (_ (line arg))))
+
+ (define (serializer-dispatch elt i)
+ ((serializer-dispatch-m elt) i))
+
+ (fold
+ ;; Dispatch function: depending on its argument, it will change
+ ;; the indentation level or add a line to the output file.
+ serializer-dispatch
+
+ ;; Initial indentation level
+ 0
+
+ ;; List of lines or indentation modifiers.
+ (list
+ ;; Header.
+ #$@(box "Auto-generated configuration")
+ "# DO NOT EDIT MANUALLY."
+
+ ;; Variables.
+ #$@(heading "Variables.")
+ #$@(map serialize-variable (sway-configuration-variables conf))
+
+ ;; Outputs.
+ #$@(heading "Outputs.")
+ #$@(flatten
+ (map serialize-output (sway-configuration-outputs conf)))
+
+ ;; Inputs.
+ #$@(heading "Inputs.")
+ #$@(flatten
+ (map serialize-input (sway-configuration-inputs conf)))
+
+ ;; Bar configuration:
+ ;; If the bar is unset, do not include anything.
+ #$@(if (eq? bar %unset-value)
+ '()
+ (append
+ (heading "Bar configuration.")
+ (serialize-bar bar)))
+
+ ;; Keybindings.
+ #$@(heading "Keybindings.")
+ #$@(map serialize-keybinding
+ (sway-configuration-keybindings conf))
+ ;; Gestures.
+ #$@(heading "Gestures.")
+ #$@(map serialize-gesture (sway-configuration-gestures conf))
+
+ ;; Modes.
+ #$@(heading "Modes.")
+ #$@(flatten
+ (map serialize-mode (sway-configuration-modes conf)))
+
+ ;; Execs.
+ #$@(heading "Programs to execute (at startup).")
+ #$@(map (serialize-exec #f) (sway-configuration-execs conf))
+ ;; Always-execs.
+ #$@(heading "Programs to execute (at startup & after reload).")
+ #$@(map (serialize-exec #t) (sway-configuration-execs conf))
+
+ ;; Extra-content.
+ #$@extra))))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 8e7abc8a47..cda3ccd732 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -114,6 +114,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
--
2.46.0
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'.
2024-09-25 6:58 ` pelzflorian (Florian Pelz)
2024-09-25 7:52 ` Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-25 11:42 ` pelzflorian (Florian Pelz)
1 sibling, 0 replies; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-09-25 11:42 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: Hilton Chain, 72714
Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
> Hello Florian,
>
>> "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
>>> I’m still looking at the details of sway, so I could myself push your
>>> patch with confidence to guix.git, but would also be happy if others
>>> pushed it
>> Nice, NB: it is also fine
>
> I meant: it is also fine if you prefer to wait a few weeks for someone
> else with commit access to comment/push this patch (as I do not want to
> put pressure on you, and you said that you preferred not to take
> responsibility for sway in a previous email).
Thank you. There’s no pressure on me, but I will be slow in my
investigation and responses.
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> Also note that the menu should default to wmenu instead of dmenu
> according to swaywm.org release notes for current sway 1.9. Both are in
> $(guix build sway)/etc/sway/config, but dmenu got used, but probably for
> compatibility only.
>
> wmenu should be the only menu.
Sorry, I had not tested this yet. Even though web searches point to
some obscure program called wmenu_path that must exist somewhere, it
seems your use of dmenu_path is what upstream uses. I do not really
understand this.
Regards,
Florian
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v6] home: services: Add 'home-sway-service-type'.
2024-09-25 8:00 ` [bug#72714] [PATCH v6] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-09-30 20:07 ` Ludovic Courtès
2024-10-01 22:12 ` [bug#72714] [PATCH] " Arnaud Daby-Seesaram via Guix-patches via
2024-10-01 22:30 ` [bug#72714] [PATCH v7] " Arnaud Daby-Seesaram via Guix-patches via
0 siblings, 2 replies; 24+ messages in thread
From: Ludovic Courtès @ 2024-09-30 20:07 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: Hilton Chain, 72714
Hi Arnaud,
Arnaud Daby-Seesaram <ds-ac@nanein.fr> skribis:
> * gnu/home/services/sway.scm: New file.
> (home-sway-service-type): New variable.
> (sway-configuration->file): New procedure.
> (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.
> (sway-mode): New configuration record.
> (flatten): New procedure.
> * gnu/local.mk: Add gnu/home/services/sway.scm.
> * doc/guix.texi (Sway window manager): New node to document the above changes.
I don’t use Sway myself but it looks like a welcome addition.
I trust Hilton’s comment here so here are some more superficial
comments.
> +The @code{(gnu home services sway)} module provides
> +@code{home-sway-service-type}, a home service to configure sway in a
> +declarative way.
To add more context:
“… to configure the @uref{https://github.com/swaywm/sway,Sway window
manager for Wayland} in a declarative way.”
> +@quotation Note
> +This home service only sets up the configuration file and profile
> +packages for sway. It does @i{not} start sway in any way. If you want
s/sway/Sway/
s/@i/@emph/
> +@defvar sway-configuration->file
Should be “@deffn {Procedure} sway-configuration->file config”.
> +Here is an example of a service and its configuration that you could add
> +to the @code{services} field of your @code{home-environment}:
I would move the example right before “@quotation Note”.
> +@item @code{always-execs} (default: @code{'()})
> +Programs to execute at startup time @i{and} after every configuration
> +reload. The value of this field is a list of strings or G-expressions.
> +
> +@item @code{execs} (default: @code{%sway-default-execs})
> +Programs to execute at startup time. The value of this field is a list
> +of strings or G-expressions.
Please avoid abbreviations. Maybe these fields could be called
‘startup+reload-programs’ and ‘startup-programs’?
> +The default value, @code{%sway-default-execs}, executes @code{swayidle}
Likewise, @code{%sway-default-startup-programs}?
> +@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
> +to @kbd{ctrl}:
> +@lisp
> +(sway-input (identifier "type:keyboard")
> + (xkb-layout "fr")
> + (xkb-options '("ctrl:nocaps")))
> +@end lisp
Would it be possible here to reuse the <keyboard-layout> record
documented in
<https://guix.gnu.org/manual/devel/en/html_node/Keyboard-Layout.html>?
If it’s possible, that would provide a nicely consistent interface. If
there’s the need for an extra identifier, maybe you’ll still need
<sway-input>:
(sway-input (identifier "type:keyboard")
(layout (keyboard-layout "tr")))
WDYT?
> +@lisp
> +(program-file
> + "sway-bar-status"
> + (with-imported-modules
> + (source-module-closure
> + '((ice-9 format) (srfi srfi-19)))
‘with-imported-modules’ can be removed here because (ice-9 format) and
(srfi srfi-19) are provided by Guile itself.
That’s it for me!
Could you send updated patches?
Thank you!
Ludo’.
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
2024-09-30 20:07 ` Ludovic Courtès
@ 2024-10-01 22:12 ` Arnaud Daby-Seesaram via Guix-patches via
2024-10-02 14:08 ` pelzflorian (Florian Pelz)
2024-10-01 22:30 ` [bug#72714] [PATCH v7] " Arnaud Daby-Seesaram via Guix-patches via
1 sibling, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-10-01 22:12 UTC (permalink / raw)
To: 72714
Cc: Hilton Chain, Ludovic Courtès, Arnaud Daby-Seesaram,
Florian Pelz
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
(sway-mode): New configuration record.
(flatten): New procedure.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
---
Hi all,
This version takes into account previous reviews (hoping that I did not
forget/break something). The modifications are mainly:
• fix a typo in the code: in the v6, execs was serialised in place of
always-execs,
• following your advice, I renamed abbreviations:
- bg → background
- execs → startup-programs
- always-execs → startup+reload-programs
• keyboard layouts are now specified with <keyboard-layout> records in
sway-input, as suggested. I have added a cross-reference to the
relevant section in the manual.
Note: (gnu home services sway) does not re-export keyboard-layout.
• the background field of sway-output now accepts pairs too, in order to
describe how the background should be displayed (fill the screen, at
the center of the screen, etc.)
• the list of default packages is simply (list sway)
• (flatten (map _ _)) with a homemade flatten is replaced by (flatmap _
_) with a homemade flatmap.
• the default terminal is now set to foot (as in the default config on
the sway 1.9)
• extra-content no longer allows file-append objects (which did not make
sense)
• new fields in sway-input
Best regards,
doc/guix.texi | 394 ++++++++++++++++++
gnu/home/services/sway.scm | 794 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 1189 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 52e36e4354..f5911a19c6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -130,6 +130,7 @@ Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
Copyright @copyright{} 2024 Fabio Natali@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -460,6 +461,7 @@ Home Services
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@@ -45196,6 +45198,7 @@ services)}.
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@@ -47110,6 +47113,397 @@ kodi} for more information.
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+
+@cindex sway, Home Service
+@cindex sway, configuration
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure the
+@uref{https://github.com/swaywm/sway,Sway window manager for Wayland} in
+a declarative way.
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg (file-append sway
+ "\
+/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png")))))))
+@end lisp
+
+The above example describes a Sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.png} is provided by
+the @code{sway} package;
+@item
+swiping down (resp.@: up) with three fingers moves the active window to
+the scratchpad (resp.@: shows/hides the scratchpad).
+@end itemize
+
+@quotation Note
+This home service only sets up the configuration file and profile
+packages for Sway. It does @emph{not} start Sway in any way. If you
+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
+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 a @code{sway-configuration} record (defined below),
+and returns a file-like object representing the serialized
+configuration.
+@end deffn
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding Sway-related packages to your profile.
+@end itemize
+@end defvar
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the Sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are either strings, G-expressions or file-append objects
+(@pxref{G-Expressions}).
+
+Example:
+@lisp
+(variables `((mod . "Mod4") ; string
+ (term ; file-append
+ . ,(file-append foot "/bin/foot"))
+ (term ; G-expression
+ . ,#~(string-append #$foot "/bin/foot"))))
+@end lisp
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+This field describes keybindings for the @emph{default} mode. The value
+is an association list: keys are symbols and values are either strings
+or G-expressions.
+
+The following snippet launches the terminal when pressing @kbd{$mod+t}
+and @kbd{$mod+Shift+t} (assuming that a variable @code{$term} is
+defined):
+@lisp
+`(($mod+t . ,#~(string-append "exec " #$foot "/bin/foot"))
+ ($mod+Shift+t . "exec $term"))
+@end lisp
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+Similar to the previous field, but for finger-gestures.
+
+The following snippet allows to navigate through workspaces by swiping
+right and left with three fingers:
+@lisp
+'((swipe:3:right . "workspace next_on_output")
+ (swipe:3:left . "workspace prev_on_output"))
+@end lisp
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile. At
+the moment, the default value only adds @code{sway} to the profile.
+
+@item @code{inputs} (default: @code{'()})
+List of @code{sway-input} configuration records (described below).
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records (described below).
+
+@item @code{bar} (optional @code{sway-bar} record)
+Optional @code{sway-bar} record (described below) to configure a Sway
+bar.
+
+@item @code{modes} (default: @code{'()})
+Optional list of @code{sway-mode} records (described below) to add modes
+to the Sway configuration (@i{e.g.}@: the ``resize'' mode of the default
+Sway configuration).
+
+@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}).
+
+@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.
+
+The default value, @code{%sway-default-execs}, executes @code{swayidle}
+in order to lock the screen after 5@ minutes of inactivity (displaying a
+background distributed with Sway) and turn the screen off after 10@
+minutes of inactivity.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+@end table
+@end deftp
+
+@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
+to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (layout
+ (keyboard-layout "fr" #:options '("ctrl:nocaps"))))
+@end lisp
+
+Available fields for @code{sway-input} configuration records are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+
+@item @code{layout} (optional @code{<keyboard-layout>} record)
+Keyboard specific option. Field specifying the layout (possibly with
+options) to use for the input. The value must be a
+@code{<keyboard-layout>} record (@pxref{Keyboard Layout}).
+
+@quotation Note
+@code{(gnu home services sway)} does not re-export the
+@code{keyboard-layout} procedure.
+@end quotation
+
+
+@item @code{disable-while-typing} (optional boolean)
+If @code{#t} (resp.@: @code{#f}) enables (resp.@: disables) the
+``disable while typing'' option for this input.
+
+@item @code{disable-while-trackpointing} (optional boolean)
+If @code{#t} (resp.@: @code{#f}), enables (resp.@: disables) the
+``disable while track-pointing'' option for this input.
+
+@item @code{tap} (optional boolean)
+Enables or disables the ``tap'' option, which allows clicking by tapping
+on a touchpad.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list
+whose elements can be either strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe Sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. The field accepts symbols and strings. If
+the @code{identifier} is a symbol, it is inserted as is; if it is a
+string, it will be quoted in the configuration file.
+
+@item @code{resolution} (optional string)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{background} (optional)
+The value of this field describes what wallpaper to use on this output.
+The field accepts the following types of values:
+@itemize
+@item
+a string,
+@item
+a G-expression,
+@item
+a file-append object,
+@item
+a pair. The first argument of this pair must be a string, a
+G-expression or a file-append object. The second element of the pair
+must be a symbol among @code{stretch}, @code{fill}, @code{fit},
+@code{center} and @code{tile}.
+@end itemize
+
+@quotation Note
+In order to use an SVG file, you must have @code{librsvg} in your
+profile (@i{e.g.}@: by adding it in the @code{packages} field of @code{sway-configuration}).
+@end quotation
+
+@item @code{extra-content} (default: @code{'()})
+List defining additional lines to add to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-border-color
+
+@table @code
+@item border
+Color of the border.
+@item background
+Color of the background.
+@item text
+Color of the text.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background} (optional string)
+Background color of the bar.
+
+@item @code{statusline} (optional string)
+Text color of the status line.
+
+@item @code{focused-background} (optional string)
+Background color of the bar on the currently focused monitor.
+
+@item @code{focused-statusline} (optional string)
+Text color of the statusline on the currently focused monitor.
+
+@item @code{focused-workspace} (optional @code{sway-border-color})
+Color scheme for focused workspaces.
+
+@item @code{active-workspace} (optional @code{sway-border-color})
+Color scheme for active workspaces.
+
+@item @code{inactive-workspace} (optional @code{sway-border-color})
+Color scheme for inactive workspaces.
+
+@item @code{urgent-workspace} (optional @code{sway-border-color})
+Color scheme for workspaces containing ``urgent'' windows.
+
+@item @code{binding-mode} (optional @code{sway-border-color})
+Color scheme for the binding mode indicator.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a symbol.
+
+@item @code{position} (optional)
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (optional)
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{'show}.
+
+@item @code{binding-mode-indicator} (optional)
+Boolean enabling or disabling the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+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.
+
+Each line printed on @code{stdout} by this command (or script) will be
+displayed on the status area of the bar.
+
+Below are a few examples using:
+@itemize
+@item
+a string: @code{"while date +'%Y-%m-%d %X'; do sleep 1; done"},
+@item
+a G-exp:
+@lisp
+#~(string-append "while "
+ #$coreutils "/bin/date"
+ " +'%Y-%m-%d %X'; do sleep 1; done")
+@end lisp
+@item
+an executable file:
+@lisp
+(program-file
+ "sway-bar-status"
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-19))
+ (let loop ()
+ (let* ((date (date->string
+ (current-date)
+ "~d/~m/~Y (~a) ~H:~M:~S")))
+ (format #t "~a~%~!" date)
+ (sleep 1)
+ (loop)))))
+@end lisp
+@end itemize
+
+@item @code{mouse-bindings} (default: @code{'()})
+This field accepts an associative list. Keys are integers describing
+mouse events. Values can either be strings or G-expressions.
+
+The module @code{(gnu home services sway)} exports constants
+@code{%ev-code-mouse-left}, @code{%ev-code-mouse-right} and
+@code{%ev-code-mouse-scroll-click} whose values are integers
+corresponding to left, right and scroll click respectively. For
+example, with @code{(mouse-bindings `((,%ev-code-mouse-left
+. ,#~(string-append "exec " #$st "/bin/st"))))}, left clicks in the
+status bar open the @code{st} terminal.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-mode
+Describes a Sway mode (see@ @cite{sway(5)}). For example, the following
+snippet defines a mockup of the resize mode of the default Sway
+configuration:
+@example
+(sway-mode
+ (mode-name "resize")
+ (keybindings
+ '(($left . "resize shrink width 10px")
+ ($right . "resize grow width 10px")
+ ($down . "resize grow height 10px")
+ ($up . "resize shrink height 10px")
+ (Return . "mode \"default\"")
+ (Escape . "mode \"default\""))))
+@end example
+
+@table @asis
+@item @code{mode-name} (default: @code{"default"})
+Name of the mode. This field accepts strings.
+
+@item @code{keybindings} (default: @code{'()})
+This field describes keybindings. The value is an association list:
+keys are symbols and values are either strings or G-expressions, as
+above.
+
+@item @code{mouse-bindings} (default: @code{'()})
+Ditto, but keys are mouse events (integers). Constants
+@code{%ev-code-mouse-*} described above can be used as helpers to define
+mouse bindings.
+@end table
+@end deftp
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..25cae56dae
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,794 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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 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)
+ #: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 terminals)
+ #:use-module (gnu packages suckless)
+ #:use-module (gnu packages glib)
+ #:export (;; Event codes
+ %ev-code-mouse-left
+ %ev-code-mouse-right
+ %ev-code-mouse-scroll-click
+
+ ;; Configuration records.
+ sway-configuration
+ sway-bar
+ sway-output
+ sway-input
+ point
+ sway-color
+ sway-border-color
+ home-sway-service-type
+ sway-configuration->file
+ sway-mode
+
+ ;; Default values.
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ %sway-default-startup-programs
+ %sway-default-packages))
+
+;; Helper function.
+(define (flatmap f l)
+ (let loop ((lst (reverse l)) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (let* ((h (f head))
+ (acc (append h acc)))
+ (loop tail acc))))))
+
+\f
+;;;
+;;; Default settings and useful constants.
+;;;
+
+(define %ev-code-mouse-left 272)
+(define %ev-code-mouse-right 273)
+(define %ev-code-mouse-scroll-click 274)
+
+(define %sway-default-packages
+ (list sway))
+
+(define %sway-default-variables
+ `((mod . "Mod4")
+ (left . "h")
+ (down . "j")
+ (up . "k")
+ (right . "l")
+ (term . ,(file-append foot "/bin/foot"))
+ (menu . ,#~(string-append
+ #$dmenu "/bin/dmenu_path | \\\n "
+ #$wmenu "/bin/wmenu | \\\n "
+ #$findutils "/bin/xargs \\\n "
+ #$sway "/bin/swaymsg exec --"))))
+
+(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")))
+
+(define %sway-default-keybindings
+ `(($mod+Return . "exec $term")
+ ($mod+Shift+q . "kill")
+ ($mod+d . "exec $menu")
+ ($mod+Shift+c . "reload")
+ ($mod+Shift+e
+ . ,#~(string-append
+ "exec " #$sway "/bin/swaynag -t warning -m \\\n "
+ "'You pressed the exit shortcut. Do you really want to exit sway?"
+ " This will end your Wayland session.' \\\n "
+ "-B 'Yes, exit sway' \\\n '"
+ #$sway "/bin/swaymsg exit'"))
+ ($mod+$left . "focus left")
+ ($mod+$down . "focus down")
+ ($mod+$up . "focus up")
+ ($mod+$right . "focus right")
+ ($mod+Left . "focus left")
+ ($mod+Down . "focus down")
+ ($mod+Up . "focus up")
+ ($mod+Right . "focus right")
+ ($mod+Shift+$left . "move left")
+ ($mod+Shift+$down . "move down")
+ ($mod+Shift+$up . "move up")
+ ($mod+Shift+$right . "move right")
+ ($mod+Shift+Left . "move left")
+ ($mod+Shift+Down . "move down")
+ ($mod+Shift+Up . "move up")
+ ($mod+Shift+Right . "move right")
+ ($mod+1 . "workspace number 1")
+ ($mod+2 . "workspace number 2")
+ ($mod+3 . "workspace number 3")
+ ($mod+4 . "workspace number 4")
+ ($mod+5 . "workspace number 5")
+ ($mod+6 . "workspace number 6")
+ ($mod+7 . "workspace number 7")
+ ($mod+8 . "workspace number 8")
+ ($mod+9 . "workspace number 9")
+ ($mod+0 . "workspace number 10")
+ ($mod+Shift+1 . "move container to workspace number 1")
+ ($mod+Shift+2 . "move container to workspace number 2")
+ ($mod+Shift+3 . "move container to workspace number 3")
+ ($mod+Shift+4 . "move container to workspace number 4")
+ ($mod+Shift+5 . "move container to workspace number 5")
+ ($mod+Shift+6 . "move container to workspace number 6")
+ ($mod+Shift+7 . "move container to workspace number 7")
+ ($mod+Shift+8 . "move container to workspace number 8")
+ ($mod+Shift+9 . "move container to workspace number 9")
+ ($mod+Shift+0 . "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+a . "focus parent")
+ ($mod+Shift+minus . "move scratchpad")
+ ($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
+ #$swayidle "/bin/swayidle -w \\\n "
+ ;; 300: lock screen.
+ "timeout 300 '" #$swaylock "/bin/swaylock "
+ "--indicator-radius 75 \\\n "
+ "-i " #$sway
+ "/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png \\\n "
+ "-f -c 000000' \\\n "
+ ;; 600: lock + screen off.
+ "timeout 600 '" #$sway "/bin/swaymsg \"output * power off\"' \\\n "
+ ;; Resume + sleep.
+ "resume '" #$sway "/bin/swaymsg \"output * power on\"' \\\n "
+ "before-sleep '" #$swaylock "/bin/swaylock -f -c 000000'")))
+
+\f
+;;;
+;;; Definition of configurations.
+;;;
+
+(define (string-ish? s)
+ (or (gexp? s)
+ (file-append? s)
+ (string? s)))
+
+(define (string-or-gexp? s)
+ (or (gexp? s)
+ (string? s)))
+
+(define (list-of-string-ish? lst)
+ (every string-ish? 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 (extra-content? extra)
+ (every string-or-gexp? extra))
+
+(define (make-alist-predicate key? val?)
+ (lambda (lst)
+ (every
+ (lambda (item)
+ (match item
+ ((k . v)
+ (and (key? k)
+ (val? v)))
+ (_ #f)))
+ lst)))
+
+(define bindings?
+ (make-alist-predicate symbol? string-or-gexp?))
+
+(define mouse-bindings?
+ (make-alist-predicate integer? string-or-gexp?))
+
+(define (variables? lst)
+ (make-alist-predicate symbol? string-ish?))
+
+(define-maybe string (no-serialization))
+(define-maybe strings (no-serialization))
+(define-maybe boolean (no-serialization))
+(define-maybe keyboard-layout (no-serialization))
+
+(define-configuration/no-serialization sway-input
+ (identifier
+ (string-or-symbol '*)
+ "Identifier of the input.")
+ (layout
+ maybe-keyboard-layout
+ "Keyboard layout of the input.")
+ (disable-while-typing
+ maybe-boolean
+ "If `#t', disable the input while typing; if `#f' do not.")
+ (disable-while-trackpointing
+ maybe-boolean
+ "If `#t', disable the input while using a trackpoint; if `#f' do not.")
+ (tap
+ maybe-boolean
+ "Enable or disable tap.")
+ (extra-content
+ (extra-content '())
+ "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 status line.")
+ (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
+ "Color scheme for focused workspaces.")
+ (active-workspace
+ maybe-sway-border-color
+ "Color scheme for active workspaces.")
+ (inactive-workspace
+ maybe-sway-border-color
+ "Color scheme for inactive workspaces.")
+ (urgent-workspace
+ maybe-sway-border-color
+ "Color scheme for workspaces containing `urgent' windows.")
+ (binding-mode
+ maybe-sway-border-color
+ "Color scheme for the binding mode indicator."))
+
+(define-maybe sway-color (no-serialization))
+
+(define (status-command? c)
+ (or (string? c)
+ (file-like? c)
+ (gexp? c)))
+
+(define-maybe bar-position (no-serialization))
+(define-maybe hidden-state (no-serialization))
+(define-maybe status-command (no-serialization))
+
+(define-configuration/no-serialization sway-bar
+ (identifier
+ (symbol 'bar0)
+ "Identifier of the bar.")
+ (position
+ maybe-bar-position
+ "Position of the bar.")
+ (hidden-state
+ maybe-hidden-state
+ "Hidden state.")
+ (binding-mode-indicator
+ maybe-boolean
+ "Binding indicator.")
+ (colors
+ maybe-sway-color
+ "Color palette of the bar.")
+ (status-command
+ maybe-status-command
+ "Status command. It must be file-like.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Actions triggered by mouse events.")
+ (extra-content
+ (extra-content '())
+ "Extra configuration lines."))
+
+(define-maybe sway-bar (no-serialization))
+
+(define-configuration/no-serialization point
+ (x integer "X coordinate.")
+ (y integer "Y coordinate."))
+
+(define (file-like-or-gexp? f)
+ (or (file-like? f)
+ (gexp? f)))
+
+(define-maybe point (no-serialization))
+(define-maybe file-like-or-gexp (no-serialization))
+
+(define (background? bg)
+ (or (string-ish? bg)
+ (and (pair? bg)
+ (string-ish? (car bg))
+ (member (cdr bg) '(stretch fill fit center tile)))))
+
+(define-maybe background (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.")
+ (background
+ maybe-background
+ "Background image.")
+ (extra-content
+ (extra-content '())
+ "Extra lines."))
+
+(define (sway-outputs? lst)
+ (every sway-output? lst))
+
+(define-configuration/no-serialization sway-mode
+ (mode-name
+ (string "default")
+ "Name of the mode.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Mouse bindings."))
+;; TODO (not necessary for 72714): switch bindings.
+
+(define (sway-modes? lst)
+ (every sway-mode? lst))
+
+(define-configuration/no-serialization sway-configuration
+ (keybindings
+ (bindings %sway-default-keybindings)
+ "Keybindings.")
+ (gestures
+ (bindings %sway-default-gestures)
+ "Gestures.")
+ (packages
+ (list-of-packages
+ %sway-default-packages)
+ "List of packages to add to the profile.")
+ (variables
+ (variables %sway-default-variables)
+ "Variables declared at the beginning of the file.")
+ (inputs
+ (sway-inputs '())
+ "Inputs.")
+ (outputs
+ (sway-outputs '())
+ "Outputs.")
+ (bar
+ maybe-sway-bar
+ "Bar configuration.")
+ (modes
+ (sway-modes '())
+ "Additional modes.")
+ (startup+reload-programs
+ (list-of-string-ish '())
+ "Programs to execute at startup time.")
+ (startup-programs
+ (list-of-string-ish %sway-default-startup-programs)
+ "Programs to execute at startup time.")
+ (extra-content
+ (extra-content '())
+ "Lines to add at the end of the configuration file."))
+
+\f
+;;;
+;;; Serialization functions.
+;;;
+
+;; Helper functions.
+(define* (add-line-if field value
+ #:key (serializer %unset-value)
+ (suffix %unset-value))
+ (if (eq? %unset-value value)
+ %unset-value
+ #~(string-append #$field " "
+ #$(if (eq? serializer %unset-value)
+ value
+ (serializer value))
+ #$(if (eq? suffix %unset-value)
+ ""
+ suffix))))
+
+(define (add-block name content)
+ (let ((content (filter
+ (lambda (elt) (not (eq? elt %unset-value)))
+ content)))
+ (if (equal? content '())
+ '()
+ (append
+ (list #~(cons 'begin-block #$name))
+ content
+ (list #~'end-block)))))
+
+(define-syntax add-block*
+ (syntax-rules ()
+ ((add-block* name elt ...)
+ (add-block name (append elt ...)))))
+
+(define (box str)
+ (let* ((len (string-length str))
+ (line (make-string (+ 8 len) #\#)))
+ (list
+ line
+ (string-append "### " str " ###")
+ line)))
+
+(define (heading str)
+ (let* ((len (string-length str))
+ (line (make-string (+ 2 len) #\#)))
+ (list
+ ""
+ (string-append "# " str)
+ line)))
+
+(define-inlinable (serialize-boolean-yn b)
+ (if b "yes" "no"))
+
+(define-inlinable (serialize-binding binder key value)
+ #~(string-append #$binder #$key " " #$value))
+
+(define (serialize-mouse-binding var)
+ (let* ((ev (car var))
+ (ev-code (number->string ev))
+ (command (cdr var)))
+ (serialize-binding "bindcode " ev-code command)))
+
+(define (serialize-keybinding var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "bindsym " name value)))
+
+(define (serialize-gesture var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "bindgesture " name value)))
+
+(define (serialize-variable var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "set $" name value)))
+
+(define (serialize-exec b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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 "\"")))
+ (background (let ((bg (sway-output-background out)))
+ (if (pair? bg)
+ bg
+ (cons bg 'fill))))
+ (resolution (sway-output-resolution out))
+ (position (sway-output-position out))
+ (extra-content (sway-output-extra-content out)))
+ (add-block
+ (string-append "output " ident)
+ (cons*
+ ;; Optional elements.
+ (add-line-if "bg" (car background)
+ #:suffix
+ (string-append " " (symbol->string (cdr background))))
+ (add-line-if "resolution" resolution)
+ (add-line-if "position" position
+ #:serializer
+ (lambda (p)
+ (string-append (number->string (point-x p))
+ " "
+ (number->string (point-x p)))))
+ ;; Extra-content: inlined as-is.
+ extra-content))))
+
+(define (serialize-input input)
+ (define-inlinable (fetch-arg layout acc)
+ (if (eq? layout %unset-value)
+ %unset-value
+ (acc layout)))
+
+ (define-inlinable (unfalse f)
+ (lambda (arg)
+ (let ((res (f arg)))
+ (if res res %unset-value))))
+
+ (define-inlinable (unnil f)
+ (lambda (arg)
+ (let ((res (f arg)))
+ (if (nil? res) %unset-value res))))
+
+ (let* ((pre-ident (sway-input-identifier input))
+ (ident (if (symbol? pre-ident)
+ (symbol->string pre-ident)
+ (string-append "\"" pre-ident "\"")))
+
+ ;; unpack the `layout' field.
+ (layout (sway-input-layout input))
+ (xkb-layout (fetch-arg layout keyboard-layout-name))
+ (xkb-variant (fetch-arg layout (unfalse keyboard-layout-variant)))
+ (xkb-model (fetch-arg layout (unfalse keyboard-layout-model)))
+ (xkb-options (fetch-arg layout (unnil keyboard-layout-options)))
+
+ (dwt (sway-input-disable-while-typing input))
+ (dwtp (sway-input-disable-while-trackpointing input))
+ (extra-content (sway-input-extra-content input)))
+ (add-block
+ (string-append "input " ident)
+ (cons*
+ ;; Optional.
+ (add-line-if "xkb_layout" xkb-layout)
+ (add-line-if "xkb_model" xkb-model)
+ (add-line-if "xkb_variant" xkb-variant)
+ (add-line-if "xkb_options" xkb-options
+ #:serializer (lambda (l) (string-join l ",")))
+ (add-line-if "dwt" dwt
+ #:serializer serialize-boolean-yn)
+ (add-line-if "dwtp" dwtp
+ #:serializer serialize-boolean-yn)
+ ;; extra-content inlined as-is.
+ extra-content))))
+
+(define (serialize-colors colors)
+ (define (border-serializer val)
+ (string-append (sway-border-color-border val)
+ " " (sway-border-color-background val)
+ " " (sway-border-color-text val)))
+ (if (eq? %unset-value colors)
+ '()
+ (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)))
+ (add-block
+ "colors"
+ (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-line-if "focused_workspace" focused-workspace
+ #:serializer border-serializer)
+ (add-line-if "active_workspace" active-workspace
+ #:serializer border-serializer)
+ (add-line-if "inactive_workspace" inactive-workspace
+ #:serializer border-serializer)
+ (add-line-if "urgent_workspace" urgent-workspace
+ #:serializer border-serializer)
+ (add-line-if "binding_mode" binding-mode
+ #:serializer border-serializer))))))
+
+(define (serialize-mode mode)
+ (let ((name (sway-mode-mode-name mode))
+ (keys (sway-mode-keybindings mode))
+ (clicks (sway-mode-mouse-bindings mode)))
+ (add-block*
+ (string-append "mode \"" name "\"")
+ (map serialize-keybinding keys)
+ (map serialize-mouse-binding clicks))))
+
+(define (serialize-bar bar)
+ (define serialize-symbol
+ symbol->string)
+
+ (let ((identifier (symbol->string (sway-bar-identifier bar)))
+ (position (sway-bar-position bar))
+ (hidden-state (sway-bar-hidden-state bar))
+ (status-command (sway-bar-status-command bar))
+ (binding-mode-indicator (sway-bar-binding-mode-indicator bar))
+ (mouse-bindings (sway-bar-mouse-bindings bar))
+ (extra-content (sway-bar-extra-content bar))
+ (colors (sway-bar-colors bar)))
+ (add-block*
+ (string-append "bar " identifier)
+
+ (if (eq? colors %unset-value)
+ '()
+ (serialize-colors colors))
+ (list
+ (add-line-if "position" position
+ #:serializer serialize-symbol)
+ (add-line-if "hidden_state" hidden-state
+ #:serializer serialize-symbol)
+ (add-line-if "status_command" status-command)
+ (add-line-if "binding_mode_indicator" binding-mode-indicator
+ #:serializer serialize-boolean-yn))
+ ;; Key- and mouse-bindings and extra-content
+ (map serialize-mouse-binding mouse-bindings)
+ extra-content)))
+
+(define (sway-configuration->file conf)
+ (let* ((extra (sway-configuration-extra-content conf))
+ (bar (sway-configuration-bar conf)))
+ (computed-file
+ "sway-config"
+ #~(begin
+ (use-modules (ice-9 format) (ice-9 popen) (ice-9 match)
+ (srfi srfi-1))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Add the (indented) line "s" to the output file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (make-string i #\ ) s)
+ i))
+
+ ;; Begin a block "name" and adjust the indentation.
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (make-string i #\ ) name)
+ (+ i 4)))
+
+ ;; Ends an open block and adjust the indentation.
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (make-string i #\ ))
+ i)))
+
+ ;; Helper function. The configuration is represented as a list
+ ;; of actions (alter the indentation level, add a line, ...).
+ ;; This function recognises the action and calls the right
+ ;; function among those defined above.
+ (define (serializer-dispatch-m arg)
+ (match arg
+ ;; Special cases:
+ (('begin-block . str) (begin-block str))
+ ('end-block (end-block))
+ ;; Default case: `arg' is assumed to be a string.
+ (_ (line arg))))
+
+ (define (serializer-dispatch elt i)
+ ((serializer-dispatch-m elt) i))
+
+ (fold
+ ;; Dispatch function: depending on its argument, it will change
+ ;; the indentation level or add a line to the output file.
+ serializer-dispatch
+
+ ;; Initial indentation level
+ 0
+
+ ;; List of lines or indentation modifiers.
+ (list
+ ;; Header.
+ #$@(box "Auto-generated configuration")
+ "# DO NOT EDIT MANUALLY."
+
+ ;; Variables.
+ #$@(heading "Variables.")
+ #$@(map serialize-variable (sway-configuration-variables conf))
+
+ ;; Outputs.
+ #$@(heading "Outputs.")
+ #$@(flatmap serialize-output (sway-configuration-outputs conf))
+
+ ;; Inputs.
+ #$@(heading "Inputs.")
+ #$@(flatmap serialize-input (sway-configuration-inputs conf))
+
+ ;; Bar configuration:
+ ;; If the bar is unset, do not include anything.
+ #$@(if (eq? bar %unset-value)
+ '()
+ (append
+ (heading "Bar configuration.")
+ (serialize-bar bar)))
+
+ ;; Keybindings.
+ #$@(heading "Keybindings.")
+ #$@(map serialize-keybinding
+ (sway-configuration-keybindings conf))
+ ;; Gestures.
+ #$@(heading "Gestures.")
+ #$@(map serialize-gesture (sway-configuration-gestures conf))
+
+ ;; Modes.
+ #$@(heading "Modes.")
+ #$@(flatmap serialize-mode (sway-configuration-modes conf))
+
+ ;; Startup-Programs.
+ #$@(heading "Programs to execute (at startup).")
+ #$@(map (serialize-exec #f)
+ (sway-configuration-startup-programs conf))
+ ;; startup+reload-programs.
+ #$@(heading "Programs to execute (at startup & after reload).")
+ #$@(map (serialize-exec #t)
+ (sway-configuration-startup+reload-programs conf))
+
+ ;; Extra-content.
+ #$@extra)))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index a8dc6bc746..a4a2b73a36 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -114,6 +114,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
--
2.46.0
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH v7] home: services: Add 'home-sway-service-type'.
2024-09-30 20:07 ` Ludovic Courtès
2024-10-01 22:12 ` [bug#72714] [PATCH] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-10-01 22:30 ` Arnaud Daby-Seesaram via Guix-patches via
1 sibling, 0 replies; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-10-01 22:30 UTC (permalink / raw)
To: 72714
Cc: Hilton Chain, Ludovic Courtès, Arnaud Daby-Seesaram,
Florian Pelz
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(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.
(sway-mode): New configuration record.
(flatten): New procedure.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above changes.
---
Sorry, I forgot to wrap a long line in guix.texi.
doc/guix.texi | 395 ++++++++++++++++++
gnu/home/services/sway.scm | 794 +++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 1190 insertions(+)
create mode 100644 gnu/home/services/sway.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 52e36e4354..8b86f57005 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -130,6 +130,7 @@ Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
Copyright @copyright{} 2024 Fabio Natali@*
+Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -460,6 +461,7 @@ Home Services
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@@ -45196,6 +45198,7 @@ services)}.
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
+* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@@ -47110,6 +47113,398 @@ kodi} for more information.
@end table
@end deftp
+@node Sway window manager
+@subsection Sway window manager
+
+@cindex sway, Home Service
+@cindex sway, configuration
+The @code{(gnu home services sway)} module provides
+@code{home-sway-service-type}, a home service to configure the
+@uref{https://github.com/swaywm/sway,Sway window manager for Wayland} in
+a declarative way.
+
+Here is an example of a service and its configuration that you could add
+to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(service home-sway-service-type
+ (sway-configuration
+ (gestures
+ '((swipe:3:down . "move to scratchpad")
+ (swipe:3:up . "scratchpad show")))
+ (outputs
+ (list (sway-output
+ (identifier '*)
+ (bg (file-append sway
+ "\
+/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png")))))))
+@end lisp
+
+The above example describes a Sway configuration in which
+@itemize
+@item
+all monitors use a particular wallpaper whose @file{.png} is provided by
+the @code{sway} package;
+@item
+swiping down (resp.@: up) with three fingers moves the active window to
+the scratchpad (resp.@: shows/hides the scratchpad).
+@end itemize
+
+@quotation Note
+This home service only sets up the configuration file and profile
+packages for Sway. It does @emph{not} start Sway in any way. If you
+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
+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 a @code{sway-configuration} record (defined below),
+and returns a file-like object representing the serialized
+configuration.
+@end deffn
+
+@defvar home-sway-service-type
+This is a home service type to set up Sway. It takes care of:
+@itemize
+@item
+providing a @file{~/.config/sway/config} file,
+@item
+adding Sway-related packages to your profile.
+@end itemize
+@end defvar
+
+@deftp {Data Type} sway-configuration
+This configuration record describes the Sway configuration
+(see@ @cite{sway(5)}). Available fields are:
+
+@table @asis
+@item @code{variables} (default: @code{%sway-default-variables})
+The value of this field is an association list in which keys are symbols
+and values are either strings, G-expressions or file-append objects
+(@pxref{G-Expressions}).
+
+Example:
+@lisp
+(variables `((mod . "Mod4") ; string
+ (term ; file-append
+ . ,(file-append foot "/bin/foot"))
+ (term ; G-expression
+ . ,#~(string-append #$foot "/bin/foot"))))
+@end lisp
+
+@item @code{keybindings} (default: @code{%sway-default-keybindings})
+This field describes keybindings for the @emph{default} mode. The value
+is an association list: keys are symbols and values are either strings
+or G-expressions.
+
+The following snippet launches the terminal when pressing @kbd{$mod+t}
+and @kbd{$mod+Shift+t} (assuming that a variable @code{$term} is
+defined):
+@lisp
+`(($mod+t . ,#~(string-append "exec " #$foot "/bin/foot"))
+ ($mod+Shift+t . "exec $term"))
+@end lisp
+
+@item @code{gestures} (default: @code{%sway-default-gestures})
+Similar to the previous field, but for finger-gestures.
+
+The following snippet allows to navigate through workspaces by swiping
+right and left with three fingers:
+@lisp
+'((swipe:3:right . "workspace next_on_output")
+ (swipe:3:left . "workspace prev_on_output"))
+@end lisp
+
+@item @code{packages} (default: @code{%sway-default-packages})
+This field describes a list of packages to add to the user profile. At
+the moment, the default value only adds @code{sway} to the profile.
+
+@item @code{inputs} (default: @code{'()})
+List of @code{sway-input} configuration records (described below).
+
+@item @code{outputs} (default: @code{'()})
+List of @code{sway-output} configuration records (described below).
+
+@item @code{bar} (optional @code{sway-bar} record)
+Optional @code{sway-bar} record (described below) to configure a Sway
+bar.
+
+@item @code{modes} (default: @code{'()})
+Optional list of @code{sway-mode} records (described below) to add modes
+to the Sway configuration (@i{e.g.}@: the ``resize'' mode of the default
+Sway configuration).
+
+@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}).
+
+@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.
+
+The default value, @code{%sway-default-execs}, executes @code{swayidle}
+in order to lock the screen after 5@ minutes of inactivity (displaying a
+background distributed with Sway) and turn the screen off after 10@
+minutes of inactivity.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the configuration file. The value of this field is a
+list of strings or G-expressions.
+@end table
+@end deftp
+
+@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
+to @kbd{ctrl}:
+@lisp
+(sway-input (identifier "type:keyboard")
+ (layout
+ (keyboard-layout "fr" #:options '("ctrl:nocaps"))))
+@end lisp
+
+Available fields for @code{sway-input} configuration records are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the input. The field accepts symbols and strings. If the
+@code{identifier} is a symbol, it is inserted as is; if it is a string,
+it will be quoted in the configuration file.
+
+
+@item @code{layout} (optional @code{<keyboard-layout>} record)
+Keyboard specific option. Field specifying the layout (possibly with
+options) to use for the input. The value must be a
+@code{<keyboard-layout>} record (@pxref{Keyboard Layout}).
+
+@quotation Note
+@code{(gnu home services sway)} does not re-export the
+@code{keyboard-layout} procedure.
+@end quotation
+
+
+@item @code{disable-while-typing} (optional boolean)
+If @code{#t} (resp.@: @code{#f}) enables (resp.@: disables) the
+``disable while typing'' option for this input.
+
+@item @code{disable-while-trackpointing} (optional boolean)
+If @code{#t} (resp.@: @code{#f}), enables (resp.@: disables) the
+``disable while track-pointing'' option for this input.
+
+@item @code{tap} (optional boolean)
+Enables or disables the ``tap'' option, which allows clicking by tapping
+on a touchpad.
+
+@item @code{extra-content} (default: @code{'()})
+Lines to add to the input block. The value of this field is a list
+whose elements can be either strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-output
+@code{sway-output} records describe Sway outputs
+(see@ @cite{sway-output(5)}). Available fields are:
+
+@table @asis
+@item @code{identifier} (default: @code{'*})
+Identifier of the monitor. The field accepts symbols and strings. If
+the @code{identifier} is a symbol, it is inserted as is; if it is a
+string, it will be quoted in the configuration file.
+
+@item @code{resolution} (optional string)
+This string defines the resolution of the monitor.
+
+@item @code{position} (optional)
+The (optional) value of this field must be a @code{point}.
+Example:
+@lisp
+(position
+ (point (x 1920)
+ (y 0)))
+@end lisp
+
+@item @code{background} (optional)
+The value of this field describes what wallpaper to use on this output.
+The field accepts the following types of values:
+@itemize
+@item
+a string,
+@item
+a G-expression,
+@item
+a file-append object,
+@item
+a pair. The first argument of this pair must be a string, a
+G-expression or a file-append object. The second element of the pair
+must be a symbol among @code{stretch}, @code{fill}, @code{fit},
+@code{center} and @code{tile}.
+@end itemize
+
+@quotation Note
+In order to use an SVG file, you must have @code{librsvg} in your
+profile (@i{e.g.}@: by adding it in the @code{packages} field of
+@code{sway-configuration}).
+@end quotation
+
+@item @code{extra-content} (default: @code{'()})
+List defining additional lines to add to the output configuration block.
+Elements of the list must be either strings or G-expressions.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-border-color
+
+@table @code
+@item border
+Color of the border.
+@item background
+Color of the background.
+@item text
+Color of the text.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-color
+@table @asis
+@item @code{background} (optional string)
+Background color of the bar.
+
+@item @code{statusline} (optional string)
+Text color of the status line.
+
+@item @code{focused-background} (optional string)
+Background color of the bar on the currently focused monitor.
+
+@item @code{focused-statusline} (optional string)
+Text color of the statusline on the currently focused monitor.
+
+@item @code{focused-workspace} (optional @code{sway-border-color})
+Color scheme for focused workspaces.
+
+@item @code{active-workspace} (optional @code{sway-border-color})
+Color scheme for active workspaces.
+
+@item @code{inactive-workspace} (optional @code{sway-border-color})
+Color scheme for inactive workspaces.
+
+@item @code{urgent-workspace} (optional @code{sway-border-color})
+Color scheme for workspaces containing ``urgent'' windows.
+
+@item @code{binding-mode} (optional @code{sway-border-color})
+Color scheme for the binding mode indicator.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-bar
+Describes the Sway bar (see@ @cite{sway-bar(5)}).
+
+@table @asis
+@item @code{identifier} (default: @code{'bar0})
+Identifier of the bar. The value must be a symbol.
+
+@item @code{position} (optional)
+Specify the position of the bar. Accepted values are @code{'top} or
+@code{'bottom}.
+
+@item @code{hidden-state} (optional)
+Specify the apparence of the bar when it is hidden. Accepted values are
+@code{'hide} or @code{'show}.
+
+@item @code{binding-mode-indicator} (optional)
+Boolean enabling or disabling the binding mode indicator.
+
+@item @code{colors} (optional)
+An optional @code{sway-color} configuration record.
+
+@item @code{status-command} (default: @code{%sway-status-command})
+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.
+
+Each line printed on @code{stdout} by this command (or script) will be
+displayed on the status area of the bar.
+
+Below are a few examples using:
+@itemize
+@item
+a string: @code{"while date +'%Y-%m-%d %X'; do sleep 1; done"},
+@item
+a G-exp:
+@lisp
+#~(string-append "while "
+ #$coreutils "/bin/date"
+ " +'%Y-%m-%d %X'; do sleep 1; done")
+@end lisp
+@item
+an executable file:
+@lisp
+(program-file
+ "sway-bar-status"
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-19))
+ (let loop ()
+ (let* ((date (date->string
+ (current-date)
+ "~d/~m/~Y (~a) ~H:~M:~S")))
+ (format #t "~a~%~!" date)
+ (sleep 1)
+ (loop)))))
+@end lisp
+@end itemize
+
+@item @code{mouse-bindings} (default: @code{'()})
+This field accepts an associative list. Keys are integers describing
+mouse events. Values can either be strings or G-expressions.
+
+The module @code{(gnu home services sway)} exports constants
+@code{%ev-code-mouse-left}, @code{%ev-code-mouse-right} and
+@code{%ev-code-mouse-scroll-click} whose values are integers
+corresponding to left, right and scroll click respectively. For
+example, with @code{(mouse-bindings `((,%ev-code-mouse-left
+. ,#~(string-append "exec " #$st "/bin/st"))))}, left clicks in the
+status bar open the @code{st} terminal.
+@end table
+@end deftp
+
+@deftp {Data Type} sway-mode
+Describes a Sway mode (see@ @cite{sway(5)}). For example, the following
+snippet defines a mockup of the resize mode of the default Sway
+configuration:
+@example
+(sway-mode
+ (mode-name "resize")
+ (keybindings
+ '(($left . "resize shrink width 10px")
+ ($right . "resize grow width 10px")
+ ($down . "resize grow height 10px")
+ ($up . "resize shrink height 10px")
+ (Return . "mode \"default\"")
+ (Escape . "mode \"default\""))))
+@end example
+
+@table @asis
+@item @code{mode-name} (default: @code{"default"})
+Name of the mode. This field accepts strings.
+
+@item @code{keybindings} (default: @code{'()})
+This field describes keybindings. The value is an association list:
+keys are symbols and values are either strings or G-expressions, as
+above.
+
+@item @code{mouse-bindings} (default: @code{'()})
+Ditto, but keys are mouse events (integers). Constants
+@code{%ev-code-mouse-*} described above can be used as helpers to define
+mouse bindings.
+@end table
+@end deftp
+
@node Networking Home Services
@subsection Networking Home Services
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
new file mode 100644
index 0000000000..25cae56dae
--- /dev/null
+++ b/gnu/home/services/sway.scm
@@ -0,0 +1,794 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@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 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)
+ #: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 terminals)
+ #:use-module (gnu packages suckless)
+ #:use-module (gnu packages glib)
+ #:export (;; Event codes
+ %ev-code-mouse-left
+ %ev-code-mouse-right
+ %ev-code-mouse-scroll-click
+
+ ;; Configuration records.
+ sway-configuration
+ sway-bar
+ sway-output
+ sway-input
+ point
+ sway-color
+ sway-border-color
+ home-sway-service-type
+ sway-configuration->file
+ sway-mode
+
+ ;; Default values.
+ %sway-default-variables
+ %sway-default-gestures
+ %sway-default-keybindings
+ %sway-default-status-command
+ %sway-default-startup-programs
+ %sway-default-packages))
+
+;; Helper function.
+(define (flatmap f l)
+ (let loop ((lst (reverse l)) (acc '()))
+ (match lst
+ (() acc)
+ ((head . tail)
+ (let* ((h (f head))
+ (acc (append h acc)))
+ (loop tail acc))))))
+
+\f
+;;;
+;;; Default settings and useful constants.
+;;;
+
+(define %ev-code-mouse-left 272)
+(define %ev-code-mouse-right 273)
+(define %ev-code-mouse-scroll-click 274)
+
+(define %sway-default-packages
+ (list sway))
+
+(define %sway-default-variables
+ `((mod . "Mod4")
+ (left . "h")
+ (down . "j")
+ (up . "k")
+ (right . "l")
+ (term . ,(file-append foot "/bin/foot"))
+ (menu . ,#~(string-append
+ #$dmenu "/bin/dmenu_path | \\\n "
+ #$wmenu "/bin/wmenu | \\\n "
+ #$findutils "/bin/xargs \\\n "
+ #$sway "/bin/swaymsg exec --"))))
+
+(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")))
+
+(define %sway-default-keybindings
+ `(($mod+Return . "exec $term")
+ ($mod+Shift+q . "kill")
+ ($mod+d . "exec $menu")
+ ($mod+Shift+c . "reload")
+ ($mod+Shift+e
+ . ,#~(string-append
+ "exec " #$sway "/bin/swaynag -t warning -m \\\n "
+ "'You pressed the exit shortcut. Do you really want to exit sway?"
+ " This will end your Wayland session.' \\\n "
+ "-B 'Yes, exit sway' \\\n '"
+ #$sway "/bin/swaymsg exit'"))
+ ($mod+$left . "focus left")
+ ($mod+$down . "focus down")
+ ($mod+$up . "focus up")
+ ($mod+$right . "focus right")
+ ($mod+Left . "focus left")
+ ($mod+Down . "focus down")
+ ($mod+Up . "focus up")
+ ($mod+Right . "focus right")
+ ($mod+Shift+$left . "move left")
+ ($mod+Shift+$down . "move down")
+ ($mod+Shift+$up . "move up")
+ ($mod+Shift+$right . "move right")
+ ($mod+Shift+Left . "move left")
+ ($mod+Shift+Down . "move down")
+ ($mod+Shift+Up . "move up")
+ ($mod+Shift+Right . "move right")
+ ($mod+1 . "workspace number 1")
+ ($mod+2 . "workspace number 2")
+ ($mod+3 . "workspace number 3")
+ ($mod+4 . "workspace number 4")
+ ($mod+5 . "workspace number 5")
+ ($mod+6 . "workspace number 6")
+ ($mod+7 . "workspace number 7")
+ ($mod+8 . "workspace number 8")
+ ($mod+9 . "workspace number 9")
+ ($mod+0 . "workspace number 10")
+ ($mod+Shift+1 . "move container to workspace number 1")
+ ($mod+Shift+2 . "move container to workspace number 2")
+ ($mod+Shift+3 . "move container to workspace number 3")
+ ($mod+Shift+4 . "move container to workspace number 4")
+ ($mod+Shift+5 . "move container to workspace number 5")
+ ($mod+Shift+6 . "move container to workspace number 6")
+ ($mod+Shift+7 . "move container to workspace number 7")
+ ($mod+Shift+8 . "move container to workspace number 8")
+ ($mod+Shift+9 . "move container to workspace number 9")
+ ($mod+Shift+0 . "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+a . "focus parent")
+ ($mod+Shift+minus . "move scratchpad")
+ ($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
+ #$swayidle "/bin/swayidle -w \\\n "
+ ;; 300: lock screen.
+ "timeout 300 '" #$swaylock "/bin/swaylock "
+ "--indicator-radius 75 \\\n "
+ "-i " #$sway
+ "/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png \\\n "
+ "-f -c 000000' \\\n "
+ ;; 600: lock + screen off.
+ "timeout 600 '" #$sway "/bin/swaymsg \"output * power off\"' \\\n "
+ ;; Resume + sleep.
+ "resume '" #$sway "/bin/swaymsg \"output * power on\"' \\\n "
+ "before-sleep '" #$swaylock "/bin/swaylock -f -c 000000'")))
+
+\f
+;;;
+;;; Definition of configurations.
+;;;
+
+(define (string-ish? s)
+ (or (gexp? s)
+ (file-append? s)
+ (string? s)))
+
+(define (string-or-gexp? s)
+ (or (gexp? s)
+ (string? s)))
+
+(define (list-of-string-ish? lst)
+ (every string-ish? 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 (extra-content? extra)
+ (every string-or-gexp? extra))
+
+(define (make-alist-predicate key? val?)
+ (lambda (lst)
+ (every
+ (lambda (item)
+ (match item
+ ((k . v)
+ (and (key? k)
+ (val? v)))
+ (_ #f)))
+ lst)))
+
+(define bindings?
+ (make-alist-predicate symbol? string-or-gexp?))
+
+(define mouse-bindings?
+ (make-alist-predicate integer? string-or-gexp?))
+
+(define (variables? lst)
+ (make-alist-predicate symbol? string-ish?))
+
+(define-maybe string (no-serialization))
+(define-maybe strings (no-serialization))
+(define-maybe boolean (no-serialization))
+(define-maybe keyboard-layout (no-serialization))
+
+(define-configuration/no-serialization sway-input
+ (identifier
+ (string-or-symbol '*)
+ "Identifier of the input.")
+ (layout
+ maybe-keyboard-layout
+ "Keyboard layout of the input.")
+ (disable-while-typing
+ maybe-boolean
+ "If `#t', disable the input while typing; if `#f' do not.")
+ (disable-while-trackpointing
+ maybe-boolean
+ "If `#t', disable the input while using a trackpoint; if `#f' do not.")
+ (tap
+ maybe-boolean
+ "Enable or disable tap.")
+ (extra-content
+ (extra-content '())
+ "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 status line.")
+ (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
+ "Color scheme for focused workspaces.")
+ (active-workspace
+ maybe-sway-border-color
+ "Color scheme for active workspaces.")
+ (inactive-workspace
+ maybe-sway-border-color
+ "Color scheme for inactive workspaces.")
+ (urgent-workspace
+ maybe-sway-border-color
+ "Color scheme for workspaces containing `urgent' windows.")
+ (binding-mode
+ maybe-sway-border-color
+ "Color scheme for the binding mode indicator."))
+
+(define-maybe sway-color (no-serialization))
+
+(define (status-command? c)
+ (or (string? c)
+ (file-like? c)
+ (gexp? c)))
+
+(define-maybe bar-position (no-serialization))
+(define-maybe hidden-state (no-serialization))
+(define-maybe status-command (no-serialization))
+
+(define-configuration/no-serialization sway-bar
+ (identifier
+ (symbol 'bar0)
+ "Identifier of the bar.")
+ (position
+ maybe-bar-position
+ "Position of the bar.")
+ (hidden-state
+ maybe-hidden-state
+ "Hidden state.")
+ (binding-mode-indicator
+ maybe-boolean
+ "Binding indicator.")
+ (colors
+ maybe-sway-color
+ "Color palette of the bar.")
+ (status-command
+ maybe-status-command
+ "Status command. It must be file-like.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Actions triggered by mouse events.")
+ (extra-content
+ (extra-content '())
+ "Extra configuration lines."))
+
+(define-maybe sway-bar (no-serialization))
+
+(define-configuration/no-serialization point
+ (x integer "X coordinate.")
+ (y integer "Y coordinate."))
+
+(define (file-like-or-gexp? f)
+ (or (file-like? f)
+ (gexp? f)))
+
+(define-maybe point (no-serialization))
+(define-maybe file-like-or-gexp (no-serialization))
+
+(define (background? bg)
+ (or (string-ish? bg)
+ (and (pair? bg)
+ (string-ish? (car bg))
+ (member (cdr bg) '(stretch fill fit center tile)))))
+
+(define-maybe background (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.")
+ (background
+ maybe-background
+ "Background image.")
+ (extra-content
+ (extra-content '())
+ "Extra lines."))
+
+(define (sway-outputs? lst)
+ (every sway-output? lst))
+
+(define-configuration/no-serialization sway-mode
+ (mode-name
+ (string "default")
+ "Name of the mode.")
+ (keybindings
+ (bindings '())
+ "Keybindings.")
+ (mouse-bindings
+ (mouse-bindings '())
+ "Mouse bindings."))
+;; TODO (not necessary for 72714): switch bindings.
+
+(define (sway-modes? lst)
+ (every sway-mode? lst))
+
+(define-configuration/no-serialization sway-configuration
+ (keybindings
+ (bindings %sway-default-keybindings)
+ "Keybindings.")
+ (gestures
+ (bindings %sway-default-gestures)
+ "Gestures.")
+ (packages
+ (list-of-packages
+ %sway-default-packages)
+ "List of packages to add to the profile.")
+ (variables
+ (variables %sway-default-variables)
+ "Variables declared at the beginning of the file.")
+ (inputs
+ (sway-inputs '())
+ "Inputs.")
+ (outputs
+ (sway-outputs '())
+ "Outputs.")
+ (bar
+ maybe-sway-bar
+ "Bar configuration.")
+ (modes
+ (sway-modes '())
+ "Additional modes.")
+ (startup+reload-programs
+ (list-of-string-ish '())
+ "Programs to execute at startup time.")
+ (startup-programs
+ (list-of-string-ish %sway-default-startup-programs)
+ "Programs to execute at startup time.")
+ (extra-content
+ (extra-content '())
+ "Lines to add at the end of the configuration file."))
+
+\f
+;;;
+;;; Serialization functions.
+;;;
+
+;; Helper functions.
+(define* (add-line-if field value
+ #:key (serializer %unset-value)
+ (suffix %unset-value))
+ (if (eq? %unset-value value)
+ %unset-value
+ #~(string-append #$field " "
+ #$(if (eq? serializer %unset-value)
+ value
+ (serializer value))
+ #$(if (eq? suffix %unset-value)
+ ""
+ suffix))))
+
+(define (add-block name content)
+ (let ((content (filter
+ (lambda (elt) (not (eq? elt %unset-value)))
+ content)))
+ (if (equal? content '())
+ '()
+ (append
+ (list #~(cons 'begin-block #$name))
+ content
+ (list #~'end-block)))))
+
+(define-syntax add-block*
+ (syntax-rules ()
+ ((add-block* name elt ...)
+ (add-block name (append elt ...)))))
+
+(define (box str)
+ (let* ((len (string-length str))
+ (line (make-string (+ 8 len) #\#)))
+ (list
+ line
+ (string-append "### " str " ###")
+ line)))
+
+(define (heading str)
+ (let* ((len (string-length str))
+ (line (make-string (+ 2 len) #\#)))
+ (list
+ ""
+ (string-append "# " str)
+ line)))
+
+(define-inlinable (serialize-boolean-yn b)
+ (if b "yes" "no"))
+
+(define-inlinable (serialize-binding binder key value)
+ #~(string-append #$binder #$key " " #$value))
+
+(define (serialize-mouse-binding var)
+ (let* ((ev (car var))
+ (ev-code (number->string ev))
+ (command (cdr var)))
+ (serialize-binding "bindcode " ev-code command)))
+
+(define (serialize-keybinding var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "bindsym " name value)))
+
+(define (serialize-gesture var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "bindgesture " name value)))
+
+(define (serialize-variable var)
+ (let ((name (symbol->string (car var)))
+ (value (cdr var)))
+ (serialize-binding "set $" name value)))
+
+(define (serialize-exec b)
+ (if b
+ (lambda (exe)
+ #~(string-append "exec_always " #$exe))
+ (lambda (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 "\"")))
+ (background (let ((bg (sway-output-background out)))
+ (if (pair? bg)
+ bg
+ (cons bg 'fill))))
+ (resolution (sway-output-resolution out))
+ (position (sway-output-position out))
+ (extra-content (sway-output-extra-content out)))
+ (add-block
+ (string-append "output " ident)
+ (cons*
+ ;; Optional elements.
+ (add-line-if "bg" (car background)
+ #:suffix
+ (string-append " " (symbol->string (cdr background))))
+ (add-line-if "resolution" resolution)
+ (add-line-if "position" position
+ #:serializer
+ (lambda (p)
+ (string-append (number->string (point-x p))
+ " "
+ (number->string (point-x p)))))
+ ;; Extra-content: inlined as-is.
+ extra-content))))
+
+(define (serialize-input input)
+ (define-inlinable (fetch-arg layout acc)
+ (if (eq? layout %unset-value)
+ %unset-value
+ (acc layout)))
+
+ (define-inlinable (unfalse f)
+ (lambda (arg)
+ (let ((res (f arg)))
+ (if res res %unset-value))))
+
+ (define-inlinable (unnil f)
+ (lambda (arg)
+ (let ((res (f arg)))
+ (if (nil? res) %unset-value res))))
+
+ (let* ((pre-ident (sway-input-identifier input))
+ (ident (if (symbol? pre-ident)
+ (symbol->string pre-ident)
+ (string-append "\"" pre-ident "\"")))
+
+ ;; unpack the `layout' field.
+ (layout (sway-input-layout input))
+ (xkb-layout (fetch-arg layout keyboard-layout-name))
+ (xkb-variant (fetch-arg layout (unfalse keyboard-layout-variant)))
+ (xkb-model (fetch-arg layout (unfalse keyboard-layout-model)))
+ (xkb-options (fetch-arg layout (unnil keyboard-layout-options)))
+
+ (dwt (sway-input-disable-while-typing input))
+ (dwtp (sway-input-disable-while-trackpointing input))
+ (extra-content (sway-input-extra-content input)))
+ (add-block
+ (string-append "input " ident)
+ (cons*
+ ;; Optional.
+ (add-line-if "xkb_layout" xkb-layout)
+ (add-line-if "xkb_model" xkb-model)
+ (add-line-if "xkb_variant" xkb-variant)
+ (add-line-if "xkb_options" xkb-options
+ #:serializer (lambda (l) (string-join l ",")))
+ (add-line-if "dwt" dwt
+ #:serializer serialize-boolean-yn)
+ (add-line-if "dwtp" dwtp
+ #:serializer serialize-boolean-yn)
+ ;; extra-content inlined as-is.
+ extra-content))))
+
+(define (serialize-colors colors)
+ (define (border-serializer val)
+ (string-append (sway-border-color-border val)
+ " " (sway-border-color-background val)
+ " " (sway-border-color-text val)))
+ (if (eq? %unset-value colors)
+ '()
+ (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)))
+ (add-block
+ "colors"
+ (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-line-if "focused_workspace" focused-workspace
+ #:serializer border-serializer)
+ (add-line-if "active_workspace" active-workspace
+ #:serializer border-serializer)
+ (add-line-if "inactive_workspace" inactive-workspace
+ #:serializer border-serializer)
+ (add-line-if "urgent_workspace" urgent-workspace
+ #:serializer border-serializer)
+ (add-line-if "binding_mode" binding-mode
+ #:serializer border-serializer))))))
+
+(define (serialize-mode mode)
+ (let ((name (sway-mode-mode-name mode))
+ (keys (sway-mode-keybindings mode))
+ (clicks (sway-mode-mouse-bindings mode)))
+ (add-block*
+ (string-append "mode \"" name "\"")
+ (map serialize-keybinding keys)
+ (map serialize-mouse-binding clicks))))
+
+(define (serialize-bar bar)
+ (define serialize-symbol
+ symbol->string)
+
+ (let ((identifier (symbol->string (sway-bar-identifier bar)))
+ (position (sway-bar-position bar))
+ (hidden-state (sway-bar-hidden-state bar))
+ (status-command (sway-bar-status-command bar))
+ (binding-mode-indicator (sway-bar-binding-mode-indicator bar))
+ (mouse-bindings (sway-bar-mouse-bindings bar))
+ (extra-content (sway-bar-extra-content bar))
+ (colors (sway-bar-colors bar)))
+ (add-block*
+ (string-append "bar " identifier)
+
+ (if (eq? colors %unset-value)
+ '()
+ (serialize-colors colors))
+ (list
+ (add-line-if "position" position
+ #:serializer serialize-symbol)
+ (add-line-if "hidden_state" hidden-state
+ #:serializer serialize-symbol)
+ (add-line-if "status_command" status-command)
+ (add-line-if "binding_mode_indicator" binding-mode-indicator
+ #:serializer serialize-boolean-yn))
+ ;; Key- and mouse-bindings and extra-content
+ (map serialize-mouse-binding mouse-bindings)
+ extra-content)))
+
+(define (sway-configuration->file conf)
+ (let* ((extra (sway-configuration-extra-content conf))
+ (bar (sway-configuration-bar conf)))
+ (computed-file
+ "sway-config"
+ #~(begin
+ (use-modules (ice-9 format) (ice-9 popen) (ice-9 match)
+ (srfi srfi-1))
+
+ (let* ((file #$output)
+ (port (open-output-file #$output)))
+
+ ;; Add the (indented) line "s" to the output file.
+ (define (line s)
+ (lambda (i)
+ (format port "~a~a~%" (make-string i #\ ) s)
+ i))
+
+ ;; Begin a block "name" and adjust the indentation.
+ (define (begin-block name)
+ (lambda (i)
+ (format port "~a~a {~%" (make-string i #\ ) name)
+ (+ i 4)))
+
+ ;; Ends an open block and adjust the indentation.
+ (define (end-block)
+ (lambda (i)
+ (let ((i (- i 4)))
+ (format port "~a}~%" (make-string i #\ ))
+ i)))
+
+ ;; Helper function. The configuration is represented as a list
+ ;; of actions (alter the indentation level, add a line, ...).
+ ;; This function recognises the action and calls the right
+ ;; function among those defined above.
+ (define (serializer-dispatch-m arg)
+ (match arg
+ ;; Special cases:
+ (('begin-block . str) (begin-block str))
+ ('end-block (end-block))
+ ;; Default case: `arg' is assumed to be a string.
+ (_ (line arg))))
+
+ (define (serializer-dispatch elt i)
+ ((serializer-dispatch-m elt) i))
+
+ (fold
+ ;; Dispatch function: depending on its argument, it will change
+ ;; the indentation level or add a line to the output file.
+ serializer-dispatch
+
+ ;; Initial indentation level
+ 0
+
+ ;; List of lines or indentation modifiers.
+ (list
+ ;; Header.
+ #$@(box "Auto-generated configuration")
+ "# DO NOT EDIT MANUALLY."
+
+ ;; Variables.
+ #$@(heading "Variables.")
+ #$@(map serialize-variable (sway-configuration-variables conf))
+
+ ;; Outputs.
+ #$@(heading "Outputs.")
+ #$@(flatmap serialize-output (sway-configuration-outputs conf))
+
+ ;; Inputs.
+ #$@(heading "Inputs.")
+ #$@(flatmap serialize-input (sway-configuration-inputs conf))
+
+ ;; Bar configuration:
+ ;; If the bar is unset, do not include anything.
+ #$@(if (eq? bar %unset-value)
+ '()
+ (append
+ (heading "Bar configuration.")
+ (serialize-bar bar)))
+
+ ;; Keybindings.
+ #$@(heading "Keybindings.")
+ #$@(map serialize-keybinding
+ (sway-configuration-keybindings conf))
+ ;; Gestures.
+ #$@(heading "Gestures.")
+ #$@(map serialize-gesture (sway-configuration-gestures conf))
+
+ ;; Modes.
+ #$@(heading "Modes.")
+ #$@(flatmap serialize-mode (sway-configuration-modes conf))
+
+ ;; Startup-Programs.
+ #$@(heading "Programs to execute (at startup).")
+ #$@(map (serialize-exec #f)
+ (sway-configuration-startup-programs conf))
+ ;; startup+reload-programs.
+ #$@(heading "Programs to execute (at startup & after reload).")
+ #$@(map (serialize-exec #t)
+ (sway-configuration-startup+reload-programs conf))
+
+ ;; Extra-content.
+ #$@extra)))))))
+
+(define (sway-configuration->files sway-conf)
+ `((".config/sway/config" ,(sway-configuration->file sway-conf))))
+
+(define home-sway-service-type
+ (service-type
+ (name 'home-sway-config)
+ (extensions
+ (list (service-extension home-files-service-type
+ sway-configuration->files)
+ (service-extension home-profile-service-type
+ sway-configuration-packages)))
+ (description "Configure Sway by providing a file
+@file{~/.config/sway/config}.")
+ (default-value (sway-configuration))))
diff --git a/gnu/local.mk b/gnu/local.mk
index a8dc6bc746..a4a2b73a36 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -114,6 +114,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
+ %D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \
--
2.46.0
^ permalink raw reply related [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
2024-10-01 22:12 ` [bug#72714] [PATCH] " Arnaud Daby-Seesaram via Guix-patches via
@ 2024-10-02 14:08 ` pelzflorian (Florian Pelz)
2024-10-02 20:49 ` Arnaud Daby-Seesaram via Guix-patches via
0 siblings, 1 reply; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-10-02 14:08 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: Hilton Chain, Ludovic Courtès, 72714
Hi Arnaud. I still have not tested nor reviewed all features, but
some comments:
Arnaud Daby-Seesaram writes:
> +(define %sway-default-variables
> + `((mod . "Mod4")
> + (left . "h")
> + (down . "j")
> + (up . "k")
> + (right . "l")
> + (term . ,(file-append foot "/bin/foot"))
> + (menu . ,#~(string-append
> + #$dmenu "/bin/dmenu_path | \\\n "
> + #$wmenu "/bin/wmenu | \\\n "
> + #$findutils "/bin/xargs \\\n "
> + #$sway "/bin/swaymsg exec --"))))
After I added new packages to home-environment’s packages field,
dmenu_path does not list newly installed packages for me, because it
is a shell script which needs a program called stest in PATH.
Now the wmenu_path I talked about earlier appears to be an invention
by the OpenBSD people that does not need stest [1].
Perhaps for more hackability, we could deviate from upstream and put in
a call to guile with a Scheme script in a computed-file that opens a
pipe to/from wmenu and does the same as dmenu_path without cache only on
~/.guix-home/profile/bin.
Or change the dmenu_path program with `substitute' to use the absolute
file-name of stest.
> +Here is an example of a service and its configuration that you could add
> +to the @code{services} field of your @code{home-environment}:
> +
> +@lisp
> +(service home-sway-service-type
> + (sway-configuration
> + (gestures
> + '((swipe:3:down . "move to scratchpad")
> + (swipe:3:up . "scratchpad show")))
> + (outputs
> + (list (sway-output
> + (identifier '*)
> + (bg (file-append sway
> + "\
> +/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png")))))))
> +@end lisp
There is no bg anymore.
> + (add-line-if "position" position
> + #:serializer
> + (lambda (p)
> + (string-append (number->string (point-x p))
> + " "
> + (number->string (point-x p)))))
Should be point-y.
Regards,
Florian
[1] https://github.com/openbsd/ports/blob/master/wayland/wmenu/files/wmenu_path
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
2024-10-02 14:08 ` pelzflorian (Florian Pelz)
@ 2024-10-02 20:49 ` Arnaud Daby-Seesaram via Guix-patches via
2024-10-03 12:41 ` pelzflorian (Florian Pelz)
0 siblings, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-10-02 20:49 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: Hilton Chain, Ludovic Courtès, 72714
[-- Attachment #1: Type: text/plain, Size: 2788 bytes --]
Hi Florian,
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> Arnaud Daby-Seesaram writes:
>> +(define %sway-default-variables
>> + `((mod . "Mod4")
>> + (left . "h")
>> + (down . "j")
>> + (up . "k")
>> + (right . "l")
>> + (term . ,(file-append foot "/bin/foot"))
>> + (menu . ,#~(string-append
>> + #$dmenu "/bin/dmenu_path | \\\n "
>> + #$wmenu "/bin/wmenu | \\\n "
>> + #$findutils "/bin/xargs \\\n "
>> + #$sway "/bin/swaymsg exec --"))))
>
> After I added new packages to home-environment’s packages field,
> dmenu_path does not list newly installed packages for me, because it
> is a shell script which needs a program called stest in PATH.
>
> Now the wmenu_path I talked about earlier appears to be an invention
> by the OpenBSD people that does not need stest [1].
>
> Perhaps for more hackability, we could deviate from upstream and put in
> a call to guile with a Scheme script in a computed-file that opens a
> pipe to/from wmenu and does the same as dmenu_path without cache only on
> ~/.guix-home/profile/bin.
Yes indeed. Do you think that the Guile script should replace all of
"$menu", or just the dmenu_path part?
On this topic, do you know if there is a built-in way to write
`find -maxdepth 1 ...' in Guile (without calling `readdir' manually)?
> only on ~/.guix-home/profile/bin.
What is the rationale for restricting the menu to this directory (and
not all directories in
(filter directory-exists? (string-split (getenv "PATH") #\:))
?
> Or change the dmenu_path program with `substitute' to use the absolute
> file-name of stest.
I think that the Guile script might be simpler.
By `substitute', do you mean in the package definition? This does not
seem necessary, as people installing dmenu have stest in their profile.
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> There is no bg anymore.
> [...]
> Should be point-y.
The point-issue was introduced in the v6. I apologise for those issues
that I bring in new patches... Thank you for catching them!
In my local files, I have also switched from using `open-output-file' to
`call-with-output-file'¹ and reduced the number of redundant calls to
`make-string'.
¹: in previous patches, I never called
`close-port'.
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> Hi Arnaud. I still have not tested nor reviewed all features, but
> some comments:
Do you want me to send a v8 with the above fixes, or should I wait until
we change the content of the "$menu" variable?
Best regards,
--
Arnaud
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
2024-10-02 20:49 ` Arnaud Daby-Seesaram via Guix-patches via
@ 2024-10-03 12:41 ` pelzflorian (Florian Pelz)
2024-10-03 20:53 ` Arnaud Daby-Seesaram via Guix-patches via
0 siblings, 1 reply; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-10-03 12:41 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: Hilton Chain, Ludovic Courtès, 72714
Hello Arnaud.
Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
> "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
>> Perhaps for more hackability, we could deviate from upstream and put in
>> a call to guile with a Scheme script in a computed-file that opens a
>> pipe to/from wmenu and does the same as dmenu_path without cache only on
>> ~/.guix-home/profile/bin.
>
> Yes indeed. Do you think that the Guile script should replace all of
> "$menu", or just the dmenu_path part?
>
All of "$menu", because it looks nicer? But I should not imply that
such deviation from upstream were necessary for getting your patch in.
Basically my issue was that dmenu_path did not work.
Indeed stest is part of the dmenu package, so when dmenu is installed to
the profile, dmenu_path would work. So a more upstream conformant
solution would be to just add the dmenu package to sway’s packages.
However, dmenu_path’s cache means that if we used dmenu_path like
upstream, it would never recognize changes to the installed packages.
OpenBSD opted for wmenu_path which is like dmenu_path without cache
and a guile script seems more appropriate for Guix’ defaults.
> On this topic, do you know if there is a built-in way to write
> `find -maxdepth 1 ...' in Guile (without calling `readdir' manually)?
scandir from the (ice-9 ftw) module, I think.
>> only on ~/.guix-home/profile/bin.
>
> What is the rationale for restricting the menu to this directory (and
> not all directories in
> (filter directory-exists? (string-split (getenv "PATH") #\:))
> ?
>
All my graphical applications are in the home profile and non-graphical
programs will not be used and clutter wmenu. Do others put graphical
apps in the system profile? Perhaps so. But then non-graphical
coreutils would be in the wmenu as well. Hmm I am not sure and would be
fine with either.
>> Or change the dmenu_path program with `substitute' to use the absolute
>> file-name of stest.
>
> I think that the Guile script might be simpler.
>
> By `substitute', do you mean in the package definition?
Yes, the dmenu package definition.
> This does not
> seem necessary, as people installing dmenu have stest in their profile.
>
If dmenu were installed in the sway-packages, substitute would not be needed.
> Do you want me to send a v8 with the above fixes, or should I wait until
> we change the content of the "$menu" variable?
It can wait.
Regards,
Florian
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
2024-10-03 12:41 ` pelzflorian (Florian Pelz)
@ 2024-10-03 20:53 ` Arnaud Daby-Seesaram via Guix-patches via
2024-10-04 20:17 ` pelzflorian (Florian Pelz)
0 siblings, 1 reply; 24+ messages in thread
From: Arnaud Daby-Seesaram via Guix-patches via @ 2024-10-03 20:53 UTC (permalink / raw)
To: pelzflorian (Florian Pelz); +Cc: Hilton Chain, Ludovic Courtès, 72714
[-- Attachment #1: Type: text/plain, Size: 4358 bytes --]
Hello Florian,
"pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
> Arnaud Daby-Seesaram <ds-ac@nanein.fr> writes:
>> "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de> writes:
>>> Perhaps for more hackability, we could deviate from upstream and put in
>>> a call to guile with a Scheme script in a computed-file that opens a
>>> pipe to/from wmenu and does the same as dmenu_path without cache only on
>>> ~/.guix-home/profile/bin.
>>
>> Yes indeed. Do you think that the Guile script should replace all of
>> "$menu", or just the dmenu_path part?
>>
>
> All of "$menu", because it looks nicer? But I should not imply that
> such deviation from upstream were necessary for getting your patch in.
No worries. I think that finding a better solution now would be better
(and should not delay this issue for too long). It would avoid opening
a second issue and delaying/forgetting the cache problem.
> Basically my issue was that dmenu_path did not work.
>
> Indeed stest is part of the dmenu package, so when dmenu is installed to
> the profile, dmenu_path would work. So a more upstream conformant
> solution would be to just add the dmenu package to sway’s packages.
>
> However, dmenu_path’s cache means that if we used dmenu_path like
> upstream, it would never recognize changes to the installed packages.
> OpenBSD opted for wmenu_path which is like dmenu_path without cache
> and a guile script seems more appropriate for Guix’ defaults.
Yes, adding dmenu would work (minus your second point). However, to
rely on both wmenu and dmenu feels a little weird, especially since the
latter is only used for a bash script.
It seems that Sway recently switched[1] to a utility called wmenu-run
(C program shipped with the last version of wmenu) to get rid of their
dependency on dmenu.
[1] https://github.com/swaywm/sway/commit/b44015578a3d53cdd9436850202d4405696c1f52
>>> only on ~/.guix-home/profile/bin.
>>
>> What is the rationale for restricting the menu to this directory (and
>> not all directories in
>> (filter directory-exists? (string-split (getenv "PATH") #\:))
>> ?
>>
> All my graphical applications are in the home profile and non-graphical
> programs will not be used and clutter wmenu. Do others put graphical
> apps in the system profile? Perhaps so. But then non-graphical
> coreutils would be in the wmenu as well. Hmm I am not sure and would be
> fine with either.
Yes, this is a good point. I also agree that using a single script for
all of the menu would make it clearer and more maintainable.
For both these reasons, here is a draft proposal for a script that could
replace the current content of "$menu". As suggested, it uses `scandir'
and only focuses on packages of the "home profile".
--8<---------------cut here---------------start------------->8---
(define sway-menu
(computed-file
"sway-menu.scm"
#~(begin
(use-modules (ice-9 receive)
(ice-9 rdelim)
(ice-9 ftw)
(guix build utils))
(define (directory->files dir)
(define (executable-file? f)
;; Cf. `(@@ (guix build utils) executable-file?)' for an
;; explanation of `(zero? ...)'.
(and=> (stat f)
(lambda (s)
(not (or (zero? (logand (stat:mode s) #o100))
(eq? (stat:type s) 'directory))))))
(with-directory-excursion dir
(scandir "." executable-file?)))
(let ((path (string-append (getenv "HOME")
"/.guix-home/profile/bin"))
(wmenu #$(file-append wmenu "/bin/wmenu"))
(swaymsg #$(file-append sway "/bin/swaymsg")))
(receive (from to pid)
((@@ (ice-9 popen) open-process) OPEN_BOTH wmenu)
(for-each
(lambda (c) (format to "~a~%" c))
(directory->files path))
(close to)
(let ((choice (read-line from)))
(close from)
(waitpid pid)
(execl swaymsg swaymsg "exec"
(string-append path "/" choice))))))))
--8<---------------cut here---------------end--------------->8---
WDYT?
Best regards,
--
Arnaud
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 857 bytes --]
^ permalink raw reply [flat|nested] 24+ messages in thread
* [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'.
2024-10-03 20:53 ` Arnaud Daby-Seesaram via Guix-patches via
@ 2024-10-04 20:17 ` pelzflorian (Florian Pelz)
0 siblings, 0 replies; 24+ messages in thread
From: pelzflorian (Florian Pelz) @ 2024-10-04 20:17 UTC (permalink / raw)
To: Arnaud Daby-Seesaram; +Cc: Hilton Chain, Ludovic Courtès, 72714
[-- Attachment #1: Type: text/plain, Size: 3205 bytes --]
Hello Arnaud. I like a lot your sway-menu.scm. For testing, I’ve
changed
(define sway-menu
(computed-file
"sway-menu.scm"
to
(define sway-menu
(scheme-file
"sway-menu.scm"
to use it like this:
(sway-configuration
(variables
`((menu . ,#~(string-append
"guile " #$sway-menu))
Sorry for having proposed compiled-file previously. At first I had
thought a compiled sway-menu.go would be appropriate, created in a
computed-file, which invokes `guild compile` on the .scm code, but
apparently this is not useful. I do not know enough here and
gnu/services/shepherd.scm does it in the scm->go procedure.
Anyway, some feedback:
> (define (directory->files dir)
> (define (executable-file? f)
> ;; Cf. `(@@ (guix build utils) executable-file?)' for an
> ;; explanation of `(zero? ...)'.
This is a comment anyway, but one @ in (@ (guix build utils)
executable-file?) would be enough, since the executable-file?
predicate is exported.
> (and=> (stat f)
> (lambda (s)
To reduce clutter in the wmenu suggestions more, I’d prefer
(and=> (and (not (eq? (string-ref f 0) #\.))
(stat f))
(lambda (s)
> (not (or (zero? (logand (stat:mode s) #o100))
> (eq? (stat:type s) 'directory))))))
> (with-directory-excursion dir
> (scandir "." executable-file?)))
>
> (let ((path (string-append (getenv "HOME")
> "/.guix-home/profile/bin"))
> (wmenu #$(file-append wmenu "/bin/wmenu"))
> (swaymsg #$(file-append sway "/bin/swaymsg")))
> (receive (from to pid)
> ((@@ (ice-9 popen) open-process) OPEN_BOTH wmenu)
Better use @ instead of @@.
> (for-each
> (lambda (c) (format to "~a~%" c))
> (directory->files path))
> (close to)
> (let ((choice (read-line from)))
> (close from)
> (waitpid pid)
> (execl swaymsg swaymsg "exec"
> (string-append path "/" choice))))))))
Even though I like to get suggestions only for
~/.guix-home/profile/bin, if you do not prepend path,
(execl swaymsg swaymsg "exec"
choice)))))))
then it will remain possible to write shell commands in wmenu such as
guix shell weston -- weston-flower
to run apps without installing them.
Thank you greatly, this will definitely become my menu and in my
opinion it is the best default.
Since you told me about wmenu-run, I also locally updated wmenu [1]
and tested the menu config
(menu . ,#~(string-append
#$wmenu "/bin/wmenu-run"))
which would also work, but in my opinion the suggestions are better
when tied to .guix-home/profile. The wmenu-run does not use exec but
a protocol called XDG_ACTIVATION_TOKEN. But I do not see an advantage
to it. It behaves like always.
I’d welcome if you, Arnaud, sent a patch calling your sway-menu script.
Also I’d be happy if more careful commiters would push it; I prefer to
restrict my commits to translation updates.
Also one more thing, in the commit message, you meant to write
flatmap instead of flatten.
Regards,
Florian
[1]
[-- Attachment #2: wm --]
[-- Type: text/plain, Size: 964 bytes --]
diff --git a/gnu/packages/wm.scm b/gnu/packages/wm.scm
index 38cb8cc717..9615054841 100644
--- a/gnu/packages/wm.scm
+++ b/gnu/packages/wm.scm
@@ -1865,16 +1865,16 @@ (define-public wl-mirror
(define-public wmenu
(package
(name "wmenu")
- (version "0.1.7")
+ (version "0.1.9")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.sr.ht/~adnano/wmenu")
- (commit version)))
+ (commit "12b8f83be447379eded03c6109fe944945cd48aa")))
(file-name (git-file-name name version))
(sha256
(base32
- "0wjn68r5cx4zvw7sby6sk2ip5h4fn0jbgb1nasm9nsgjpv63pnpm"))))
+ "06fgvss3grihm3a1g6pj99rvjq2y2p496gkr2ahcnia7vn0wpc6y"))))
(build-system meson-build-system)
(native-inputs (append (if (%current-target-system)
;; for wayland-scanner
^ permalink raw reply related [flat|nested] 24+ messages in thread
end of thread, other threads:[~2024-10-04 20:18 UTC | newest]
Thread overview: 24+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-08-19 15:30 [bug#72714] [PATCH] home: services: Add 'home-sway-service-type' Arnaud Daby-Seesaram via Guix-patches via
2024-08-24 15:32 ` [bug#72714] [PATCH v2] " Arnaud Daby-Seesaram via Guix-patches via
2024-08-26 10:38 ` [bug#72714] [PATCH v3] " Arnaud Daby-Seesaram via Guix-patches via
2024-09-03 7:27 ` [bug#72714] [PATCH v4] " Arnaud Daby-Seesaram via Guix-patches via
2024-09-14 13:28 ` pelzflorian (Florian Pelz)
2024-09-14 14:06 ` pelzflorian (Florian Pelz)
2024-09-17 6:52 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-20 16:45 ` pelzflorian (Florian Pelz)
2024-09-22 13:43 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-25 6:58 ` pelzflorian (Florian Pelz)
2024-09-25 7:52 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-25 11:42 ` pelzflorian (Florian Pelz)
2024-09-18 8:15 ` [bug#72714] [PATCH v5] " Arnaud Daby-Seesaram via Guix-patches via
2024-09-18 18:56 ` Arnaud Daby-Seesaram via Guix-patches via
2024-09-22 8:14 ` Hilton Chain via Guix-patches via
2024-09-25 8:00 ` [bug#72714] [PATCH v6] " Arnaud Daby-Seesaram via Guix-patches via
2024-09-30 20:07 ` Ludovic Courtès
2024-10-01 22:12 ` [bug#72714] [PATCH] " Arnaud Daby-Seesaram via Guix-patches via
2024-10-02 14:08 ` pelzflorian (Florian Pelz)
2024-10-02 20:49 ` Arnaud Daby-Seesaram via Guix-patches via
2024-10-03 12:41 ` pelzflorian (Florian Pelz)
2024-10-03 20:53 ` Arnaud Daby-Seesaram via Guix-patches via
2024-10-04 20:17 ` pelzflorian (Florian Pelz)
2024-10-01 22:30 ` [bug#72714] [PATCH v7] " Arnaud Daby-Seesaram via Guix-patches via
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).