guix_mirror_bot pushed a commit to branch mesa-updates
in repository guix.

commit 3fdf7981fce4cfc3f4ebd3f9e8b07009fe99770b
Author: Sergey Trofimov <[email protected]>
AuthorDate: Wed Jun 18 11:15:34 2025 +0200

    services: sane: Support pluggable backends.
    
    * gnu/services/desktop.scm (sane-configuration): New record.
    (sane-service-type): Add native search paths to environment.
    
    Change-Id: Ia7b66b62cf027200dd94533f32c1e4bc0ed373d3
---
 doc/guix.texi            | 56 ++++++++++++++++++++++++++++++++++--------------
 gnu/services/desktop.scm | 46 ++++++++++++++++++++++++++++++++++++---
 2 files changed, 83 insertions(+), 19 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 9aadad4c2e..cad210d293 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -26957,23 +26957,46 @@ site} for more information.
 @defvar sane-service-type
 This service provides access to scanners @i{via}
 @uref{http://www.sane-project.org, SANE} by installing the necessary
-udev rules.  It is included in @code{%desktop-services} (@pxref{Desktop
-Services}) and relies by default on @code{sane-backends-minimal} package
-(see below) for hardware support.
+udev rules and pluggable backends.  It is included in
+@code{%desktop-services} (@pxref{Desktop Services}) and relies by
+default on @code{sane-backends} package (see below) for hardware
+support.
 @end defvar
 
-@defvar sane-backends-minimal
-The default package which the @code{sane-service-type} installs.  It
-supports many recent scanners.
-@end defvar
+@deftp {Data Type} sane-configuration
+Data type representing the configuration for SANE.
 
-@defvar sane-backends
-This package includes support for all scanners that
-@code{sane-backends-minimal} supports, plus older Hewlett-Packard
-scanners supported by @code{hplip} package.  In order to use this on
-a system which relies on @code{%desktop-services}, you may use
-@code{modify-services} (@pxref{Service Reference,
-@code{modify-services}}) as illustrated below:
+@table @asis
+
+@item @code{sane} (default: @code{sane})
+Package containing SANE library.
+
+@item @code{backends} (default: @code{(sane-backends)})
+List of packages with pluggable SANE backends:
+
+@itemize @bullet
+@item
+@code{sane-backends}: The default backend collection which supports many 
recent scanners,
+
+@item
+@code{sane-airscan}: A backend that enables network scanners supporting eSCL 
(Apple) or WSD,
+(Microsoft) protocols
+
+@item
+@code{hplip}: A backend containing drivers for older Hewlett-Packard scanners,
+
+@item
+@code{utsushi}: A backend containing drivers for older Epson devices.
+
+@end itemize
+
+@end table
+@end deftp
+
+In order to use additional backends on a system which relies on
+@code{%desktop-services}, you may use @code{modify-services}
+(@pxref{Service Reference, @code{modify-services}}) as illustrated
+below:
 
 @lisp
 (use-modules (gnu))
@@ -26987,13 +27010,14 @@ a system which relies on @code{%desktop-services}, 
you may use
 (define %my-desktop-services
   ;; List of desktop services that supports a broader range of scanners.
   (modify-services %desktop-services
-    (sane-service-type _ => sane-backends)))
+    (sane-service-type _ =>
+      (sane-configuration
+        (backends (list sane-backends sane-airscan))))))
 
 (operating-system
   @dots{}
   (services %my-desktop-services))
 @end lisp
-@end defvar
 
 @deffn {Procedure} geoclue-application name [#:allowed? #t] [#:system? #f] 
[#:users '()]
 Return a configuration allowing an application to access GeoClue
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 76533b1a76..83132480fb 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -80,8 +80,10 @@
   #:use-module (gnu packages nfs)
   #:use-module (gnu packages enlightenment)
   #:use-module (guix deprecation)
+  #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
+  #:use-module (guix search-paths)
   #:use-module (guix store)
   #:use-module (guix ui)
   #:use-module (guix utils)
@@ -147,6 +149,11 @@
             accountsservice-service  ; deprecated
 
             cups-pk-helper-service-type
+
+            sane-configuration
+            sane-configuration?
+            sane-configuration-backends
+            sane-configuration-sane
             sane-service-type
 
             gnome-desktop-configuration
@@ -1681,6 +1688,33 @@ accountsservice web site} for more information."
   ;; The '60-libsane.rules' udev rules refers to the "scanner" group.
   (list (user-group (name "scanner") (system? #t))))
 
+(define (non-empty-list-of-packages? val)
+  (and (not (null? val)) (list-of-packages? val)))
+
+(define-configuration/no-serialization sane-configuration
+  (sane
+   (package sane)
+   "The package that provides the SANE library.")
+  (backends
+   (non-empty-list-of-packages (list sane-backends))
+   "A list of packages containing SANE backends."))
+
+(define (sane-search-paths config)
+  (match-record config <sane-configuration> (sane backends)
+    (let ((backend-union (directory-union "sane-backends" backends)))
+      (map (match-lambda
+             (($ <search-path-specification> variable (files))
+              (cons variable (file-append backend-union "/" files))))
+           (package-native-search-paths sane)))))
+
+(define* (lift-sane-configuration config #:key warn?)
+  (if (sane-configuration? config)
+      config
+      (begin
+        (when warn?
+          (warning (G_ "'sane' service now expects a 'sane-configuration' 
record~%")))
+        (sane-configuration (backends (list config))))))
+
 (define sane-service-type
   (service-type
    (name 'sane)
@@ -1688,9 +1722,15 @@ accountsservice web site} for more information."
     "This service provides access to scanners @i{via}
 @uref{http://www.sane-project.org, SANE} by installing the necessary udev
 rules.")
-   (default-value sane-backends-minimal)
+   (default-value (sane-configuration))
    (extensions
-    (list (service-extension udev-service-type list)
+    (list (service-extension udev-service-type
+                             (lambda (c)
+                               (sane-configuration-backends
+                                (lift-sane-configuration c #:warn? #t))))
+          (service-extension session-environment-service-type
+                             (lambda (c)
+                               (sane-search-paths (lift-sane-configuration 
c))))
           (service-extension account-service-type
                              (const %sane-accounts))))))
 
@@ -2445,7 +2485,7 @@ applications needing access to be root.")
          ;; Add udev rules for MTP devices so that non-root users can access
          ;; them.
          (simple-service 'mtp udev-service-type (list libmtp))
-         ;; Add udev rules for scanners.
+         ;; Add udev rules and default backends for scanners.
          (service sane-service-type)
          ;; Add polkit rules, so that non-root users in the wheel group can
          ;; perform administrative tasks (similar to "sudo").

Reply via email to