From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: , guix-patches@gnu.org Resent-Date: Mon, 19 Aug 2024 15:33:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Arnaud Daby-Seesaram , ( , Andrew Tropin , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Tanguy Le Carrour X-Debbugs-Original-To: guix-patches@gnu.org X-Debbugs-Original-Xcc: ( , Andrew Tropin , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Tanguy Le Carrour Received: via spool by submit@debbugs.gnu.org id=B.172408156030457 (code B ref -1); Mon, 19 Aug 2024 15:33:02 +0000 Received: (at submit) by debbugs.gnu.org; 19 Aug 2024 15:32:40 +0000 Received: from localhost ([127.0.0.1]:58974 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sg4N5-0007v9-Fh for submit@debbugs.gnu.org; Mon, 19 Aug 2024 11:32:40 -0400 Received: from lists.gnu.org ([209.51.188.17]:42746) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sg4N3-0007uy-3l for submit@debbugs.gnu.org; Mon, 19 Aug 2024 11:32:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sg4MM-00083x-VV for guix-patches@gnu.org; Mon, 19 Aug 2024 11:31:54 -0400 Received: from nanein.fr ([185.230.78.41]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sg4MH-0002Iv-KF for guix-patches@gnu.org; Mon, 19 Aug 2024 11:31:54 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1724081496; bh=0+mky3sZaS67yqtdrFFTKDWy+Jq5m9ridGbgyoMqM6o=; h=From:To:Cc:Subject:Date:From; b=mUDLqPmpagqoMW6OpPXXN0nQ80uyfbXK0HkhMqL69DOifkaLfj+juEi+cUet9qcEH mXi5yxH2tcEo9z2/v+XQvQgV6WSXqx9/C2+yw8kXrik/ZLgz4Nab136aDYU977IY2j S9DZhPhTW/9eW9Cfe6RmbWe3TRenb/0R2xDHD+J3ahglt7uuSxPl37/9wcBbbHfeGC MwcQmM4HiuQ+Z5yk1ItACdxL8yLMppgH/zS5n8uJkN7oEyYwPyib7cDTiabf9UoXci shEgEKiM1M/5fa5H5a6TYBIKP0PzQAYbKyxzzR1u5uyTPT/eqp/z9s/oobKgSjJSi7 qAkNKOONoAeN0eNrfIdzWrx05DKYFb4cyu0DBikq1Njly2efNIO6lx1P5JxFjhIzNj MMpFVg8vg+WlSHRw4W+WE1aoPnaISGVbbm1Pj/+IR35d7lN1zkXxU/uSQW2in8DKoH PqIofkShYEyh3p+GuXJhoyDRvmKdKgfu0ul6WSu9vTbEkKJssPylMkr8mTHy6Wbdo8 qcdkqURgOAl1ajhwkRlB458J+utJY4M07YI2B1JQ8Cgsb/f4V81KvzbdBn7TKtB2Pj 5wjRVEuL91KAnSKW2DMsKZPSQfIk6Y3wWGEVljd7xUDyMN9Dx1W/21HHVOivxeEOj2 YDIIcFzQQSnI4WUmww6oIw/8= Received: from localhost.localdomain (unknown [IPv6:2a01:e34:ec01:e860:f052:4634:b50a:d5f5]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id E32EC140266; Mon, 19 Aug 2024 17:31:36 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Mon, 19 Aug 2024 17:30:42 +0200 Message-ID: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> X-Mailer: git-send-email 2.45.2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=185.230.78.41; envelope-from=ds-ac@nanein.fr; helo=nanein.fr X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) * 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 +;;; +;;; 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 . + +(define-module (gnu home services sway) + #:use-module (guix monads) + #:use-module (guix modules) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 popen) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (guix packages) + #:use-module (gnu services configuration) + #:use-module (gnu home services) + #:use-module (gnu packages freedesktop) + #:use-module (gnu packages xdisorg) + #:use-module (gnu packages image) + #:use-module (gnu packages gnome) + #:use-module (gnu packages wm) + #:use-module (gnu packages emacs) + #:use-module (gnu packages linux) + #:use-module (gnu packages base) + #:use-module (gnu packages suckless) + #:use-module (gnu packages glib) + #:export (;; Accessors and predicates do not need to be exported. + sway-configuration + sway-bar + sway-output + sway-input + point + sway-color + sway-border-color + home-sway-service-type)) + +;; Helper function. +(define (flatten l) + (let loop ((lst l) (acc '())) + (match lst + (() acc) + ((head . tail) + (loop tail (append acc head)))))) + + +;;; +;;; Default settings. +;;; + +(define %sway-default-variables + `((mod . "Mod4") + (left . "h") + (down . "j") + (up . "k") + (right . "l") + (term . ,#~(string-append #$st "/bin/st")) + (menu . ,#~(string-append #$dmenu "/bin/dmenu_run")))) + +(define %sway-default-gestures + `((swipe:3:right . "workspace next_on_output") + (swipe:3:left . "workspace prev_on_output") + (swipe:3:down . "move to scratchpad") + (swipe:3:up . "scratchpad show") + (pinch:2:clockwise + . "move container to workspace prev_on_output") + (pinch:2:counterclockwise + . "move container to workspace next_on_output") + (swipe:4:left . "exec alacritty") + (swipe:4:right . "exec qutebrowser") + (swipe:4:down . "exec st") + (swipe:4:up + . ,#~(string-append + "exec " #$emacs "/bin/emacsclient -a '" + #$libnotify "/bin/notify-send Oups \"emacs not loaded :/\"' -c")) + (pinch:inward+right . "resize shrink width") + (pinch:inward+left . "resize grow width") + (pinch:inward+down . "resize shrink height") + (pinch:inward+up . "resize grow height") + (pinch:outward+up . "move up") + (pinch:outward+down . "move down") + (pinch:outward+left . "move left") + (pinch:outward+right . "move right"))) + +(define %sway-default-keybindings + `(($mod+Shift+e + . ,#~(string-append + "exec " #$emacs + "/bin/emacsclient -a '" + #$libnotify "/bin/notify-send Oups \"emacs not loaded :/\"' -c")) + ($mod+Return . "exec $term") + ($mod+Shift+c . "kill") + ($mod+p . "exec $menu") + ($mod+Shift+r . "reload") + ($mod+Shift+q + . ,#~(string-append + "exec " #$sway "/bin/swaynag -t warning " + "-m 'You pressed the exit shortcut. Do you really want to exit sway?" + " This will end your Wayland session.'" + " -B 'Yes, exit sway' 'swaymsg exit'")) + ($mod+$left . "focus left") + ($mod+$right . "focus right") + ($mod+$up . "focus up") + ($mod+$down . "focus down") + ($mod+Shift+$left . "move left") + ($mod+Shift+$right . "move right") + ($mod+Shift+$up . "move up") + ($mod+Shift+$down . "move down") + ($mod+ampersand . "workspace number 1") + ($mod+eacute . "workspace number 2") + ($mod+quotedbl . "workspace number 3") + ($mod+apostrophe . "workspace number 4") + ($mod+parenleft . "workspace number 5") + ($mod+minus . "workspace number 6") + ($mod+egrave . "workspace number 7") + ($mod+underscore . "workspace number 8") + ($mod+ccedilla . "workspace number 9") + ($mod+agrave . "workspace number 10") + ($mod+Shift+ampersand . "move container to workspace number 1") + ($mod+Shift+eacute . "move container to workspace number 2") + ($mod+Shift+quotedbl . "move container to workspace number 3") + ($mod+Shift+apostrophe . "move container to workspace number 4") + ($mod+Shift+parenleft . "move container to workspace number 5") + ($mod+Shift+minus . "move container to workspace number 6") + ($mod+Shift+egrave . "move container to workspace number 7") + ($mod+Shift+underscore . "move container to workspace number 8") + ($mod+Shift+ccedilla . "move container to workspace number 9") + ($mod+Shift+agrave . "move container to workspace number 10") + ($mod+b . "splith") + ($mod+v . "splitv") + ($mod+s . "layout stacking") + ($mod+w . "layout tabbed") + ($mod+e . "layout toggle split") + ($mod+f . "fullscreen") + ($mod+Shift+space . "floating toggle") + ($mod+space . "focus mode_toggle") + ($mod+z . "focus parent") + ($mod+Shift+o . "move scratchpad") + ($mod+o . "scratchpad show") + ($mod+r . "mode \"resize\"") + ($mod+Shift+n . "bar mode toggle") + ($mod+Shift+b . "border toggle") + ($mod+tab . "workspace back_and_forth"))) + + +;;; +;;; Definition of configurations. +;;; + +(define (list-of-string-or-gexp? lst) + (every (lambda (elt) + (or (string? elt) + (gexp? elt))) + lst)) + +(define (list-of-packages? lst) + (every package? lst)) + +(define (bar-position? p) + (member p '(top bottom))) + +(define (hidden-state? st) + (member st '(hide show))) + +(define (string-or-symbol? s) + (or (string? s) + (symbol? s))) + +(define (strings? lst) + (every string? lst)) + +(define-maybe string (no-serialization)) +(define-maybe strings (no-serialization)) + +(define-configuration/no-serialization sway-input + (identifier + (string-or-symbol '*) + "Identifier of the input.") + (xkb-layout + maybe-string + "Keyboard layout.") + (xkb-model + maybe-string + "Keyboard model.") + (xkb-options + maybe-strings + "Keyboard options.") + (xkb-variant + maybe-string + "Keyboard layout variant.") + (extra-content + (list-of-string-or-gexp '()) + "Lines to add at the end of the configuration file.")) + +(define (sway-inputs? lst) + (every sway-input? lst)) + +(define-configuration/no-serialization sway-border-color + (border + string + "Border color.") + (background + string + "Background color.") + (text + string + "Text color.")) + +(define-maybe sway-border-color (no-serialization)) + +(define-configuration/no-serialization sway-color + (background + maybe-string + "Background color of the bar.") + (statusline + maybe-string + "Text color of the separator.") + (focused-background + maybe-string + "Background color of the bar on the currently focused monitor.") + (focused-statusline + maybe-string + "Text color of the statusline on the currently focused monitor.") + (focused-workspace + maybe-sway-border-color + "...") + (active-workspace + maybe-sway-border-color + "...") + (inactive-workspace + maybe-sway-border-color + "...") + (urgent-workspace + maybe-sway-border-color + "...") + (binding-mode + maybe-sway-border-color + "...")) + +(define-maybe sway-color (no-serialization)) + +(define-configuration/no-serialization sway-bar + (identifier + (symbol 'bar0) + "Identifier of the bar.") + (position + (bar-position 'top) + "Position of the bar.") + (hidden-state + (hidden-state 'hide) + "Hidden state.") + (binding-mode-indicator + (boolean #t) + "Binding indicator.") + (colors + maybe-sway-color + "Color palette of the bar.") + (status-command + (file-like + (program-file + "sway-bar-status" + (with-imported-modules + (source-module-closure + '((ice-9 textual-ports) (ice-9 regex) (ice-9 popen) (ice-9 format) + (srfi srfi-19))) + #~(begin + (use-modules (ice-9 textual-ports) + (ice-9 format) + (ice-9 popen) + (ice-9 regex) + (srfi srfi-19)) + (let loop () + (let* ((date (date->string (current-date) "~a ~D ~H:~M:~S")) + (batline (let* ((p (open-pipe* + OPEN_READ + #$(file-append acpi "/bin/acpi") "-b")) + (bat (get-line p))) + (close-pipe p) + bat)) + (bat (match:substring (string-match "[0-9]+%" batline)))) + (format #t "~a - ~a~%~!" bat date) + (sleep 1) + (loop))))))) + "Status command. It must be file-like.")) + +(define-configuration/no-serialization point + (x integer "X coordinate.") + (y integer "Y coordinate.")) + +(define-maybe point (no-serialization)) +(define-maybe file-like (no-serialization)) + +(define-configuration/no-serialization sway-output + (identifier + (string-or-symbol '*) + "Identifier of the output.") + (resolution + maybe-string + "Mode of the monitor.") + (position + maybe-point + "Position of the monitor.") + (bg + maybe-file-like + "Background image.") + (extra-content + (list-of-string-or-gexp '()) + "Extra lines.")) + +(define (sway-outputs? lst) + (every sway-output? lst)) + +(define-configuration/no-serialization sway-configuration + (keybindings + (alist %sway-default-keybindings) + "Keybindings.") + (gestures + (alist %sway-default-gestures) + "Gestures.") + (packages + (list-of-packages + (list sway swaylock waybar swaybg slurp grim dmenu bemenu + dbus xdg-desktop-portal-wlr xdg-desktop-portal)) + "List of packages to add to the profile.") + (variables + (alist %sway-default-variables) + "Variables declared at the beginning of the file.") + (inputs + (sway-inputs (list (sway-input))) + "Inputs.") + (outputs + (sway-outputs '()) + "Outputs.") + (bar + (sway-bar (sway-bar)) + "Bar configuration.") + (execs + (list-of-string-or-gexp '()) + "Programs to execute at startup time.") + (extra-content + (list-of-string-or-gexp '()) + "Lines to add at the end of the configuration file.")) + + +;;; +;;; Serialization functions. +;;; + +(define (serialize-keybinding var) + (let ((name (symbol->string (car var))) + (value (cdr var))) + #~(string-append "bindsym " #$name " " #$value))) + +(define (serialize-gesture var) + (let ((name (symbol->string (car var))) + (value (cdr var))) + #~(string-append "bindgesture " #$name " " #$value))) + +(define (serialize-variable var) + (let ((name (symbol->string (car var))) + (value (cdr var))) + #~(string-append "set $" #$name " " #$value))) + +(define (serialize-exec exe) + #~(string-append "exec " #$exe)) + +(define (serialize-output out) + (let* ((pre-ident (sway-output-identifier out)) + (ident (if (symbol? pre-ident) + (symbol->string pre-ident) + (string-append "\"" pre-ident "\""))) + (bg (sway-output-bg out)) + (resolution (sway-output-resolution out)) + (position (sway-output-position out)) + (extra-content (sway-output-extra-content out))) + (append + (filter + (lambda (elt) (not (eq? elt %unset-value))) + (list + ;; Beginning of the block. + #~(string-append "output " #$ident " {") + ;; Optional elements. + (if (eq? %unset-value bg) + %unset-value + #~(string-append " bg " #$bg " fill")) + (if (eq? %unset-value resolution) + %unset-value + (string-append " resolution " resolution)) + (if (eq? %unset-value position) + %unset-value + (string-append " position " (number->string (point-x position)) + " " (number->string (point-y position)))))) + extra-content + ;; End of the block. + '("}")))) + +(define-inlinable (add-line-if prefix value) + (if (eq? %unset-value value) + %unset-value + (string-append prefix " " value))) + +(define (serialize-input input) + (let* ((pre-ident (sway-input-identifier input)) + (ident (if (symbol? pre-ident) + (symbol->string pre-ident) + (string-append "\"" pre-ident "\""))) + (xkb-layout (sway-input-xkb-layout input)) + (xkb-model (sway-input-xkb-model input)) + (xkb-variant (sway-input-xkb-variant input)) + (xkb-options (sway-input-xkb-options input))) + (append + (filter + (lambda (elt) (not (eq? elt %unset-value))) + (list + (string-append "input " ident " {") + ;; Optional. + (add-line-if " xkb_layout" xkb-layout) + (add-line-if " xkb_model" xkb-model) + (add-line-if " xkb_variant" xkb-variant) + (if (eq? %unset-value xkb-options) + %unset-value + (string-concatenate (cons " xkb_options " xkb-options))))) + (map (lambda (s) + (string-append (string-pad "" 4) s)) + (sway-input-extra-content input)) + '("}")))) + +(define (serialize-colors colors) + (define (add-border-color-if name val) + (if (eq? %unset-value val) + %unset-value + (string-append + name + " " (sway-border-color-border val) + " " (sway-border-color-background val) + " " (sway-border-color-text val)))) + (let ((background (sway-color-background colors)) + (statusline (sway-color-statusline colors)) + (focused-background (sway-color-focused-background colors)) + (focused-statusline (sway-color-focused-statusline colors)) + (focused-workspace (sway-color-focused-workspace colors)) + (active-workspace (sway-color-active-workspace colors)) + (inactive-workspace (sway-color-inactive-workspace colors)) + (urgent-workspace (sway-color-urgent-workspace colors)) + (binding-mode (sway-color-binding-mode colors))) + (filter + (lambda (elt) (not (eq? elt %unset-value))) + (list + (add-line-if "background" background) + (add-line-if "statusline" statusline) + (add-line-if "focused_background" focused-background) + (add-line-if "focused_statusline" focused-statusline) + (add-border-color-if "focused_workspace" focused-workspace) + (add-border-color-if "active_workspace" active-workspace) + (add-border-color-if "inactive_workspace" inactive-workspace) + (add-border-color-if "urgent_workspace" urgent-workspace) + (add-border-color-if "binding_mode" binding-mode))))) + +(define (make-sway-config conf) + (let* ((extra (sway-configuration-extra-content conf)) + (bar (sway-configuration-bar conf))) + + (with-imported-modules + (source-module-closure + '((ice-9 popen) (ice-9 match) (ice-9 format) (guix monads))) + (computed-file + "sway-config" + #~(begin + (use-modules (ice-9 format) (ice-9 popen) (ice-9 match) + (guix monads)) + ;; Helper functions to pretty-print the configuration file. + (define (line s) + (lambda (port) + (lambda (i) + (format port "~a~a~%" (string-pad "" i) s) + (values port i)))) + (define (lines lst) + (lambda (port) + (lambda (i) + (let loop ((l lst)) + (match l + (() #t) + ((head . tail) + (format port "~a~a~%" (string-pad "" i) + (if (list? head) + (string-concatenate head) + head)) + (loop tail)))) + (values port i)))) + (define-syntax line* + (syntax-rules () + ((line* elt ...) + (lines (list elt ...))))) + (define-syntax line2 + (syntax-rules () + ((line2 a b) + (line (string-append a b))))) + (define (indent k) + (lambda (port) + (lambda (i) + (values port (+ i k))))) + (define (begin-block name) + (lambda (port) + (lambda (i) + (format port "~a~a {~%" (string-pad "" i) name) + (values port (+ i 4))))) + (define (end-block) + (lambda (port) + (lambda (i) + (let ((i (- i 4))) + (format port "~a}~%" (string-pad "" i)) + (values port i))))) + + (let* ((file #$output) + (port (open-output-file #$output))) + ;; The previous iteration of this work computed the content of the + ;; configuration file as a string. The state monad was used to + ;; keep track of the state during the computation. + ;; However, this first approach was too expensive. Now that I use + ;; `computed-file', the "computed value" is the constant port to + ;; which I write. Thus, using the state monad is overkill here. + ;; It can be replaced by the identity monad, where the value being + ;; passed around is the pair of `port' and the indentation level. + (run-with-state + (with-monad + %state-monad + (>>= (return port) + ;; Header of the configuration file. + (line* + "#####################################" + "### Auto-generated configuration. ###" + "#####################################" + "# DO NOT EDIT MANUALLY." "") + (line* + "# Variables." + "# ==========" + #$@(map serialize-variable + (sway-configuration-variables conf)) "") + (line* + "# Outputs." + "# ========" + #$@(flatten + (map serialize-output + (sway-configuration-outputs conf))) "") + (line* + "# Inputs." + "# =======" + #$@(flatten + (map serialize-input + (sway-configuration-inputs conf))) "") + (line* "# Bar configuration." + "# ==================") + (begin-block + (string-append + "bar " #$(symbol->string + (sway-bar-identifier bar)))) + (line2 "position " #$(symbol->string + (sway-bar-position bar))) + (line2 "hidden_state " + #$(symbol->string + (sway-bar-hidden-state bar))) + (line2 "status_command " + #$(sway-bar-status-command bar)) + (line2 "binding_mode_indicator " + #$(if (sway-bar-binding-mode-indicator bar) + "true" "false")) + (begin-block "colors") + (line* + #$@(serialize-colors (sway-bar-colors bar))) + (end-block) ;; colors + (end-block) ;; bar + (line* + "" "# Extra configuration content." + "# ============================" + #$@extra "") + (line* + "# Keybindings." + "# ============" + #$@(map serialize-keybinding + (sway-configuration-keybindings conf)) + "") + (line* + "# Gestures." + "# =========" + #$@(map serialize-gesture + (sway-configuration-gestures conf)) "") + (line* + "# Programs to execute." + "# ====================" + #$@(map serialize-exec + (sway-configuration-execs conf))))) + 0))))))) + +(define (sway-configuration->file sway-conf) + `((".config/sway/config" + ,(make-sway-config + sway-conf)))) + +(define home-sway-service-type + (service-type + (name 'home-sway-config) + (extensions + (list (service-extension home-files-service-type + sway-configuration->file) + (service-extension home-profile-service-type + sway-configuration-packages))) + (description "Configure Sway by providing a file +@file{~/.config/sway/config}.") + (default-value (sway-configuration)))) base-commit: d3832de763777759eb1f56e20731cb39da4c7b5b -- 2.45.2 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v2] home: services: Add 'home-sway-service-type'. References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> In-Reply-To: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: , guix-patches@gnu.org Resent-Date: Sat, 24 Aug 2024 15:36:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Arnaud Daby-Seesaram , ( , Andrew Tropin , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: ( , Andrew Tropin , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172451372110350 (code B ref 72714); Sat, 24 Aug 2024 15:36:02 +0000 Received: (at 72714) by debbugs.gnu.org; 24 Aug 2024 15:35:21 +0000 Received: from localhost ([127.0.0.1]:41779 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1shsnP-0002gr-PM for submit@debbugs.gnu.org; Sat, 24 Aug 2024 11:35:21 -0400 Received: from nanein.fr ([185.230.78.41]:40386) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1shsnN-0002gb-3d for 72714@debbugs.gnu.org; Sat, 24 Aug 2024 11:35:19 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1724513661; bh=xQMBe4xR5u1dzHqpib/7zEQq5eMVFOAqGop2Uw7wN14=; h=From:To:Cc:Subject:Date:From; b=g/kck4pwcpESCw2pNOQlsrW5ZLUoEnmT6xsa3sMb9F1ChdUDYOIBOiXQy+LXqLhX/ pqug0Mf3L9Drccxpf1In7cPMyvE6M5lUsKHX6tV4OICF3276+xinvEJQLFIO69pCT2 rKxzBN+KCurIMNzFQx9XYGzXWqmxAfcOwsUwLEGTKOBz/M125Oii98qEjmlLEaowtk STgiwl+n3b4FLCyMJit74qw4HvsW+IUy9ZCmVtQlDhovJmVwTWa6V6eSjm5ow7P7sX 9N/hQRcAHI64LngyaTYDPaazhLTCM+AqVsGp+wX0RdUyPgnZYDt3TXEBMVO4AWkOqo KaQQxZP+a7drhvmrVQPWhjUn6GptEnEEwocf20DArDWYLgyQzWHZf/RE+ffK1A7Dg8 PYuBP381Y1R59e/EJXy6bNi/oezUnJCAix/DBXTb4Lfd6rW79cDS/4KMXfjz3Lfhg0 fSs2aQaDY7oV0hGmA3YoYpzWCNpGrjhv9ky/QV/xTDfxI17PggFNXP9gtNkMCTAdxP pOvP8I1jN6mDTygzCLx9jwHGo7hcU9YRSdUlTcMzzgvT63XfmE0ubgZd9/O1tm7mUb UZTTyajBjhKBzJ/Z8EY6IgGKdGQq4/Sq4t8R+NbeGGUkA+HddpsLxmMAhBeiIzPN44 cr3AotaX+Kdk6ELAS4TKDZlE= Received: from localhost.localdomain (unknown [IPv6:2a01:e34:ec01:e860:5b27:5fd8:232b:dd64]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id A47CF140266; Sat, 24 Aug 2024 17:34:21 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Sat, 24 Aug 2024 17:32:33 +0200 Message-ID: <901afa1d4bd6d28400da2f3403bf5cd5f1ee177c.1724513553.git.ds-ac@nanein.fr> X-Mailer: git-send-email 2.45.2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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))))))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v3] home: services: Add 'home-sway-service-type'. References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> In-Reply-To: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: , guix-patches@gnu.org Resent-Date: Mon, 26 Aug 2024 10:41:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Arnaud Daby-Seesaram , ( , Andrew Tropin , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: ( , Andrew Tropin , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17246688381180 (code B ref 72714); Mon, 26 Aug 2024 10:41:01 +0000 Received: (at 72714) by debbugs.gnu.org; 26 Aug 2024 10:40:38 +0000 Received: from localhost ([127.0.0.1]:43782 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1siX9J-0000Iw-0H for submit@debbugs.gnu.org; Mon, 26 Aug 2024 06:40:38 -0400 Received: from nanein.fr ([185.230.78.41]:36900) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1siX9F-0000IW-Dv for 72714@debbugs.gnu.org; Mon, 26 Aug 2024 06:40:36 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1724668745; bh=SLmzisil8S9xV+JQBWBsgznliYhQIaCUUh7b0UdGUXw=; h=From:To:Cc:Subject:Date:From; b=AXyJznBY2je4XME4x19e73/CbxF8ooXXzbWRkxBQIyXVlGA9Uw2hThmKWT6RPZORQ WwQHBwWRtS5G0vTE4/QGHPidFbMQAKSZRV7vsrVTZTTRK45gIbB1bo8n75Ek2GHexY 9LpTCB9mCMVwcg0/kiy8kGXhuBIrmJEmViHLXlLjMMJERcSsgHXeflLbpmFBXxVNIW +WPWjh810vXFOtEcDjGFq6ntbFbAwhB3aSvkSBBi8UkPurvkJpCkb9xyN/DN+uoWzP JA/4BVRFIKpkuR/BHR7qsROZQ2i+DrRQiXRoOftqpEMuMUzxu8F0VqdZ65UV/3WeMX cmbBCL6unYB9qY/XkKwVPwslmG2mRVevpRKqy4Fk4P0cfFBATysHl+fWDDjSPM1/41 Vay663z1xUKiR0UsphV8JKkXSRrKTs3REPjs8y6qPhUmL0/QjhSLEY6I/4LcMhuFiB 15Ob5vjbzHENLvLGwg7T1C4HVB0pWqQypUJ6m3iTFpVEwuh4QIcUvvyN/bBe7vgYVW ivrX/0r5SzQlkk+h/Vl3yQAYU2kKraBp6Bj6+HCjRdiCP5u6bkt+RkQVTc0QmmVqNu iy48LYbxKHsZI7+sTis3vf3+Fa2hgisqpPrIvwZRlbeEx9B5n9Zd7u7Pf6HVv0egsQ Ng5iLdyeWgB+tabQ1rs3JkLI= Received: from localhost.localdomain (unknown [IPv6:2a01:e34:ec01:e860:5b27:5fd8:232b:dd64]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id C4F3E140266; Mon, 26 Aug 2024 12:39:05 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Mon, 26 Aug 2024 12:38:13 +0200 Message-ID: <4b0a03801d5879f745e791635f57b9fa591fc0d2.1724668693.git.ds-ac@nanein.fr> X-Mailer: git-send-email 2.45.2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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))))))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> In-Reply-To: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 03 Sep 2024 07:30:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Arnaud Daby-Seesaram Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17253485605689 (code B ref 72714); Tue, 03 Sep 2024 07:30:02 +0000 Received: (at 72714) by debbugs.gnu.org; 3 Sep 2024 07:29:20 +0000 Received: from localhost ([127.0.0.1]:56412 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1slNyY-0001Te-BL for submit@debbugs.gnu.org; Tue, 03 Sep 2024 03:29:20 -0400 Received: from nanein.fr ([185.230.78.41]:46654) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1slNyT-0001TL-Qa for 72714@debbugs.gnu.org; Tue, 03 Sep 2024 03:29:17 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1725348483; bh=I9zKLwQT8MEmxEJ4P+sPlXPTERuT6LcdEdo4g/r4FcY=; h=From:To:Cc:Subject:Date:From; b=o4U3MJRAK//k9tHcCzRcyJ6gWQgcE28dlGT6lNrUovSaK3C2ayWvqavC9ck0RQHXv 0tl3z3n9adAuiuQPUq6mGyDRI/OQyaYLjOa+aXTN4XF9HMy6TENTvCpCMrfuzAkdaU tBiwuVt1lipPjJ/DIF338cFqXokIanB0RykmyIA9jwZ50n0Sc/pF8+dlD/EOfqh+lY COZk0MqwtHGyfmfRY5MReU9IoJwsL442vODHE/1cRhtlFcRTNVjoY6+5sWlhGuwy6K Mo9y9CTUEBIWR/aAnIBwyvlCNYvmN8wW1kERExAGv228ZNtAsGP2Yt52M2we8sxPRx /qzilWTPtKU+AaqlFS+JVFN8FcFo6HC8kBhVYWnVyHsOEJa/UBbTciFuTmXB1GyPaY XGy48BGfpgjmagCX+2INFTSA1Zg2zJKZLYvZN6uAc3ls1q2z9EziLymiNulHHzBu31 nP1HVI+C5L/7PCiOOmGHqSgD9eB27IEwZe6KEL85YDERcS+VloAL7r5gdDvGBFkaQA 6ZHrSXWiI+VaSoK66lpopP2KtN82HLKdB9Q5CFL3Mf2zrwHnXqZchk82Viis/fzXHP qCd0sdIMYR2j+8fz1WVQu2V6qWtCRpWPpoa5sOMHUE9r6afIgrukmwjYdVX3/Bn+Pk R1bw5E9P7pQByElLrkIZjwUI= Received: from arnaudGuixPortable.eduroam.net.au.dk (eduroam09.au.dk [185.45.22.146]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 4E37014026A; Tue, 3 Sep 2024 09:28:03 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Tue, 3 Sep 2024 09:27:33 +0200 Message-ID: <20240903072745.5118-1-ds-ac@nanein.fr> X-Mailer: git-send-email 2.45.2 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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'"))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 14 Sep 2024 13:30:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172632054223547 (code B ref 72714); Sat, 14 Sep 2024 13:30:03 +0000 Received: (at 72714) by debbugs.gnu.org; 14 Sep 2024 13:29:02 +0000 Received: from localhost ([127.0.0.1]:45114 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1spSpi-00067f-2k for submit@debbugs.gnu.org; Sat, 14 Sep 2024 09:29:02 -0400 Received: from relay.yourmailgateway.de ([188.68.63.174]:50675) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1spSpf-00067N-Hg for 72714@debbugs.gnu.org; Sat, 14 Sep 2024 09:29:00 -0400 Received: from mors-relay8204.netcup.net (localhost [127.0.0.1]) by mors-relay8204.netcup.net (Postfix) with ESMTPS id 4X5X7g3Kyzz8bMc; Sat, 14 Sep 2024 13:28:47 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1726320527; bh=bgbLkUMb+lwBeIkd/mV272HcDB3cK0q71oeHixWZBAI=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=Czts9ckc1cuYHwm9cKNM4yY/+8cYQK6QaPQ7tjTkb8QNFj1qhFSz7uE19ZVzdzHpB LYjYZB7k1ZP7Kwu6cz10AbauPebnHwxI9Dfy0qAPQRODx3JcLjOXyvWdwNzuLtvoxY D93QUgirva7Mnx9D/NyR2qcStoQGvF/7IUwkT472uzO5cY0L/AwGW8m+8fYxBDntNL jZsgNykDm2HY5K6cg2Ke8dhC+XbGk436DWTW6Wjma8dIBtG50MGoAGMx64wQk2OV/I yr31ydT/Ir9kYmpXJ3Ps0DUlHU1MRLRd/kcXM9HThsOK9QiYz87uUQiCgnAHs6QWf2 tPz3NPtmaFcag== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by mors-relay8204.netcup.net (Postfix) with ESMTPS id 4X5X7g2bJGz8bKF; Sat, 14 Sep 2024 13:28:47 +0000 (UTC) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4X5X7g0Gtzz8scM; Sat, 14 Sep 2024 15:28:46 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id AF3A984194; Sat, 14 Sep 2024 15:28:41 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <20240903072745.5118-1-ds-ac@nanein.fr> (Arnaud Daby-Seesaram via Guix-patches via's message of "Tue, 3 Sep 2024 09:27:33 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> Date: Sat, 14 Sep 2024 15:28:42 +0200 Message-ID: <87bk0qe54l.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Rspamd-Queue-Id: AF3A984194 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: RQvlHkSbOPipdLon4qFbNBeYTPg2+RtSRccnz8nmCTZgtHU23Q+xNH+W X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 14 Sep 2024 14:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17263228362289 (code B ref 72714); Sat, 14 Sep 2024 14:08:02 +0000 Received: (at 72714) by debbugs.gnu.org; 14 Sep 2024 14:07:16 +0000 Received: from localhost ([127.0.0.1]:47447 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1spTQh-0000ar-QB for submit@debbugs.gnu.org; Sat, 14 Sep 2024 10:07:16 -0400 Received: from relay.yourmailgateway.de ([188.68.63.166]:48849) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1spTQe-0000aS-97 for 72714@debbugs.gnu.org; Sat, 14 Sep 2024 10:07:13 -0400 Received: from mors-relay-8202.netcup.net (localhost [127.0.0.1]) by mors-relay-8202.netcup.net (Postfix) with ESMTPS id 4X5Xr036wgz3w2m; Sat, 14 Sep 2024 16:00:16 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1726322416; bh=CqF0NrPbniGUCkJfNnW1V4zWyb2/wdDzMiCNCkAqUZI=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=guBl+PZ45NYJXadWQfsM0eR3WkhkGMB96awWeXqcCbOYY52sjst9nbKPXmrIVy/e4 SayBF4I6jBP8/W1OSU0kqNBJx+6/B++lRbFCxBIHbiFzotLsWXbseM6OGVDkpy9owX aa4/rsFNaDuTOTfNetK/xD6opL3yc9d5CxnW7bgDtjWQ0h7OECLlfB+iwCCfdutIlX c0SyGW3nsmGUkLUAH80HK30sjbmfsemLogOW44Sa+RTrQEJtU3k7IWDrZbDXXeCUK6 2RI9csorNRwgnOtg1m6OngGYhXYrcmlT+YFi7cKuQc+QNYf85ls6hH/v2VuAdzsctN ShK4OJOqs2OJQ== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by mors-relay-8202.netcup.net (Postfix) with ESMTPS id 4X5Xr02PRGz3w2j; Sat, 14 Sep 2024 16:00:16 +0200 (CEST) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4X5Xzl3v5yz8sZP; Sat, 14 Sep 2024 16:06:58 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id 44E5F841BC; Sat, 14 Sep 2024 16:06:53 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <87bk0qe54l.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Sat, 14 Sep 2024 15:28:42 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> Date: Sat, 14 Sep 2024 16:06:53 +0200 Message-ID: <87wmje1g8y.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Rspamd-Queue-Id: 44E5F841BC X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: Y2887C/K+fERp4usKU/yg2k5Y2xIzk+IlvCUN2qLPcmA2Y6dYYtv5KqL X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 17 Sep 2024 06:54:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172655602229765 (code B ref 72714); Tue, 17 Sep 2024 06:54:02 +0000 Received: (at 72714) by debbugs.gnu.org; 17 Sep 2024 06:53:42 +0000 Received: from localhost ([127.0.0.1]:53765 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sqS5m-0007k1-0v for submit@debbugs.gnu.org; Tue, 17 Sep 2024 02:53:42 -0400 Received: from nanein.fr ([185.230.78.41]:48642) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sqS5j-0007ji-HW for 72714@debbugs.gnu.org; Tue, 17 Sep 2024 02:53:40 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1726555966; bh=ZoSTqpkjJKKAvAg6fjkkhOB4PE1CThpy7zmElstsysY=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=k8ssfW0OFsfKzHG5TRqIZaVAnQMo40cIJa9vvT10nWs4dJtXUFgINq4/RKnmnllt/ +X820ZWxBOddk2xfPWb4pHqGV75yrOwC/KL6pFAOaVxja4qOuHYUrmySQlWscdhCyp raFG6YOuTsH2UFtLzX1mDfDzPcfAyyZwXFW7HqSpSyp/ZKokVc341F8ySEWg+o84tv aWIhbrOQra63ePjuW7hGJyS5Hgjj+0Ru4w3XKCWVtfceMpbDwXmjaYjyNz7zJRpopT Ke0AMHbF49aS8yLvw2tuZuXHQe/TaL7T3O2n9YgZXqnpuZIyfVMPxJHYkxFAgigHyz cKgLhYkxpj43w4qpx1O2/cnZRnU/2YH8ba2eAreQDz+wMptm/U6CNnzlUwBZM0ehSL ltiXPtyUZEDzeqYSPxYAggaaEv5plqjzSLn31Q2Yow1Q+polLnHVA2qve45m8ADwJe mB/wmfzG4b/ivvKS0EuvjZdXvAuiyvApQqjDFKP/1+TqKMuB1lqmTiGzXm8XPxUjcO 04LZJ4guWB0N+Wpo28YRvvUIjr43i2Ih6a+Mclwup/rT+NDAbeJmL4G22aM2Gppl3m bhe+/1hmWuQMqTktM+G4iKegbQPAy78tSu9HUVgTvY4uzG3hcy+6xS9uz+SjNX+SLj NrLQy1zjmtir1p/9wHVKA9jM= Received: from arnaudGuixPortable (wg.nanein.fr [IPv6:2a0c:700:12:50:1::109]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id BBA6E140215; Tue, 17 Sep 2024 08:52:46 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <87bk0qe54l.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Sat, 14 Sep 2024 15:28:42 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> Date: Tue, 17 Sep 2024 08:52:41 +0200 Message-ID: <87plp2db5y.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable 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, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmbpJzoQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDAlmEACVja8D3L53O0CnLdRCgYY0vBQcKwt4R79T h5BvcAWF+mZK+lGZ+myLtTLSh9oYuF3dCjD29KCnpC07/b4HohDow9ibfGEoe+sp 7GFAef0PH+bWjMiQVgOVNkFZeXH8XuaDCjNMgvkVZ41BzNp+mKQ2zCbZnVNzNRnY O6GnbYZoGhAJqZa6knCIlMaTUsMYgAaWl3NvBtBHG4+8CPPPMONcRG1DmOeCUyJY GrzUOvTMIGcMbr6i8dPlh4Z90gHa6OleeMy7U9rcZqxErpuYS8wCEa6bg28rG5Y/ R4mT/DcYNseV094+ljpAgl/7eGqxwe05aaj/8tjg3os2KoES6T5/gsYTVO1iar0B 1v93FrjmhVxnZrxLULhFlA13y4wTT28TMXvU7v8NiT5iuWhn2lDswsoN9pJf9O9+ 7f5I5oud6WKSGk21P+WjjLWyJ2poUMBHzCqUc+E4aZV2/kk27KananJI1MwaQsm4 pPa/mWE6wsdgI7RSbQD/s13erP6nazqa0VgNM7tH78R2zv4vVe2vopUPhadVtEsY KMzA2/1LogvgU/bpTns4IIpIX9UPJRCqWG7gR0MBYJbPyEgS1m5boqKR3SI8RlyV pqP9n6URCBazBh+avYbO9CXXdyHmWZFBsXn17eu4OFIK5WSg5JVvFbPIe6Ft+qYM yj85Htihvg== =PX4M -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v5] home: services: Add 'home-sway-service-type'. References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> In-Reply-To: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: , guix-patches@gnu.org Resent-Date: Wed, 18 Sep 2024 08:17:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Arnaud Daby-Seesaram , ( , Andrew Tropin , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: ( , Andrew Tropin , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172664740813501 (code B ref 72714); Wed, 18 Sep 2024 08:17:01 +0000 Received: (at 72714) by debbugs.gnu.org; 18 Sep 2024 08:16:48 +0000 Received: from localhost ([127.0.0.1]:56956 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sqpri-0003Vd-GJ for submit@debbugs.gnu.org; Wed, 18 Sep 2024 04:16:48 -0400 Received: from nanein.fr ([185.230.78.41]:45530) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sqprf-0003VM-AM for 72714@debbugs.gnu.org; Wed, 18 Sep 2024 04:16:45 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1726647351; bh=2buOKGXP2Ng0AtYkiBNW1qxX6Js4v5sgt4mX3kBKI7g=; h=From:To:Cc:Subject:Date:From; b=VrPlFoKjP4zqR4mXbOWa/gi5KPtkntO1j+tQKExLhZC9PDL5B4XQNlRSCrjkWk6uh RtyPjuvSpkRJ7qbCVQnP7QNGRhrtX3HPHAfqXO83LCJ8bEznjXEkS6YsljcEM/LsaX kwZA4eXRm9Ii2Yaz2ySCaAWxx3uaRh0xASK8215oKkcqdnd/VGbAFiSDxN8XAngqyO ZbuweuzC7v+7TTuR0F0o/H+T2BlysvXLoErzshaS5jvgVhGLZVkn0J8T8hq5MDFmh+ MXJ7nL4SF4U9t3Tfd+dtKJfb5DxJMOfczZ+TgRtS0r2Z+1bbU8XVH7zf7XbYlkXNkL GxecLJZGgb5aOOfA/rBqn9x/ptLeEM3xlJ3wJCXThhaLK0efvkZv/+geBBA8B+z7e4 E4y3cRsOzkMncFe6MVdirgFcowZjiUagwSxXKjJt4iat1VMD4AGy8DmZE2EYdZ+n1l e/3X0vBUk9xtLxpe3dAho0fOoAAatP+RdmQTDga+KQw2a4j/Ur17BoBUt3wDgZhMQo IHWkPywQ2urFyZ4q9S8QzfKXYJo8/t80W9/X3E8GFb6UXyb7/hCbHIsLOSR/LyWBxW mRSVOZwZAafW049ncYVz26vvllPgKtE5bIj9l3MzeuNG7FwNvtAwEPFr6Vgqhsgxm/ +wxTmRCT//9Ye5/YrIgQORas= Received: from localhost.localdomain (wg.nanein.fr [IPv6:2a0c:700:12:50:1::109]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id BFFB6140215; Wed, 18 Sep 2024 10:15:50 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Wed, 18 Sep 2024 10:15:40 +0200 Message-ID: <20240918081545.8885-1-ds-ac@nanein.fr> X-Mailer: git-send-email 2.46.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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'"))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v5] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 18 Sep 2024 18:58:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172668585622899 (code B ref 72714); Wed, 18 Sep 2024 18:58:01 +0000 Received: (at 72714) by debbugs.gnu.org; 18 Sep 2024 18:57:36 +0000 Received: from localhost ([127.0.0.1]:59244 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sqzrr-0005xG-Rg for submit@debbugs.gnu.org; Wed, 18 Sep 2024 14:57:36 -0400 Received: from nanein.fr ([185.230.78.41]:34816) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sqzro-0005wv-L3 for 72714@debbugs.gnu.org; Wed, 18 Sep 2024 14:57:34 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1726685798; bh=v9Ho1nPiHQHUJRmTRqEmkw7OrsSAa6htua5nVLpSptQ=; h=From:To:Subject:In-Reply-To:References:Date:From; b=KlPrwj7vfyHwIkm2zEIsQuVlgGbrPeMJG03w4iKeSXrY27eHZ8B90drHSuBzMincc eEJS9LegSqqI4f6hg8gTBJYwyvfxCPzIDHZhgrt+VPTCxJcxztog+KlRnbuqalydzD xEpgJolE3HeQ9IhsUMwVMwD1tzDqIZmTOauJKKu4rgUl+jN1mK4gB184Golq5j23XE RArdDY+PmE/xaY9kH1JBJmLG6amA0KrUaUQTMZaqT7TlppxuRtlI/Z72PVzHNk2v2I 0Y8V8+w+cIjc6du+8d8DFVW5by/r+M8AuyOFqEpfvgpb/D7OL1DfvmbqpBX2tSHCkr F0pXla7vdMQRIlwUU/7ct7u+2BZrP9ZlG2wMKtGZa3RD/1f5nM/M8Zz8u4YlcVvpEz VOhHI9NV3WA16EuCqnlY4Jp1gpDXdBHiKhHgLJRjldAbCWKguZBwdekEmfkiNEKAlK WhwfZTGvrgTbMSM66DubStd2lwQQc+Qh62TGKvRprkVHwJMM/sI6s7YEUoVrc4jXlL JouP9x6tHnfqJEFAE042myUVux9fOumNm5WcZiQjB2+M2t+iPgHvonuh6zgR77o1I3 8WRdpPsP/AF+6uFTMqZa9hzr4HGm4KKHt8h9Vgpq3zXp0JHw1xb+W4aXaRMmyAaMJB p5gJFX37cne8ar+DuQlZpL8w= Received: from arnaudGuixPortable (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 59970140266 for <72714@debbugs.gnu.org>; Wed, 18 Sep 2024 20:56:38 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <20240918081545.8885-1-ds-ac@nanein.fr> (Arnaud Daby-Seesaram's message of "Wed, 18 Sep 2024 10:15:40 +0200") References: <20240918081545.8885-1-ds-ac@nanein.fr> Date: Wed, 18 Sep 2024 20:56:34 +0200 Message-ID: <87zfo494f1.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: 3.5 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Apologies for the noise. I just realised that I forgot one line in the commit message: (sway-mode): New configuration record. Best, Content analysis details: (3.5 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record -0.0 SPF_HELO_PASS SPF: HELO matches SPF record 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 T_SCC_BODY_TEXT_LINE No description available. X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.5 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Apologies for the noise. I just realised that I forgot one line in the commit message: (sway-mode): New configuration record. Best, Content analysis details: (2.5 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_PASS SPF: sender matches SPF record -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 T_SCC_BODY_TEXT_LINE No description available. -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable Apologies for the noise. I just realised that I forgot one line in the commit message: (sway-mode): New configuration record. Best, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmbrImMQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDI2TD/4rsIzME46DhQkk1Vy8jieL7Y48PYJiTNYw VpiRhKzZmjn5vEMyV23tUQiOGPuBSZAxiqKH2Fw/Y7BwPAhck+ciqsM+c+8FS6Hn qcdLyw7pRV8Z3O5z6q2E65hxBNLKqMLPmS3BFZ0OkwKarl+YN4dHa98dozyN7B79 XMX7v/Y+QOC7GeLhvlmVq2tmb6caj1NYT85rK/44PeQQQ2wAkko4UdxRdCIND280 j0Li0BOQrR0lkeGDx8gbjAxuIxVm4zB5zhkdmkbN8083YU+mJPlK2PYJGTF72ZMF ijApVAiS4L2o1d92A8EOfR9yeJDiCcmCBpvjHYhWiMCotvwTSugbmbbIou/A3YJF k1NLRBX/P2hlPb+va01d5sFTNC5JK4kvy6V6bSHRXui9+xGBiZRmxJkyL+2eOXgl DIvcx1hWFuZ6ggA5iKD9H8CXvD29BOs1WtvkUvePwa2Etf2z/nJAjo5sh8k2vJko fT+6Jv0O5ZF4siSrtg3/3jXvd0V29QIaUXaB7Uzw3BwYGxMGJWaAxnKsfHQg0K9T jI2Ng5hX4VJUPkS+WLaBADIEy0gThmTJ++R7CizbwtLkPmreCyM5SCPnzCtqfNGI 8tqrTp+wSg+XIsHrHCiN5Ugk8HX3mv1ZLk1ujjKSDlpZqAMIcvYqL7i+unThwkN9 paaDp82T2A== =crwo -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 20 Sep 2024 16:46:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172685072824430 (code B ref 72714); Fri, 20 Sep 2024 16:46:02 +0000 Received: (at 72714) by debbugs.gnu.org; 20 Sep 2024 16:45:28 +0000 Received: from localhost ([127.0.0.1]:36197 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srgl5-0006Lm-In for submit@debbugs.gnu.org; Fri, 20 Sep 2024 12:45:28 -0400 Received: from relay.yourmailgateway.de ([185.244.194.184]:55581) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srgl3-0006Io-0E for 72714@debbugs.gnu.org; Fri, 20 Sep 2024 12:45:26 -0400 Received: from relay01-mors.netcup.net (localhost [127.0.0.1]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4X9JCM4t5cz90F8; Fri, 20 Sep 2024 18:45:03 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1726850703; bh=8lIZxQSNUoxRgkbzN5bieOrUeTwlav/MJJFlcPK00lM=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=OyZOG9WDxr/f0faXuOY1IVeE7amaOOmPgxiTtc7OvHeIC7bZ96e/Drtu6u8qSJ7cy 0MsAfEUVkY0u4yBUTlAyPvnMZmvvMYVsNWUPc7N0wQ4trYN7kXoQAuWIU8ia5jK1v1 4M8T7acq6JwETH1rISengVTUiMuronSUYJHpdEwuIDzh0Kh2qaTfAjbbkISBGET/Pr BYs9n7SrlBN4DvseOJAH2LNDthgFZedEUFLDPLUpVVhtcAFjHJDux+gwUy4r7/Rfr/ jmTkuAH0ovYf9xd22A3OCAX6FIEi7J+GnNZvyeg00WfX8w98UMxe7Sz9VBsl1t24fW sJ+u0HQXJ+h1w== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4X9JCM4CBvz7x5F; Fri, 20 Sep 2024 18:45:03 +0200 (CEST) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4X9JCM2CMCz8sZV; Fri, 20 Sep 2024 18:45:03 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id B008A83A99; Fri, 20 Sep 2024 18:44:57 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <87plp2db5y.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Tue, 17 Sep 2024 08:52:41 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> <87plp2db5y.fsf@nanein.fr> Date: Fri, 20 Sep 2024 18:45:00 +0200 Message-ID: <87bk0icm0j.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Rspamd-Queue-Id: B008A83A99 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: /h1DBdiNazMnS8Y29rDLL7JTCDZmYorzCyLHI59vd/uDD87mOqLvCkVu X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hello Arnaud. I=E2=80=99m 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=E2=80=99s me= dia PC now [1]. Thank you for it! Arnaud Daby-Seesaram 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 =E2=80=9Coptional= ly=E2=80=9D 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 =E2=80=9Cdefault: =E2=80=9D. In other pla= ces you correctly write =E2=80=9Cdefault: =E2=80=9D. Regards, Florian [1] https://lists.gnu.org/archive/html/guile-user/2024-09/msg00041.html From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v5] home: services: Add 'home-sway-service-type'. Resent-From: Hilton Chain Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 22 Sep 2024 08:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17269929399613 (code B ref 72714); Sun, 22 Sep 2024 08:16:02 +0000 Received: (at 72714) by debbugs.gnu.org; 22 Sep 2024 08:15:39 +0000 Received: from localhost ([127.0.0.1]:40832 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ssHkp-0002Uy-A6 for submit@debbugs.gnu.org; Sun, 22 Sep 2024 04:15:39 -0400 Received: from mail.boiledscript.com ([144.168.59.46]:56742) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ssHkm-0002N2-Gd for 72714@debbugs.gnu.org; Sun, 22 Sep 2024 04:15:37 -0400 Date: Sun, 22 Sep 2024 16:14:48 +0800 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ultrarare.space; s=dkim; t=1726992907; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=Ps/668HZVzSk8bObFXRYdDegbwqJs5a+Hjt0eDPA+bs=; b=wWU6yXrz3tMCLjVonyk2RSCkcpARKXoKf416dcELQ4LLTLvQSJWF+j0r8jVtCQquR/V/yR DGEMfuuXgNk9CJoOstEkXUWBbz2LG6Ibwahzme1l9YUGAeiaE8Ef7OlgKcs7szdZRx6NZN HcLzCcHAVtuakxnri17AHtVQu8LXSopjcNma7ilylN7F5d72QvOhqguu8LI0wp1cqA5/UI IitQFrUYI4r+0OFW2NqXjtP3KPHHuSo07EdoW6cPCcvHYZpk5vq45QJxUsGZ200+azbjQA CvoAHGHPAT/9PDYpIi9qNEkwHXWmeZ25GnasiA0EhOKxcI42LoBLZjNm/4x9lA== Authentication-Results: mail.boiledscript.com; auth=pass smtp.mailfrom=hako@ultrarare.space Message-ID: <87r09cm7ev.wl-hako@ultrarare.space> From: Hilton Chain In-Reply-To: <20240918081545.8885-1-ds-ac@nanein.fr> References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240918081545.8885-1-ds-ac@nanein.fr> MIME-Version: 1.0 Content-Type: text/plain; charset=US-ASCII X-Spamd-Bar: -- X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 22 Sep 2024 13:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172701266913663 (code B ref 72714); Sun, 22 Sep 2024 13:45:02 +0000 Received: (at 72714) by debbugs.gnu.org; 22 Sep 2024 13:44:29 +0000 Received: from localhost ([127.0.0.1]:41094 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ssMt3-0003YH-26 for submit@debbugs.gnu.org; Sun, 22 Sep 2024 09:44:29 -0400 Received: from nanein.fr ([185.230.78.41]:57654) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ssMsz-0003Xw-Rv for 72714@debbugs.gnu.org; Sun, 22 Sep 2024 09:44:27 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727012637; bh=hCQYFi/YGR0SAsxl8r3Dlf0FfTVe0iX/G5z9PgaU4k4=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=KQNxpqq2kMZlBjLdrEt6SpS//znwPsnECfTsS7fho5APNJ7tx9uYBd2DjG/HpZgzd P0AP+Tio0luGkgItASjzFeM2MMJNaAt2sz29JyuTF76cNl/CKZs+NGKrwayb3uk/qV +zdPRJHaVtYQaGeGnyfiKXF1/g1jBhs0gntT5cS9N0VWs4Xd3CS7o1yBdjkLiYhhfJ KpYjNk5Qm0vwOKxeAE/2Ch7NjdhYb4CH8MIppRbD0OtOiu5+zs/hnIILRrFPz+CuTt bTPLy0A4O/COkO68Z7uNFJ4+hIZJCltBU7IxmovE9pKm544IynjTawdAzjeWsvY0CF siABVMqCCbKuhaElInW8WvT2vHuF9XcoSqB1PMiqyr4ObXzqrPezliKU6w0J1i6PV6 2ihLQcEbXEDIx3xBecOql97Oe20eR67Zucs8BZVQ1Nmuj7umplZdgCY4pw+9HWRSbV ovglpqyP5Rsog3zvZ73GoIzUiYZcPMUcbj+pD56lTdghXSLmFvtA0P/qTzXEXusf92 0WfCzz3P3D1YMS7hkYzWSYCsvgE/9PFbDrp2oZsyzn+80KOf8iy0QomDzCt2iHKOYK i2520Pfg8M9v4nUJv68sVas+9rc9T3fyN0XJ3GrbyZcX/yuuTzkIxr1+tB/p//CxPL b2yLbPV37aVyxkTHb1tGMFoA= Received: from arnaudGuixPortable (wg.nanein.fr [IPv6:2a0c:700:12:50:1::109]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 312F5140266; Sun, 22 Sep 2024 15:43:57 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <87bk0icm0j.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Fri, 20 Sep 2024 18:45:00 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> <87plp2db5y.fsf@nanein.fr> <87bk0icm0j.fsf@pelzflorian.de> Date: Sun, 22 Sep 2024 15:43:45 +0200 Message-ID: <875xqn4xda.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Florian and Hilton, Thank you for your words and reviews! It is nice to know that a few people are interested :). > I=E2=80=99m 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=20 Upon reading the code again, one point is still unclear: the list of packages that I include in user profiles seems a bit random :/. =2D sway, swaylock and swaybg: useful to launch some commands manually (including swaymsg). =2D waybar, dmenu and bemenu: do not seem necessary. I will probably remove them. =2D dbus, xdg-desktop-portal and xdg-desktop-portal-wlr: may be interesting to have. On my laptop, screen sharing=C2=B9 only works when xdg-desktop-portal and xdg-desktop-portal-wlr are in the same profile=C2= =B2 (associated executable files end up in ~/.guix-home/profile/libexec/). =C2=B9: 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. =C2=B2: I do not know if that is a hard requirement or if my issues are related to something else. =2D 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 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 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 =E2=80=9Coption= ally=E2=80=9D > 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 =E2=80=9Cdefault: =E2=80=9D. In other p= laces you > correctly write =E2=80=9Cdefault: =E2=80=9D. Got it, thx! Best regards, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmbwHxEQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDJ0LD/9J1qsU6TzAroRjZMrYHZB0RJ0UrthVqqtk 84ZMqX7hOUnZmpaxuMQGcuLHtgSJaR9oEjlKuG1mr9DlPkazPo0FLnYyAqwdnJb5 wJbahFcUuHdMtAG3FFJmUhriMVpXHnCRqCQP2KompuZZ2REjM7krTdloAXvKVtwC 8n1WD5JPdCWQ8RvlZ2oBeoYUk9KfG955020ygOdgckuSmQPhjLtUwElDUPYIMwfS AvwTOkJ3TNDId0ERvzHu2hjZSOmVdWe/GyWv726n1krzsYFtJUvIO8SeBdwYvkYe LpVnAiF14547nyonGqClHBjZgsXjbnwAzu5WBEmXpLth4wLUcLtUR9TaTMHsZZBh vx5Q1AmgTTamM2kgMxfHMe2Of+jcM4dlCyFZCHsoGnHEdunokaVNe42xG90OB8lO QWGvEpufABiyZGQFoTPrSVAjjxvkqvRd0+YiSem88o+5o3qV8pC005/Bpdq4I8HG UPoXjgcmbqVI7gnofXuclUVNxwE7wyVuVvYjmEk3NkVHszGWV2GdPIcHYGM4MSHx +wszNPizFBqxEVwxo96deNKlH0S97+VCvzvdHFXKEN7RKE+eToMauJlMvm4mFLlA 5J+JN7T2xvVXN5CuwIQWs7+JcDdYmXF7HAKuDVXCl1rIAp3funXDqRr8NhYSd2Jk 1qQROLWCVg== =12ki -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 25 Sep 2024 06:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172724753230990 (code B ref 72714); Wed, 25 Sep 2024 06:59:02 +0000 Received: (at 72714) by debbugs.gnu.org; 25 Sep 2024 06:58:52 +0000 Received: from localhost ([127.0.0.1]:42834 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stLz9-00083m-HT for submit@debbugs.gnu.org; Wed, 25 Sep 2024 02:58:51 -0400 Received: from relay.yourmailgateway.de ([185.244.194.184]:57439) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stLz6-00083X-Dd for 72714@debbugs.gnu.org; Wed, 25 Sep 2024 02:58:50 -0400 Received: from relay01-mors.netcup.net (localhost [127.0.0.1]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4XD6y44grfz8xp2; Wed, 25 Sep 2024 08:58:20 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1727247500; bh=dYKdYGEbt1KZj/vc10Q28/OP+doAxzzLDDtAIof7RJo=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=A/r6L1Eqg6MhPwKF7EKlJQlqiABGLwlmCKCNJ5YHjSqc2/gJhbdzWcB/ZSEedq8/9 r4PTnCfbDhY8RdTGaGdYCzQPgs7MLOVZFTbDUlESWZk6Y6brKbZk2mcIx7v+ddG6tH Ba9CawV86aM+dBlttUkQINXhgtyKakwSMIKsQlJooZAJYGHtyEX0CSlZeoyfc1PSvf gt9onubtYHzP1yWFktD41JhjVdeEKTDhDIQXsV6FGzkm6Y/tKV2WHasOimjtfOpTBn rLlFi3LdvhE9BWwtvyD0JiRFRIgPM9eS/aj+Iln/hGtNFHb8xJXK9frzzns/yfL9UU pPyJ0wtE9BoAA== Received: from policy01-mors.netcup.net (unknown [46.38.225.35]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4XD6y43zvrz7wT8; Wed, 25 Sep 2024 08:58:20 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at policy01-mors.netcup.net X-Spam-Flag: NO X-Spam-Score: -2.897 X-Spam-Level: X-Spam-Status: No, score=-2.897 required=6.31 tests=[ALL_TRUSTED=-1, BAYES_00=-1.9, URIBL_BLOCKED=0.001, URIBL_DBL_BLOCKED_OPENDNS=0.001, URIBL_ZEN_BLOCKED_OPENDNS=0.001] autolearn=ham autolearn_force=no Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy01-mors.netcup.net (Postfix) with ESMTPS id 4XD6y40CXHz8sYY; Wed, 25 Sep 2024 08:58:19 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id 69E5E841B3; Wed, 25 Sep 2024 08:58:13 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <875xqn4xda.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Sun, 22 Sep 2024 15:43:45 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> <87plp2db5y.fsf@nanein.fr> <87bk0icm0j.fsf@pelzflorian.de> <875xqn4xda.fsf@nanein.fr> Date: Wed, 25 Sep 2024 08:58:18 +0200 Message-ID: <87v7ykrzhx.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Rspamd-Queue-Id: 69E5E841B3 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: mf3tqvvRnMary1eDchnb/8wx7V/4PCivFzb1F6twPaiFjJdgk+6sM+R2 X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hello Arnaud. Arnaud Daby-Seesaram 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=E2=80=99s 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=E2=80=99s 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 25 Sep 2024 07:54:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172725082411480 (code B ref 72714); Wed, 25 Sep 2024 07:54:02 +0000 Received: (at 72714) by debbugs.gnu.org; 25 Sep 2024 07:53:44 +0000 Received: from localhost ([127.0.0.1]:44110 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stMqF-0002z1-AK for submit@debbugs.gnu.org; Wed, 25 Sep 2024 03:53:43 -0400 Received: from nanein.fr ([185.230.78.41]:34576) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stMqC-0002yd-NV for 72714@debbugs.gnu.org; Wed, 25 Sep 2024 03:53:41 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727250758; bh=sVjgpXxZa1F2YtnaLKAHtSXeqLUFJc3O7FC7eyEuuo8=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=emlbV1A5Epj/mv2nTeLjW8Qk4HZOMPmskYQACT51lv/thzTkz39EXYvpMSyRyocVC 2WSrj1aMjPAowjPnKwukwH0icspPlNSyvDFEuEKgiuLq1pUOvE/81j79RqGFgjKLtS I34FO4wXKl76xg9yFDAb4AgcYa/MGrf8Kp1qKoBBMCHCnLhLb7JBWFLClNuEILU2DT tvhdRy9rjc4grYSdim2pxjaUZUDL+9CTcJApcvEIhCxhAhm5uyt4xaaUaIWvzJ01VZ lRaT60wHxjaAkaS97lLoZilLYELWO+rA6SYyqU0bm4hYEfiysR668DCB97c8WZXZGb WslHaRDUI4FdIjANQ1jhYZV6dWt0bJoy0AN/4zHvW00rkEm+b3sD02d0eVAUX3IT0r 9QCr6uFLl7G4OkGfwU55zM7GEoRIcMnvrmnTloDOUBf44uQaMSoq6eK7lS46SMLjJg 021zUcwUj0ExZLjmV2JiVRce/KY92S7iUw4eUcW+KI3g6pU3CKIFLdUg1n8sparyL2 Zrfqaj420Y+U475flsrZ1FLxVYteEXf+JVcmEupW1RV6XlRhchuGKmNsjPhFKE6ve/ GyIEy3Z9vI8Tz5TXLBcVzej1xXGPmYAOk+D1QyDnqe61j5kW2sU1zQ6+qecWAdSk2i 2gI1+KC9uu0Z08RjzogpuK1U= Received: from arnaudGuixPortable (eduroam09.au.dk [185.45.22.146]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 6F72B140215; Wed, 25 Sep 2024 09:52:38 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <87v7ykrzhx.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Wed, 25 Sep 2024 08:58:18 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> <87plp2db5y.fsf@nanein.fr> <87bk0icm0j.fsf@pelzflorian.de> <875xqn4xda.fsf@nanein.fr> <87v7ykrzhx.fsf@pelzflorian.de> Date: Wed, 25 Sep 2024 09:52:36 +0200 Message-ID: <87ikukqiez.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Florian, > "pelzflorian (Florian Pelz)" writes: >> I=E2=80=99m 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)" 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)" writes: > Arnaud Daby-Seesaram 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, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmbzwUQQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDDLmD/9mkq0SoHhaz91H7rJUI2DhkD0V0PGb+t1c spAw8opIVr00DDbsy9Pyyuv9uzROBe0Iv1F2RfzoEnLSSy32WaepFnUSv4XtGY35 2NPAe+1h/03K+hQHNnxs+2Hye6CfhtVdNDim4WjCbUPkTqqVRhvvLqDVRo3NoPff yzZJflp23yWtkd2jzzExV7faM/Y+im0CopZz2WXnHo5dAAUeZoYQ3m5EytbtRfOW Jj6JgYxm/N0/O/DxyUqs4tru2GX2Ivn45t6dvDG57EQqXozWzXmCgEaSS+0PJtzd ZbRbBYLkPw9qheO+R1/q2XnwwnS2It9hb+v8nwyV4nh1YrBctUOaSf+bdd+IYC9f QlwtPdtsdef8NX34OCpGaWJr25NjtpEBBIH7dwvCqe7a7SD6AO6w2y5FR9CU6IBJ PJGNEDbX+aYYGBJk55xfePcm2FN5GH7v/F4mPvQKWtBKtRhNZvVdz72MYr4iArYZ ei/U4ibNROv8852Fr8m7QYhYR0DIFuIMWCHzlFP5drkpoRB9kTzdbmFSbWZsVDWM A4VPysVv4WVneM5cqE4017KT9qD/48CApDVrMVYjMJXYNXxPV8nLfOWsk3lzY8sy yf5YeppgLLnddCHASlGIKkNB7pbSDK+mkTR7y2A7at73eQ/bklWqldD0Eel5MNDr jUii2FyvKA== =ol8n -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v6] home: services: Add 'home-sway-service-type'. References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> In-Reply-To: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 25 Sep 2024 08:06:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Arnaud Daby-Seesaram Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172725153615293 (code B ref 72714); Wed, 25 Sep 2024 08:06:01 +0000 Received: (at 72714) by debbugs.gnu.org; 25 Sep 2024 08:05:36 +0000 Received: from localhost ([127.0.0.1]:44782 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stN1i-0003vf-8y for submit@debbugs.gnu.org; Wed, 25 Sep 2024 04:05:36 -0400 Received: from nanein.fr ([185.230.78.41]:37864) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stN1e-0003qN-Cz for 72714@debbugs.gnu.org; Wed, 25 Sep 2024 04:05:33 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727251498; bh=dtLG4V4bjVQj0T67MJc7Uyx1wba8ToyRJykMWjcLUc4=; h=From:To:Cc:Subject:Date:From; b=Bp27gp/2GtXgQYmNYwEChVr5H97U4fDfjQWbreiPOEn2nKP2K/xnnnkvPVc0kOrCI hfYI6dSEzDFeDuq5wgn+feESe7+mR0Crs4wqtb1/MoIqFgPI4h/C83AwmiuI8MPfn9 EcS6ay42A11UI/BEGvHM78PWsOKiF62HByOMFpPKMvpBwo2UZt0R0eJG5n5EqiGk+Y Xgkn0UgC9T5VKFzOPHixDLxwZaDWycbGBHVHe4X1uRAzxWTNYk1FSHgFhMuWfbwWTF KD1QYbA5BdmEDsZDCop3glWwDqRGNUYQ37UmJYgCSweRH+nrEEVzZitdhB4MI5MrFv h50eBhaI3H5if/Sz2WVxPDvjiLfJGP26ZoN0e5dyUXxxTMVAxtcc+QS+IYRzAVODFe aLdId80CTPWkXpxkN8VTlkJeipExrf/VhS3I86wIILKPJhQ2pe3VLQwvPrYN4JXk68 wnUbzcGTIeoGyaZkxpbMVdpKmhI0hThVkeb/TMLYXnD5bAHhEFGaWfiNSMgfF0c/Kn POSLvN6X+hjE+N5Qetk93V41BP/+pWk5l/T5dT/YqkL3bkf3zpz0T1PGikPy2bDrW3 vOdmKQ1Rxp8YNoUv+mxfTe/d7Dyo7nxyrJTaw7EtnANY5K85TVvR6Ex/QXxJo0fOTp CLKdNDM8kPAeHGtHwXsA4NYk= Received: from arnaudGuixPortable.eduroam.net.au.dk (eduroam09.au.dk [185.45.22.146]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 57567140215; Wed, 25 Sep 2024 10:04:58 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Wed, 25 Sep 2024 10:00:43 +0200 Message-ID: <20240925080442.13752-1-ds-ac@nanein.fr> X-Mailer: git-send-email 2.46.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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'"))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v4] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 25 Sep 2024 11:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172726459710973 (code B ref 72714); Wed, 25 Sep 2024 11:44:02 +0000 Received: (at 72714) by debbugs.gnu.org; 25 Sep 2024 11:43:17 +0000 Received: from localhost ([127.0.0.1]:57677 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stQQP-0002qt-Bj for submit@debbugs.gnu.org; Wed, 25 Sep 2024 07:43:17 -0400 Received: from relay.yourmailgateway.de ([185.244.194.184]:45065) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1stQQL-0002qg-Jk for 72714@debbugs.gnu.org; Wed, 25 Sep 2024 07:43:15 -0400 Received: from relay01-mors.netcup.net (localhost [127.0.0.1]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4XDFGF5YWlz8x3q; Wed, 25 Sep 2024 13:42:45 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1727264565; bh=kLZ1IMJPCYmW+aUWIP0FjJuOcGSBe6UOtTAOz8xlKmE=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=VP34dcLoJkAP13nv7xg6FkZ+x7Tdpss8aCL5FvgIWVPOZG4E7BvxaIVJqf3UW5K+X 3W0fIPuaJ4ABAumG+UaZWrqy+25ku1LrjI+S6TppdbyEA2zTM4Cu1aKSPcKxvK9U+O Ifa12QYRPTkX6PISMgtrifeap7VWzgjNwWxUxR80+ZCkan2xkz70AvscjKQwJglXEn qjgurhEEOSzPlujtp46mVQg9abbM6eyySIZegV3V0JaRMp8c3uEZJUPQiGjSFy0N1t UGTY9EQV6O1N6fpul/hh7/5BvMt4cXJRSAMUXiMp4JbiT1HBU6AKiy+0iLZjq6LUPB e+LLI6Rtp5OBw== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4XDFGF4s4Yz7wNk; Wed, 25 Sep 2024 13:42:45 +0200 (CEST) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4XDFGF2Mhcz8sZh; Wed, 25 Sep 2024 13:42:44 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id 5847E8419A; Wed, 25 Sep 2024 13:42:38 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <87v7ykrzhx.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Wed, 25 Sep 2024 08:58:18 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240903072745.5118-1-ds-ac@nanein.fr> <87bk0qe54l.fsf@pelzflorian.de> <87plp2db5y.fsf@nanein.fr> <87bk0icm0j.fsf@pelzflorian.de> <875xqn4xda.fsf@nanein.fr> <87v7ykrzhx.fsf@pelzflorian.de> Date: Wed, 25 Sep 2024 13:42:42 +0200 Message-ID: <87wmj0q7rh.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Rspamd-Queue-Id: 5847E8419A X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: o7O4Ebsz6+RxBGxbky7jC685f8tAQLuUWloOPoAW8Rrxq36/fuanhjJq X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Arnaud Daby-Seesaram writes: > Hello Florian, > >> "pelzflorian (Florian Pelz)" writes: >>> I=E2=80=99m still looking at the details of sway, so I could myself pus= h 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=E2=80=99s no pressure on me, but I will be slow in my investigation and responses. "pelzflorian (Florian Pelz)" 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v6] home: services: Add 'home-sway-service-type'. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 30 Sep 2024 20:09:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172772690221367 (code B ref 72714); Mon, 30 Sep 2024 20:09:01 +0000 Received: (at 72714) by debbugs.gnu.org; 30 Sep 2024 20:08:22 +0000 Received: from localhost ([127.0.0.1]:46773 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svMgu-0005YG-4H for submit@debbugs.gnu.org; Mon, 30 Sep 2024 16:08:22 -0400 Received: from eggs.gnu.org ([209.51.188.92]:46754) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svMgr-0005Xh-TY for 72714@debbugs.gnu.org; Mon, 30 Sep 2024 16:08:18 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1svMgE-0005Qb-F8; Mon, 30 Sep 2024 16:07:38 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=Wrc+wM+XtDB+ujsLX22LLj0MAenpJe5ULribjsJbY+I=; b=kvox/CGkyjoWK3ymEfPY xJ/DAhK83o0f7r+RFH0qac+3yc2KeAlSmJlTHWoa/MncAJaUti/qKIT9o6NkYrsjavwE6eJwywBZa Gscej2CveMbwmg/AgDLYmD8HeEvnpAJBjamWoNGE+2SRRobUuzDzQfkw7YCfZZIR+1ZIVnyRcD3CY BiFT3sB2Qjz1NCwA5L8b/WDLn7aX06u5DOQJzYjFXYlqzevQh/bmth1Ot50L5w0Vn1XUL/vu+RzJ5 l/wOcKnNs/W9eARLkX9uDoEQ5Cecnepb+TYAOT6mrdMC4sKPm/TDqMFTrgYbqAtgojuOQp/qFx+gx 6MId9YQ1chQmhQ==; From: Ludovic =?UTF-8?Q?Court=C3=A8s?= In-Reply-To: <20240925080442.13752-1-ds-ac@nanein.fr> (Arnaud Daby-Seesaram's message of "Wed, 25 Sep 2024 10:00:43 +0200") References: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> <20240925080442.13752-1-ds-ac@nanein.fr> Date: Mon, 30 Sep 2024 22:07:35 +0200 Message-ID: <87zfno52ig.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi Arnaud, Arnaud Daby-Seesaram 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 cha= nges. I don=E2=80=99t use Sway myself but it looks like a welcome addition. I trust Hilton=E2=80=99s 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: =E2=80=9C=E2=80=A6 to configure the @uref{https://github.com/swaywm/sway,Sw= ay window manager for Wayland} in a declarative way.=E2=80=9D > +@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 =E2=80=9C@deffn {Procedure} sway-configuration->file config=E2=80= =9D. > +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 =E2=80=9C@quotation Note=E2=80=9D. > +@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 =E2=80=98startup+reload-programs=E2=80=99 and =E2=80=98startup-programs=E2= =80=99? > +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 record documented in ? If it=E2=80=99s possible, that would provide a nicely consistent interface.= If there=E2=80=99s the need for an extra identifier, maybe you=E2=80=99ll stil= l need : (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))) =E2=80=98with-imported-modules=E2=80=99 can be removed here because (ice-9 = format) and (srfi srfi-19) are provided by Guile itself. That=E2=80=99s it for me! Could you send updated patches? Thank you! Ludo=E2=80=99. From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 01 Oct 2024 22:15:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Arnaud Daby-Seesaram , Florian Pelz Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172782086321215 (code B ref 72714); Tue, 01 Oct 2024 22:15:02 +0000 Received: (at 72714) by debbugs.gnu.org; 1 Oct 2024 22:14:23 +0000 Received: from localhost ([127.0.0.1]:54005 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svl8P-0005W7-KB for submit@debbugs.gnu.org; Tue, 01 Oct 2024 18:14:23 -0400 Received: from nanein.fr ([185.230.78.41]:50278) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svl8L-0005Vw-Sh for 72714@debbugs.gnu.org; Tue, 01 Oct 2024 18:14:20 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727820821; bh=WnkZdaPo8mQFx/BUQgucjICYtrdklkuQNami3i/xkiU=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=cYmndmYO+cGSZrw9V2RbQQJeKUqYhf4rvAHohODd88ij1qmK4JhqzzHFZK/jrIqZB K468dnybI+BhswiykLl1RaA1Hk30kxzwmwtRxzi8h19kVvVxdk/q5Y27a0dEP5kI4V qDsnMN5homgsXtZ10IrGo1hLe5tw9Em/6KN3DDkQp/xlg8uBECbOE60XWsmqm1Cbus B0QXcBjiFq8h8OAO68f9xSmsdWe+URZt5hzDdaOolYNwgdaFWQiYhlbr9bMlUIIX7F 0TiuTJYeyXq55RzT0pjrv2RuiLF3VAnn3f1OekvNqHJkZvsHD1/mpagbXtEUowk93h eEzcpujppjuGAPxV65PWv+fAKkZ31sPM+huqeHA/+C/s/xUYyJnraFa61bxOqI19z5 tS6THLk5KNWZs5IB2YpOtiG9rWdMMX9rWk0HT9flRZIrZeJQds+rpNhtA/ed3zddPT +BvSp2+9OjgDhnb1FFZSew4yN7LGW/IHDIoXRg8dxvKS00AOzwPuPdh/4uITwdzyVx vl6Bhn/ur8cw0y7Si+smi0FLJ0k4J/TAPczX0+EtsHXCbzRM8EkxNJQae1fRYFjvOa /IkAFziFbJCoUq6UmdizUwj9GxPZ0Nfd/9WtxybR88RGYyj82KntuY6FwjZcLz7zom L1Mlhe+F6DrclZnajKHJttx8= Received: from cochea.c.hoisthospitality.com (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 63D87140267; Wed, 2 Oct 2024 00:13:41 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Wed, 2 Oct 2024 00:12:58 +0200 Message-ID: <20241001221313.2490-1-ds-ac@nanein.fr> X-Mailer: git-send-email 2.46.0 In-Reply-To: <87zfno52ig.fsf@gnu.org> References: <87zfno52ig.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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 [...] Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 0.0 RCVD_IN_VALIDITY_CERTIFIED_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] -0.0 SPF_PASS SPF: sender matches SPF record -0.0 SPF_HELO_PASS SPF: HELO matches SPF record X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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 [...] Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_CERTIFIED_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-trusted.bondedsender.org] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_PASS SPF: sender matches SPF record -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager * 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 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{} record) +Keyboard specific option. Field specifying the layout (possibly with +options) to use for the input. The value must be a +@code{} 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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'"))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v7] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 01 Oct 2024 22:32:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Arnaud Daby-Seesaram , Florian Pelz Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172782190924375 (code B ref 72714); Tue, 01 Oct 2024 22:32:02 +0000 Received: (at 72714) by debbugs.gnu.org; 1 Oct 2024 22:31:49 +0000 Received: from localhost ([127.0.0.1]:54098 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svlPG-0006L5-Ra for submit@debbugs.gnu.org; Tue, 01 Oct 2024 18:31:48 -0400 Received: from nanein.fr ([185.230.78.41]:53092) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svlPD-0006Kt-36 for 72714@debbugs.gnu.org; Tue, 01 Oct 2024 18:31:45 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727821867; bh=/mjVqypYnsDYLZRXapXR/v4iE0O/nbR6GUtSrZyEop0=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=SCD/bwYKdi99Ui/LfqF3e0GTItmWN7P4EvdlnwkfivhC9k7Qc2WW0BC/NtXn01RJu 21bBshm5e68IEG273Xw2AIkaX/LER4qbpkOgm0B+BT/FLhhRmDRn3GUzfoEcaqplUo 4nYNapfE6GznLXBUAsm/GNjHYaVptXWYpgmo+j3g8peaGPDatUAawfURS8NlEeACKX 5Nt8TMAijROwAlG1VtgRNW6BpaJB7MZdc02nzkYxB7oupcAjX55P/LS6PRwRpSALcZ MyDt5FQnqJpM+WkuP+Py3LTWhdY0xGgBewNT88PyuqplMlpRoRRaxYYNlxuPOcHRa/ o+6RDSKIJG50RNsKZuWYLTGIuq2RLvBg4NxXdNnB/CxSArxb7wfHJgqO9E1NtIxLOA Esuvk425pqgEBRz2c33vj8rH/AYfae48ppDe44kZ03FLczkbWD2yfrQKsyf1gSfkeX c4cJvfzvo7wthkgo1vl2gho6tGI576d8oJz04rQkgDqSbVqU1k+tVRUnTqCYHCdujn SC7Jlcp27H2QYXZuYWxcItd98ZhHo76LrXqkC18QpJx4G+gYf+siI9ztmX6Y6y+izb pFv4xLAs/Cae4/+KWSdm6EcqjezK3/oUkk0Eju03PjbIdCO/dWPPo+6NYxIjKwnUNd 8gbxeCfRTh8kqmPXtD+xinpk= Received: from cochea.c.hoisthospitality.com (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 14E1C140267; Wed, 2 Oct 2024 00:31:07 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Wed, 2 Oct 2024 00:30:24 +0200 Message-ID: <20241001223050.1203-1-ds-ac@nanein.fr> X-Mailer: git-send-email 2.46.0 In-Reply-To: <87zfno52ig.fsf@gnu.org> References: <87zfno52ig.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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 [...] Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] 0.0 RCVD_IN_VALIDITY_CERTIFIED_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-trusted.bondedsender.org] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] -0.0 SPF_PASS SPF: sender matches SPF record -0.0 SPF_HELO_PASS SPF: HELO matches SPF record X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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 [...] Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_CERTIFIED_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-trusted.bondedsender.org] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_PASS SPF: sender matches SPF record -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager * 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{} record) +Keyboard specific option. Field specifying the layout (possibly with +options) to use for the input. The value must be a +@code{} 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 +;;; +;;; 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 . + +(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)))))) + + +;;; +;;; 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'"))) + + +;;; +;;; 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.")) + + +;;; +;;; 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 02 Oct 2024 14:09:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172787812911760 (code B ref 72714); Wed, 02 Oct 2024 14:09:01 +0000 Received: (at 72714) by debbugs.gnu.org; 2 Oct 2024 14:08:49 +0000 Received: from localhost ([127.0.0.1]:58919 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sw025-00033c-4F for submit@debbugs.gnu.org; Wed, 02 Oct 2024 10:08:49 -0400 Received: from relay.yourmailgateway.de ([188.68.63.98]:46965) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sw022-00033S-Ng for 72714@debbugs.gnu.org; Wed, 02 Oct 2024 10:08:48 -0400 Received: from mors-relay-2501.netcup.net (localhost [127.0.0.1]) by mors-relay-2501.netcup.net (Postfix) with ESMTPS id 4XJc9T0NLSz61Xg; Wed, 2 Oct 2024 16:08:45 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1727878125; bh=yUGMkhQGuzAvdWMiFP+jjE9KCBiwl7DRTfEolyEL6Os=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=Ke/tX0kq9qieAUftM9Z6NZZS1vw1+THt7WOPKCbTRORwxZLzEs8BJgkBT5o2R3qf2 TCgXa7TLC66Mmmwek+Pfco6Y/GNR9/eDiOVkxK+/D/g20Si+AtBbF8T4x7QVu8Nx2V pmO8gzu+PqPux6ckUkm9XXutJQ6aV/TWVGefdUSFn4McQuP9J8R2P6LLy6erCum3A1 HJ6+255psff6rPsnUj42LgsijOaA6dvVALtT68HG2tkyEWutB/zohAea14eILWtXVC V0bn0KGc/Kwm469x0uTIaLqoilV//MssR5SosuEnwnwY1Hk/OnASkTIpBBY2VA2i57 9cBIEIOKO3nrA== Received: from policy01-mors.netcup.net (unknown [46.38.225.35]) by mors-relay-2501.netcup.net (Postfix) with ESMTPS id 4XJc9S6lrWz4xTL; Wed, 2 Oct 2024 16:08:44 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at policy01-mors.netcup.net X-Spam-Flag: NO X-Spam-Score: -2.9 X-Spam-Level: X-Spam-Status: No, score=-2.9 required=6.31 tests=[ALL_TRUSTED=-1, BAYES_00=-1.9] autolearn=ham autolearn_force=no Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy01-mors.netcup.net (Postfix) with ESMTPS id 4XJc9Q4kZhz8sbk; Wed, 2 Oct 2024 16:08:41 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id C4A8F8417E; Wed, 2 Oct 2024 16:08:33 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <20241001221313.2490-1-ds-ac@nanein.fr> (Arnaud Daby-Seesaram's message of "Wed, 2 Oct 2024 00:12:58 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> Date: Wed, 02 Oct 2024 16:08:41 +0200 Message-ID: <878qv6tx5i.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Rspamd-Queue-Id: C4A8F8417E X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: LFzeC9Byj29jcGF/TDQTbedGaGeVkZWzazk+aT0fS0kdEdYUuxJ2XCtQ X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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=E2=80=99s 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 02 Oct 2024 20:51:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17279022281339 (code B ref 72714); Wed, 02 Oct 2024 20:51:02 +0000 Received: (at 72714) by debbugs.gnu.org; 2 Oct 2024 20:50:28 +0000 Received: from localhost ([127.0.0.1]:59383 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sw6Im-0000LX-7p for submit@debbugs.gnu.org; Wed, 02 Oct 2024 16:50:28 -0400 Received: from nanein.fr ([185.230.78.41]:38214) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sw6Ik-0000LD-HC for 72714@debbugs.gnu.org; Wed, 02 Oct 2024 16:50:27 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727902218; bh=nelJHmd1VS1epnNy+6oEYqy/NDiu2/sh8F88DSAiYmM=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=CNS3Aiu8uoHjsyTEZtsWFRRO/9zKWdjdzbciSfoJmv4rUU8vtjLOYjwa/lRSw3ojW pT8QCzpmKdtBDr0RsC1DXhg8W2Re06S8uU5yBbY6m8PqaJHmMpbuvCPhufkHUuaDPt zi7CxX/PikgYS89bkTL6kqPqraC5GXUANENvI0WtmYxKqonVkgNYfVO3kn+49sW5ec W5t0eZWlXvdyd2USMiDqtO2Ync+1VS3S+Yj2N/Hz92okZFX0ZIFkpUa1c1lMk6POAR sxchyPZBWxp/wRNPq4inb7hsnokOu+NaZrqmkrI7TyEj2b2fcRZjdiU3BgpvwjtnU8 Ozh8b4CaoJG9LwIEdHWnLqGkh0qUMdVrtym4p2m63ARn2j/UL3KamOUYllzpT4fVT2 198dW+PHgwOal7J57VfyZgGiSKmngQuVhKX0tED988GI8bbHVk6Mcpcl+Q38OWDY7d j97X13ZbR6BA/7pzxMXUFbghKD8fdyOJ7L5mtcwYXJdcA7honNm8UN2ZT1wkKBeajl 60VeKmqYMHVAAXtJGSuTLGCt3a1r0Pszdkg5ALgi0ZK+s26XdXYg+CC8cmJAB9HYqq ZmEiajoaXhrMNT/6+i3KZJwOqkyI0QcciiizGnZ96PF+KCVh33HVyH6HcC9PUuFBaA DoceyL1HY1AH4qbPYUcOjadk= Received: from cochea (wg.nanein.fr [IPv6:2a0c:700:12:50:1::109]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id ADF82140266; Wed, 2 Oct 2024 22:50:18 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <878qv6tx5i.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Wed, 02 Oct 2024 16:08:41 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> Date: Wed, 02 Oct 2024 22:49:51 +0200 Message-ID: <87ttdu9qmo.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Florian, "pelzflorian (Florian Pelz)" 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=E2=80=99s 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=C2=A0-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)" 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'=C2=B9 and reduced the number of redundant calls to `make-string'. =C2=B9: in previous patches, I never called `close-port'. "pelzflorian (Florian Pelz)" 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, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmb9sfAQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDEgOD/9+4WPKHxyKSNdj7PIzPDluIpfEVYONcYeP UXYtnDx1hxuSMollWcHLn3XOrwthCymKnd+O0Q/+pXQdKMA/v1Jz2SCwg0mG3U1o fbAAq7DXtzrB6g7WLSPsFNHAIzwYuFVtH2zzzeahTI1KnM+/yi9qwDfL/S6rhMKr wcZaH8OT9kbzBnje0fACYa3o4xASz3wfskSRQIeP9O9NaWLyQsYdDq5V2hQccOM0 YbmdmtA338ASW6UCFTRG6vjQZ1JzAzT2PNJEmw6a+fgy/i7IpIfVUoVLwZ61Muu+ AlF71idH2LQBNTmD1I8cLDefSZs7ByMCxYAmAzPUwpYll1FQ6JCTv6urpgAp1HLz E8P1HA/iSh5tS4xzB7Y2y0ClpMdvhzSuOQX3SZsHVB8T2OD4qSx3Lb8vB/GGxpWu LStwp/myLpIp7BSzV3DGSaE2FuAIkwpJt9SkOHWw8elUQbwkzBCM1sRbiEmtf4yS haZqK87sTIEj/yRRN0eegBql9/9qnpLP5fwlfa7SgKOZ4wdO5nLjeYP/KvTlaxEW YL7/EOmukgFQrOlZqQEQb2xZaP0KvPHEQ3h0JT+e2NujwlOpjntM94S9JsGM7grW sp9QztF49oJ0qBxWmyHhhUgRojtYM3dSnGIDbIZVJ8imI1sJgQuQdulNPAjKfhpa wWHGLIy5Sg== =uBH9 -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 03 Oct 2024 12:42:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17279593165290 (code B ref 72714); Thu, 03 Oct 2024 12:42:01 +0000 Received: (at 72714) by debbugs.gnu.org; 3 Oct 2024 12:41:56 +0000 Received: from localhost ([127.0.0.1]:60268 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swL9Y-0001NG-0e for submit@debbugs.gnu.org; Thu, 03 Oct 2024 08:41:56 -0400 Received: from relay.yourmailgateway.de ([185.244.194.184]:33581) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swL9V-0001N5-NU for 72714@debbugs.gnu.org; Thu, 03 Oct 2024 08:41:54 -0400 Received: from relay01-mors.netcup.net (localhost [127.0.0.1]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4XKBBk0dYFz8y5l; Thu, 3 Oct 2024 14:41:50 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1727959310; bh=o4ViMtY1XJBj0j2bfBotqSDpkqiUcXMwlGpSZdzzS0k=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=TEVFxPCzYhuKVemaNSBV+JPokCOoXdfJapRjZxDCnsQ2cdFDSP+dQkyOmjEh41DLX uBX1mRgkPFqagpHPYDCuiYyWZpBE2WzrWH/6xmldjcRtFGwGJe7TnyurIUGCedTYB4 fhwCwwliHzbNBQJYWjsAY/i++LIAs8IdPEf2omdZT0Cws/L13P+Z7jRjgLvlj5LUQT t62l4AT+YjQHLN8kVJUKHGmpZ/eN4IeSCTv5my/Sur56KT2EB0q6yYeYKqtzenLrrM iJlgx4I+CTA6UT4N3wkHkqoXiOIQT7Qtcu90x+KZ0BheOnxs989SBCnj7Vpf8/zqbZ yTdAk8aVc9TYg== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by relay01-mors.netcup.net (Postfix) with ESMTPS id 4XKBBj74d7z7wGB; Thu, 3 Oct 2024 14:41:49 +0200 (CEST) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4XKBBh3c2jz8sb3; Thu, 3 Oct 2024 14:41:47 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id E39EA824B7; Thu, 3 Oct 2024 14:41:39 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <87ttdu9qmo.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Wed, 02 Oct 2024 22:49:51 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> Date: Thu, 03 Oct 2024 14:41:48 +0200 Message-ID: <875xq9we7n.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Rspamd-Queue-Id: E39EA824B7 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: tpvTsPe77r5yhyFEx4Y8zO6YfBa2yUZdu1F3RA2pcLyAusBISEk+W5Fu X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hello Arnaud. Arnaud Daby-Seesaram writes: > "pelzflorian (Florian Pelz)" 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=E2=80=99s packages. However, dmenu_path=E2=80=99s 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=E2=80=99 defaults. > On this topic, do you know if there is a built-in way to write > `find=C2=A0-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 neede= d. > 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 From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 03 Oct 2024 20:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172798888011246 (code B ref 72714); Thu, 03 Oct 2024 20:55:02 +0000 Received: (at 72714) by debbugs.gnu.org; 3 Oct 2024 20:54:40 +0000 Received: from localhost ([127.0.0.1]:33955 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swSqO-0002vK-80 for submit@debbugs.gnu.org; Thu, 03 Oct 2024 16:54:40 -0400 Received: from nanein.fr ([185.230.78.41]:40180) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swSqL-0002v4-WA for 72714@debbugs.gnu.org; Thu, 03 Oct 2024 16:54:38 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1727988836; bh=YNvGSvdKSE0eGNbE+B1wz6zVgwpwD+qfEeY5nLVu+6g=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=CL+GuTGIRkR5GIQKa3Be5QuVnNfYgArdCqVZHoc5q96ZXOlxFozreINRDfk8+MlSY KY+bOw1c4Hw/2lv6BWMDfJ386g4IF37n4qdbUtosnmJqTV1AQdvpyC2ubLxCB1nWIY 7aDNwsqVa+HrJh9k7flzdYJmxY299YnZhnVmMvH3A/SFvjdna9hsc2XepBabkQVC0d 5AffZWhQBM5suNGUhg4kXcsJ6Bdl3cgVi5JOMWbZd3dyJw41foeLUgqSku85KLbIws uTRh4AHfWI/M6BIQqJ3DANozvIET8Fv2XECcsa3nf9H+dCufWB4xX/snLeny/pI+OE ja0rBps6xVPMz7ZThCpI2klYtGVm9FNJJMZPGusjDrYDbE+wMwsM8W+k2dU5qnEK5B 7h68FVGVB9tuNXSlsLQVIya7F1wNptHIksChwUIDBB4kOohmSt9LQFDAKKnzvq44GJ +NvfVGm2EKOR0er7b12/P1AF9L0HT2587xJYlz9+RMrkLN55pYOgUxHjT3qSWSo8UQ Z3jUnNxv/DBG9d1tkkqXIenU2MGgFYFXsige1TqWmWuDPqEU6yTCNYbi/YOU8F3XKM 8HB3tWvuFP4reUagS3UPri4Tb6XIHbVSl7gkVG8P6XSXSoSH0HkFJGoDQGk5FpumTL RhuiBdglCOfjyWiU99RiJ4o4= Received: from cochea (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 1E1DA140266; Thu, 3 Oct 2024 22:53:56 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <875xq9we7n.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Thu, 03 Oct 2024 14:41:48 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> Date: Thu, 03 Oct 2024 22:53:42 +0200 Message-ID: <877caoewmh.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hello Florian, "pelzflorian (Florian Pelz)" writes: > Arnaud Daby-Seesaram writes: >> "pelzflorian (Florian Pelz)" writes: >>> Perhaps for [...] Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-trusted.bondedsender.org] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hello Florian, "pelzflorian (Florian Pelz)" writes: > Arnaud Daby-Seesaram writes: >> "pelzflorian (Florian Pelz)" writes: >>> Perhaps for [...] Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Florian, "pelzflorian (Florian Pelz)" writes: > Arnaud Daby-Seesaram writes: >> "pelzflorian (Florian Pelz)" 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=E2=80=99s package= s. > > However, dmenu_path=E2=80=99s 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=E2=80=99 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=C2=A0program shipped with the last version of wmenu) to get rid of their dependency on dmenu. [1] https://github.com/swaywm/sway/commit/b44015578a3d53cdd9436850202d44056= 96c1f52 >>> 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". =2D-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=3D> (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)))))))) =2D-8<---------------cut here---------------end--------------->8--- WDYT? Best regards, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmb/BFYQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDKpJD/wOCO7McVLaBLs01FSVtEcdNK8QPL6AfBxY xesl/oc/hLeLXwIW7d79dXzRgf3MfMhPKHSBLU/9Mstqwf8H1tQLmVRKEoML/6Lt vuvNbEM6l9nHIgWVbPM9NShYc9OTNaomzX4GYZPm8nz7+P8YEQ38h2exOJIFmV/Q dai0U3Y0nYsc71PiggR/yZXo+qOPjSTEzS8sPROsvSr5Cjiotwj45WX7S5xPhC+7 Udrv8t95v16FJbHceSAPwvoG3aIMUGp8iUaocBK1n5TpKgZSuIA6vOfaDwCgJCTP 0LxPmAyKsLMGR5EWo62Exabi76JkL4/kC3sx593fPehV8RcbfXAP64Nco0edihOO K9frfA9B/p6LCy3ClnkklE2dtTqB0J/9P2dykByQUn5WsKGead4/9pAOPRGJurvK xHY/eryWtauAjVwO1C/7JOzej8kSL+0gs8xUQEtYWW2lchurdtp8hd49PbI96gSB QFGrydu57DFaVl7KxyHhOCCA93ozC1l415pclkUtGiLCWUeJ71qbEXARVMhUnG3q 8nqVCh/kCZOSoyXEvMeeJh0qJMh8jIevIxANDyjcU017PeLI2TCLM+jN6laELVGn UNTFdogVC6lT5ebH6HWrD7WylXi2QZIeSuXxiD9hXIgKeOCuh+K058OCA7v0q74+ Xn8E7phxuw== =44NG -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 04 Oct 2024 20:18:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172807304910614 (code B ref 72714); Fri, 04 Oct 2024 20:18:01 +0000 Received: (at 72714) by debbugs.gnu.org; 4 Oct 2024 20:17:29 +0000 Received: from localhost ([127.0.0.1]:36658 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swojw-0002l8-Ps for submit@debbugs.gnu.org; Fri, 04 Oct 2024 16:17:29 -0400 Received: from relay.yourmailgateway.de ([188.68.63.98]:50583) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1swoju-0002ky-4S for 72714@debbugs.gnu.org; Fri, 04 Oct 2024 16:17:27 -0400 Received: from mors-relay-2501.netcup.net (localhost [127.0.0.1]) by mors-relay-2501.netcup.net (Postfix) with ESMTPS id 4XL0Fs2tRnz61gS; Fri, 4 Oct 2024 22:17:21 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1728073041; bh=qikm5qF+mvJekMWvU0SbQLynXL+n9+NQCI7tb1ycYAQ=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=TV3EDclK1e7GY03IYBorXV8Xdptwf+V4Qf1GIQECpiCYRDMEaj+CK3f8es3Kvff5U 8Vi1bxBm0pqrOh9rXMYVdZYwsurf4ibo56GbMFtyfiBo00eerqDz4gH4SgJKQiQGmi L9SuG//6+5n92qXIZuY9RViGiyCNbw3oufqwIS6oEt2fKtVK+aSiUPEgkue6TR4IkY 5rNmr9ydwmW/R0J0SO0e5hqQvUs037fuxMk3nEbGmkJ7QsnIPzLxRgrwdAQ3y6qcTj 1GTmnsAFWHqpvNel4hMBfrNJX7GYVuwiMccreocd5qZVgnCWTjEtfT8sIYJ1aL9RHK u/ITWQ7Tu99gw== Received: from policy01-mors.netcup.net (unknown [46.38.225.35]) by mors-relay-2501.netcup.net (Postfix) with ESMTPS id 4XL0Fs29Tkz4xX9; Fri, 4 Oct 2024 22:17:21 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at policy01-mors.netcup.net X-Spam-Flag: NO X-Spam-Score: -2.897 X-Spam-Level: X-Spam-Status: No, score=-2.897 required=6.31 tests=[ALL_TRUSTED=-1, BAYES_00=-1.9, URIBL_BLOCKED=0.001, URIBL_DBL_BLOCKED_OPENDNS=0.001, URIBL_ZEN_BLOCKED_OPENDNS=0.001] autolearn=ham autolearn_force=no Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy01-mors.netcup.net (Postfix) with ESMTPS id 4XL0Fq4sj5z8tXJ; Fri, 4 Oct 2024 22:17:19 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id 6693A83C3E; Fri, 4 Oct 2024 22:17:11 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <877caoewmh.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Thu, 03 Oct 2024 22:53:42 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> Date: Fri, 04 Oct 2024 22:17:20 +0200 Message-ID: <87jzenr5bj.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Rspamd-Queue-Id: 6693A83C3E X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: KudeTj3DdANAesGKMSxlF3NBoSEQMFRV0CKK0+R5BuHSwVDjqMzVQoAR X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Arnaud. I like a lot your sway-menu.scm. For testing, I=E2=80=99ve 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=3D> (stat f) > (lambda (s) To reduce clutter in the wmenu suggestions more, I=E2=80=99d prefer (and=3D> (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?))) >=20 > (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=E2=80=99d welcome if you, Arnaud, sent a patch calling your sway-menu scr= ipt. Also I=E2=80=99d 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] --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=wm 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 --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 05 Oct 2024 17:03:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17281477639993 (code B ref 72714); Sat, 05 Oct 2024 17:03:02 +0000 Received: (at 72714) by debbugs.gnu.org; 5 Oct 2024 17:02:43 +0000 Received: from localhost ([127.0.0.1]:39519 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sx8B0-0002b5-CE for submit@debbugs.gnu.org; Sat, 05 Oct 2024 13:02:42 -0400 Received: from nanein.fr ([185.230.78.41]:49190) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sx8Ay-0002al-K4 for 72714@debbugs.gnu.org; Sat, 05 Oct 2024 13:02:41 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1728147749; bh=jprxF3nD+zxVOItLdGgjW/cJEhvH6kPsqUKLCEccNLk=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=fCwW8e6l9zAL0Nb4oXvZRt4Jk1w4JhhEbCCowK6xdpMyHlpqUiL5A1JeX/eJc490s 9Q529DgmRIPZnBZjBvvKReA2hbmeBFI+cqa8sM2U+WEkyGE0xMklen0X1COzvbWmE/ i1c5MrYJJHPbXcIVbVV1jhomQ9CYIES5bqjtJzBAYM2Xh2GZZnG8d0dXAMQMsWxYNm 2Wanf4EJwH7lshThtsfOL6UglM+LJzicFYFLxz35tZHUUiPBTraiZe+ddrjgUrHVaf Kw8adLkOzN1XiRz6OjD19ikPvJUvDCjYSRk1QSgRKuo9Ll2+pFA0RmMmrOGt7p2uB9 ColKJRTwUN/+I7gvmACG87n42PwAOpw7EwP4Q8yUcY62JxPPdoW7dP9y0fEnKjz8Hg VFho7ed8MQnPix6S6uZiIvifDUV+ToBMjs2HZm4KgRPpkh65e6gMSVVz6u2ukm5U40 /IKgCWGWgKGe4GiTStXsMCQSNkquSpRs8V8RVYKQidfRh1+WSVrBNEr1w3f5mkYPnv 2Uz0mDjwaJxUnop91dywS8qa95ZRZOQvS+bClpfia49BXILphn3y3K97f+pppni+HB EZFItHs82k4AnbMqKexYFIBADzn4aKs6YPShBqgre7TWi6kA14lkulHhFwrM9SaS7v aFs+qhtU4cHKY0WpKgVvJXVU= Received: from cochea (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id CBB67140266; Sat, 5 Oct 2024 19:02:28 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <87jzenr5bj.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Fri, 04 Oct 2024 22:17:20 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> <87jzenr5bj.fsf@pelzflorian.de> Date: Sat, 05 Oct 2024 19:02:11 +0200 Message-ID: <877camv5yk.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hello Florian, > =?UTF-8?Q?I=E2=80=99d?= welcome if you, Arnaud, sent a patch calling your sway-menu script. > > Also =?UTF-8?Q?I=E2=80=99d?= be happy if more careful commiters would push it; I prefer to > restrict my commits to translation updates. Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hello Florian, > =?UTF-8?Q?I=E2=80=99d?= welcome if you, Arnaud, sent a patch calling your sway-menu script. > > Also =?UTF-8?Q?I=E2=80=99d?= be happy if more careful commiters would push it; I prefer to > restrict my commits to translation updates. Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Florian, > I=E2=80=99d welcome if you, Arnaud, sent a patch calling your sway-menu s= cript. >=20 > Also I=E2=80=99d be happy if more careful commiters would push it; I pref= er to > restrict my commits to translation updates. I will proof-read and re-test the whole patch soon, hoping to avoid additional careless bugs on my end. Also: given that you assisted me quite a lot, do you want me to add a line in the commit message to express that you helped me write the patch (such as "This patch was co-authored with Florian Pelz.", as in Guix commit 9371cf2138711ea7305951d82c5cf0b36ac4d6f1)? I will send a v8 as soon as I have both seen your answer and proof-read the patch. NB: I think that the v8 can be the last version of the patch. Thank you for your help and for your patience :)! > Sorry for having proposed compiled-file previously. No problem. I actually meant `program-file' instead of `computed-file' (which was incorrectly used in my previous email). This way, the lowered object in the store will be executable, allowing to define the menu directly like this=C2=B9: =2D-8<---------------cut here---------------start------------->8--- (define %sway-default-variables `([...] (menu . ,sway-menu))) =2D-8<---------------cut here---------------end--------------->8--- =C2=B9: In the next version of the patch, I=C2=A0allow any file-like object= in `string-ish' instead of file-append objects only, so that Sway variables can be bound to anything that can be lowered into a file (in additions to strings and G-expressions). > 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. Thank you for the pointer, `scm->go' is an interesting function. I=C2=A0experimented and bit and was able to compile the menu to byte-code using a similar function. However, I do not know a way to compile to native code in Guile. Hence, I will stick to `program-file'. > 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. Thx, fixed. >> (lambda (s) > > To reduce clutter in the wmenu suggestions more, I=E2=80=99d prefer > > (and=3D> (and (not (eq? (string-ref f 0) #\.)) > (stat f)) > (lambda (s) Indeed, this is better. >> (not (or (zero? (logand (stat:mode s) #o100)) >> (eq? (stat:type s) 'directory)))))) >> (with-directory-excursion dir >> (scandir "." executable-file?))) >>=20 >> (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 @@. Unfortunately, `open-process' is not exported in `(ice-9 popen)', so I kept @@. >> (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, [...] > then it will remain possible to write shell commands in wmenu [...] > to run apps without installing them. Yes; I removed the string-append here. (As ~/.guix-home/profile/bin is supposed to be in the path, this should work properly). > 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. It is nice that this works too. NB: if you want, you can use `(file-append pkg "stuff")' instead of `#~(string-append #$pkg "stuff")'. I do not know much about the XDG_ACTIVATION stuff; only that it has to do with focused clients on Wayland IIRC. In my menu, I use `swaymsg exec -- [command]', which takes care of a few things as well, as explained below. =2D-8<---------------cut here---------------start------------->8--- Note: pass the final command to swaymsg so that the resulting window can be opened on the original workspace that the command was run on. =2D-8<---------------cut here---------------end--------------->8--- Source: commit c3353bb27317d294a91a8accec9a554ea392de04 of Sway. It explains why the menu is piped to 'swaymg exec --'. (I have added the "--" argument in the v8). > Also one more thing, in the commit message, you meant to write > flatmap instead of flatten. Indeed, thx. Best regards, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmcBcRQQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDC/AEACVkEc2PL7Q9LsaegS955SdM5QxwazAEe9F n9Q/DsZ85Yk36IzGHIWc0T4Z/BySv2X9waQhjRYDsLSZAQzDSl1Skf5KhHlKPbrV JwpMG6t4DN0dHMetz1wS+tjsRr7F4f1kNKGtXWO/ZYxfUP3M3jm2RT7IFr0547aL nWv5dna5L3mL3Funq7J06Batqj5+flPRaBjJBSRZq723TTmgEgeVC5R809YIaod9 MAu1eFsl5+8h2OHUlJSMAZE0WLWcOi7u9SZTImm5kP7mhDD3uzCOBp/rIgfslgoj tVqjeaCEOA54BEoNbiGV2sVTziD01gMwg++f0CwXO/BCgyEGZNIveVEXSprfo2DZ G5k8X8Vh1fBhmRtXBFbaVKQ2iI8ubQbl7Odz39YnONBlfHybW0U1atu8yQfx0s05 MpjwWpzwHChRuFtTuq4iHXdrIavC5CblqBVltSX4EyaY0kxErmixe61IKgJ1J17d oAkVtSEI5A6DeNgAOOofMdpT+tMQtqb0zUuQNYa+Ef47U24r4+4m+QtDYiM4pGIX 8Y1wIGDSTr/zNy6vtEp/4BmXTr0E1jZduCzXrsrZTjqtG8QpqkLDNVkWKcvyi9eD XNN5gAW1m01pDhAbiig9F2aBH9JZQEj7+Hp6rrTcT+tR2YAKbRuFsWwVRsx7z8Id OBjuBhM9Iw== =hS73 -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 06 Oct 2024 08:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17282025443177 (code B ref 72714); Sun, 06 Oct 2024 08:16:02 +0000 Received: (at 72714) by debbugs.gnu.org; 6 Oct 2024 08:15:44 +0000 Received: from localhost ([127.0.0.1]:40082 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxMQZ-0000p9-Uf for submit@debbugs.gnu.org; Sun, 06 Oct 2024 04:15:44 -0400 Received: from relay.yourmailgateway.de ([188.68.63.174]:41707) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxMQX-0000ol-4Q for 72714@debbugs.gnu.org; Sun, 06 Oct 2024 04:15:42 -0400 Received: from mors-relay8204.netcup.net (localhost [127.0.0.1]) by mors-relay8204.netcup.net (Postfix) with ESMTPS id 4XLw855pXsz8ZLD; Sun, 6 Oct 2024 08:15:33 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1728202533; bh=YRRjVEBRa4Fjy7woF+XX0YvucLlFYGqt/Zr1TaU3gyk=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=kwY+4spRIGoorb57Y8T24bLJk8FikO+0KmhFQgPjg2gyb2EaPlYn8XywE6OKgQLMV JI4wfHaS+XlyMSBIb7KZlcKaN2BoaRTCXr8yD9rUgGTRs9yilb4DeUandHQpI0cmmF YqWjvrtN7QQmznsuZmTUd5ZGxvtPyM+HmLaD9rLT2MLopTJ6x3NISRoHVUJCu7cpJa wbN7rU25kP514eRAl5sjPkVLwuAP54eurZEJMVJS5bNTtYNiVuK9uLQwlKBjVz2jHm z7oBni3SjUCwQ4vfpRBsEvHwFbQcTb+Qu4LToX2+Y/dOkV/tz5PBKzUq8KxLEdzhb7 2WUlVluHUNI0Q== Received: from policy01-mors.netcup.net (unknown [46.38.225.35]) by mors-relay8204.netcup.net (Postfix) with ESMTPS id 4XLw85552Xz8ZGP; Sun, 6 Oct 2024 08:15:33 +0000 (UTC) X-Virus-Scanned: Debian amavisd-new at policy01-mors.netcup.net X-Spam-Flag: NO X-Spam-Score: -2.897 X-Spam-Level: X-Spam-Status: No, score=-2.897 required=6.31 tests=[ALL_TRUSTED=-1, BAYES_00=-1.9, URIBL_BLOCKED=0.001, URIBL_DBL_BLOCKED_OPENDNS=0.001, URIBL_ZEN_BLOCKED_OPENDNS=0.001] autolearn=ham autolearn_force=no Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy01-mors.netcup.net (Postfix) with ESMTPS id 4XLw841l86z8tXH; Sun, 6 Oct 2024 10:15:31 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id 6872084231; Sun, 6 Oct 2024 10:15:24 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <877camv5yk.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Sat, 05 Oct 2024 19:02:11 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> <87jzenr5bj.fsf@pelzflorian.de> <877camv5yk.fsf@nanein.fr> Date: Sun, 06 Oct 2024 10:15:33 +0200 Message-ID: <8734l94pga.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Rspamd-Queue-Id: 6872084231 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: WL4Dx68+dJTblnbZAvGTRXWRAL6DH4jcsQD9B31Qo1Rq4cgAUCpK/+oV X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Thank you Arnaud for this mountain of work. Arnaud Daby-Seesaram writes: > Also: given that you assisted me quite a lot, do you want me to add a > line in the commit message to express that you helped me write the > patch Not for my review; this would be unusual. Normally scm->go is probably unneeded here, because guile will find the compiled .go file. However program-file seems to add --no-auto-compile. Not sure now. > NB: I think that the v8 can be the last version of the patch. Otherwise yes, though I would prefer if another committer read it again and pushed it. Another more thing. I try (bar (sway-bar)), but it prints an empty bar configuration to .config/sway/config. In patch 6, you added no-serialization. Did this break it? Regards, Florian From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 06 Oct 2024 09:06:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172820555913402 (code B ref 72714); Sun, 06 Oct 2024 09:06:02 +0000 Received: (at 72714) by debbugs.gnu.org; 6 Oct 2024 09:05:59 +0000 Received: from localhost ([127.0.0.1]:40136 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxNDC-0003U5-N4 for submit@debbugs.gnu.org; Sun, 06 Oct 2024 05:05:59 -0400 Received: from nanein.fr ([185.230.78.41]:56896) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxND9-0003Tp-LN for 72714@debbugs.gnu.org; Sun, 06 Oct 2024 05:05:56 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1728205544; bh=aGMDZvBFmq6DV45lROn0VE4CjpcZZ0ep50c05P/0wnE=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=oUMTXpbcH+m2Ioy+rl+1Kuv5XhXQ/J6f6aNkinBR4GxlffB4tfvGh2LnWcPKZpm2F uykTFKWLkuflCzq3uZJEmbojt+tDVuWJzEYAfG/YcxDT6/ckcyP6Qwh2c5dWcKEmAV t8NyPPKlMx7ZkRaaIScxDyPp1VLGPPqMsVSa0fw/sR+tXs/zyeeMqBA5uea17KzKl+ G6VhqOz8z778mqeHuKXAAPfMDooUyjd+idY6BqCaGNJMsftZX8CXBx7535zUOuiYT7 /+Bu4/Evu7v2unxGkeVCtGi+YJRgO/nyut3zEMgrNnXv7EiPzitQwewg0f3kKHBfrp UMvymmbzUehR6BnJS/YAF6O/n43bKXSMReSdIOyfkvdO+FDvsOuPTKIR4XgKEdFvuE v79FvP132jdkEIzl3NIu7jmSLkghSW2OxhoeBi1+9nav6s2Yauly3FJI1kiXYnBH32 BR0S72EJdZUYCorpXwEhq10/nByOvl6uPNNEDydDpGEDU09zyhAhYkOh3fQ4oKUM+4 vZpvCh1JqD2qKird5B2TPptNjf9jjv+QE0lBan3JRJrijMgKYMAuACX6QtpJnPYF9X ByHcoO7/fX04I+ytH1dV6zMyqMUGyNcfwFxo9R/D4iAgNgQ3X+kgscywEUzse7CY17 kcDM7W3t6nmZb69f8WMLlV8k= Received: from cochea (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id EAC76140268; Sun, 6 Oct 2024 11:05:43 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <8734l94pga.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Sun, 06 Oct 2024 10:15:33 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> <87jzenr5bj.fsf@pelzflorian.de> <877camv5yk.fsf@nanein.fr> <8734l94pga.fsf@pelzflorian.de> Date: Sun, 06 Oct 2024 11:05:31 +0200 Message-ID: <87wmily52c.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hi Florian, "pelzflorian (Florian Pelz)" writes: > Thank you Arnaud for this mountain of work. With pleasure :). > Arnaud Daby-Seesaram writes: >> Also: given that you assisted me quite a lot, do you want me to add a >> line in the commit message to express that you helped me write the >> patch [...] Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-trusted.bondedsender.org] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hi Florian, "pelzflorian (Florian Pelz)" writes: > Thank you Arnaud for this mountain of work. With pleasure :). > Arnaud Daby-Seesaram writes: >> Also: given that you assisted me quite a lot, do you want me to add a >> line in the commit message to express that you helped me write the >> patch [...] Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable Hi Florian, "pelzflorian (Florian Pelz)" writes: > Thank you Arnaud for this mountain of work. With pleasure :). > Arnaud Daby-Seesaram writes: >> Also: given that you assisted me quite a lot, do you want me to add a >> line in the commit message to express that you helped me write the >> patch > > Not for my review; this would be unusual. Noted. > Normally scm->go is probably unneeded here, because guile will find the c= ompiled > .go file. However program-file seems to add --no-auto-compile. Not > sure now. I do not know why the flag --no-auto-compile is passed either. > Another more thing. I try (bar (sway-bar)), but it prints an empty bar > configuration to .config/sway/config. In patch 6, you added > no-serialization. Did this break it? Hmmm, I am not sure. It is normal that `(sway-bar)' is an empty bar configuration (as all bar fields are now optional or empty by default). However, no configuration block should appear in the serialised configuration in this case. Maybe you need to pass --fresh-auto-compile to Guile when executing your test scripts (so that it does not trust its cache). I realised once that when updating the module `(gnu home services sway)', my test files would not be recompiled and old serialisation functions were used. In v6, `serialize-bar' looks like =2D-8<---------------cut here---------------start------------->8--- (add-block* "bar [bar name]" [possibly empty list L1] [...] [possibly empty list Ln]) =2D-8<---------------cut here---------------end--------------->8--- Thus, if all lists `Li' are empty, this should not add any line to the configuration file. (Except for the header "# Bar configuration.[...]", as it is added in the main serialisation function). In my current version of the patch, the header is also removed if nothing follows. Currently (on my local files), `(sway-configuration (bar (sway-bar)))' is serialised into the following: =2D-8<---------------cut here---------------start------------->8--- #################################### ### Auto-generated configuration ### #################################### # DO NOT EDIT MANUALLY. # Variables. ############ [ ... default variables ... ] # Keybindings. ############## [ ... default keybindings ...] # Gestures. ########### [ ... default gestures ...] # Programs to execute (at startup). ################################### [ ... default startup programs ...] =2D-8<---------------cut here---------------end--------------->8--- and `(sway-configuration (bar (sway-bar (hidden-state 'show))))' is serialised into: =2D-8<---------------cut here---------------start------------->8--- #################################### ### Auto-generated configuration ### #################################### # DO NOT EDIT MANUALLY. # Variables. ############ [ ... ] # Bar configuration. #################### bar bar0 { hidden_state show } # Keybindings. ############## [ ... ] # Gestures. ########### [ ... ] # Programs to execute (at startup). ################################### [ ... ] =2D-8<---------------cut here---------------end--------------->8--- So at least, the v8 should behave as expected. Best regards, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmcCUtwQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDCjBD/9+bPkvTbIt6eF8km+cT0erkoF2EFdJ2x1a /CC/1y/cDHnZXOYlIZi5FC7I8Mg3uURful7ExtS1Q0pDcMtOrX8rbZwTvb/fRneB UtfISHkrPDnLHkUiEkbpVbByCmu2Z15Y4Uts5JPLufpX09pUkfI4ez7p71RUGxV5 MaRWvnN1O18ZnXxqWosLGyJbFm0yX7qE8L3S7qkE60yrbF6f4KdCrocNavGMC0Jf +so3i/lTK791LBZ6WJRGsKiVCiX9oPqhaDB69AZ8EuPBbxdDWs8ifDwgwfensqBT +7YGr6uO7sa1Vegy5bS5iQkT/bwF2hICQH0Y6U1Sapx3TDRqjy7Q3AWD99R8Pkt+ J7NyMJnKcQVY6SVtKynlcccoq+Lrm99zH3lRzJEn/dknv+epTAwgR4bsePUPD4SA qFFxmRN4F5zp6Zwhjss79iK5AyTo3DSiNp0jpgB/lYw4LaBXuYNq8VsA75m6UtQN EkZgp+9fIGJsQatbFYLAxA04RoOtTTOCznS0WHLBDRujeOKpe0jRnALn/RBrrflU Jhdb8L1ZdwwFJAeNgsBZ2PRCCwfzdEtUbsVFrZtkrB0fObS2REXyW4V2z/HzpxTk guDc20B2W3hNq8hQNaJKspVtGK7po60EM6EuUaw9F/37T07jm/aJQl8biCVukpK8 IN1Rqq1FEw== =8x6o -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 06 Oct 2024 09:52:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172820827422822 (code B ref 72714); Sun, 06 Oct 2024 09:52:02 +0000 Received: (at 72714) by debbugs.gnu.org; 6 Oct 2024 09:51:14 +0000 Received: from localhost ([127.0.0.1]:40200 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxNv0-0005w1-40 for submit@debbugs.gnu.org; Sun, 06 Oct 2024 05:51:14 -0400 Received: from relay.yourmailgateway.de ([188.68.63.174]:37635) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxNuu-0005vq-K0 for 72714@debbugs.gnu.org; Sun, 06 Oct 2024 05:51:12 -0400 Received: from mors-relay8204.netcup.net (localhost [127.0.0.1]) by mors-relay8204.netcup.net (Postfix) with ESMTPS id 4XLyGF1qLDz8ZHx; Sun, 6 Oct 2024 09:51:01 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1728208261; bh=iiE+qFD5kRGBw9WguvkzWhb6yEjaJOb1kWKUNGJEXQI=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=DCHkXioszSvp9+QhZpoCcXcoehsU6Vx2DMpDp+z+/L27BDFZCQhS1aG2n5qK5ggGF fGvPRFSZnXuryuKZQq/F4nFkhdW/kxhc2d876jUfYhFHc8KZVl50ZhT96xXs03imr0 gOr8Ga3aoTDqKEK//9+nqB54haOX1RoopGQUJU6IfKzFkENUhSmrm4yL3ELxJ2b4qa i1sg7IKzHWdSxn8RvtbmESeaPOrFXgPN4wQvn7IlyG3b/i9b/TqmOeWirSJbukhsJU nlJZmvRMG7jl+ItRVH+ZNY+3F9UQewueXH1L1gsaQbINmNy2+yEc6hUahTf4PeP2J5 cTA5vwd16IwaQ== Received: from policy02-mors.netcup.net (unknown [46.38.225.35]) by mors-relay8204.netcup.net (Postfix) with ESMTPS id 4XLyGF15wnz8ZHD; Sun, 6 Oct 2024 09:51:01 +0000 (UTC) Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy02-mors.netcup.net (Postfix) with ESMTPS id 4XLyGC5kcyz8sZw; Sun, 6 Oct 2024 11:50:59 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id 57093841E5; Sun, 6 Oct 2024 11:50:51 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <87wmily52c.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Sun, 06 Oct 2024 11:05:31 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> <87jzenr5bj.fsf@pelzflorian.de> <877camv5yk.fsf@nanein.fr> <8734l94pga.fsf@pelzflorian.de> <87wmily52c.fsf@nanein.fr> Date: Sun, 06 Oct 2024 11:51:00 +0200 Message-ID: <87r08ta7az.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Rspamd-Queue-Id: 57093841E5 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: DWecqPQ287zD5bP9BRpBUn/Rn08iotbhkCkV+iChYQTsdmxuZww06gk6 X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Arnaud Daby-Seesaram writes: >> Normally scm->go is probably unneeded here, because guile will find the compiled >> .go file. However program-file seems to add --no-auto-compile. Not >> sure now. > I do not know why the flag --no-auto-compile is passed either. > I am not sure if program-file or scheme-file should be preferred. >> Another more thing. I try (bar (sway-bar)), but it prints an empty bar >> configuration to .config/sway/config. In patch 6, you added >> no-serialization. Did this break it? > > Hmmm, I am not sure. > It is normal that `(sway-bar)' is an empty bar configuration (as all bar > fields are now optional or empty by default). Ooops, the identifier is not written, of course. (bar (sway-bar (position 'top))) is fine. Not sure what defaults are best. Arnaud Daby-Seesaram writes: >>> (receive (from to pid) >>> ((@@ (ice-9 popen) open-process) OPEN_BOTH wmenu) >> >> Better use @ instead of @@. > Unfortunately, `open-process' is not exported in `(ice-9 popen)', so I > kept @@. > Not sure if exported open-pipe* would be better. open-process is checked in guile tests, but not exported, that is right. But maybe a red flag not to use it. > It is nice that this works too. > NB: if you want, you can use `(file-append pkg "stuff")' instead of > `#~(string-append #$pkg "stuff")'. Oops yes. Regards, Florian From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 06 Oct 2024 10:45:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: "pelzflorian (Florian Pelz)" Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.1728211496596 (code B ref 72714); Sun, 06 Oct 2024 10:45:01 +0000 Received: (at 72714) by debbugs.gnu.org; 6 Oct 2024 10:44:56 +0000 Received: from localhost ([127.0.0.1]:40243 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxOky-00009Y-EL for submit@debbugs.gnu.org; Sun, 06 Oct 2024 06:44:56 -0400 Received: from nanein.fr ([185.230.78.41]:43084) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxOkv-00009K-DH for 72714@debbugs.gnu.org; Sun, 06 Oct 2024 06:44:55 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1728211451; bh=HUNRTTHYl6F0a2Tey/rq2fV/ynZPhF9+sdGRo5M0bDg=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=Xpq3JyH/EV3So3X7UJmxaa8y0p6ON18w7q89yOKdT6I3t5AjO/aFlHQz6lzYC5jbA dGO65ZqOCegBoTFCcG6CKrpuLNeDYztYPwiaejKOQ6LsECXiH77gB1Jz70Gvc7cDEl 9N/XbnYnn+MFt+E+LY0g6+6eD8jgbbROnPezTHOJSpQ1ZZOAqrXuqGCpmmMjfVWyfv NPGayL9Cx70/p39e1WcH6tLqdnQIVmYlXDc/OXz5gpXQdjKf6GQunXRm6KrInRo8OM ScQuIhRcP6sgQyHKQl7kg9WFb2gO8HAFt72FKVLoVjWI8u1BjOZsNhsH4gdHUnP653 2YT/A7xsGMOU1r2ahaHEKKta1NFqQ1qlMTjYe5hTYepOoWtOZMpGRZ1AjD+apBgwfm gWgnWyTIhE6rRCAzpaE9Lj3KMsgW4XSysAkfekw+G2pHAUtFhAXaN5TY+5sy0FpXcQ 3NZwmmaBVcxe15Ok/RqYZ/F6fIawduZnnALCRgRyvJDqHAy/vbq/siNOD9AEzJFO0Y xG3gGB5URZhfy4EvBPeBKai7/uq0TW7V2N3dLDVZc3PMAk36wa1wdegLGWN2zzqNz/ 4DoP+e238haZCGo+IWZAWUBvBs5oT0IhLwbzG61Z7LuLpv5Brj5E7ja5zgVOXczK+N t+5XsrkD9OorMHwXebKy2q9c= Received: from cochea (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange ECDHE (prime256v1) server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 3F6DA140268; Sun, 6 Oct 2024 12:44:11 +0200 (CEST) From: Arnaud Daby-Seesaram In-Reply-To: <87r08ta7az.fsf@pelzflorian.de> (pelzflorian@pelzflorian.de's message of "Sun, 06 Oct 2024 11:51:00 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> <87jzenr5bj.fsf@pelzflorian.de> <877camv5yk.fsf@nanein.fr> <8734l94pga.fsf@pelzflorian.de> <87wmily52c.fsf@nanein.fr> <87r08ta7az.fsf@pelzflorian.de> Date: Sun, 06 Oct 2024 12:44:08 +0200 Message-ID: <87set9y0hz.fsf@nanein.fr> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hi, "pelzflorian (Florian Pelz)" writes: > Arnaud Daby-Seesaram writes: >>> Normally scm->go is probably unneeded here, because guile will find the compiled [...] Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hi, "pelzflorian (Florian Pelz)" writes: > Arnaud Daby-Seesaram writes: >>> Normally scm->go is probably unneeded here, because guile will find the compiled [...] Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi, "pelzflorian (Florian Pelz)" writes: > Arnaud Daby-Seesaram writes: >>> Normally scm->go is probably unneeded here, because guile will find the= compiled >>> .go file. However program-file seems to add --no-auto-compile. Not >>> sure now. >> I do not know why the flag --no-auto-compile is passed either. >> > > I am not sure if program-file or scheme-file should be preferred. I think that in our use case, program-file is better, because it does not require to call Guile explicitly in the Sway configuration (all we care about is that the serialised script "behaves like a menu program"). >>> Another more thing. I try (bar (sway-bar)), but it prints an empty bar >>> configuration to .config/sway/config. In patch 6, you added >>> no-serialization. Did this break it? >> >> Hmmm, I am not sure. >> It is normal that `(sway-bar)' is an empty bar configuration (as all bar >> fields are now optional or empty by default). > > Ooops, the identifier is not written, of course. > > (bar (sway-bar > (position 'top))) > > is fine. Not sure what defaults are best. Yes, this is arbitrary in my code. Rationale behind my choice: At first, I wanted to make the default value match that of the default Sway configuration file. However, this would force some fields to be mandatory (namely status-command, colors and position). As users may not want to specify these fields in their Sway configuration, I=C2=A0preferred to make everything optional. > Arnaud Daby-Seesaram writes: >>>> (receive (from to pid) >>>> ((@@ (ice-9 popen) open-process) OPEN_BOTH wmenu) >>> >>> Better use @ instead of @@. >> Unfortunately, `open-process' is not exported in `(ice-9 popen)', so I >> kept @@. >> > > Not sure if exported open-pipe* would be better. open-process is > checked in guile tests, but not exported, that is right. But maybe a > red flag not to use it. I first tried to use (open-pipe wmenu OPEN_BOTH). However, I needed to close the port to wmenu before reading its output. I do not know how to do that with `open-pipe'. Best, =2D-=20 Arnaud --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJEBAEBCgAuFiEEMgqfJ4U0fby1t860ojLKXoMTiAwFAmcCafgQHGRzLWFjQG5h bmVpbi5mcgAKCRCiMspegxOIDOQGD/0eBMu1zXYKMPgzz6z5WjjGqYy9kcoTOgEX a6blPNGMR4VvypjQEZ3omNNJLCJOy7TF1I/lFwURSldBZCQBUV9niRfzMJRWhkbS 4zb7z269Q1otirbeBG64JtqA8p7eQcAEQg8chxREW+vIA9QquGpz0eKG9pklhGS2 A8BShbIFxTMBQrGnqvQvDYTcyC/see1RykC5+/5+GY9LUWRFtZR4ouBV76EKOLld UueY7b8jZgpbBRx8/n5658i7YCbCQhJ3FnFoYw1mNgYoY2INj/wO9ImnDnXkbSV1 dlA9GBTb+FIfV2Rfsw0HuAU6bElft0a7IlkIgvWqDYzvA9EELWrjewso8BDmVCvA BWJ/f34hJi1jN4pgQVJ6Sv5MkWUIZo/G2JX1HQZnV/BJ4xCLywH1yBI+ur3OwePS GX9Hm3iUQCiEegTCi0wePQ9sfkIF1wx5NsVBkpoZ2uT7MnWEnUbDUi/FEzwdABCs iJzCA3brRJ/mAxYSoRcIlvMWDZv2o0/SvXtfs3SwTrl3jfbTEeopLa/U1vwg2Wme bCGgs57lPhdwws605QzmKOfEd9cDnOsHIPGFdW8NPD409kVmWWcA/QclYp8P8Rn9 Kfhk7+SZNqX08nq+AAb9sG87GdHkq3ATIgtsFOG19RlnHunfjg4JPG89xHvwklsT brRS1MHRdA== =jTAE -----END PGP SIGNATURE----- --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH] home: services: Add 'home-sway-service-type'. Resent-From: "pelzflorian (Florian Pelz)" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 08 Oct 2024 16:40:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Arnaud Daby-Seesaram Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 72714@debbugs.gnu.org Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.17284055673152 (code B ref 72714); Tue, 08 Oct 2024 16:40:01 +0000 Received: (at 72714) by debbugs.gnu.org; 8 Oct 2024 16:39:27 +0000 Received: from localhost ([127.0.0.1]:54118 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1syDF8-0000ol-Lh for submit@debbugs.gnu.org; Tue, 08 Oct 2024 12:39:27 -0400 Received: from relay.yourmailgateway.de ([188.68.63.102]:36311) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1syDF5-0000ob-LN for 72714@debbugs.gnu.org; Tue, 08 Oct 2024 12:39:25 -0400 Received: from mors-relay-2502.netcup.net (localhost [127.0.0.1]) by mors-relay-2502.netcup.net (Postfix) with ESMTPS id 4XNMDK3SmWz61yj; Tue, 8 Oct 2024 18:39:13 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1728405553; bh=1ZYZrQ8NeyxkdZLiHyvgGMmpX/vsnU7GsZ6foq6TBME=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=euoazLOw4VS+qTX5tYEibeYueOmhUVJ1C4Q1bEJM8T6p6cwwFCNgFh6HQniebYxec YZCFYeP/Xy6GBPflaOHs8jwDVD/IibpInaZbT2Od3HaBPnQrST+Gx4jBSpnui+9B98 63l/OIskfawObVkNYZ1I92QAwtgvMYPIhjkNuAtAEhpcQYkLZbONDjpf7d91vktBSp pcqbnANzUxtnJF1YUSv2Yw15ifyIdnDKEZf6n2rA1kpADDdYjD4wP0sBOUXvzX2Jp4 jc6X3p6VoqLUtgbZoMNrN3RsGw/3dBQMYWwOf2wJIFOMmT9p7EP8dqaRm9SOp018IL kyDZnBbnmfTjQ== Received: from policy01-mors.netcup.net (unknown [46.38.225.35]) by mors-relay-2502.netcup.net (Postfix) with ESMTPS id 4XNMDK2l54z4yMY; Tue, 8 Oct 2024 18:39:13 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at policy01-mors.netcup.net X-Spam-Flag: NO X-Spam-Score: -2.897 X-Spam-Level: X-Spam-Status: No, score=-2.897 required=6.31 tests=[ALL_TRUSTED=-1, BAYES_00=-1.9, URIBL_BLOCKED=0.001, URIBL_DBL_BLOCKED_OPENDNS=0.001, URIBL_ZEN_BLOCKED_OPENDNS=0.001] autolearn=ham autolearn_force=no Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy01-mors.netcup.net (Postfix) with ESMTPS id 4XNMDJ3yRCz8t3x; Tue, 8 Oct 2024 18:39:12 +0200 (CEST) Received: from florianhp (ipb2186896.dynamic.kabel-deutschland.de [178.24.104.150]) by mxe217.netcup.net (Postfix) with ESMTPSA id C727084255; Tue, 8 Oct 2024 18:39:03 +0200 (CEST) From: "pelzflorian (Florian Pelz)" In-Reply-To: <87set9y0hz.fsf@nanein.fr> (Arnaud Daby-Seesaram's message of "Sun, 06 Oct 2024 12:44:08 +0200") References: <87zfno52ig.fsf@gnu.org> <20241001221313.2490-1-ds-ac@nanein.fr> <878qv6tx5i.fsf@pelzflorian.de> <87ttdu9qmo.fsf@nanein.fr> <875xq9we7n.fsf@pelzflorian.de> <877caoewmh.fsf@nanein.fr> <87jzenr5bj.fsf@pelzflorian.de> <877camv5yk.fsf@nanein.fr> <8734l94pga.fsf@pelzflorian.de> <87wmily52c.fsf@nanein.fr> <87r08ta7az.fsf@pelzflorian.de> <87set9y0hz.fsf@nanein.fr> Date: Tue, 08 Oct 2024 18:39:13 +0200 Message-ID: <87cyka1rda.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Rspamd-Queue-Id: C727084255 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: ku4Dr1s6EK/S9uCkBCXzTf1V+iKVRIY9XAPuzwV+0gnHVaumRih2LRSC X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Arnaud. Please excuse the long delay. Arnaud Daby-Seesaram writes: > "pelzflorian (Florian Pelz)" writes: >> I am not sure if program-file or scheme-file should be preferred. > > I think that in our use case, program-file is better, because it does > not require to call Guile explicitly in the Sway configuration (all we > care about is that the serialised script "behaves like a menu program"). Not sure, because program-file calls guile with --no-auto-compile. Maybe someone else has an opinion. Also it does not really matter. >>>> Another more thing. I try (bar (sway-bar)), but it prints an empty bar >>>> configuration to .config/sway/config. In patch 6, you added >>>> no-serialization. Did this break it? >[=E2=80=A6] >> (bar (sway-bar >> (position 'top))) >> >> is fine. Not sure what defaults are best. > > Yes, this is arbitrary in my code. Rationale behind my choice: > > At first, I wanted to make the default value match that of the default > Sway configuration file. However, this would force some fields to be > mandatory (namely status-command, colors and position). As users may > not want to specify these fields in their Sway configuration, > I=C2=A0preferred to make everything optional. I agree to better keep the sway-bar record simple. Maybe a more complete sway-bar should be the default value for bar rather than optional, because it is what upstream does, although then I would disagree with Hilton (?) and actually I prefer no bar. >> Arnaud Daby-Seesaram writes: >>>>> (receive (from to pid) >>>>> ((@@ (ice-9 popen) open-process) OPEN_BOTH wmenu) >>>> >>>> Better use @ instead of @@. >>> Unfortunately, `open-process' is not exported in `(ice-9 popen)', so I >>> kept @@. >>> >> >> Not sure if exported open-pipe* would be better. open-process is >> checked in guile tests, but not exported, that is right. But maybe a >> red flag not to use it. > > I first tried to use (open-pipe wmenu OPEN_BOTH). However, I needed > to close the port to wmenu before reading its output. I do not know how > to do that with `open-pipe'. > > > Best, In vain I tried rewriting code to use open-pipe* until I looked at the source : > static void read_items(struct menu *menu) { > char buf[sizeof menu->input]; > while (fgets(buf, sizeof buf, stdin)) { > char *p =3D strchr(buf, '\n'); > if (p) { > *p =3D '\0'; > } > menu_add_item(menu, strdup(buf), false); > } > } Well, I guess the port must be closed or wmenu does not leave the while loop. No other way. But perhaps use pipeline from (ice-9 popen), which is public, unlike open-process. --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=diff diff --git a/home-configuration.scm b/home-configuration.scm index b961f84..c7eed63 100644 --- a/home-configuration.scm +++ b/home-configuration.scm @@ -41,10 +41,12 @@ (scheme-file "sway-menu.scm" #~(begin - (use-modules (ice-9 receive) + (use-modules (ice-9 popen) + (ice-9 receive) (ice-9 rdelim) (ice-9 ftw) - (guix build utils)) + (guix build utils) + (srfi srfi-1)) (define (directory->files dir) (define (executable-file? f) @@ -62,15 +64,15 @@ "/.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) + (receive (from to pids) + (pipeline `((,wmenu))) (for-each (lambda (c) (format to "~a~%" c)) (directory->files path)) (close to) (let ((choice (read-line from))) (close from) - (waitpid pid) + (waitpid (first pids)) (execl swaymsg swaymsg "exec" ;(string-append path "/" choice) choice))))))) --=-=-= Content-Type: text/plain Could you send v8? Regards, Florian --=-=-=-- From unknown Sun Jun 22 08:11:07 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#72714] [PATCH v8] home: services: Add 'home-sway-service-type'. Resent-From: Arnaud Daby-Seesaram Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 08 Oct 2024 22:39:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72714 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72714@debbugs.gnu.org Cc: Hilton Chain , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Arnaud Daby-Seesaram , pelzflorian Received: via spool by 72714-submit@debbugs.gnu.org id=B72714.172842708211383 (code B ref 72714); Tue, 08 Oct 2024 22:39:02 +0000 Received: (at 72714) by debbugs.gnu.org; 8 Oct 2024 22:38:02 +0000 Received: from localhost ([127.0.0.1]:54807 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1syIq7-0002xB-QS for submit@debbugs.gnu.org; Tue, 08 Oct 2024 18:38:02 -0400 Received: from nanein.fr ([185.230.78.41]:55388) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1syIq2-0002wp-OX for 72714@debbugs.gnu.org; Tue, 08 Oct 2024 18:37:57 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1728427028; bh=+um8ljdr5JPkK0M6lPX3HEZV2+gSOyYoZtjdNspLbL0=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=TfE62y8I3exMg3Rljx+oJqZFvDbgZyBYZ72NCVszK9msHpG2GbGtsIu1evPuYdGRM 6RRpW3UIvo+7gaVZ/nd8NkBCSAJ1x4tdH8ZgYna324YCWeCbrUp+iGB/vnfJ6qRcx+ cbZxaFl7r1FpSMjszt2Ty+kJktxo4nmZbHgcMM3rUp1XbI5buhkXwaLOK0I0crFSI0 Sid6K4n8OZQ+m6vC3abHwxI2NGGZDOTcqYpsgpIv2qAmsEpZ79iK/TKaKLeKPDLsGr FW/uC/39FP9XkA01Gu2FjVLPgpigwwqviZaNiOr3X6SDftv7nTfrVf3NALCnuuN8TW +z6O3KIuk8H29hQ1tqPH1rz/c0HNZ4hBSo8rEcvo74aVkLCAhAJYUQF5WEVF8D/iL1 G1CFbbeK7jOqFvmmNhnTcbct9fb+Oylku0XPLlC7ibD2ZQeD1bU9Z6hQSvyGL1kvJE u6RvonQuUC9ZSGqHFymhxqfoHHu4ivxX8w82p+kX49n1HTB1Nb4kEFOwz27VTC3bvx RVaVUyyMQNO5TU2bVG52CQqHm1/M/2OMZFbTDHARp88XJaVdSWPMhNDGIxV3OW+8tV I+xVTq8NC3aZ+2lF6uNw6sIi4fXN7EpN57GWqzpy+KIuhwDTZBuIlDUDDrDl0UGd8Y lDM5ADUDn1OQxe6lvpmGFvwg= Received: from cochea.c.hoisthospitality.com (unknown [212.178.179.82]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id 654E6140266; Wed, 9 Oct 2024 00:37:08 +0200 (CEST) From: Arnaud Daby-Seesaram Date: Wed, 9 Oct 2024 00:33:41 +0200 Message-ID: <20241008223645.19674-1-ds-ac@nanein.fr> X-Mailer: git-send-email 2.46.0 In-Reply-To: <87cyka1rda.fsf@pelzflorian.de> References: <87cyka1rda.fsf@pelzflorian.de> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: 3.6 (+++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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 [...] Content analysis details: (3.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-trusted.bondedsender.org] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.6 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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 [...] Content analysis details: (2.6 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 0.0 RCVD_IN_VALIDITY_SAFE_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in sa-accredit.habeas.com] 0.0 RCVD_IN_VALIDITY_RPBL_BLOCKED RBL: ADMINISTRATOR NOTICE: The query to Validity was blocked. See https://knowledge.validity.com/hc/en-us/articles/20961730681243 for more information. [185.230.78.41 listed in bl.score.senderscore.com] 3.6 RCVD_IN_SBL_CSS RBL: Received via a relay in Spamhaus SBL-CSS [212.178.179.82 listed in zen.spamhaus.org] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record -0.0 SPF_PASS SPF: sender matches SPF record -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager * 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. (flatmap): New procedure. * gnu/local.mk: Add gnu/home/services/sway.scm. * doc/guix.texi (Sway window manager): New node to document the above changes. --- Hello Florian, Please find below the v8 of the patch. Main changes since the v7 and our last emails : • I no longer call make-string once per line, • I serialize the tap field of input (I forgot it before), • I have added the resize mode of Sway in the default modes, • I have swapped the sections "default values" and "definition of configuration records" in sway.scm so that I could define %sway-default-modes, • I have proof-read the code and documentation, • I have re-tested the code on example configurations (and have hopefully caught all remaining small bugs/oversight). > Please excuse the long delay. No worries; it has only been two days :). > Well, I guess the port must be closed or wmenu does not leave the > while loop. No other way. But perhaps use pipeline from (ice-9 > popen), which is public, unlike open-process. As suggested, I now use `pipeline'. The menu script also makes sure that the output of wmenu is not null before trying to execute it. Best regards, doc/guix.texi | 406 +++++++++++++++++ gnu/home/services/sway.scm | 878 +++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + 3 files changed, 1285 insertions(+) create mode 100644 gnu/home/services/sway.scm diff --git a/doc/guix.texi b/doc/guix.texi index 52e36e4354..127219d25f 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,409 @@ 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 '*) + (background (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 one argument @code{config}, which must be a +@code{sway-configuration} record (defined below), and returns a +file-like object representing the serialized configuration. +@end deffn + +@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-like 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 + +@quotation Note +Default keybindings assume the existence of variables named @code{$mod}, +@code{$left}, @code{$right}, @code{$up} and @code{$down}. If you choose +not to define these variables, make sure to remove keybindings referring +to them. +@end quotation + +@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{%sway-default-modes}) +List of @code{sway-mode} records (described below) to add modes to the +Sway configuration. The default value @code{%sway-default-modes} adds +the ``resize'' mode of the default Sway configuration (as described +below). + +@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{} record) +Keyboard specific option. Field specifying the layout to use for the +input. The value must be a @code{} 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 must a list +whose elements are 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-like object, +@item +a pair. The first argument of this pair must be a string, a +G-expression or a file-like object. The second element describes how +the wallpaper will be displayed. It must be a symbol among +@code{stretch}, @code{fill}, @code{fit}, @code{center} and @code{tile}. + +If the second element is not specified (@i{i.e.}@: when the value not a +pair), the @code{fill} mode will be used. +@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 . "exec +$term")))}, left clicks in the status bar open the terminal (assuming +that the variable @code{$term} is bound to a terminal). +@end table +@end deftp + +@deftp {Data Type} sway-mode +Describes a Sway mode (see@ @cite{sway(5)}). For example, the following +snippet defines 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") + (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..9401c80400 --- /dev/null +++ b/gnu/home/services/sway.scm @@ -0,0 +1,878 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Arnaud Daby-Seesaram +;;; +;;; 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 . + +(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 wm) + #:use-module (gnu packages terminals) + #: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-modes + %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)))))) + + +;;; +;;; Definition of configurations. +;;; + +(define (string-ish? s) + (or (gexp? s) + (file-like? 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-maybe point (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 %sway-default-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.")) + + +;;; +;;; Default settings and useful constants. +;;; + +(define sway-menu + (program-file + "sway-menu.scm" + (with-imported-modules + (source-module-closure '((guix build utils))) + #~(begin + (use-modules (ice-9 popen) + (ice-9 receive) + (ice-9 rdelim) + (ice-9 ftw) + (guix build utils) + (srfi srfi-1)) + + (define (directory->files dir) + (define (executable-file? f) + ;; Cf. `(@ (guix build utils) executable-file?)' for an + ;; explanation of `(zero? ...)'. + (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) + (pipeline `((,wmenu))) + (for-each + (lambda (c) (format to "~a~%" c)) + (directory->files path)) + (close to) + (let ((choice (read-line from))) + (close from) + (waitpid (first pid)) + (when (string? choice) ;do not attempty to launch if no choice + ;was given (e.g. if Escape is pressed in + ;wmenu). + (execl swaymsg swaymsg "exec" "--" + choice))))))))) + +(define %ev-code-mouse-left 272) +(define %ev-code-mouse-right 273) +(define %ev-code-mouse-scroll-click 274) + +(define %sway-default-modes + (list (sway-mode + (mode-name "resize") + (keybindings + '(($left . "resize shrink width 10px") + ($down . "resize grow height 10px") + ($up . "resize shrink height 10px") + ($right . "resize grow width 10px") + (Left . "resize shrink width 10px") + (Down . "resize grow height 10px") + (Up . "resize shrink height 10px") + (Right . "resize grow width 10px") + (Return . "mode \"default\"") + (Escape . "mode \"default\"")))))) + +(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 . ,sway-menu))) + +(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'"))) + + +;;; +;;; Serialization functions. +;;; + +;; The main serialization code is defined in `sway-configuration->file' below. +;; In this function, the configuration is seen as a list of lines and blocks. +;; +;; The other serialization functions of this files are helpers that will build +;; the above list. Each function either returns a list, or elements that will +;; be put in one. The elements of these lists will either be: +;; - strings, +;; In this case, the string is seen as a line to add to the configuraiton +;; file. +;; - a pair (cons 'begin-block string), +;; In this case, a line "string {" is added to the configuration file, and +;; the indentation level is increased by four. +;; - the symbol 'end-block. +;; In which case the indentation level is decreased by four, and the current +;; configuration block is closed (with the line "}"). + +;; A few 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 ...))))) + +;; Serialization functions: + +(define (box str) + (let* ((len (string-length str)) + (line (make-string (+ 8 len) #\#))) + (list + line + (string-append "### " str " ###") + line))) + +(define (with-heading str lst) + (define (heading str) + (let* ((len (string-length str)) + (line (make-string (+ 2 len) #\#))) + (list + "" ;add an empty line before the configuration section. + (string-append "# " str) + line))) + (if (equal? lst '()) + '() ;if the configuration block is empty, do not add the heading. + (append (heading str) lst))) + +(define-inlinable (serialize-boolean-yn b) + (if b "yes" "no")) +(define-inlinable (serialize-boolean-ed b) + (if b "enable" "disable")) + +(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-y 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))) + + (tap (sway-input-tap input)) + (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-ed) + (add-line-if "dwtp" dwtp + #:serializer serialize-boolean-ed) + (add-line-if "tap" tap + #:serializer serialize-boolean-ed) + ;; 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)) + ;; 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)) + + (call-with-output-file #$output + (lambda (port) + + ;; Add the (indented) line "s" to the output file. + (define (line s) + (lambda (i) + (format port "~a~a~%" i s) + i)) + + ;; Begin a block "name" and adjust the indentation. + (define (begin-block name) + (lambda (i) + (format port "~a~a {~%" i name) + (string-append " " i))) + + ;; Ends an open block and adjust the indentation. + ;; Note: we must currently be in a configuration block. + ;; Otherwise, `string-drop' might fail. + (define (end-block) + (lambda (i) + (let ((i (string-drop i 4))) + (format port "~a}~%" 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 string. This string is prepended to + ;; lines before their serialization. + "" + ;; List of lines or indentation modifiers. + (list + ;; Header. + #$@(box "Auto-generated configuration") + "# DO NOT EDIT MANUALLY." + + ;; Variables. + #$@(with-heading "Variables." + (map serialize-variable + (sway-configuration-variables conf))) + + ;; Outputs. + #$@(with-heading "Outputs." + (flatmap serialize-output + (sway-configuration-outputs conf))) + + ;; Inputs. + #$@(with-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) + '() + (with-heading "Bar configuration." + (serialize-bar bar))) + + ;; Keybindings. + #$@(with-heading "Keybindings." + (map serialize-keybinding + (sway-configuration-keybindings conf))) + ;; Gestures. + #$@(with-heading "Gestures." + (map serialize-gesture + (sway-configuration-gestures conf))) + + ;; Modes. + #$@(with-heading "Modes." + (flatmap serialize-mode + (sway-configuration-modes conf))) + + ;; Startup-Programs. + #$@(with-heading + "Programs to execute (at startup)." + (map (serialize-exec #f) + (sway-configuration-startup-programs conf))) + ;; startup+reload-programs. + #$@(with-heading + "Programs to execute (at startup & after reload)." + (map (serialize-exec #t) + (sway-configuration-startup+reload-programs conf))) + + ;; Extra-content. + #$@(with-heading "Extra-content" extra))))))))) + + +;;; +;;; Definition of th Home Service. +;;; + +(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 2adf196a87..003cda1259 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 From unknown Sun Jun 22 08:11:07 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Arnaud Daby-Seesaram Subject: bug#72714: closed (Re: [PATCH v8] home: services: Add 'home-sway-service-type'.) Message-ID: References: <87iktx79er.fsf@pelzflorian.de> <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> X-Gnu-PR-Message: they-closed 72714 X-Gnu-PR-Package: guix-patches X-Gnu-PR-Keywords: patch Reply-To: 72714@debbugs.gnu.org Date: Sat, 12 Oct 2024 13:13:02 +0000 Content-Type: multipart/mixed; boundary="----------=_1728738782-22901-1" This is a multi-part message in MIME format... ------------=_1728738782-22901-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #72714: [PATCH] home: services: Add 'home-sway-service-type'. which was filed against the guix-patches package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 72714@debbugs.gnu.org. --=20 72714: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D72714 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1728738782-22901-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 72714-done) by debbugs.gnu.org; 12 Oct 2024 13:12:13 +0000 Received: from localhost ([127.0.0.1]:43073 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1szbul-0005vx-V6 for submit@debbugs.gnu.org; Sat, 12 Oct 2024 09:12:12 -0400 Received: from relay.yourmailgateway.de ([188.68.63.166]:38215) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1szbuj-0005vp-6Q for 72714-done@debbugs.gnu.org; Sat, 12 Oct 2024 09:12:10 -0400 Received: from mors-relay-8202.netcup.net (localhost [127.0.0.1]) by mors-relay-8202.netcup.net (Postfix) with ESMTPS id 4XQk9d3pKJz3vgr; Sat, 12 Oct 2024 15:00:05 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de; s=key2; t=1728738005; bh=5BJ2/zHdK+w/fmmRlvysjJyJBJx8itnobOVM+VjaCLU=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=agTNlzd7kuL81zcE84CdIutuCrc5cMKsRurvyDkY4VUJZM0HibIKIHzHGyf5+dPBn 7SvUub62Nu95+eRVohFPtXRjTcgtjBCvzL085aUmuSADPEurA0EdkAzQsTHX5566B5 HKQBaYlu/swx+vzX+UK7cH+bNSAelw/2dZx09/TWNTweX9qQz0OgFoBS9LByy/yVeM LxFpldc16NuxajApo5B7Sb1OUr6lj5tGkxFwg3muKBrKeog2znsuQI9Q5BBMyqz0Cu c3T2lLc6jh68YdKJQI21auF4duRF3Fwe9UzQxoINJSC22oiYaYV2CqMk+yJsn49DIh kZY7sS1UIyGug== Received: from policy01-mors.netcup.net (unknown [46.38.225.35]) by mors-relay-8202.netcup.net (Postfix) with ESMTPS id 4XQk9d353Sz3vgk; Sat, 12 Oct 2024 15:00:05 +0200 (CEST) X-Virus-Scanned: Debian amavisd-new at policy01-mors.netcup.net X-Spam-Flag: NO X-Spam-Score: -2.9 X-Spam-Level: X-Spam-Status: No, score=-2.9 required=6.31 tests=[ALL_TRUSTED=-1, BAYES_00=-1.9] autolearn=ham autolearn_force=no Received: from mxe217.netcup.net (unknown [10.243.12.53]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by policy01-mors.netcup.net (Postfix) with ESMTPS id 4XQkRD5HW1z8t3t; Sat, 12 Oct 2024 15:11:52 +0200 (CEST) Received: from florianhp (ipb218687b.dynamic.kabel-deutschland.de [178.24.104.123]) by mxe217.netcup.net (Postfix) with ESMTPSA id E236683EF1; Sat, 12 Oct 2024 15:11:44 +0200 (CEST) From: "pelzflorian (Florian Pelz)" To: Arnaud Daby-Seesaram Subject: Re: [PATCH v8] home: services: Add 'home-sway-service-type'. In-Reply-To: <20241008223645.19674-1-ds-ac@nanein.fr> (Arnaud Daby-Seesaram's message of "Wed, 9 Oct 2024 00:33:41 +0200") References: <87cyka1rda.fsf@pelzflorian.de> <20241008223645.19674-1-ds-ac@nanein.fr> Date: Sat, 12 Oct 2024 15:11:56 +0200 Message-ID: <87iktx79er.fsf@pelzflorian.de> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Rspamd-Queue-Id: E236683EF1 X-Rspamd-Server: rspamd-worker-8404 X-NC-CID: NUVffUrWUkomG61wNq3aaXABgM793RxNLMe4qeR8VmYRXBfySCVtxCQB X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 72714-done Cc: Hilton Chain , Ludovic =?utf-8?Q?Court=C3=A8s?= , 72714-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain Pushed as b64f7984a5e2aba04df72a92f0044e423efe77c6, Change-Id: I880261570c5afdb795f2ce18bac2b9a5c898677f with tiny changes. --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=diff --- doc/guix.texi | 16 ++++++++-------- gnu/home/services/sway.scm | 24 ++++++++---------------- 2 files changed, 16 insertions(+), 24 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 0f45ef3b15..ddbff8bc23 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -47170,13 +47170,13 @@ Sway window manager want to do so, you might be interested in using @code{greetd-wlgreet-sway-session} instead. -The function @code{sway-configuration->file} defined below can be used +The proceedure @code{sway-configuration->file} defined below can be used to provide the value for the @emph{optional} @code{sway-configuration} field of @code{greetd-wlgreet-sway-session}. @end quotation @deffn {Procedure} sway-configuration->file config -This function takes one argument @code{config}, which must be a +This procedure takes one argument @code{config}, which must be a @code{sway-configuration} record (defined below), and returns a file-like object representing the serialized configuration. @end deffn @@ -47263,11 +47263,11 @@ Sway window manager @item @code{startup+reload-programs} (default: @code{'()}) Programs to execute at startup time @emph{and} after every configuration reload. The value of this field is a list of strings, G-expressions or -file-append objects (@pxref{G-Expressions}). +file-like objects (@pxref{G-Expressions}). @item @code{startup-programs} (default: @code{%sway-default-execs}) Programs to execute at startup time. As above, values of this field are -a list of strings, G-expressions or file-append objects. +a list of strings, G-expressions or file-like objects. The default value, @code{%sway-default-execs}, executes @code{swayidle} in order to lock the screen after 5@ minutes of inactivity (displaying a @@ -47283,7 +47283,7 @@ Sway window manager @deftp {Data Type} sway-input @code{sway-input} records describe input blocks (see@ @cite{sway-input(5)}). For example, the following snippet makes all -keyboards use a french layout, in which @kbd{capslock} has been remaped +keyboards use a French layout, in which @kbd{capslock} has been remapped to @kbd{ctrl}: @lisp (sway-input (identifier "type:keyboard") @@ -47365,8 +47365,8 @@ Sway window manager the wallpaper will be displayed. It must be a symbol among @code{stretch}, @code{fill}, @code{fit}, @code{center} and @code{tile}. -If the second element is not specified (@i{i.e.}@: when the value not a -pair), the @code{fill} mode will be used. +If the second element is not specified (@i{i.e.}@: when the value is not +a pair), the @code{fill} mode will be used. @end itemize @quotation Note @@ -47444,7 +47444,7 @@ Sway window manager @item @code{colors} (optional) An optional @code{sway-color} configuration record. -@item @code{status-command} (default: @code{%sway-status-command}) +@item @code{status-command} (optional) This field accept strings, G-expressions and executable file-like values. The default value is a command (string) that prints the date and time every second. diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm index 9401c80400..0e1a2d57b2 100644 --- a/gnu/home/services/sway.scm +++ b/gnu/home/services/sway.scm @@ -20,9 +20,6 @@ (define-module (gnu home services sway) #:use-module (guix modules) #:use-module (guix gexp) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (ice-9 popen) - #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (guix packages) #:use-module (gnu system keyboard) @@ -52,7 +49,6 @@ (define-module (gnu home services sway) %sway-default-gestures %sway-default-modes %sway-default-keybindings - %sway-default-status-command %sway-default-startup-programs %sway-default-packages)) @@ -221,7 +217,7 @@ (define-configuration/no-serialization sway-bar "Color palette of the bar.") (status-command maybe-status-command - "Status command. It must be file-like.") + "Status command.") (mouse-bindings (mouse-bindings '()) "Actions triggered by mouse events.") @@ -275,7 +271,6 @@ (define-configuration/no-serialization sway-mode (mouse-bindings (mouse-bindings '()) "Mouse bindings.")) -;; TODO (not necessary for 72714): switch bindings. (define (sway-modes? lst) (every sway-mode? lst)) @@ -327,10 +322,10 @@ (define sway-menu (with-imported-modules (source-module-closure '((guix build utils))) #~(begin - (use-modules (ice-9 popen) + (use-modules (ice-9 ftw) + (ice-9 popen) (ice-9 receive) (ice-9 rdelim) - (ice-9 ftw) (guix build utils) (srfi srfi-1)) @@ -351,7 +346,7 @@ (define sway-menu "/.guix-home/profile/bin")) (wmenu #$(file-append wmenu "/bin/wmenu")) (swaymsg #$(file-append sway "/bin/swaymsg"))) - (receive (from to pid) + (receive (from to pids) (pipeline `((,wmenu))) (for-each (lambda (c) (format to "~a~%" c)) @@ -359,8 +354,8 @@ (define sway-menu (close to) (let ((choice (read-line from))) (close from) - (waitpid (first pid)) - (when (string? choice) ;do not attempty to launch if no choice + (waitpid (first pids)) + (when (string? choice) ;do not attempt to launch if no choice ;was given (e.g. if Escape is pressed in ;wmenu). (execl swaymsg swaymsg "exec" "--" @@ -464,9 +459,6 @@ (define %sway-default-keybindings ($mod+minus . "scratchpad show") ($mod+r . "mode \"resize\""))) -(define %sway-default-status-command - "while date +'%Y-%m-%d %X'; do sleep 1; done") - (define %sway-default-startup-programs (list #~(string-append @@ -751,7 +743,7 @@ (define (sway-configuration->file conf) (computed-file "sway-config" #~(begin - (use-modules (ice-9 format) (ice-9 popen) (ice-9 match) + (use-modules (ice-9 format) (ice-9 match) (srfi srfi-1)) (call-with-output-file #$output @@ -859,7 +851,7 @@ (define (sway-configuration->file conf) ;;; -;;; Definition of th Home Service. +;;; Definition of the Home Service. ;;; (define (sway-configuration->files sway-conf) -- 2.45.2 --=-=-= Content-Type: text/plain I also reindented the commit message and put a line break because the last line did not fit on my terminal. Thank you greatly! Regards, Florian --=-=-=-- ------------=_1728738782-22901-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 19 Aug 2024 15:32:40 +0000 Received: from localhost ([127.0.0.1]:58974 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sg4N5-0007v9-Fh for submit@debbugs.gnu.org; Mon, 19 Aug 2024 11:32:40 -0400 Received: from lists.gnu.org ([209.51.188.17]:42746) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sg4N3-0007uy-3l for submit@debbugs.gnu.org; Mon, 19 Aug 2024 11:32:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sg4MM-00083x-VV for guix-patches@gnu.org; Mon, 19 Aug 2024 11:31:54 -0400 Received: from nanein.fr ([185.230.78.41]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sg4MH-0002Iv-KF for guix-patches@gnu.org; Mon, 19 Aug 2024 11:31:54 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=nanein.fr; s=mail; t=1724081496; bh=0+mky3sZaS67yqtdrFFTKDWy+Jq5m9ridGbgyoMqM6o=; h=From:To:Cc:Subject:Date:From; b=mUDLqPmpagqoMW6OpPXXN0nQ80uyfbXK0HkhMqL69DOifkaLfj+juEi+cUet9qcEH mXi5yxH2tcEo9z2/v+XQvQgV6WSXqx9/C2+yw8kXrik/ZLgz4Nab136aDYU977IY2j S9DZhPhTW/9eW9Cfe6RmbWe3TRenb/0R2xDHD+J3ahglt7uuSxPl37/9wcBbbHfeGC MwcQmM4HiuQ+Z5yk1ItACdxL8yLMppgH/zS5n8uJkN7oEyYwPyib7cDTiabf9UoXci shEgEKiM1M/5fa5H5a6TYBIKP0PzQAYbKyxzzR1u5uyTPT/eqp/z9s/oobKgSjJSi7 qAkNKOONoAeN0eNrfIdzWrx05DKYFb4cyu0DBikq1Njly2efNIO6lx1P5JxFjhIzNj MMpFVg8vg+WlSHRw4W+WE1aoPnaISGVbbm1Pj/+IR35d7lN1zkXxU/uSQW2in8DKoH PqIofkShYEyh3p+GuXJhoyDRvmKdKgfu0ul6WSu9vTbEkKJssPylMkr8mTHy6Wbdo8 qcdkqURgOAl1ajhwkRlB458J+utJY4M07YI2B1JQ8Cgsb/f4V81KvzbdBn7TKtB2Pj 5wjRVEuL91KAnSKW2DMsKZPSQfIk6Y3wWGEVljd7xUDyMN9Dx1W/21HHVOivxeEOj2 YDIIcFzQQSnI4WUmww6oIw/8= Received: from localhost.localdomain (unknown [IPv6:2a01:e34:ec01:e860:f052:4634:b50a:d5f5]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (prime256v1) server-digest SHA256) (No client certificate requested) by nanein.fr (Postfix) with ESMTPSA id E32EC140266; Mon, 19 Aug 2024 17:31:36 +0200 (CEST) From: Arnaud Daby-Seesaram To: guix-patches@gnu.org Subject: [PATCH] home: services: Add 'home-sway-service-type'. Date: Mon, 19 Aug 2024 17:30:42 +0200 Message-ID: <1e82e473639f21a2950a0827f156437ef1bc9c48.1724081442.git.ds-ac@nanein.fr> X-Mailer: git-send-email 2.45.2 MIME-Version: 1.0 X-Debbugs-Cc: ( , Andrew Tropin , Ludovic Courtès , Tanguy Le Carrour Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=185.230.78.41; envelope-from=ds-ac@nanein.fr; helo=nanein.fr X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-Debbugs-Envelope-To: submit Cc: Arnaud Daby-Seesaram X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) * 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 +;;; +;;; 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 . + +(define-module (gnu home services sway) + #:use-module (guix monads) + #:use-module (guix modules) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 popen) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (guix packages) + #:use-module (gnu services configuration) + #:use-module (gnu home services) + #:use-module (gnu packages freedesktop) + #:use-module (gnu packages xdisorg) + #:use-module (gnu packages image) + #:use-module (gnu packages gnome) + #:use-module (gnu packages wm) + #:use-module (gnu packages emacs) + #:use-module (gnu packages linux) + #:use-module (gnu packages base) + #:use-module (gnu packages suckless) + #:use-module (gnu packages glib) + #:export (;; Accessors and predicates do not need to be exported. + sway-configuration + sway-bar + sway-output + sway-input + point + sway-color + sway-border-color + home-sway-service-type)) + +;; Helper function. +(define (flatten l) + (let loop ((lst l) (acc '())) + (match lst + (() acc) + ((head . tail) + (loop tail (append acc head)))))) + + +;;; +;;; Default settings. +;;; + +(define %sway-default-variables + `((mod . "Mod4") + (left . "h") + (down . "j") + (up . "k") + (right . "l") + (term . ,#~(string-append #$st "/bin/st")) + (menu . ,#~(string-append #$dmenu "/bin/dmenu_run")))) + +(define %sway-default-gestures + `((swipe:3:right . "workspace next_on_output") + (swipe:3:left . "workspace prev_on_output") + (swipe:3:down . "move to scratchpad") + (swipe:3:up . "scratchpad show") + (pinch:2:clockwise + . "move container to workspace prev_on_output") + (pinch:2:counterclockwise + . "move container to workspace next_on_output") + (swipe:4:left . "exec alacritty") + (swipe:4:right . "exec qutebrowser") + (swipe:4:down . "exec st") + (swipe:4:up + . ,#~(string-append + "exec " #$emacs "/bin/emacsclient -a '" + #$libnotify "/bin/notify-send Oups \"emacs not loaded :/\"' -c")) + (pinch:inward+right . "resize shrink width") + (pinch:inward+left . "resize grow width") + (pinch:inward+down . "resize shrink height") + (pinch:inward+up . "resize grow height") + (pinch:outward+up . "move up") + (pinch:outward+down . "move down") + (pinch:outward+left . "move left") + (pinch:outward+right . "move right"))) + +(define %sway-default-keybindings + `(($mod+Shift+e + . ,#~(string-append + "exec " #$emacs + "/bin/emacsclient -a '" + #$libnotify "/bin/notify-send Oups \"emacs not loaded :/\"' -c")) + ($mod+Return . "exec $term") + ($mod+Shift+c . "kill") + ($mod+p . "exec $menu") + ($mod+Shift+r . "reload") + ($mod+Shift+q + . ,#~(string-append + "exec " #$sway "/bin/swaynag -t warning " + "-m 'You pressed the exit shortcut. Do you really want to exit sway?" + " This will end your Wayland session.'" + " -B 'Yes, exit sway' 'swaymsg exit'")) + ($mod+$left . "focus left") + ($mod+$right . "focus right") + ($mod+$up . "focus up") + ($mod+$down . "focus down") + ($mod+Shift+$left . "move left") + ($mod+Shift+$right . "move right") + ($mod+Shift+$up . "move up") + ($mod+Shift+$down . "move down") + ($mod+ampersand . "workspace number 1") + ($mod+eacute . "workspace number 2") + ($mod+quotedbl . "workspace number 3") + ($mod+apostrophe . "workspace number 4") + ($mod+parenleft . "workspace number 5") + ($mod+minus . "workspace number 6") + ($mod+egrave . "workspace number 7") + ($mod+underscore . "workspace number 8") + ($mod+ccedilla . "workspace number 9") + ($mod+agrave . "workspace number 10") + ($mod+Shift+ampersand . "move container to workspace number 1") + ($mod+Shift+eacute . "move container to workspace number 2") + ($mod+Shift+quotedbl . "move container to workspace number 3") + ($mod+Shift+apostrophe . "move container to workspace number 4") + ($mod+Shift+parenleft . "move container to workspace number 5") + ($mod+Shift+minus . "move container to workspace number 6") + ($mod+Shift+egrave . "move container to workspace number 7") + ($mod+Shift+underscore . "move container to workspace number 8") + ($mod+Shift+ccedilla . "move container to workspace number 9") + ($mod+Shift+agrave . "move container to workspace number 10") + ($mod+b . "splith") + ($mod+v . "splitv") + ($mod+s . "layout stacking") + ($mod+w . "layout tabbed") + ($mod+e . "layout toggle split") + ($mod+f . "fullscreen") + ($mod+Shift+space . "floating toggle") + ($mod+space . "focus mode_toggle") + ($mod+z . "focus parent") + ($mod+Shift+o . "move scratchpad") + ($mod+o . "scratchpad show") + ($mod+r . "mode \"resize\"") + ($mod+Shift+n . "bar mode toggle") + ($mod+Shift+b . "border toggle") + ($mod+tab . "workspace back_and_forth"))) + + +;;; +;;; Definition of configurations. +;;; + +(define (list-of-string-or-gexp? lst) + (every (lambda (elt) + (or (string? elt) + (gexp? elt))) + lst)) + +(define (list-of-packages? lst) + (every package? lst)) + +(define (bar-position? p) + (member p '(top bottom))) + +(define (hidden-state? st) + (member st '(hide show))) + +(define (string-or-symbol? s) + (or (string? s) + (symbol? s))) + +(define (strings? lst) + (every string? lst)) + +(define-maybe string (no-serialization)) +(define-maybe strings (no-serialization)) + +(define-configuration/no-serialization sway-input + (identifier + (string-or-symbol '*) + "Identifier of the input.") + (xkb-layout + maybe-string + "Keyboard layout.") + (xkb-model + maybe-string + "Keyboard model.") + (xkb-options + maybe-strings + "Keyboard options.") + (xkb-variant + maybe-string + "Keyboard layout variant.") + (extra-content + (list-of-string-or-gexp '()) + "Lines to add at the end of the configuration file.")) + +(define (sway-inputs? lst) + (every sway-input? lst)) + +(define-configuration/no-serialization sway-border-color + (border + string + "Border color.") + (background + string + "Background color.") + (text + string + "Text color.")) + +(define-maybe sway-border-color (no-serialization)) + +(define-configuration/no-serialization sway-color + (background + maybe-string + "Background color of the bar.") + (statusline + maybe-string + "Text color of the separator.") + (focused-background + maybe-string + "Background color of the bar on the currently focused monitor.") + (focused-statusline + maybe-string + "Text color of the statusline on the currently focused monitor.") + (focused-workspace + maybe-sway-border-color + "...") + (active-workspace + maybe-sway-border-color + "...") + (inactive-workspace + maybe-sway-border-color + "...") + (urgent-workspace + maybe-sway-border-color + "...") + (binding-mode + maybe-sway-border-color + "...")) + +(define-maybe sway-color (no-serialization)) + +(define-configuration/no-serialization sway-bar + (identifier + (symbol 'bar0) + "Identifier of the bar.") + (position + (bar-position 'top) + "Position of the bar.") + (hidden-state + (hidden-state 'hide) + "Hidden state.") + (binding-mode-indicator + (boolean #t) + "Binding indicator.") + (colors + maybe-sway-color + "Color palette of the bar.") + (status-command + (file-like + (program-file + "sway-bar-status" + (with-imported-modules + (source-module-closure + '((ice-9 textual-ports) (ice-9 regex) (ice-9 popen) (ice-9 format) + (srfi srfi-19))) + #~(begin + (use-modules (ice-9 textual-ports) + (ice-9 format) + (ice-9 popen) + (ice-9 regex) + (srfi srfi-19)) + (let loop () + (let* ((date (date->string (current-date) "~a ~D ~H:~M:~S")) + (batline (let* ((p (open-pipe* + OPEN_READ + #$(file-append acpi "/bin/acpi") "-b")) + (bat (get-line p))) + (close-pipe p) + bat)) + (bat (match:substring (string-match "[0-9]+%" batline)))) + (format #t "~a - ~a~%~!" bat date) + (sleep 1) + (loop))))))) + "Status command. It must be file-like.")) + +(define-configuration/no-serialization point + (x integer "X coordinate.") + (y integer "Y coordinate.")) + +(define-maybe point (no-serialization)) +(define-maybe file-like (no-serialization)) + +(define-configuration/no-serialization sway-output + (identifier + (string-or-symbol '*) + "Identifier of the output.") + (resolution + maybe-string + "Mode of the monitor.") + (position + maybe-point + "Position of the monitor.") + (bg + maybe-file-like + "Background image.") + (extra-content + (list-of-string-or-gexp '()) + "Extra lines.")) + +(define (sway-outputs? lst) + (every sway-output? lst)) + +(define-configuration/no-serialization sway-configuration + (keybindings + (alist %sway-default-keybindings) + "Keybindings.") + (gestures + (alist %sway-default-gestures) + "Gestures.") + (packages + (list-of-packages + (list sway swaylock waybar swaybg slurp grim dmenu bemenu + dbus xdg-desktop-portal-wlr xdg-desktop-portal)) + "List of packages to add to the profile.") + (variables + (alist %sway-default-variables) + "Variables declared at the beginning of the file.") + (inputs + (sway-inputs (list (sway-input))) + "Inputs.") + (outputs + (sway-outputs '()) + "Outputs.") + (bar + (sway-bar (sway-bar)) + "Bar configuration.") + (execs + (list-of-string-or-gexp '()) + "Programs to execute at startup time.") + (extra-content + (list-of-string-or-gexp '()) + "Lines to add at the end of the configuration file.")) + + +;;; +;;; Serialization functions. +;;; + +(define (serialize-keybinding var) + (let ((name (symbol->string (car var))) + (value (cdr var))) + #~(string-append "bindsym " #$name " " #$value))) + +(define (serialize-gesture var) + (let ((name (symbol->string (car var))) + (value (cdr var))) + #~(string-append "bindgesture " #$name " " #$value))) + +(define (serialize-variable var) + (let ((name (symbol->string (car var))) + (value (cdr var))) + #~(string-append "set $" #$name " " #$value))) + +(define (serialize-exec exe) + #~(string-append "exec " #$exe)) + +(define (serialize-output out) + (let* ((pre-ident (sway-output-identifier out)) + (ident (if (symbol? pre-ident) + (symbol->string pre-ident) + (string-append "\"" pre-ident "\""))) + (bg (sway-output-bg out)) + (resolution (sway-output-resolution out)) + (position (sway-output-position out)) + (extra-content (sway-output-extra-content out))) + (append + (filter + (lambda (elt) (not (eq? elt %unset-value))) + (list + ;; Beginning of the block. + #~(string-append "output " #$ident " {") + ;; Optional elements. + (if (eq? %unset-value bg) + %unset-value + #~(string-append " bg " #$bg " fill")) + (if (eq? %unset-value resolution) + %unset-value + (string-append " resolution " resolution)) + (if (eq? %unset-value position) + %unset-value + (string-append " position " (number->string (point-x position)) + " " (number->string (point-y position)))))) + extra-content + ;; End of the block. + '("}")))) + +(define-inlinable (add-line-if prefix value) + (if (eq? %unset-value value) + %unset-value + (string-append prefix " " value))) + +(define (serialize-input input) + (let* ((pre-ident (sway-input-identifier input)) + (ident (if (symbol? pre-ident) + (symbol->string pre-ident) + (string-append "\"" pre-ident "\""))) + (xkb-layout (sway-input-xkb-layout input)) + (xkb-model (sway-input-xkb-model input)) + (xkb-variant (sway-input-xkb-variant input)) + (xkb-options (sway-input-xkb-options input))) + (append + (filter + (lambda (elt) (not (eq? elt %unset-value))) + (list + (string-append "input " ident " {") + ;; Optional. + (add-line-if " xkb_layout" xkb-layout) + (add-line-if " xkb_model" xkb-model) + (add-line-if " xkb_variant" xkb-variant) + (if (eq? %unset-value xkb-options) + %unset-value + (string-concatenate (cons " xkb_options " xkb-options))))) + (map (lambda (s) + (string-append (string-pad "" 4) s)) + (sway-input-extra-content input)) + '("}")))) + +(define (serialize-colors colors) + (define (add-border-color-if name val) + (if (eq? %unset-value val) + %unset-value + (string-append + name + " " (sway-border-color-border val) + " " (sway-border-color-background val) + " " (sway-border-color-text val)))) + (let ((background (sway-color-background colors)) + (statusline (sway-color-statusline colors)) + (focused-background (sway-color-focused-background colors)) + (focused-statusline (sway-color-focused-statusline colors)) + (focused-workspace (sway-color-focused-workspace colors)) + (active-workspace (sway-color-active-workspace colors)) + (inactive-workspace (sway-color-inactive-workspace colors)) + (urgent-workspace (sway-color-urgent-workspace colors)) + (binding-mode (sway-color-binding-mode colors))) + (filter + (lambda (elt) (not (eq? elt %unset-value))) + (list + (add-line-if "background" background) + (add-line-if "statusline" statusline) + (add-line-if "focused_background" focused-background) + (add-line-if "focused_statusline" focused-statusline) + (add-border-color-if "focused_workspace" focused-workspace) + (add-border-color-if "active_workspace" active-workspace) + (add-border-color-if "inactive_workspace" inactive-workspace) + (add-border-color-if "urgent_workspace" urgent-workspace) + (add-border-color-if "binding_mode" binding-mode))))) + +(define (make-sway-config conf) + (let* ((extra (sway-configuration-extra-content conf)) + (bar (sway-configuration-bar conf))) + + (with-imported-modules + (source-module-closure + '((ice-9 popen) (ice-9 match) (ice-9 format) (guix monads))) + (computed-file + "sway-config" + #~(begin + (use-modules (ice-9 format) (ice-9 popen) (ice-9 match) + (guix monads)) + ;; Helper functions to pretty-print the configuration file. + (define (line s) + (lambda (port) + (lambda (i) + (format port "~a~a~%" (string-pad "" i) s) + (values port i)))) + (define (lines lst) + (lambda (port) + (lambda (i) + (let loop ((l lst)) + (match l + (() #t) + ((head . tail) + (format port "~a~a~%" (string-pad "" i) + (if (list? head) + (string-concatenate head) + head)) + (loop tail)))) + (values port i)))) + (define-syntax line* + (syntax-rules () + ((line* elt ...) + (lines (list elt ...))))) + (define-syntax line2 + (syntax-rules () + ((line2 a b) + (line (string-append a b))))) + (define (indent k) + (lambda (port) + (lambda (i) + (values port (+ i k))))) + (define (begin-block name) + (lambda (port) + (lambda (i) + (format port "~a~a {~%" (string-pad "" i) name) + (values port (+ i 4))))) + (define (end-block) + (lambda (port) + (lambda (i) + (let ((i (- i 4))) + (format port "~a}~%" (string-pad "" i)) + (values port i))))) + + (let* ((file #$output) + (port (open-output-file #$output))) + ;; The previous iteration of this work computed the content of the + ;; configuration file as a string. The state monad was used to + ;; keep track of the state during the computation. + ;; However, this first approach was too expensive. Now that I use + ;; `computed-file', the "computed value" is the constant port to + ;; which I write. Thus, using the state monad is overkill here. + ;; It can be replaced by the identity monad, where the value being + ;; passed around is the pair of `port' and the indentation level. + (run-with-state + (with-monad + %state-monad + (>>= (return port) + ;; Header of the configuration file. + (line* + "#####################################" + "### Auto-generated configuration. ###" + "#####################################" + "# DO NOT EDIT MANUALLY." "") + (line* + "# Variables." + "# ==========" + #$@(map serialize-variable + (sway-configuration-variables conf)) "") + (line* + "# Outputs." + "# ========" + #$@(flatten + (map serialize-output + (sway-configuration-outputs conf))) "") + (line* + "# Inputs." + "# =======" + #$@(flatten + (map serialize-input + (sway-configuration-inputs conf))) "") + (line* "# Bar configuration." + "# ==================") + (begin-block + (string-append + "bar " #$(symbol->string + (sway-bar-identifier bar)))) + (line2 "position " #$(symbol->string + (sway-bar-position bar))) + (line2 "hidden_state " + #$(symbol->string + (sway-bar-hidden-state bar))) + (line2 "status_command " + #$(sway-bar-status-command bar)) + (line2 "binding_mode_indicator " + #$(if (sway-bar-binding-mode-indicator bar) + "true" "false")) + (begin-block "colors") + (line* + #$@(serialize-colors (sway-bar-colors bar))) + (end-block) ;; colors + (end-block) ;; bar + (line* + "" "# Extra configuration content." + "# ============================" + #$@extra "") + (line* + "# Keybindings." + "# ============" + #$@(map serialize-keybinding + (sway-configuration-keybindings conf)) + "") + (line* + "# Gestures." + "# =========" + #$@(map serialize-gesture + (sway-configuration-gestures conf)) "") + (line* + "# Programs to execute." + "# ====================" + #$@(map serialize-exec + (sway-configuration-execs conf))))) + 0))))))) + +(define (sway-configuration->file sway-conf) + `((".config/sway/config" + ,(make-sway-config + sway-conf)))) + +(define home-sway-service-type + (service-type + (name 'home-sway-config) + (extensions + (list (service-extension home-files-service-type + sway-configuration->file) + (service-extension home-profile-service-type + sway-configuration-packages))) + (description "Configure Sway by providing a file +@file{~/.config/sway/config}.") + (default-value (sway-configuration)))) base-commit: d3832de763777759eb1f56e20731cb39da4c7b5b -- 2.45.2 ------------=_1728738782-22901-1--