[PATCH] Discover extensions via GUIX_EXTENSIONS_PATH.

[Ricardo Wurmus]

* guix/scripts.scm (%command-categories): Add extension category.
* guix/ui.scm (command-files): Accept an optional directory argument.
(extension-directories): New procedure.
(commands): Use it.
(show-guix-help): Hide empty categories.
(run-guix-command): Try loading an extension if there is no Guix command.
---
 guix/scripts.scm |  4 +++-
 guix/ui.scm      | 60 +++++++++++++++++++++++++++++++++++-------------
 2 files changed, 47 insertions(+), 17 deletions(-)

diff --git a/guix/scripts.scm b/guix/scripts.scm
index 9792aaebe9..34cba35401 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -86,7 +87,8 @@
   (development (G_ "software development commands"))
   (packaging   (G_ "packaging commands"))
   (plumbing    (G_ "plumbing commands"))
-  (internal    (G_ "internal commands")))
+  (internal    (G_ "internal commands"))
+  (extension   (G_ "extension commands")))
 
 (define-syntax define-command
   (syntax-rules (category synopsis)
diff --git a/guix/ui.scm b/guix/ui.scm
index 0a1c9bd615..2ecfb53c7b 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2046,24 +2046,36 @@ contain a 'define-command' form."
           (_
            (loop)))))))
 
-(define (command-files)
+(define* (command-files #:optional directory)
   "Return the list of source files that define Guix sub-commands."
-  (define directory
-    (and=> (search-path %load-path "guix.scm")
-           (compose (cut string-append <> "/guix/scripts")
-                    dirname)))
+  (define directory*
+    (or directory
+        (and=> (search-path %load-path "guix.scm")
+               (compose (cut string-append <> "/guix/scripts")
+                        dirname))))
 
   (define dot-scm?
     (cut string-suffix? ".scm" <>))
 
-  (if directory
-      (map (cut string-append directory "/" <>)
-           (scandir directory dot-scm?))
+  (if directory*
+      (map (cut string-append directory* "/" <>)
+           (scandir directory* dot-scm?))
       '()))
 
+(define (extension-directories)
+  "Return the list of directories containing Guix extensions."
+  (filter-map (lambda (directory)
+                (let ((scripts (string-append directory "/guix/scripts")))
+                  (and (file-exists? scripts) scripts)))
+              (parse-path
+               (getenv "GUIX_EXTENSIONS_PATH"))))
+
 (define (commands)
   "Return the list of commands, alphabetically sorted."
-  (filter-map source-file-command (command-files)))
+  (filter-map source-file-command
+              (append (command-files)
+                      (append-map command-files
+                                  (extension-directories)))))
 
 (define (show-guix-help)
   (define (internal? command)
@@ -2098,9 +2110,14 @@ Run COMMAND with ARGS.\n"))
                 (('internal . _)
                  #t)                              ;hide internal commands
                 ((category . synopsis)
-                 (format #t "~%  ~a~%" (G_ synopsis))
-                 (display-commands (filter (category-predicate category)
-                                           commands))))
+                 (let ((relevant-commands (filter (category-predicate category)
+                                                  commands)))
+                   ;; Only print categories that contain commands.
+                   (match relevant-commands
+                     ((one . more)
+                      (format #t "~%  ~a~%" (G_ synopsis))
+                      (display-commands relevant-commands))
+                     (_ #f)))))
               categories))
   (show-bug-report-information))
 
@@ -2111,10 +2128,21 @@ found."
     (catch 'misc-error
       (lambda ()
         (resolve-interface `(guix scripts ,command)))
-      (lambda -
-        (format (current-error-port)
-                (G_ "guix: ~a: command not found~%") command)
-        (show-guix-usage))))
+      (lambda _
+        ;; Check if there is a matching extension.
+        (catch 'misc-error
+          (lambda ()
+            (match (search-path (extension-directories)
+                                (format #f "~a.scm" command))
+              (file
+               (load file)
+               (resolve-interface `(guix scripts ,command)))
+              (_
+               (throw 'misc-error))))
+          (lambda _
+            (format (current-error-port)
+                    (G_ "guix: ~a: command not found~%") command)
+            (show-guix-usage))))))
 
   (let ((command-main (module-ref module
                                   (symbol-append 'guix- command))))
-- 
2.29.2