diff options
author | Ricardo Wurmus <rekado@elephly.net> | 2021-01-05 11:14:51 +0100 |
---|---|---|
committer | Ricardo Wurmus <rekado@elephly.net> | 2021-01-05 23:58:21 +0100 |
commit | cf289d7cfa34315bf13b3114b9a5bf3d3c05ebea (patch) | |
tree | 0630425a05c2c3ead31775ec2c825e950d4329b1 | |
parent | f42c6bbb8e279045dbd358b25fc1d53cb1dfeeed (diff) |
Discover extensions via GUIX_EXTENSIONS_PATH.
* guix/scripts.scm (%command-categories): Add extension category.
* guix/ui.scm (source-file-command): Also parse extensions files.
(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 matching Guix
command.
-rw-r--r-- | guix/scripts.scm | 4 | ||||
-rw-r--r-- | guix/ui.scm | 65 |
2 files changed, 49 insertions, 20 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..7f52518023 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -2021,10 +2021,11 @@ optionally contain a version number and an output name, as in these examples: on the 'define-command' top-level form found therein, or #f if FILE does not contain a 'define-command' form." (define command-name - (match (string-split file #\/) - ((_ ... "guix" "scripts" name) + (match (filter (negate string-null?) + (string-split file #\/)) + ((_ ... "guix" (or "scripts" "extensions") name) (list (file-sans-extension name))) - ((_ ... "guix" "scripts" first second) + ((_ ... "guix" (or "scripts" "extensions") first second) (list first (file-sans-extension second))))) ;; The strategy here is to parse FILE. This is much cheaper than a @@ -2046,24 +2047,34 @@ 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 file-exists? + (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 +2109,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 +2127,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 extensions ,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)))) |