From: Ricardo Wurmus <rekado@elephly.net>
To: guix-devel@gnu.org
Subject: [PATCH] Discover extensions via GUIX_EXTENSIONS_PATH.
Date: Tue, 5 Jan 2021 11:18:17 +0100 [thread overview]
Message-ID: <20210105101817.7576-1-rekado@elephly.net> (raw)
In-Reply-To: <87blf4woei.fsf@gnu.org>
* 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
prev parent reply other threads:[~2021-01-05 10:50 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-02-19 15:36 Extending Guix without using the Guile load path Ricardo Wurmus
2020-02-19 19:46 ` Gábor Boskovits
2020-02-19 20:40 ` Julien Lepiller
2020-03-12 13:29 ` Ludovic Courtès
2020-03-17 18:32 ` Joshua Branson
2020-03-17 19:36 ` Julien Lepiller
2020-10-31 22:53 ` Ricardo Wurmus
2020-10-31 22:53 ` Ricardo Wurmus
2020-11-01 22:23 ` Ludovic Courtès
2020-12-06 1:14 ` Ricardo Wurmus
2020-12-08 11:03 ` Ludovic Courtès
2021-01-05 10:18 ` Ricardo Wurmus [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210105101817.7576-1-rekado@elephly.net \
--to=rekado@elephly.net \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).