Add 'guix-default-services' command

* scheme/emacs-guix/utils.scm (read-eval): New procedure.
* scheme/emacs-guix/services.scm (register/return-services): New procedure.
(find-services): Add 'from-expression' search type.
* elisp/guix-ui-service.el (guix-service-message): Add a message for it.
(guix-default-services-variables): New variable.
(guix-default-services): New command.
* elisp/guix-help.el (guix-help-specifications): Add it.
* doc/emacs-guix.texi (Services): Document it.

doc/emacs-guix.texi

@@ -761,6 +761,14 @@ interface for packages (@pxref{Packages}).
 @item M-x guix-all-services
 Display all available services.
 
+@findex guix-default-services
+@item M-x guix-default-services
+Display services from @code{%base-services} (@pxref{Base Services,,,
+guix, The GNU Guix Reference Manual}) or @code{%desktop-services}
+(@pxref{Desktop Services,,, guix, The GNU Guix Reference Manual}).
+You will be prompted in the minibuffer for the variable name
+(completions available).
+
 @findex guix-services-by-name
 @item M-x guix-services-by-name
 Display service(s) with the specified name.

elisp/guix-help.el

@@ -100,6 +100,7 @@ If ARG is non-nil (interactively with prefix), show Guix info manual."
 
     "Show services and their definitions"
     guix-all-services
+    guix-default-services
     guix-services-by-name
     guix-services-by-regexp
     guix-services-by-location

elisp/guix-ui-service.el

@@ -40,7 +40,7 @@
 (defun guix-service-get-entries (search-type search-values params)
   "Receive 'service' entries.
 SEARCH-TYPE may be one of the following symbols: `id', `all',
-`name', `regexp', `location', `from-os-file'."
+`name', `regexp', `location', `from-os-file', `from-expression'."
   (guix-eval-read
    (guix-make-guile-expression
     'service-sexps search-type search-values params)))
@@ -59,6 +59,9 @@ SEARCH-TYPE may be one of the following symbols: `id', `all',
         (from-os-file
          (message "%d services from OS file '%s'."
                   count (car search-values)))
+        (from-expression
+         (message "%d services from '%s'."
+                  count (car search-values)))
         (name
          (if (= 1 count)
              (message "'%s' service." (car search-values))
@@ -235,6 +238,19 @@ See `guix-find-location' for the meaning of DIRECTORY."
 (defvar guix-service-search-history nil
   "A history of minibuffer prompts.")
 
+(defvar guix-default-services-variables
+  '(("%base-services"    . "(gnu services base)")
+    ("%desktop-services" . "(gnu services desktop)"))
+  "Alist of variables with services and their modules.
+Each element from this alist should have the following form:
+
+  (VAR-NAME . MODULE)
+
+VAR-NAME is the name (string) of a guile variable that evaluates
+to a list of services.
+
+MODULE is the guile module (string) where this variable is placed in.")
+
 ;;;###autoload
 (defun guix-services-from-system-config-file (file)
   "Display Guix services from the operating system configuration FILE.
@@ -249,6 +265,26 @@ See `guix-packages-from-system-config-file' for more details on FILE."
   (interactive)
   (guix-service-get-display 'all))
 
+;;;###autoload
+(defun guix-default-services (var-name)
+  "Display Guix services from VAR-NAME.
+VAR-NAME is a name of the variable from
+`guix-default-services-variables'."
+  (interactive
+   (list (completing-read
+          "Variable with services: "
+          guix-default-services-variables nil t nil nil
+          (caar guix-default-services-variables))))
+  (let ((module (bui-assoc-value guix-default-services-variables
+                                 var-name)))
+    (if module
+        (guix-service-get-display
+         'from-expression
+         (format "(@ %s %s)" module var-name))
+      (error "Unknown guile variable '%s'.
+Check the value of 'guix-default-services-variables'"
+             var-name))))
+
 ;;;###autoload
 (defun guix-services-by-name (name)
   "Display Guix service(s) with NAME."

scheme/emacs-guix/services.scm

@@ -118,6 +118,11 @@ SERVICE can be either a service object, or a service type itself."
                (delay (vhash-consq (service-id service)
                                    service table*))))))))
 
+(define (register/return-services services)
+  "Call `register-service' on SERVICES and return them."
+  (map register-service services)
+  services)
+
 (define-values (service-names
                 services-by-name)
   (let ((table (delay (fold-service-types
@@ -205,13 +210,11 @@ MATCH-PARAMS is a list of parameters that REGEXP can match."
      (services-by-location-file (car search-values)))
     ((all)
      (fold-service-types cons '()))
+    ((from-expression)
+     (register/return-services (read-eval (car search-values))))
     ((from-os-file)
-     (match search-values
-       ((file)
-        (let ((services (services-from-system-config-file file)))
-          (map register-service services)
-          services))
-       (_ '())))
+     (register/return-services
+      (services-from-system-config-file (car search-values))))
     (else
      (error (format #f "Wrong search type '~a' for services"
                     search-type)))))
@@ -221,7 +224,7 @@ MATCH-PARAMS is a list of parameters that REGEXP can match."
 
 SEARCH-TYPE and SEARCH-VALUES define how to get the information.
 SEARCH-TYPE should be one of the following symbols: 'id', 'name', 'all',
-'regexp', 'location', 'from-os-file'."
+'regexp', 'location', 'from-os-file', 'from-expression'."
   (let ((services (find-services search-type search-values))
         (->sexp (object-transformer %service-param-alist params)))
     (to-emacs-side (map ->sexp services))))

scheme/emacs-guix/utils.scm

@@ -26,6 +26,7 @@
             list-maybe
             string->symbol*
             search-load-path
+            read-eval
             object-transformer))
 
 (define-syntax-rule (first-or-false lst)
@@ -79,4 +80,18 @@ Example:
   "Call (search-path %load-path FILE-NAME)."
   (search-path %load-path file-name))
 
+(define (read-eval str)
+  "Read and evaluate STR, raising an error if something goes wrong."
+  (let ((exp (catch #t
+               (lambda ()
+                 (call-with-input-string str read))
+               (lambda args
+                 (error (format #f "Failed to read expression ~s: ~s~%"
+                                str args))))))
+    (catch #t
+      (lambda ()
+        (eval exp (interaction-environment)))
+      (lambda args
+        (error (format #f "Failed to evaluate expression '~a'~%" exp))))))
+
 ;;; utils.scm ends here