mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 06:46:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

home: services: Add 'home-sway-service-type'.

Browse source 
* gnu/home/services/sway.scm: New file.
(home-sway-service-type): New variable.
(sway-configuration->file): New procedure.
(sway-configuration): New configuration record.
(sway-bar): New configuration record.
(sway-output): New configuration record.
(sway-input): New configuration record.
(point): New configuration record.
(sway-color): New configuration record.
(sway-border-color): New configuration record.
(sway-mode): New configuration record.
(flatmap): New procedure.
* gnu/local.mk: Add gnu/home/services/sway.scm.
* doc/guix.texi (Sway window manager): New node to document the above
changes.

Signed-off-by: Florian Pelz <pelzflorian@pelzflorian.de>
Change-Id: I880261570c5afdb795f2ce18bac2b9a5c898677f
This commit is contained in:
Arnaud Daby-Seesaram 2024-10-09 00:33:41 +02:00 committed by Florian Pelz
parent b9ec6251be
commit b64f7984a5
No known key found for this signature in database
GPG key ID: 300888CB39C63817
3 changed files with 1277 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

406
doc/guix.texi
View file

@ -130,6 +130,7 @@ Copyright @copyright{} 2024 Richard Sent@*
Copyright @copyright{} 2024 Dariqq@*
Copyright @copyright{} 2024 Denis 'GNUtoo' Carikli@*
Copyright @copyright{} 2024 Fabio Natali@*
Copyright @copyright{} 2024 Arnaud Daby-Seesaram@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -460,6 +461,7 @@ Home Services
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@ -45210,6 +45212,7 @@ services)}.
* Mail: Mail Home Services. Services for managing mail.
* Messaging: Messaging Home Services. Services for managing messaging.
* Media: Media Home Services. Services for managing media.
* Sway: Sway window manager. Setting up the Sway configuration.
* Networking: Networking Home Services. Networking services.
* Miscellaneous: Miscellaneous Home Services. More services.
@end menu
@ -47124,6 +47127,409 @@ kodi} for more information.
@end table
@end deftp
@node Sway window manager
@subsection Sway window manager
@cindex sway, Home Service
@cindex sway, configuration
The @code{(gnu home services sway)} module provides
@code{home-sway-service-type}, a home service to configure the
@uref{https://github.com/swaywm/sway,Sway window manager for Wayland} in
a declarative way.
Here is an example of a service and its configuration that you could add
to the @code{services} field of your @code{home-environment}:
@lisp
(service home-sway-service-type
(sway-configuration
(gestures
'((swipe:3:down . "move to scratchpad")
(swipe:3:up . "scratchpad show")))
(outputs
(list (sway-output
(identifier '*)
(background (file-append sway
"\
/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png")))))))
@end lisp
The above example describes a Sway configuration in which
@itemize
@item
all monitors use a particular wallpaper whose @file{.png} is provided by
the @code{sway} package;
@item
swiping down (resp.@: up) with three fingers moves the active window to
the scratchpad (resp.@: shows/hides the scratchpad).
@end itemize
@quotation Note
This home service only sets up the configuration file and profile
packages for Sway. It does @emph{not} start Sway in any way. If you
want to do so, you might be interested in using
@code{greetd-wlgreet-sway-session} instead.
The proceedure @code{sway-configuration->file} defined below can be used
to provide the value for the @emph{optional} @code{sway-configuration}
field of @code{greetd-wlgreet-sway-session}.
@end quotation
@deffn {Procedure} sway-configuration->file config
This procedure takes one argument @code{config}, which must be a
@code{sway-configuration} record (defined below), and returns a
file-like object representing the serialized configuration.
@end deffn
@defvar home-sway-service-type
This is a home service type to set up Sway. It takes care of:
@itemize
@item
providing a @file{~/.config/sway/config} file,
@item
adding Sway-related packages to your profile.
@end itemize
@end defvar
@deftp {Data Type} sway-configuration
This configuration record describes the Sway configuration
(see@ @cite{sway(5)}). Available fields are:
@table @asis
@item @code{variables} (default: @code{%sway-default-variables})
The value of this field is an association list in which keys are symbols
and values are either strings, G-expressions or file-like objects
(@pxref{G-Expressions}).
Example:
@lisp
(variables `((mod . "Mod4") ; string
(term ; file-append
. ,(file-append foot "/bin/foot"))
(Term ; G-expression
. ,#~(string-append #$foot "/bin/foot"))))
@end lisp
@quotation Note
Default keybindings assume the existence of variables named @code{$mod},
@code{$left}, @code{$right}, @code{$up} and @code{$down}. If you choose
not to define these variables, make sure to remove keybindings referring
to them.
@end quotation
@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.
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"))
@end lisp
@item @code{gestures} (default: @code{%sway-default-gestures})
Similar to the previous field, but for finger-gestures.
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"))
@end lisp
@item @code{packages} (default: @code{%sway-default-packages})
This field describes a list of packages to add to the user profile. At
the moment, the default value only adds @code{sway} to the profile.
@item @code{inputs} (default: @code{'()})
List of @code{sway-input} configuration records (described below).
@item @code{outputs} (default: @code{'()})
List of @code{sway-output} configuration records (described below).
@item @code{bar} (optional @code{sway-bar} record)
Optional @code{sway-bar} record (described below) to configure a Sway
bar.
@item @code{modes} (default: @code{%sway-default-modes})
List of @code{sway-mode} records (described below) to add modes to the
Sway configuration. The default value @code{%sway-default-modes} adds
the ``resize'' mode of the default Sway configuration (as described
below).
@item @code{startup+reload-programs} (default: @code{'()})
Programs to execute at startup time @emph{and} after every configuration
reload. The value of this field is a list of strings, G-expressions or
file-like objects (@pxref{G-Expressions}).
@item @code{startup-programs} (default: @code{%sway-default-execs})
Programs to execute at startup time. As above, values of this field are
a list of strings, G-expressions or file-like objects.
The default value, @code{%sway-default-execs}, executes @code{swayidle}
in order to lock the screen after 5@ minutes of inactivity (displaying a
background distributed with Sway) and turn the screen off after 10@
minutes of inactivity.
@item @code{extra-content} (default: @code{'()})
Lines to add to the configuration file. The value of this field is a
list of strings or G-expressions.
@end table
@end deftp
@deftp {Data Type} sway-input
@code{sway-input} records describe input blocks (see@
@cite{sway-input(5)}). For example, the following snippet makes all
keyboards use a French layout, in which @kbd{capslock} has been remapped
to @kbd{ctrl}:
@lisp
(sway-input (identifier "type:keyboard")
(layout
(keyboard-layout "fr" #:options '("ctrl:nocaps"))))
@end lisp
Available fields for @code{sway-input} configuration records are:
@table @asis
@item @code{identifier} (default: @code{'*})
Identifier of the input. The field accepts symbols and strings. If the
@code{identifier} is a symbol, it is inserted as is; if it is a string,
it will be quoted in the configuration file.
@item @code{layout} (optional @code{<keyboard-layout>} record)
Keyboard specific option. Field specifying the layout to use for the
input. The value must be a @code{<keyboard-layout>} record
(@pxref{Keyboard Layout}).
@quotation Note
@code{(gnu home services sway)} does not re-export the
@code{keyboard-layout} procedure.
@end quotation
@item @code{disable-while-typing} (optional boolean)
If @code{#t} (resp.@: @code{#f}) enables (resp.@: disables) the
``disable while typing'' option for this input.
@item @code{disable-while-trackpointing} (optional boolean)
If @code{#t} (resp.@: @code{#f}), enables (resp.@: disables) the
``disable while track-pointing'' option for this input.
@item @code{tap} (optional boolean)
Enables or disables the ``tap'' option, which allows clicking by tapping
on a touchpad.
@item @code{extra-content} (default: @code{'()})
Lines to add to the input block. The value of this field must a list
whose elements are either strings or G-expressions.
@end table
@end deftp
@deftp {Data Type} sway-output
@code{sway-output} records describe Sway outputs (see@
@cite{sway-output(5)}). Available fields are:
@table @asis
@item @code{identifier} (default: @code{'*})
Identifier of the monitor. The field accepts symbols and strings. If
the @code{identifier} is a symbol, it is inserted as is; if it is a
string, it will be quoted in the configuration file.
@item @code{resolution} (optional string)
This string defines the resolution of the monitor.
@item @code{position} (optional)
The (optional) value of this field must be a @code{point}.
Example:
@lisp
(position
(point (x 1920)
(y 0)))
@end lisp
@item @code{background} (optional)
The value of this field describes what wallpaper to use on this output.
The field accepts the following types of values:
@itemize
@item
a string,
@item
a G-expression,
@item
a file-like object,
@item
a pair. The first argument of this pair must be a string, a
G-expression or a file-like object. The second element describes how
the wallpaper will be displayed. It must be a symbol among
@code{stretch}, @code{fill}, @code{fit}, @code{center} and @code{tile}.
If the second element is not specified (@i{i.e.}@: when the value is not
a pair), the @code{fill} mode will be used.
@end itemize
@quotation Note
In order to use an SVG file, you must have @code{librsvg} in your
profile (@i{e.g.}@: by adding it in the @code{packages} field of
@code{sway-configuration}).
@end quotation
@item @code{extra-content} (default: @code{'()})
List defining additional lines to add to the output configuration block.
Elements of the list must be either strings or G-expressions.
@end table
@end deftp
@deftp {Data Type} sway-border-color
@table @code
@item border
Color of the border.
@item background
Color of the background.
@item text
Color of the text.
@end table
@end deftp
@deftp {Data Type} sway-color
@table @asis
@item @code{background} (optional string)
Background color of the bar.
@item @code{statusline} (optional string)
Text color of the status line.
@item @code{focused-background} (optional string)
Background color of the bar on the currently focused monitor.
@item @code{focused-statusline} (optional string)
Text color of the statusline on the currently focused monitor.
@item @code{focused-workspace} (optional @code{sway-border-color})
Color scheme for focused workspaces.
@item @code{active-workspace} (optional @code{sway-border-color})
Color scheme for active workspaces.
@item @code{inactive-workspace} (optional @code{sway-border-color})
Color scheme for inactive workspaces.
@item @code{urgent-workspace} (optional @code{sway-border-color})
Color scheme for workspaces containing ``urgent windows''.
@item @code{binding-mode} (optional @code{sway-border-color})
Color scheme for the binding mode indicator.
@end table
@end deftp
@deftp {Data Type} sway-bar
Describes the Sway bar (see@ @cite{sway-bar(5)}).
@table @asis
@item @code{identifier} (default: @code{'bar0})
Identifier of the bar. The value must be a symbol.
@item @code{position} (optional)
Specify the position of the bar. Accepted values are @code{'top} or
@code{'bottom}.
@item @code{hidden-state} (optional)
Specify the apparence of the bar when it is hidden. Accepted values are
@code{'hide} or @code{'show}.
@item @code{binding-mode-indicator} (optional)
Boolean enabling or disabling the binding mode indicator.
@item @code{colors} (optional)
An optional @code{sway-color} configuration record.
@item @code{status-command} (optional)
This field accept strings, G-expressions and executable file-like
values. The default value is a command (string) that prints the date
and time every second.
Each line printed on @code{stdout} by this command (or script) will be
displayed on the status area of the bar.
Below are a few examples using:
@itemize
@item
a string: @code{"while date +'%Y-%m-%d %X'; do sleep 1; done"},
@item
a G-exp:
@lisp
#~(string-append "while "
#$coreutils "/bin/date"
" +'%Y-%m-%d %X'; do sleep 1; done")
@end lisp
@item
an executable file:
@lisp
(program-file
"sway-bar-status"
#~(begin
(use-modules (ice-9 format)
(srfi srfi-19))
(let loop ()
(let* ((date (date->string
(current-date)
"~d/~m/~Y (~a) • ~H:~M:~S")))
(format #t "~a~%~!" date)
(sleep 1)
(loop)))))
@end lisp
@end itemize
@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.
The module @code{(gnu home services sway)} exports constants
@code{%ev-code-mouse-left}, @code{%ev-code-mouse-right} and
@code{%ev-code-mouse-scroll-click} whose values are integers
corresponding to left, right and scroll click respectively. For
example, with @code{(mouse-bindings `((,%ev-code-mouse-left . "exec
$term")))}, left clicks in the status bar open the terminal (assuming
that the variable @code{$term} is bound to a terminal).
@end table
@end deftp
@deftp {Data Type} sway-mode
Describes a Sway mode (see@ @cite{sway(5)}). For example, the following
snippet defines the resize mode of the default Sway configuration:
@example
(sway-mode
(mode-name "resize")
(keybindings
'(($left . "resize shrink width 10px")
($right . "resize grow width 10px")
($down . "resize grow height 10px")
($up . "resize shrink height 10px")
(Left . "resize shrink width 10px")
(Right . "resize grow width 10px")
(Down . "resize grow height 10px")
(Up . "resize shrink height 10px")
(Return . "mode \"default\"")
(Escape . "mode \"default\""))))
@end example
@table @asis
@item @code{mode-name} (default: @code{"default"})
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.
@item @code{mouse-bindings} (default: @code{'()})
Ditto, but keys are mouse events (integers). Constants
@code{%ev-code-mouse-*} described above can be used as helpers to define
mouse bindings.
@end table
@end deftp
@node Networking Home Services
@subsection Networking Home Services

870
gnu/home/services/sway.scm Normal file
View file

@ -0,0 +1,870 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Arnaud Daby-Seesaram <ds-ac@nanein.fr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu home services sway)
#:use-module (guix modules)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (guix packages)
#:use-module (gnu system keyboard)
#:use-module (gnu services configuration)
#:use-module (gnu home services)
#:use-module (gnu packages wm)
#:use-module (gnu packages terminals)
#:export (;; Event codes
%ev-code-mouse-left
%ev-code-mouse-right
%ev-code-mouse-scroll-click
;; Configuration records.
sway-configuration
sway-bar
sway-output
sway-input
point
sway-color
sway-border-color
home-sway-service-type
sway-configuration->file
sway-mode
;; Default values.
%sway-default-variables
%sway-default-gestures
%sway-default-modes
%sway-default-keybindings
%sway-default-startup-programs
%sway-default-packages))
;; Helper function.
(define (flatmap f l)
(let loop ((lst (reverse l)) (acc '()))
(match lst
(() acc)
((head . tail)
(let* ((h (f head))
(acc (append h acc)))
(loop tail acc))))))
;;;
;;; Definition of configurations.
;;;
(define (string-ish? s)
(or (gexp? s)
(file-like? s)
(string? s)))
(define (string-or-gexp? s)
(or (gexp? s)
(string? s)))
(define (list-of-string-ish? lst)
(every string-ish? lst))
(define (list-of-packages? lst)
(every package? lst))
(define (bar-position? p)
(member p '(top bottom)))
(define (hidden-state? st)
(member st '(hide show)))
(define (string-or-symbol? s)
(or (string? s)
(symbol? s)))
(define (strings? lst)
(every string? lst))
(define (extra-content? extra)
(every string-or-gexp? extra))
(define (make-alist-predicate key? val?)
(lambda (lst)
(every
(lambda (item)
(match item
((k . v)
(and (key? k)
(val? v)))
(_ #f)))
lst)))
(define bindings?
(make-alist-predicate symbol? string-or-gexp?))
(define mouse-bindings?
(make-alist-predicate integer? string-or-gexp?))
(define (variables? lst)
(make-alist-predicate symbol? string-ish?))
(define-maybe string (no-serialization))
(define-maybe strings (no-serialization))
(define-maybe boolean (no-serialization))
(define-maybe keyboard-layout (no-serialization))
(define-configuration/no-serialization sway-input
(identifier
(string-or-symbol '*)
"Identifier of the input.")
(layout
maybe-keyboard-layout
"Keyboard layout of the input.")
(disable-while-typing
maybe-boolean
"If `#t', disable the input while typing; if `#f' do not.")
(disable-while-trackpointing
maybe-boolean
"If `#t', disable the input while using a trackpoint; if `#f' do not.")
(tap
maybe-boolean
"Enable or disable tap.")
(extra-content
(extra-content '())
"Lines to add at the end of the configuration file."))
(define (sway-inputs? lst)
(every sway-input? lst))
(define-configuration/no-serialization sway-border-color
(border
string
"Border color.")
(background
string
"Background color.")
(text
string
"Text color."))
(define-maybe sway-border-color (no-serialization))
(define-configuration/no-serialization sway-color
(background
maybe-string
"Background color of the bar.")
(statusline
maybe-string
"Text color of the status line.")
(focused-background
maybe-string
"Background color of the bar on the currently focused monitor.")
(focused-statusline
maybe-string
"Text color of the statusline on the currently focused monitor.")
(focused-workspace
maybe-sway-border-color
"Color scheme for focused workspaces.")
(active-workspace
maybe-sway-border-color
"Color scheme for active workspaces.")
(inactive-workspace
maybe-sway-border-color
"Color scheme for inactive workspaces.")
(urgent-workspace
maybe-sway-border-color
"Color scheme for workspaces containing `urgent' windows.")
(binding-mode
maybe-sway-border-color
"Color scheme for the binding mode indicator."))
(define-maybe sway-color (no-serialization))
(define (status-command? c)
(or (string? c)
(file-like? c)
(gexp? c)))
(define-maybe bar-position (no-serialization))
(define-maybe hidden-state (no-serialization))
(define-maybe status-command (no-serialization))
(define-configuration/no-serialization sway-bar
(identifier
(symbol 'bar0)
"Identifier of the bar.")
(position
maybe-bar-position
"Position of the bar.")
(hidden-state
maybe-hidden-state
"Hidden state.")
(binding-mode-indicator
maybe-boolean
"Binding indicator.")
(colors
maybe-sway-color
"Color palette of the bar.")
(status-command
maybe-status-command
"Status command.")
(mouse-bindings
(mouse-bindings '())
"Actions triggered by mouse events.")
(extra-content
(extra-content '())
"Extra configuration lines."))
(define-maybe sway-bar (no-serialization))
(define-configuration/no-serialization point
(x integer "X coordinate.")
(y integer "Y coordinate."))
(define-maybe point (no-serialization))
(define (background? bg)
(or (string-ish? bg)
(and (pair? bg)
(string-ish? (car bg))
(member (cdr bg) '(stretch fill fit center tile)))))
(define-maybe background (no-serialization))
(define-configuration/no-serialization sway-output
(identifier
(string-or-symbol '*)
"Identifier of the output.")
(resolution
maybe-string
"Mode of the monitor.")
(position
maybe-point
"Position of the monitor.")
(background
maybe-background
"Background image.")
(extra-content
(extra-content '())
"Extra lines."))
(define (sway-outputs? lst)
(every sway-output? lst))
(define-configuration/no-serialization sway-mode
(mode-name
(string "default")
"Name of the mode.")
(keybindings
(bindings '())
"Keybindings.")
(mouse-bindings
(mouse-bindings '())
"Mouse bindings."))
(define (sway-modes? lst)
(every sway-mode? lst))
(define-configuration/no-serialization sway-configuration
(keybindings
(bindings %sway-default-keybindings)
"Keybindings.")
(gestures
(bindings %sway-default-gestures)
"Gestures.")
(packages
(list-of-packages
%sway-default-packages)
"List of packages to add to the profile.")
(variables
(variables %sway-default-variables)
"Variables declared at the beginning of the file.")
(inputs
(sway-inputs '())
"Inputs.")
(outputs
(sway-outputs '())
"Outputs.")
(bar
maybe-sway-bar
"Bar configuration.")
(modes
(sway-modes %sway-default-modes)
"Additional modes.")
(startup+reload-programs
(list-of-string-ish '())
"Programs to execute at startup time.")
(startup-programs
(list-of-string-ish %sway-default-startup-programs)
"Programs to execute at startup time.")
(extra-content
(extra-content '())
"Lines to add at the end of the configuration file."))
;;;
;;; Default settings and useful constants.
;;;
(define sway-menu
(program-file
"sway-menu.scm"
(with-imported-modules
(source-module-closure '((guix build utils)))
#~(begin
(use-modules (ice-9 ftw)
(ice-9 popen)
(ice-9 receive)
(ice-9 rdelim)
(guix build utils)
(srfi srfi-1))
(define (directory->files dir)
(define (executable-file? f)
;; Cf. `(@ (guix build utils) executable-file?)' for an
;; explanation of `(zero? ...)'.
(and=> (and (not (eq? (string-ref f 0) #\.))
(stat f))
(lambda (s)
(not (or
(zero? (logand (stat:mode s) #o100))
(eq? (stat:type s) 'directory))))))
(with-directory-excursion dir
(scandir "." executable-file?)))
(let ((path (string-append (getenv "HOME")
"/.guix-home/profile/bin"))
(wmenu #$(file-append wmenu "/bin/wmenu"))
(swaymsg #$(file-append sway "/bin/swaymsg")))
(receive (from to pids)
(pipeline `((,wmenu)))
(for-each
(lambda (c) (format to "~a~%" c))
(directory->files path))
(close to)
(let ((choice (read-line from)))
(close from)
(waitpid (first pids))
(when (string? choice) ;do not attempt to launch if no choice
;was given (e.g. if Escape is pressed in
;wmenu).
(execl swaymsg swaymsg "exec" "--"
choice)))))))))
(define %ev-code-mouse-left 272)
(define %ev-code-mouse-right 273)
(define %ev-code-mouse-scroll-click 274)
(define %sway-default-modes
(list (sway-mode
(mode-name "resize")
(keybindings
'(($left . "resize shrink width 10px")
($down . "resize grow height 10px")
($up . "resize shrink height 10px")
($right . "resize grow width 10px")
(Left . "resize shrink width 10px")
(Down . "resize grow height 10px")
(Up . "resize shrink height 10px")
(Right . "resize grow width 10px")
(Return . "mode \"default\"")
(Escape . "mode \"default\""))))))
(define %sway-default-packages
(list sway))
(define %sway-default-variables
`((mod . "Mod4")
(left . "h")
(down . "j")
(up . "k")
(right . "l")
(term . ,(file-append foot "/bin/foot"))
(menu . ,sway-menu)))
(define %sway-default-gestures
'((swipe:3:right . "workspace next_on_output")
(swipe:3:left . "workspace prev_on_output")
(swipe:3:down . "move to scratchpad")
(swipe:3:up . "scratchpad show")))
(define %sway-default-keybindings
`(($mod+Return . "exec $term")
($mod+Shift+q . "kill")
($mod+d . "exec $menu")
($mod+Shift+c . "reload")
($mod+Shift+e
. ,#~(string-append
"exec " #$sway "/bin/swaynag -t warning -m \\\n "
"'You pressed the exit shortcut. Do you really want to exit sway?"
" This will end your Wayland session.' \\\n "
"-B 'Yes, exit sway' \\\n '"
#$sway "/bin/swaymsg exit'"))
($mod+$left . "focus left")
($mod+$down . "focus down")
($mod+$up . "focus up")
($mod+$right . "focus right")
($mod+Left . "focus left")
($mod+Down . "focus down")
($mod+Up . "focus up")
($mod+Right . "focus right")
($mod+Shift+$left . "move left")
($mod+Shift+$down . "move down")
($mod+Shift+$up . "move up")
($mod+Shift+$right . "move right")
($mod+Shift+Left . "move left")
($mod+Shift+Down . "move down")
($mod+Shift+Up . "move up")
($mod+Shift+Right . "move right")
($mod+1 . "workspace number 1")
($mod+2 . "workspace number 2")
($mod+3 . "workspace number 3")
($mod+4 . "workspace number 4")
($mod+5 . "workspace number 5")
($mod+6 . "workspace number 6")
($mod+7 . "workspace number 7")
($mod+8 . "workspace number 8")
($mod+9 . "workspace number 9")
($mod+0 . "workspace number 10")
($mod+Shift+1 . "move container to workspace number 1")
($mod+Shift+2 . "move container to workspace number 2")
($mod+Shift+3 . "move container to workspace number 3")
($mod+Shift+4 . "move container to workspace number 4")
($mod+Shift+5 . "move container to workspace number 5")
($mod+Shift+6 . "move container to workspace number 6")
($mod+Shift+7 . "move container to workspace number 7")
($mod+Shift+8 . "move container to workspace number 8")
($mod+Shift+9 . "move container to workspace number 9")
($mod+Shift+0 . "move container to workspace number 10")
($mod+b . "splith")
($mod+v . "splitv")
($mod+s . "layout stacking")
($mod+w . "layout tabbed")
($mod+e . "layout toggle split")
($mod+f . "fullscreen")
($mod+Shift+space . "floating toggle")
($mod+space . "focus mode_toggle")
($mod+a . "focus parent")
($mod+Shift+minus . "move scratchpad")
($mod+minus . "scratchpad show")
($mod+r . "mode \"resize\"")))
(define %sway-default-startup-programs
(list
#~(string-append
#$swayidle "/bin/swayidle -w \\\n "
;; 300: lock screen.
"timeout 300 '" #$swaylock "/bin/swaylock "
"--indicator-radius 75 \\\n "
"-i " #$sway
"/share/backgrounds/sway/Sway_Wallpaper_Blue_1920x1080.png \\\n "
"-f -c 000000' \\\n "
;; 600: lock + screen off.
"timeout 600 '" #$sway "/bin/swaymsg \"output * power off\"' \\\n "
;; Resume + sleep.
"resume '" #$sway "/bin/swaymsg \"output * power on\"' \\\n "
"before-sleep '" #$swaylock "/bin/swaylock -f -c 000000'")))
;;;
;;; Serialization functions.
;;;
;; The main serialization code is defined in `sway-configuration->file' below.
;; In this function, the configuration is seen as a list of lines and blocks.
;;
;; The other serialization functions of this files are helpers that will build
;; the above list. Each function either returns a list, or elements that will
;; be put in one. The elements of these lists will either be:
;; - strings,
;; In this case, the string is seen as a line to add to the configuraiton
;; file.
;; - a pair (cons 'begin-block string),
;; In this case, a line "string {" is added to the configuration file, and
;; the indentation level is increased by four.
;; - the symbol 'end-block.
;; In which case the indentation level is decreased by four, and the current
;; configuration block is closed (with the line "}").
;; A few helper functions:
(define* (add-line-if field value
#:key (serializer %unset-value)
(suffix %unset-value))
(if (eq? %unset-value value)
%unset-value
#~(string-append #$field " "
#$(if (eq? serializer %unset-value)
value
(serializer value))
#$(if (eq? suffix %unset-value)
""
suffix))))
(define (add-block name content)
(let ((content (filter
(lambda (elt) (not (eq? elt %unset-value)))
content)))
(if (equal? content '())
'()
(append
(list #~(cons 'begin-block #$name))
content
(list #~'end-block)))))
(define-syntax add-block*
(syntax-rules ()
((add-block* name elt ...)
(add-block name (append elt ...)))))
;; Serialization functions:
(define (box str)
(let* ((len (string-length str))
(line (make-string (+ 8 len) #\#)))
(list
line
(string-append "### " str " ###")
line)))
(define (with-heading str lst)
(define (heading str)
(let* ((len (string-length str))
(line (make-string (+ 2 len) #\#)))
(list
"" ;add an empty line before the configuration section.
(string-append "# " str)
line)))
(if (equal? lst '())
'() ;if the configuration block is empty, do not add the heading.
(append (heading str) lst)))
(define-inlinable (serialize-boolean-yn b)
(if b "yes" "no"))
(define-inlinable (serialize-boolean-ed b)
(if b "enable" "disable"))
(define-inlinable (serialize-binding binder key value)
#~(string-append #$binder #$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)))
(define (serialize-keybinding var)
(let ((name (symbol->string (car var)))
(value (cdr var)))
(serialize-binding "bindsym " name value)))
(define (serialize-gesture var)
(let ((name (symbol->string (car var)))
(value (cdr var)))
(serialize-binding "bindgesture " name value)))
(define (serialize-variable var)
(let ((name (symbol->string (car var)))
(value (cdr var)))
(serialize-binding "set $" name value)))
(define (serialize-exec b)
(if b
(lambda (exe)
#~(string-append "exec_always " #$exe))
(lambda (exe)
#~(string-append "exec " #$exe))))
(define (serialize-output out)
(let* ((pre-ident (sway-output-identifier out))
(ident (if (symbol? pre-ident)
(symbol->string pre-ident)
(string-append "\"" pre-ident "\"")))
(background (let ((bg (sway-output-background out)))
(if (pair? bg)
bg
(cons bg 'fill))))
(resolution (sway-output-resolution out))
(position (sway-output-position out))
(extra-content (sway-output-extra-content out)))
(add-block
(string-append "output " ident)
(cons*
;; Optional elements.
(add-line-if "bg" (car background)
#:suffix
(string-append " " (symbol->string (cdr background))))
(add-line-if "resolution" resolution)
(add-line-if "position" position
#:serializer
(lambda (p)
(string-append (number->string (point-x p))
" "
(number->string (point-y p)))))
;; Extra-content: inlined as-is.
extra-content))))
(define (serialize-input input)
(define-inlinable (fetch-arg layout acc)
(if (eq? layout %unset-value)
%unset-value
(acc layout)))
(define-inlinable (unfalse f)
(lambda (arg)
(let ((res (f arg)))
(if res res %unset-value))))
(define-inlinable (unnil f)
(lambda (arg)
(let ((res (f arg)))
(if (nil? res) %unset-value res))))
(let* ((pre-ident (sway-input-identifier input))
(ident (if (symbol? pre-ident)
(symbol->string pre-ident)
(string-append "\"" pre-ident "\"")))
;; unpack the `layout' field.
(layout (sway-input-layout input))
(xkb-layout (fetch-arg layout keyboard-layout-name))
(xkb-variant (fetch-arg layout (unfalse keyboard-layout-variant)))
(xkb-model (fetch-arg layout (unfalse keyboard-layout-model)))
(xkb-options (fetch-arg layout (unnil keyboard-layout-options)))
(tap (sway-input-tap input))
(dwt (sway-input-disable-while-typing input))
(dwtp (sway-input-disable-while-trackpointing input))
(extra-content (sway-input-extra-content input)))
(add-block
(string-append "input " ident)
(cons*
;; Optional.
(add-line-if "xkb_layout" xkb-layout)
(add-line-if "xkb_model" xkb-model)
(add-line-if "xkb_variant" xkb-variant)
(add-line-if "xkb_options" xkb-options
#:serializer (lambda (l) (string-join l ",")))
(add-line-if "dwt" dwt
#:serializer serialize-boolean-ed)
(add-line-if "dwtp" dwtp
#:serializer serialize-boolean-ed)
(add-line-if "tap" tap
#:serializer serialize-boolean-ed)
;; extra-content inlined as-is.
extra-content))))
(define (serialize-colors colors)
(define (border-serializer val)
(string-append (sway-border-color-border val)
" " (sway-border-color-background val)
" " (sway-border-color-text val)))
(if (eq? %unset-value colors)
'()
(let ((background (sway-color-background colors))
(statusline (sway-color-statusline colors))
(focused-background (sway-color-focused-background colors))
(focused-statusline (sway-color-focused-statusline colors))
(focused-workspace (sway-color-focused-workspace colors))
(active-workspace (sway-color-active-workspace colors))
(inactive-workspace (sway-color-inactive-workspace colors))
(urgent-workspace (sway-color-urgent-workspace colors))
(binding-mode (sway-color-binding-mode colors)))
(add-block
"colors"
(list
(add-line-if "background" background)
(add-line-if "statusline" statusline)
(add-line-if "focused_background" focused-background)
(add-line-if "focused_statusline" focused-statusline)
(add-line-if "focused_workspace" focused-workspace
#:serializer border-serializer)
(add-line-if "active_workspace" active-workspace
#:serializer border-serializer)
(add-line-if "inactive_workspace" inactive-workspace
#:serializer border-serializer)
(add-line-if "urgent_workspace" urgent-workspace
#:serializer border-serializer)
(add-line-if "binding_mode" binding-mode
#:serializer border-serializer))))))
(define (serialize-mode mode)
(let ((name (sway-mode-mode-name mode))
(keys (sway-mode-keybindings mode))
(clicks (sway-mode-mouse-bindings mode)))
(add-block*
(string-append "mode \"" name "\"")
(map serialize-keybinding keys)
(map serialize-mouse-binding clicks))))
(define (serialize-bar bar)
(define serialize-symbol
symbol->string)
(let ((identifier (symbol->string (sway-bar-identifier bar)))
(position (sway-bar-position bar))
(hidden-state (sway-bar-hidden-state bar))
(status-command (sway-bar-status-command bar))
(binding-mode-indicator (sway-bar-binding-mode-indicator bar))
(mouse-bindings (sway-bar-mouse-bindings bar))
(extra-content (sway-bar-extra-content bar))
(colors (sway-bar-colors bar)))
(add-block*
(string-append "bar " identifier)
(if (eq? colors %unset-value)
'()
(serialize-colors colors))
(list
(add-line-if "position" position
#:serializer serialize-symbol)
(add-line-if "hidden_state" hidden-state
#:serializer serialize-symbol)
(add-line-if "status_command" status-command)
(add-line-if "binding_mode_indicator" binding-mode-indicator
#:serializer serialize-boolean-yn))
;; Mouse-bindings and extra-content
(map serialize-mouse-binding mouse-bindings)
extra-content)))
(define (sway-configuration->file conf)
(let* ((extra (sway-configuration-extra-content conf))
(bar (sway-configuration-bar conf)))
(computed-file
"sway-config"
#~(begin
(use-modules (ice-9 format) (ice-9 match)
(srfi srfi-1))
(call-with-output-file #$output
(lambda (port)
;; Add the (indented) line "s" to the output file.
(define (line s)
(lambda (i)
(format port "~a~a~%" i s)
i))
;; Begin a block "name" and adjust the indentation.
(define (begin-block name)
(lambda (i)
(format port "~a~a {~%" i name)
(string-append " " i)))
;; Ends an open block and adjust the indentation.
;; Note: we must currently be in a configuration block.
;; Otherwise, `string-drop' might fail.
(define (end-block)
(lambda (i)
(let ((i (string-drop i 4)))
(format port "~a}~%" i)
i)))
;; Helper function. The configuration is represented as a list
;; of actions (alter the indentation level, add a line, ...).
;; This function recognises the action and calls the right
;; function among those defined above.
(define (serializer-dispatch-m arg)
(match arg
;; Special cases:
(('begin-block . str) (begin-block str))
('end-block (end-block))
;; Default case: `arg' is assumed to be a string.
(_ (line arg))))
(define (serializer-dispatch elt i)
((serializer-dispatch-m elt) i))
(fold
;; Dispatch function: depending on its argument, it will change
;; the indentation level or add a line to the output file.
serializer-dispatch
;; Initial indentation string. This string is prepended to
;; lines before their serialization.
""
;; List of lines or indentation modifiers.
(list
;; Header.
#$@(box "Auto-generated configuration")
"# DO NOT EDIT MANUALLY."
;; Variables.
#$@(with-heading "Variables."
(map serialize-variable
(sway-configuration-variables conf)))
;; Outputs.
#$@(with-heading "Outputs."
(flatmap serialize-output
(sway-configuration-outputs conf)))
;; Inputs.
#$@(with-heading "Inputs."
(flatmap serialize-input
(sway-configuration-inputs conf)))
;; Bar configuration:
;; If the bar is unset, do not include anything.
#$@(if (eq? bar %unset-value)
'()
(with-heading "Bar configuration."
(serialize-bar bar)))
;; Keybindings.
#$@(with-heading "Keybindings."
(map serialize-keybinding
(sway-configuration-keybindings conf)))
;; Gestures.
#$@(with-heading "Gestures."
(map serialize-gesture
(sway-configuration-gestures conf)))
;; Modes.
#$@(with-heading "Modes."
(flatmap serialize-mode
(sway-configuration-modes conf)))
;; Startup-Programs.
#$@(with-heading
"Programs to execute (at startup)."
(map (serialize-exec #f)
(sway-configuration-startup-programs conf)))
;; startup+reload-programs.
#$@(with-heading
"Programs to execute (at startup & after reload)."
(map (serialize-exec #t)
(sway-configuration-startup+reload-programs conf)))
;; Extra-content.
#$@(with-heading "Extra-content" extra)))))))))
;;;
;;; Definition of the Home Service.
;;;
(define (sway-configuration->files sway-conf)
`((".config/sway/config" ,(sway-configuration->file sway-conf))))
(define home-sway-service-type
(service-type
(name 'home-sway-config)
(extensions
(list (service-extension home-files-service-type
sway-configuration->files)
(service-extension home-profile-service-type
sway-configuration-packages)))
(description "Configure Sway by providing a file
@file{~/.config/sway/config}.")
(default-value (sway-configuration))))

1
gnu/local.mk
View file

@ -114,6 +114,7 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/shepherd.scm \
%D%/home/services/sound.scm \
%D%/home/services/ssh.scm \
%D%/home/services/sway.scm \
%D%/home/services/syncthing.scm \
%D%/home/services/mcron.scm \
%D%/home/services/utils.scm \