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.master
parent
f42c6bbb8e
commit
cf289d7cfa
|
@ -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)
|
||||
|
|
65
guix/ui.scm
65
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))))
|
||||
|
|
Reference in New Issue