2 files changed, 82 insertions(+), 31 deletions(-)

M doc/guix.texi
M gnu/home/services/sway.scm

@@ 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
-or G-expressions.
+is an association list in which keys are symbols.  Values can either be:
+@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:
-keys are symbols and values are either strings or G-expressions, as
-above.
+This field describes keybindings.  The value is an association list.  As
+above, keys are symbols and values are either strings, G-expressions or
+cons-cells.
 
 @item @code{mouse-bindings} (default: @code{'()})
 Ditto, but keys are mouse events (integers).  Constants

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