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

29
doc/guix.texi
View file

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

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