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

* 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>

doc/guix.texi

@@ -52541,25 +52541,35 @@ to them.
 
 @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
+is an association list in which keys are symbols.  Values can either be:
-or G-expressions.
+@itemize
+@item
+strings or G-expressions,
+@item
+a cons-cell of a string or G-expression and a list of options.  Options
+must be a string starting with ``input-device='' or strings among
+``no-warn'', ``whole-window'', ``border'', ``exclude-titlebar'',
+``release'', ``locked'', ``to-code'', ``inhibited'' and ``no-repeat''.
+@end itemize
 
 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"))
+  ($mod+Shift+t . "exec $term")
+  ($mod+q "exec $term" . ("to-code"))) ;; passes the --to-code option.
 @end lisp
 
 @item @code{gestures} (default: @code{%sway-default-gestures})
-Similar to the previous field, but for finger-gestures.
+Similar to the previous field, but for finger-gestures.  Options must
+start with ``input-device='' or be among ``exact'' and ``no-warn''.
 
 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"))
+  (swipe:3:left    "workspace prev_on_output" . ("exact")))
 @end lisp
 
 @item @code{packages} (default: @code{%sway-default-packages})
@@ -52805,7 +52815,8 @@ an executable file:
 
 @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.
+mouse events.  Values are similar to that of key-bindings (except that
+``to-code'' is not a valid option for mouse-bindings).
 
 The module @code{(gnu home services sway)} exports constants
 @code{%ev-code-mouse-left}, @code{%ev-code-mouse-right} and
@@ -52841,9 +52852,9 @@ snippet defines the resize mode of the default Sway configuration:
 Name of the mode.  This field accepts strings.
 
 @item  @code{keybindings} (default: @code{'()})
-This field describes keybindings.  The value is an association list:
+This field describes keybindings.  The value is an association list.  As
-keys are symbols and values are either strings or G-expressions, as
+above, keys are symbols and values are either strings, G-expressions or
-above.
+cons-cells.
 
 @item @code{mouse-bindings} (default: @code{'()})
 Ditto, but keys are mouse events (integers).  Constants

gnu/home/services/sway.scm

@@ -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?
+(define (keybinding-options? lst)
-  (make-alist-predicate symbol? string-or-gexp?))
+  (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)
+(define-inlinable (serialize-binding binder key value options)
-  #~(string-append #$binder #$key " " #$value))
+  #~(string-append
+     #$binder
+     #$(string-join options " --" 'prefix) " "
+     #$key " " #$value))
 
 (define (serialize-mouse-binding var)
-  (let* ((ev (car var))
+  (match var
-         (ev-code (number->string ev))
+    ((ev command . options)
-         (command (cdr var)))
+     (serialize-binding "bindcode" (number->string ev) command options))
-    (serialize-binding "bindcode " ev-code command)))
+    ((ev . command)
+     (serialize-binding "bindcode" (number->string ev) command '()))))
 
 (define (serialize-keybinding var)
-  (let ((name (symbol->string (car var)))
+  (match var
-        (value (cdr var)))
+    ((name value . options)
-    (serialize-binding "bindsym " name value)))
+     (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)))
+  (match var
-        (value (cdr var)))
+    ((name value . options)
-    (serialize-binding "bindgesture " name value)))
+     (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