Package: guix-patches;
Reported by: Carmine Margiotta <email <at> cmargiotta.net>
Date: Sat, 29 Mar 2025 06:22:01 UTC
Severity: normal
Tags: patch
Done: Carmine Margiotta <email <at> cmargiotta.net>
To reply to this bug, email your comments to 77351 AT debbugs.gnu.org.
There is no need to reopen the bug first.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#77351; Package guix-patches.
(Sat, 29 Mar 2025 06:22:01 GMT) Full text and rfc822 format available.Carmine Margiotta <email <at> cmargiotta.net>:guix-patches <at> gnu.org.
(Sat, 29 Mar 2025 06:22:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Carmine Margiotta <email <at> cmargiotta.net> To: guix-patches <at> gnu.org Cc: Carmine Margiotta <email <at> cmargiotta.net> Subject: [PATCH] home: services: define hyprland home service Date: Sat, 29 Mar 2025 00:25:02 +0100
---
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 <email <at> cmargiotta.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services 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
Carmine Margiotta <email <at> cmargiotta.net>:Carmine Margiotta <email <at> cmargiotta.net>:Message #10 received at 77351-done <at> debbugs.gnu.org (full text, mbox):
From: Carmine Margiotta <email <at> cmargiotta.net> To: 77351-done <at> debbugs.gnu.org Cc: Carmine Margiotta <email <at> cmargiotta.net> Subject: Re: [PATCH] home: services: define hyprland home service Date: Sun, 30 Mar 2025 21:20:27 +0200
> ---
> 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 <email <at> cmargiotta.net>
> +;;;
> +;;; This file is part of GNU Guix.
> +;;;
> +;;; GNU Guix is free software; you can redistribute it and/or modify it
> +;;; under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation; either version 3 of the License, or (at
> +;;; your option) any later version.
> +;;;
> +;;; GNU Guix is distributed in the hope that it will be useful, but
> +;;; WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (gnu home services 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.