amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

home: services: Support options for bindings in sway-service-type.

Browse source 
* gnu/home/services/sway.scm (make-alist-predicate): Add an optional argument.
  (bindings?): Remove procedure.
  (keybinding-options?): New procedures.
  (codebinding-options?): New procedures.
  (gesture-options?): New procedures.
  (mouse-bindings?): Allow to pass options to mouse-bindings.
  (sway-configuration) [keybindings]: Allow to pass options to key-bindings.
  [gestures]: Allow to pass options to gesture-bindings.
  (sway-mode) [keybindings]: Allow to pass options to key-bindings.
  (serialize-binding): Support options.
  (serialize-mouse-binding): Support options.
  (serialize-keybinding): Support options.
  (serialize-gesture): Support options.
  (serialize-variable): Inline previous definition.
* doc/guix.texi (Sway window manager): Document this.

Change-Id: Icf210aca4a9b44adc0baead7430637f6fcda17e5
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Arnaud Daby-Seesaram 2025-09-08 15:13:22 +02:00 • committed by Ludovic Courtès
parent b05fc57386
commit 0b0f8702ea
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 82 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

84
gnu/home/services/sway.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@nanein.fr>
;;; Copyright © 2024, 2025 Arnaud Daby-Seesaram <ds-ac@nanein.fr>
;;;
;;; This file is part of GNU Guix.
;;;
@ -98,22 +98,54 @@
(define (extra-content? extra)
(every string-or-gexp? extra))
(define (make-alist-predicate key? val?)
(define* (make-alist-predicate key? val? #:optional (options? (lambda _ #f)))
(lambda (lst)
(every
(lambda (item)
(match item
((k v . o)
(and (key? k)
(val? v)
(options? o)))
((k . v)
(and (key? k)
(val? v)))
(_ #f)))
lst)))
(define bindings?
(make-alist-predicate symbol? string-or-gexp?))
(define (keybinding-options? lst)
(every
(lambda (e)
(or (member e
'("no-warn" "whole-window" "border" "exclude-titlebar"
"release" "locked" "inhibited" "no-repeat"))
(string-prefix? "input-device=" e)))
lst))
(define (codebinding-options? lst)
(every
(lambda (e)
(or (member e
'("no-warn" "whole-window" "border" "exclude-titlebar"
"release" "locked" "to-code" "inhibited" "no-repeat"))
(string-prefix? "input-device=" e)))
lst))
(define (gesture-options? lst)
(every
(lambda (e)
(or (member e '("exact" "no-warn"))
(string-prefix? "input-device=" e)))
lst))
(define key-bindings?
(make-alist-predicate symbol? string-or-gexp? keybinding-options?))
(define gestures?
(make-alist-predicate symbol? string-or-gexp? gesture-options?))
(define mouse-bindings?
(make-alist-predicate integer? string-or-gexp?))
(make-alist-predicate integer? string-or-gexp? codebinding-options?))
(define (variables? lst)
(make-alist-predicate symbol? string-ish?))
@ -266,7 +298,7 @@
(string "default")
"Name of the mode.")
(keybindings
(bindings '())
(key-bindings '())
"Keybindings.")
(mouse-bindings
(mouse-bindings '())
@ -277,10 +309,10 @@
(define-configuration/no-serialization sway-configuration
(keybindings
(bindings %sway-default-keybindings)
(key-bindings %sway-default-keybindings)
"Keybindings.")
(gestures
(bindings %sway-default-gestures)
(gestures %sway-default-gestures)
"Gestures.")
(packages
(list-of-packages
@ -554,29 +586,37 @@
(define-inlinable (serialize-boolean-ed b)
(if b "enable" "disable"))
(define-inlinable (serialize-binding binder key value)
#~(string-append #$binder #$key " " #$value))
(define-inlinable (serialize-binding binder key value options)
#~(string-append
#$binder
#$(string-join options " --" 'prefix) " "
#$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)))
(match var
((ev command . options)
(serialize-binding "bindcode" (number->string ev) command options))
((ev . command)
(serialize-binding "bindcode" (number->string ev) command '()))))
(define (serialize-keybinding var)
(let ((name (symbol->string (car var)))
(value (cdr var)))
(serialize-binding "bindsym " name value)))
(match var
((name value . options)
(serialize-binding "bindsym" (symbol->string name) value options))
((name . value)
(serialize-binding "bindsym" (symbol->string name) value '()))))
(define (serialize-gesture var)
(let ((name (symbol->string (car var)))
(value (cdr var)))
(serialize-binding "bindgesture " name value)))
(match var
((name value . options)
(serialize-binding "bindgesture" (symbol->string name) value options))
((name . value)
(serialize-binding "bindgesture" (symbol->string name) value '()))))
(define (serialize-variable var)
(let ((name (symbol->string (car var)))
(value (cdr var)))
(serialize-binding "set $" name value)))
#~(string-append "set $" #$name " " #$value)))
(define (serialize-exec b)
(if b
@ -743,7 +783,7 @@
(computed-file
"sway-config"
#~(begin
(use-modules (ice-9 format) (ice-9 match)
(use-modules (ice-9 format) (ice-9 match)
(srfi srfi-1))
(call-with-output-file #$output