diff --git a/doc/guix.texi b/doc/guix.texi index 4ab404dcdb2..622a4e76f06 100644 --- a/doc/guix.texi +++ b/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 -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 diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm index eebc65766ea..4e521091900 100644 --- a/gnu/home/services/sway.scm +++ b/gnu/home/services/sway.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2024 Arnaud Daby-Seesaram +;;; Copyright © 2024, 2025 Arnaud Daby-Seesaram ;;; ;;; 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