From debbugs-submit-bounces@debbugs.gnu.org Sat Mar 29 02:21:06 2025 Received: (at submit) by debbugs.gnu.org; 29 Mar 2025 06:21:06 +0000 Received: from localhost ([127.0.0.1]:56428 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tyPZ0-0003Gp-P9 for submit@debbugs.gnu.org; Sat, 29 Mar 2025 02:21:06 -0400 Received: from lists.gnu.org ([2001:470:142::17]:54304) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tyJ5B-0000pu-R8 for submit@debbugs.gnu.org; Fri, 28 Mar 2025 19:25:51 -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 1tyJ55-0007Zk-Ef for guix-patches@gnu.org; Fri, 28 Mar 2025 19:25:43 -0400 Received: from out-02.smtp.spacemail.com ([63.250.43.87]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tyJ52-0007j8-0C for guix-patches@gnu.org; Fri, 28 Mar 2025 19:25:43 -0400 Received: from prod-lbout-phx.jellyfish.systems (unknown [198.177.122.3]) by smtp.spacemail.com (Postfix) with ESMTPA id 4ZPc864ZvpzGp4Y; Fri, 28 Mar 2025 23:25:26 +0000 (UTC) Received: from localhost.localdomain (unknown [81.56.0.160]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by mail.spacemail.com (Postfix) with ESMTPSA id 4ZPc855R5sz6tkM; Fri, 28 Mar 2025 23:25:25 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=cmargiotta.net; s=spacemail; t=1743204326; bh=tpeaw1Uwu8LGBNfJB7f8ZOIfg9UCpASUWmI/MzQKsm4=; h=From:To:Cc:Subject:Date:From; b=IJAIvInV1XxLbnlRyoyzszPAj4UsDbi55ZFnzYZbfiDNOLS/WlNXhm48VQ1qc9T59 wCleqHJ4WxnJgc4ymr1mUkBqfQyWmLM4JJw+KPRAqUtfP52ddPcjB9zwWoI4eCuJVO iCizGnQIWdJwQvApTgHP8RAPRVGOhKQLL4qc6Rzgd/Xalhjo/FvIcpk0ySr75nqVD1 omJOLnCF6vraSyKD294wjKjlNOPFhc/ILcivqNTlsPOMVGOaZ7oYc2cZmmmoPVHz9w cL1jrV66sjdwNerI0Vdc79l2bP4nvzbYejDCFZjF2YVgdVo3pJlveQOQ1cHMD3jVgW 9rnBprsUFKKEQ== From: Carmine Margiotta To: guix-patches@gnu.org Subject: [PATCH] home: services: define hyprland home service Date: Sat, 29 Mar 2025 00:25:02 +0100 Message-ID: <20250328232510.32282-1-email@cmargiotta.net> X-Mailer: git-send-email 2.49.0 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=63.250.43.87; envelope-from=email@cmargiotta.net; helo=out-02.smtp.spacemail.com 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, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_VALIDITY_CERTIFIED_BLOCKED=0.001, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: 1.0 (+) X-Debbugs-Envelope-To: submit X-Mailman-Approved-At: Sat, 29 Mar 2025 02:21:01 -0400 Cc: Carmine Margiotta 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: -0.0 (/) --- gnu/home/services/hyprland.scm | 490 +++++++++++++++++++++++++++++++++ 1 file changed, 490 insertions(+) create mode 100644 gnu/home/services/hyprland.scm diff --git a/gnu/home/services/hyprland.scm b/gnu/home/services/hyprland.scm new file mode 100644 index 0000000000..f024f272d7 --- /dev/null +++ b/gnu/home/services/hyprland.scm @@ -0,0 +1,490 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Carmine Margiotta +;;; +;;; 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 hyprland) + #:use-module (gnu packages wm) + #:use-module (guix gexp) + #:use-module (gnu services configuration) + #:use-module (gnu home services) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + + #:export (hyprland-extension hyprland-configuration binding block monitor + home-hyprland-service-type)) + +;;; Commentary: +;;; +;;; A Guix Home service to configure Hyprland, an highly customizabile dynamic tiling Wayland compositor +;;; +;;; Code: + +;;; +;;; Helper functions. +;;; + +;; Repeat v n times +(define (repeat v n) + (if (eq? n 0) + '() + `(,v ,@(repeat v + (- n 1))))) + +;; Generate an indenter string of n tabs +(define (indent tabs) + (if (<= tabs 0) "" + (apply string-append + (repeat "\t" tabs)))) + +(define (flatten lst) + (let loop + ((lst lst) + (acc '())) + (cond + ((null? lst) + acc) + ((pair? lst) + (loop (car lst) + (loop (cdr lst) acc))) + (else (cons lst acc))))) + +;;; +;;; Definition of configurations. +;;; + +;; Entry inside a 'block' configuration +;; allowed formats: (symbol string) (symbol number) (symbol boolean) (symbol block-entries) +;; A block entry can contain a list of block entries, effectively allowing nested blocks +(define (block-entry? data) + (or (null? data) + (match data + (((? symbol?) + (or (? string?) + (? number?) + (? boolean?) + (? block-entries?))) + #t)))) + +;; List of block entries +(define (block-entries? data) + (every block-entry? data)) + +;; An executable (a target for the exec action) can be a string or a gexp +(define (executable? value) + (or (string? value) + (gexp? value))) + +;; A list of valid executables +(define (executable-list? values) + (every executable? values)) + +;; Block sub-configuration (a container of block entries) +(define-configuration block + (entries (block-entries '()) "Block entries" + (serializer (lambda (name value) + (serialize-block-entries name value 1))))) + +;; Monitor sub-configuration +(define-configuration monitor + (name (string "") "Monitor's name" + (serializer (lambda (_ n) + (string-append "monitor = " n ", ")))) + (resolution (string "preferred") "Monitor's resolution" + (serializer (lambda (_ n) + (string-append n ", ")))) + (position (string "auto") "Monitor's position" + (serializer (lambda (_ n) + (string-append n ", ")))) + (scale (string "1") "Monitor's scale" + (serializer (lambda (_ n) + n))) + (transform (string "") "Monitor's scale" + (serializer (lambda (_ n) + (if (string-null? n) "\n" + (string-append ", transform, " n "\n")))))) + +;; List of monitors definition +(define (monitors? arg) + (every monitor? arg)) + +;; List of strings +(define (string-list? arg) + (every string? arg)) + +;; Binding sub-configuration +(define-configuration binding + (flags (string "") + "Bind flags (https://wiki.hyprland.org/Configuring/Binds/)" + (serializer (lambda (_ n) + (string-append "bind" n " = ")))) + (mod (string "$mod") "Mod key" + (serializer (lambda (_ n) + n))) + (shift? (boolean #f) "If mod is shifted" + (serializer (lambda (_ n) + (string-append (if n " SHIFT" "") ", ")))) + (key (string) "Binding main key" + (serializer (lambda (_ n) + (string-append n ", ")))) + (action (string "exec") "Binding action" + (serializer (lambda (_ n) + n))) + (args (executable "") "Binding action's args" + (serializer (lambda (name value) + (if (string? value) + (if (string-null? value) "\n" + (string-append ", " value "\n")) + #~(string-append ", " + #$(serialize-executable name value) + "\n")))))) + +;; List of bindings +(define (binding-list? value) + (every binding? value)) + +;; Optional string +(define-maybe/no-serialization string) + +;; Binding block sub-configuration +(define-configuration bindings + (main-mod (maybe-string "") "Main mod bound to $mod" + (serializer (lambda (_ n) + (string-append "\n$mod = " n "\n\n")))) + (binds (binding-list '()) "Bindings" + (serializer (lambda (_ n) + #~(string-append #$@(map (lambda (b) + (serialize-configuration b + binding-fields)) n)))))) + +;;; +;;; Serialization functions. +;;; + +(define (serialize-block name block) + #~(string-append #$(symbol->string name) " {\n" + #$(if (null? block) "" + (serialize-configuration block block-fields)) "\n}\n")) + +;; A block entry will be serialized as an indented hyprlang +;; statement, nested blocks are allowed +(define (serialize-block-entry value tabs) + (string-append (or (match value + (() "") + (((? symbol? name) + value) + (string-append (indent tabs) + (symbol->string name) + (match value + ((? string? v) + (string-append " = " v)) + ((? number? v) + (string-append " = " + (number->string v))) + ((? boolean? v) + (if v " = true" " = false")) + ((? block-entries? v) + (string-append " {\n" + (serialize-block-entries + #f v + (+ tabs 1)) + (indent tabs) "}"))) + "\n")) + ((_) + #f)) "\n"))) + +;; String lists will be serialized as name = value\n +(define (serialize-string-list name values) + (apply string-append + (map (lambda (w) + (string-append (symbol->string name) " = " w "\n")) values))) + +;; Gexp executables will be serialized on a program-file +(define (serialize-executable name value) + (if (string? value) value + (program-file (symbol->string name) value + #:module-path %load-path))) + +;; Lists serializers +(define (serialize-block-entries _ entries level) + (apply string-append + (map (lambda (e) + (serialize-block-entry e level)) entries))) + +(define (serialize-monitors _ monitors) + #~(string-append #$@(map (lambda (m) + (serialize-configuration m monitor-fields)) + monitors))) + +(define (serialize-executable-list name values) + #~(apply string-append + (map (lambda (w) + (string-append #$(symbol->string name) " = " w "\n")) + '#$(map (lambda (v) + (serialize-executable name v)) values)))) + +;; Hyprland full configuration +(define-configuration hyprland-configuration + (package + (package + hyprland) "Hyprland package to use" + (serializer (λ (_ n) ""))) + (monitors (monitors (list (monitor))) "Monitors definition") + (exec-once (executable-list '()) "Command to exec once") + (exec (executable-list '()) "Command to automatically exec") + (general (block (block)) "General configuration variables") + (decoration (block (block)) "Decoration configuration variables") + (animations (block (block)) "Animation configuration variables") + (workspace (string-list '()) "Workspaces settings") + (windowrule (string-list '()) "Window rules (v2)") + (dwindle (block (block)) "Dwindle layout settings") + (master (block (block)) "Master layout settings") + (misc (block (block)) "Misc settings") + (input (block (block)) "Input settings") + (gestures (block (block)) "Gestures settings") + (bindings (bindings (bindings)) "Bindings configuration" + (serializer (λ (_ n) + (serialize-configuration n bindings-fields)))) + (extra-config (string "") "Extra config" + (serializer (λ (_ n) + (string-append n "\n"))))) + +;; Hyprland configuration extension for other services +;; External services can add new exec entries or new bindings +(define-configuration hyprland-extension + (exec-once (executable-list '()) + "Commands to be executed with hyprland once") + (exec (executable-list '()) "Commands to be executed with hyprland") + (bindings (binding-list '()) "Extra binds") + (no-serialization)) + +;;; +;;; Default settings and useful constants. +;;; +(define-public %default-hyprland-general + (block (entries '((gaps_in 5) + (gaps_out 20) + (border_size 2) + (col.active_border "rgba(33ccffee) rgba(00ff99ee) 45deg") + (col.inactive_border "rgba(595959aa)") + (resize_on_border #f) + (allow_tearing #f) + (layout "dwindle"))))) + +(define-public %default-hyprland-decoration + (block (entries '((rounding 10) + (rounding_power 2) + (active_opacity 1.0) + (inactive_opacity 0.9) + (dim_inactive #t) + (dim_strength 0.05) + + (shadow ((enabled #t) + (range 4) + (render_power 3) + (color "rgba(1a1a1aee)"))) + (blur ((enabled #t) + (size 3) + (passes 1) + (vibrancy 0.1696))))))) + +(define-public %default-hyprland-animations + (block (entries '((enabled #t) + (bezier "easeOutQuint,0.23,1,0.32,1") + (bezier "easeInOutCubic,0.65,0.05,0.36,1") + (bezier "linear,0,0,1,1") + (bezier "almostLinear,0.5,0.5,0.75,1.0") + (bezier "quick,0.15,0,0.1,1") + + (animation "global, 1, 10, default") + (animation "border, 1, 5.39, easeOutQuint") + (animation "windows, 1, 4.79, easeOutQuint") + (animation "windowsIn, 1, 4.1, easeOutQuint, popin 87%") + (animation "windowsOut, 1, 1.49, linear, popin 87%") + (animation "fadeIn, 1, 1.73, almostLinear") + (animation "fadeOut, 1, 1.46, almostLinear") + (animation "fade, 1, 3.03, quick") + (animation "layers, 1, 3.81, easeOutQuint") + (animation "layersIn, 1, 4, easeOutQuint, fade") + (animation "layersOut, 1, 1.5, linear, fade") + (animation "fadeLayersIn, 1, 1.79, almostLinear") + (animation "fadeLayersOut, 1, 1.39, almostLinear") + (animation "workspaces, 1, 1.94, almostLinear, fade") + (animation "workspacesIn, 1, 1.21, almostLinear, fade") + (animation "workspacesOut, 1, 1.94, almostLinear, fade"))))) + +(define-public %default-hyprland-workspace + '("w[tv1], gapsout:0, gapsin:0" "f[1], gapsout:0, gapsin:0")) + +(define-public %default-hyprland-windowrule + '("bordersize 0, floating:0, onworkspace:w[tv1]" + "rounding 0, floating:0, onworkspace:w[tv1]" + "bordersize 0, floating:0, onworkspace:f[1]" + "rounding 0, floating:0, onworkspace:f[1]")) + +(define-public %default-hyprland-misc + (block (entries '((force_default_wallpaper -1) + (disable_hyprland_logo #f) + (enable_swallow #t) + (vrr 2))))) + +(define-public %default-hyprland-gestures + (block (entries '((workspace_swipe #t))))) + +(define-public %default-hyprland-bindings + (bindings (main-mod "SUPER") + (binds `(,(binding (key "Q") + (action "killactive")) ,(binding (shift? #t) + (key "F") + (action + "togglefloating")) + ,(binding (key "F") + (action "fullscreen")) + ,(binding (shift? #t) + (key "R") + (action "exec") + (args "hyprctl reload")) + ;; Dwindle layout + ,(binding (key "P") + (action "pseudo")) + ,(binding (key "J") + (action "togglesplit")) + ;; Move focus with arrow keys + ,(binding (key "left") + (action "movefocus") + (args "l")) + ,(binding (key "right") + (action "movefocus") + (args "r")) + ,(binding (key "up") + (action "movefocus") + (args "u")) + ,(binding (key "down") + (action "movefocus") + (args "d")) + ;; Switch workspaces + ,@(map (lambda (index) + (binding (key (number->string index)) + (action "workspace") + (args (number->string index)))) + (iota 10)) + ;; Move active window to workspace + ,@(map (lambda (index) + (binding (shift? #t) + (key (number->string index)) + (action "movetoworkspace") + (args (number->string index)))) + (iota 10)) + ;; Move/resize with mouse + ,(binding (flags "m") + (key "mouse:272") + (action "movewindow")) + ,(binding (flags "m") + (key "mouse:273") + (action "resizewindow")) + ,(binding (key "R") + (action "submap") + (args "resize")))))) + +(define-public %hyprland-resize-submap + "submap = resize +binde = ,right, resizeactive, 10 0 +binde = ,left, resizeactive, -10 0 +binde = ,up, resizeactive, 0 -10 +binde = ,down, resizeactive, 0 10 +bind = ,escape, submap, reset +submap = reset +") + +(define-public %default-hyprland-configuration + (hyprland-configuration (general %default-hyprland-general) + (decoration %default-hyprland-decoration) + (animations %default-hyprland-animations) + (workspace %default-hyprland-workspace) + (windowrule %default-hyprland-windowrule) + (misc %default-hyprland-misc) + (gestures %default-hyprland-gestures) + (bindings %default-hyprland-bindings) + (extra-config %hyprland-resize-submap))) + +;;; +;;; Useful scripts +;;; + +;; Reload the first instance of hyprland, to +;; automatically load the new configuration +(define (hyprland-reload config) + #~(begin + (display "Reloading hyprland configuration...") + (system* #$(file-append (hyprland-configuration-package config) + "/bin/hyprctl") "--instance" "0" "reload"))) + +;;; +;;; Definition of the Home Service. +;;; + +(define-public home-hyprland-service-type + (service-type (name 'home-hyprland-config) + (description "Configure Sway by providing a file +@file{~/.config/hypr/hyprland.conf}.") + (compose (λ (extensions) + (hyprland-extension (exec-once (flatten (map + hyprland-extension-exec-once + extensions))) + (exec (flatten (map + hyprland-extension-exec + extensions))) + (bindings (flatten (map + hyprland-extension-bindings + extensions)))))) + (extend (λ (config rules) + (hyprland-configuration (inherit config) + (exec-once (append (hyprland-configuration-exec-once + config) + (hyprland-extension-exec-once + rules))) + (exec (append (hyprland-configuration-exec + config) + (hyprland-extension-exec + rules))) + (bindings (bindings (inherit + (hyprland-configuration-bindings + config)) + (binds (append + (bindings-binds + (hyprland-configuration-bindings + config)) + + (hyprland-extension-bindings + rules)))))))) + (extensions (list (service-extension + home-activation-service-type + ;; Trigger hyprctl reload after a new config has been applied + hyprland-reload) + (service-extension home-profile-service-type + (λ (config) + `(,(hyprland-configuration-package + config)))) + (service-extension + home-xdg-configuration-files-service-type + (λ (c) + `(("hypr/hyprland.conf" ,(mixed-text-file + "hyprland-cfg" + (serialize-configuration + c + hyprland-configuration-fields)))))))) + (default-value %default-hyprland-configuration))) -- 2.49.0 From debbugs-submit-bounces@debbugs.gnu.org Sun Mar 30 15:20:43 2025 Received: (at 77351-done) by debbugs.gnu.org; 30 Mar 2025 19:20:43 +0000 Received: from localhost ([127.0.0.1]:38133 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tyyD3-0004L0-Up for submit@debbugs.gnu.org; Sun, 30 Mar 2025 15:20:43 -0400 Received: from out-02.smtp.spacemail.com ([63.250.43.87]:37920) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1tyyCz-0004KX-HD for 77351-done@debbugs.gnu.org; Sun, 30 Mar 2025 15:20:39 -0400 Received: from prod-lbout-phx.jellyfish.systems (unknown [198.177.122.3]) by smtp.spacemail.com (Postfix) with ESMTPA id 4ZQkcZ2WdrzGp60; Sun, 30 Mar 2025 19:20:30 +0000 (UTC) Received: from [192.168.8.194] (unknown [81.56.0.160]) (using TLSv1.3 with cipher TLS_AES_128_GCM_SHA256 (128/128 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by mail.spacemail.com (Postfix) with ESMTPSA id 4ZQkcY3H3Zz8sWP; Sun, 30 Mar 2025 19:20:29 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=cmargiotta.net; s=spacemail; t=1743362430; bh=M9iKjl+VghymoOvfZbhz3Vv/PchDrbiNemL8st97+5w=; h=Date:To:Cc:References:Subject:From:In-Reply-To:From; b=TFGuoqic33yk7p5pZptpK9f6l7gwhT0AsvwlOHxiQXtGjrsH5TVZNqJwNEN6h9K5Y qrOSRD7K9U94QSusyAt38KFWB5NdQeDMkn5SEZuiAzoWnAeu1miRcILU16BEMy8nYF qWzaJc7cKcYM7Wje1/S4v6FeWI7JPDcpOReW9+GWr+rz27LIG8NoTQYXRW9y2Lvzrn 0OYRz1zOccXbCWm5BlWx1fUlYB6/Fc0JuO39o2PV1SQEOsoQ6YDORQAhmoCDa0QF/k 9/33PJnEnD6JZu+FOPjgEFYyWg4VwrwXG5FUMeqBM5IrHx7yp47DzibfzQx1nubHg3 lx5kWGIkZ/RgA== Message-ID: Date: Sun, 30 Mar 2025 21:20:27 +0200 MIME-Version: 1.0 User-Agent: Icedove Daily To: 77351-done@debbugs.gnu.org References: <20250328232510.32282-1-email@cmargiotta.net> Subject: Re: [PATCH] home: services: define hyprland home service Content-Language: en-US From: Carmine Margiotta In-Reply-To: <20250328232510.32282-1-email@cmargiotta.net> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 77351-done Cc: Carmine Margiotta 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/hyprland.scm | 490 +++++++++++++++++++++++++++++++++ > 1 file changed, 490 insertions(+) > create mode 100644 gnu/home/services/hyprland.scm > > diff --git a/gnu/home/services/hyprland.scm b/gnu/home/services/hyprland.scm > new file mode 100644 > index 0000000000..f024f272d7 > --- /dev/null > +++ b/gnu/home/services/hyprland.scm > @@ -0,0 +1,490 @@ > +;;; GNU Guix --- Functional package management for GNU > +;;; Copyright © 2025 Carmine Margiotta > +;;; > +;;; 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 hyprland) > + #:use-module (gnu packages wm) > + #:use-module (guix gexp) > + #:use-module (gnu services configuration) > + #:use-module (gnu home services) > + #:use-module (guix packages) > + #:use-module (ice-9 match) > + #:use-module (srfi srfi-1) > + > + #:export (hyprland-extension hyprland-configuration binding block monitor > + home-hyprland-service-type)) > + > +;;; Commentary: > +;;; > +;;; A Guix Home service to configure Hyprland, an highly customizabile dynamic tiling Wayland compositor > +;;; > +;;; Code: > + > +;;; > +;;; Helper functions. > +;;; > + > +;; Repeat v n times > +(define (repeat v n) > + (if (eq? n 0) > + '() > + `(,v ,@(repeat v > + (- n 1))))) > + > +;; Generate an indenter string of n tabs > +(define (indent tabs) > + (if (<= tabs 0) "" > + (apply string-append > + (repeat "\t" tabs)))) > + > +(define (flatten lst) > + (let loop > + ((lst lst) > + (acc '())) > + (cond > + ((null? lst) > + acc) > + ((pair? lst) > + (loop (car lst) > + (loop (cdr lst) acc))) > + (else (cons lst acc))))) > + > +;;; > +;;; Definition of configurations. > +;;; > + > +;; Entry inside a 'block' configuration > +;; allowed formats: (symbol string) (symbol number) (symbol boolean) (symbol block-entries) > +;; A block entry can contain a list of block entries, effectively allowing nested blocks > +(define (block-entry? data) > + (or (null? data) > + (match data > + (((? symbol?) > + (or (? string?) > + (? number?) > + (? boolean?) > + (? block-entries?))) > + #t)))) > + > +;; List of block entries > +(define (block-entries? data) > + (every block-entry? data)) > + > +;; An executable (a target for the exec action) can be a string or a gexp > +(define (executable? value) > + (or (string? value) > + (gexp? value))) > + > +;; A list of valid executables > +(define (executable-list? values) > + (every executable? values)) > + > +;; Block sub-configuration (a container of block entries) > +(define-configuration block > + (entries (block-entries '()) "Block entries" > + (serializer (lambda (name value) > + (serialize-block-entries name value 1))))) > + > +;; Monitor sub-configuration > +(define-configuration monitor > + (name (string "") "Monitor's name" > + (serializer (lambda (_ n) > + (string-append "monitor = " n ", ")))) > + (resolution (string "preferred") "Monitor's resolution" > + (serializer (lambda (_ n) > + (string-append n ", ")))) > + (position (string "auto") "Monitor's position" > + (serializer (lambda (_ n) > + (string-append n ", ")))) > + (scale (string "1") "Monitor's scale" > + (serializer (lambda (_ n) > + n))) > + (transform (string "") "Monitor's scale" > + (serializer (lambda (_ n) > + (if (string-null? n) "\n" > + (string-append ", transform, " n "\n")))))) > + > +;; List of monitors definition > +(define (monitors? arg) > + (every monitor? arg)) > + > +;; List of strings > +(define (string-list? arg) > + (every string? arg)) > + > +;; Binding sub-configuration > +(define-configuration binding > + (flags (string "") > + "Bind flags (https://wiki.hyprland.org/Configuring/Binds/)" > + (serializer (lambda (_ n) > + (string-append "bind" n " = ")))) > + (mod (string "$mod") "Mod key" > + (serializer (lambda (_ n) > + n))) > + (shift? (boolean #f) "If mod is shifted" > + (serializer (lambda (_ n) > + (string-append (if n " SHIFT" "") ", ")))) > + (key (string) "Binding main key" > + (serializer (lambda (_ n) > + (string-append n ", ")))) > + (action (string "exec") "Binding action" > + (serializer (lambda (_ n) > + n))) > + (args (executable "") "Binding action's args" > + (serializer (lambda (name value) > + (if (string? value) > + (if (string-null? value) "\n" > + (string-append ", " value "\n")) > + #~(string-append ", " > + #$(serialize-executable name value) > + "\n")))))) > + > +;; List of bindings > +(define (binding-list? value) > + (every binding? value)) > + > +;; Optional string > +(define-maybe/no-serialization string) > + > +;; Binding block sub-configuration > +(define-configuration bindings > + (main-mod (maybe-string "") "Main mod bound to $mod" > + (serializer (lambda (_ n) > + (string-append "\n$mod = " n "\n\n")))) > + (binds (binding-list '()) "Bindings" > + (serializer (lambda (_ n) > + #~(string-append #$@(map (lambda (b) > + (serialize-configuration b > + binding-fields)) n)))))) > + > +;;; > +;;; Serialization functions. > +;;; > + > +(define (serialize-block name block) > + #~(string-append #$(symbol->string name) " {\n" > + #$(if (null? block) "" > + (serialize-configuration block block-fields)) "\n}\n")) > + > +;; A block entry will be serialized as an indented hyprlang > +;; statement, nested blocks are allowed > +(define (serialize-block-entry value tabs) > + (string-append (or (match value > + (() "") > + (((? symbol? name) > + value) > + (string-append (indent tabs) > + (symbol->string name) > + (match value > + ((? string? v) > + (string-append " = " v)) > + ((? number? v) > + (string-append " = " > + (number->string v))) > + ((? boolean? v) > + (if v " = true" " = false")) > + ((? block-entries? v) > + (string-append " {\n" > + (serialize-block-entries > + #f v > + (+ tabs 1)) > + (indent tabs) "}"))) > + "\n")) > + ((_) > + #f)) "\n"))) > + > +;; String lists will be serialized as name = value\n > +(define (serialize-string-list name values) > + (apply string-append > + (map (lambda (w) > + (string-append (symbol->string name) " = " w "\n")) values))) > + > +;; Gexp executables will be serialized on a program-file > +(define (serialize-executable name value) > + (if (string? value) value > + (program-file (symbol->string name) value > + #:module-path %load-path))) > + > +;; Lists serializers > +(define (serialize-block-entries _ entries level) > + (apply string-append > + (map (lambda (e) > + (serialize-block-entry e level)) entries))) > + > +(define (serialize-monitors _ monitors) > + #~(string-append #$@(map (lambda (m) > + (serialize-configuration m monitor-fields)) > + monitors))) > + > +(define (serialize-executable-list name values) > + #~(apply string-append > + (map (lambda (w) > + (string-append #$(symbol->string name) " = " w "\n")) > + '#$(map (lambda (v) > + (serialize-executable name v)) values)))) > + > +;; Hyprland full configuration > +(define-configuration hyprland-configuration > + (package > + (package > + hyprland) "Hyprland package to use" > + (serializer (λ (_ n) ""))) > + (monitors (monitors (list (monitor))) "Monitors definition") > + (exec-once (executable-list '()) "Command to exec once") > + (exec (executable-list '()) "Command to automatically exec") > + (general (block (block)) "General configuration variables") > + (decoration (block (block)) "Decoration configuration variables") > + (animations (block (block)) "Animation configuration variables") > + (workspace (string-list '()) "Workspaces settings") > + (windowrule (string-list '()) "Window rules (v2)") > + (dwindle (block (block)) "Dwindle layout settings") > + (master (block (block)) "Master layout settings") > + (misc (block (block)) "Misc settings") > + (input (block (block)) "Input settings") > + (gestures (block (block)) "Gestures settings") > + (bindings (bindings (bindings)) "Bindings configuration" > + (serializer (λ (_ n) > + (serialize-configuration n bindings-fields)))) > + (extra-config (string "") "Extra config" > + (serializer (λ (_ n) > + (string-append n "\n"))))) > + > +;; Hyprland configuration extension for other services > +;; External services can add new exec entries or new bindings > +(define-configuration hyprland-extension > + (exec-once (executable-list '()) > + "Commands to be executed with hyprland once") > + (exec (executable-list '()) "Commands to be executed with hyprland") > + (bindings (binding-list '()) "Extra binds") > + (no-serialization)) > + > +;;; > +;;; Default settings and useful constants. > +;;; > +(define-public %default-hyprland-general > + (block (entries '((gaps_in 5) > + (gaps_out 20) > + (border_size 2) > + (col.active_border "rgba(33ccffee) rgba(00ff99ee) 45deg") > + (col.inactive_border "rgba(595959aa)") > + (resize_on_border #f) > + (allow_tearing #f) > + (layout "dwindle"))))) > + > +(define-public %default-hyprland-decoration > + (block (entries '((rounding 10) > + (rounding_power 2) > + (active_opacity 1.0) > + (inactive_opacity 0.9) > + (dim_inactive #t) > + (dim_strength 0.05) > + > + (shadow ((enabled #t) > + (range 4) > + (render_power 3) > + (color "rgba(1a1a1aee)"))) > + (blur ((enabled #t) > + (size 3) > + (passes 1) > + (vibrancy 0.1696))))))) > + > +(define-public %default-hyprland-animations > + (block (entries '((enabled #t) > + (bezier "easeOutQuint,0.23,1,0.32,1") > + (bezier "easeInOutCubic,0.65,0.05,0.36,1") > + (bezier "linear,0,0,1,1") > + (bezier "almostLinear,0.5,0.5,0.75,1.0") > + (bezier "quick,0.15,0,0.1,1") > + > + (animation "global, 1, 10, default") > + (animation "border, 1, 5.39, easeOutQuint") > + (animation "windows, 1, 4.79, easeOutQuint") > + (animation "windowsIn, 1, 4.1, easeOutQuint, popin 87%") > + (animation "windowsOut, 1, 1.49, linear, popin 87%") > + (animation "fadeIn, 1, 1.73, almostLinear") > + (animation "fadeOut, 1, 1.46, almostLinear") > + (animation "fade, 1, 3.03, quick") > + (animation "layers, 1, 3.81, easeOutQuint") > + (animation "layersIn, 1, 4, easeOutQuint, fade") > + (animation "layersOut, 1, 1.5, linear, fade") > + (animation "fadeLayersIn, 1, 1.79, almostLinear") > + (animation "fadeLayersOut, 1, 1.39, almostLinear") > + (animation "workspaces, 1, 1.94, almostLinear, fade") > + (animation "workspacesIn, 1, 1.21, almostLinear, fade") > + (animation "workspacesOut, 1, 1.94, almostLinear, fade"))))) > + > +(define-public %default-hyprland-workspace > + '("w[tv1], gapsout:0, gapsin:0" "f[1], gapsout:0, gapsin:0")) > + > +(define-public %default-hyprland-windowrule > + '("bordersize 0, floating:0, onworkspace:w[tv1]" > + "rounding 0, floating:0, onworkspace:w[tv1]" > + "bordersize 0, floating:0, onworkspace:f[1]" > + "rounding 0, floating:0, onworkspace:f[1]")) > + > +(define-public %default-hyprland-misc > + (block (entries '((force_default_wallpaper -1) > + (disable_hyprland_logo #f) > + (enable_swallow #t) > + (vrr 2))))) > + > +(define-public %default-hyprland-gestures > + (block (entries '((workspace_swipe #t))))) > + > +(define-public %default-hyprland-bindings > + (bindings (main-mod "SUPER") > + (binds `(,(binding (key "Q") > + (action "killactive")) ,(binding (shift? #t) > + (key "F") > + (action > + "togglefloating")) > + ,(binding (key "F") > + (action "fullscreen")) > + ,(binding (shift? #t) > + (key "R") > + (action "exec") > + (args "hyprctl reload")) > + ;; Dwindle layout > + ,(binding (key "P") > + (action "pseudo")) > + ,(binding (key "J") > + (action "togglesplit")) > + ;; Move focus with arrow keys > + ,(binding (key "left") > + (action "movefocus") > + (args "l")) > + ,(binding (key "right") > + (action "movefocus") > + (args "r")) > + ,(binding (key "up") > + (action "movefocus") > + (args "u")) > + ,(binding (key "down") > + (action "movefocus") > + (args "d")) > + ;; Switch workspaces > + ,@(map (lambda (index) > + (binding (key (number->string index)) > + (action "workspace") > + (args (number->string index)))) > + (iota 10)) > + ;; Move active window to workspace > + ,@(map (lambda (index) > + (binding (shift? #t) > + (key (number->string index)) > + (action "movetoworkspace") > + (args (number->string index)))) > + (iota 10)) > + ;; Move/resize with mouse > + ,(binding (flags "m") > + (key "mouse:272") > + (action "movewindow")) > + ,(binding (flags "m") > + (key "mouse:273") > + (action "resizewindow")) > + ,(binding (key "R") > + (action "submap") > + (args "resize")))))) > + > +(define-public %hyprland-resize-submap > + "submap = resize > +binde = ,right, resizeactive, 10 0 > +binde = ,left, resizeactive, -10 0 > +binde = ,up, resizeactive, 0 -10 > +binde = ,down, resizeactive, 0 10 > +bind = ,escape, submap, reset > +submap = reset > +") > + > +(define-public %default-hyprland-configuration > + (hyprland-configuration (general %default-hyprland-general) > + (decoration %default-hyprland-decoration) > + (animations %default-hyprland-animations) > + (workspace %default-hyprland-workspace) > + (windowrule %default-hyprland-windowrule) > + (misc %default-hyprland-misc) > + (gestures %default-hyprland-gestures) > + (bindings %default-hyprland-bindings) > + (extra-config %hyprland-resize-submap))) > + > +;;; > +;;; Useful scripts > +;;; > + > +;; Reload the first instance of hyprland, to > +;; automatically load the new configuration > +(define (hyprland-reload config) > + #~(begin > + (display "Reloading hyprland configuration...") > + (system* #$(file-append (hyprland-configuration-package config) > + "/bin/hyprctl") "--instance" "0" "reload"))) > + > +;;; > +;;; Definition of the Home Service. > +;;; > + > +(define-public home-hyprland-service-type > + (service-type (name 'home-hyprland-config) > + (description "Configure Sway by providing a file > +@file{~/.config/hypr/hyprland.conf}.") > + (compose (λ (extensions) > + (hyprland-extension (exec-once (flatten (map > + hyprland-extension-exec-once > + extensions))) > + (exec (flatten (map > + hyprland-extension-exec > + extensions))) > + (bindings (flatten (map > + hyprland-extension-bindings > + extensions)))))) > + (extend (λ (config rules) > + (hyprland-configuration (inherit config) > + (exec-once (append (hyprland-configuration-exec-once > + config) > + (hyprland-extension-exec-once > + rules))) > + (exec (append (hyprland-configuration-exec > + config) > + (hyprland-extension-exec > + rules))) > + (bindings (bindings (inherit > + (hyprland-configuration-bindings > + config)) > + (binds (append > + (bindings-binds > + (hyprland-configuration-bindings > + config)) > + > + (hyprland-extension-bindings > + rules)))))))) > + (extensions (list (service-extension > + home-activation-service-type > + ;; Trigger hyprctl reload after a new config has been applied > + hyprland-reload) > + (service-extension home-profile-service-type > + (λ (config) > + `(,(hyprland-configuration-package > + config)))) > + (service-extension > + home-xdg-configuration-files-service-type > + (λ (c) > + `(("hypr/hyprland.conf" ,(mixed-text-file > + "hyprland-cfg" > + (serialize-configuration > + c > + hyprland-configuration-fields)))))))) > + (default-value %default-hyprland-configuration))) > -- > 2.49.0 From unknown Fri Sep 19 16:51:37 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Mon, 28 Apr 2025 11:24:13 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator