diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/edit.scm | 30 | ||||
| -rw-r--r-- | guix/scripts/home.scm | 7 | ||||
| -rw-r--r-- | guix/scripts/home/edit.scm | 66 | ||||
| -rw-r--r-- | guix/scripts/home/import.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/shell.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 10 | ||||
| -rw-r--r-- | guix/scripts/system/edit.scm | 64 |
7 files changed, 165 insertions, 18 deletions
diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index a2e1ffb434..8e777d1405 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015-2016, 2019-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2020, 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; @@ -27,6 +27,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-37) #:export (%editor + spawn-editor guix-edit)) (define %options @@ -77,6 +78,21 @@ line." (location-line location))) (search-path* %load-path (location-file location)))) +(define (spawn-editor locations) + "Spawn (%editor) to edit the code at LOCATIONS, a list of <location> +records, and exit." + (catch 'system-error + (lambda () + (let ((file-names (append-map location->location-specification + locations))) + ;; Use `system' instead of `exec' in order to sanely handle + ;; possible command line arguments in %EDITOR. + (exit (system (string-join (cons (%editor) file-names)))))) + (lambda args + (let ((errno (system-error-errno args))) + (leave (G_ "failed to launch '~a': ~a~%") + (%editor) (strerror errno)))))) + (define-command (guix-edit . args) (category packaging) @@ -94,14 +110,4 @@ line." (when (null? specs) (leave (G_ "no packages specified, nothing to edit~%"))) - (catch 'system-error - (lambda () - (let ((file-names (append-map location->location-specification - locations))) - ;; Use `system' instead of `exec' in order to sanely handle - ;; possible command line arguments in %EDITOR. - (exit (system (string-join (cons (%editor) file-names)))))) - (lambda args - (let ((errno (system-error-errno args))) - (leave (G_ "failed to launch '~a': ~a~%") - (%editor) (strerror errno)))))))) + (spawn-editor locations)))) diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index f43bf865a7..0f5c3388a1 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -60,6 +60,7 @@ #:autoload (guix scripts pull) (channel-commit-hyperlink) #:autoload (guix scripts system) (service-node-type shepherd-service-node-type) + #:autoload (guix scripts home edit) (guix-home-edit) #:autoload (guix scripts home import) (import-manifest) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix build utils) #:select (mkdir-p)) @@ -93,6 +94,8 @@ Some ACTIONS support additional ARGS.\n")) (newline) (display (G_ "\ search search for existing service types\n")) + (display (G_ "\ + edit edit the definition of an existing service type\n")) (display (G_ " container run the home environment configuration in a container\n")) (display (G_ "\ @@ -539,6 +542,8 @@ argument list and OPTS is the option alist." ;; an home environment file. ((search) (apply search args)) + ((edit) + (apply guix-home-edit args)) ((import) (let* ((profiles (delete-duplicates (match (filter-map (match-lambda @@ -611,7 +616,7 @@ deploy the home environment described by these files.\n") extension-graph shepherd-graph list-generations describe delete-generations roll-back - switch-generation search + switch-generation search edit import container) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) diff --git a/guix/scripts/home/edit.scm b/guix/scripts/home/edit.scm new file mode 100644 index 0000000000..a6c05675b3 --- /dev/null +++ b/guix/scripts/home/edit.scm @@ -0,0 +1,66 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts home edit) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + #:use-module (guix ui) + #:autoload (guix utils) (string-closest) + #:use-module (gnu services) + #:use-module (gnu home services) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:autoload (guix scripts edit) (spawn-editor) + #:export (guix-home-edit)) + +(define (service-type-not-found type) + "Report an error about @var{type} not being found and exit." + (report-error (G_ "~a: no such service type~%") type) + + (let* ((type (symbol->string type)) + (available (fold-home-service-types (lambda (type lst) + (cons (symbol->string + (service-type-name type)) + lst)) + '())) + (closest (string-closest type available))) + (unless (or (not closest) (string=? closest type)) + (display-hint (format #f (G_ "Did you mean @code{~a}?~%") + closest)))) + + (exit 1)) + + +(define (guix-home-edit . args) + (when (null? args) + (leave (G_ "no service types specified, nothing to edit~%"))) + + (with-error-handling + (let* ((types (append-map (lambda (type) + (let ((type (string->symbol type))) + (match (lookup-home-service-types type) + (() (service-type-not-found type)) + ((one) (list one)) + (lst + (warning (N_ "~a: ~a matching service type~%" + "~a: ~a matching service types~%" + (length lst)) + type (length lst)) + lst)))) + args))) + (spawn-editor (filter-map service-type-location types))))) diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 575fe8f688..825ccb1e73 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se> +;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -170,8 +171,7 @@ user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them." ,@(delete-duplicates (concatenate modules))) (home-environment - (packages (map (compose list specification->package+output) - ,packages)) + (packages (specifications->packages ,packages)) (services (list ,@services))))))))) (define* (import-manifest diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index d9af2517c2..1a6df98829 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -410,7 +410,7 @@ concatenates MANIFESTS, a list of expressions." (if (null? (manifest-entries manifest)) (match extra-manifests ((one) one) - (lst `(concatenate-manifests ,@extra-manifests))) + (lst `(concatenate-manifests (list ,@extra-manifests)))) (match (manifest->code manifest #:entry-package-version manifest-entry-version-prefix) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index eaa245eb44..63e3b9b934 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -945,6 +946,8 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ "\ search search for existing service types\n")) (display (G_ "\ + edit edit the definition of an existing service type\n")) + (display (G_ "\ reconfigure switch to a new operating system configuration\n")) (display (G_ "\ roll-back switch to the previous operating system configuration\n")) @@ -1172,7 +1175,8 @@ Some ACTIONS support additional ARGS.\n")) "extension-graph" "shepherd-graph" "list-generations" "describe" "delete-generations" "roll-back" - "switch-generation" "search" "docker-image")) + "switch-generation" "search" "edit" + "docker-image")) (define (process-action action args opts) "Process ACTION, a sub-command, with the arguments are listed in ARGS. @@ -1270,7 +1274,7 @@ resulting from command-line parsing." (export-shepherd-graph os (current-output-port) #:backend (graph-backend))) (else - (unless (memq action '(build init)) + (unless (memq action '(build init reconfigure)) (warn-about-old-distro #:suggested-command "guix system reconfigure")) @@ -1340,6 +1344,8 @@ argument list and OPTS is the option alist." (display-system-generation generation)))) ((search) (apply (resolve-subcommand "search") args)) + ((edit) + (apply (resolve-subcommand "edit") args)) ;; The following commands need to use the store, but they do not need an ;; operating system configuration file. ((delete-generations) diff --git a/guix/scripts/system/edit.scm b/guix/scripts/system/edit.scm new file mode 100644 index 0000000000..d966ee0aaa --- /dev/null +++ b/guix/scripts/system/edit.scm @@ -0,0 +1,64 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts system edit) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + #:use-module (guix ui) + #:autoload (guix utils) (string-closest) + #:use-module (gnu services) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:autoload (guix scripts edit) (spawn-editor) + #:export (guix-system-edit)) + +(define (service-type-not-found type) + "Report an error about @var{type} not being found and exit." + (report-error (G_ "~a: no such service type~%") type) + + (let* ((type (symbol->string type)) + (available (fold-service-types (lambda (type lst) + (cons (symbol->string + (service-type-name type)) + lst)) + '())) + (closest (string-closest type available))) + (unless (or (not closest) (string=? closest type)) + (display-hint (format #f (G_ "Did you mean @code{~a}?~%") + closest)))) + + (exit 1)) + + +(define (guix-system-edit . args) + (when (null? args) + (leave (G_ "no service types specified, nothing to edit~%"))) + + (let* ((types (append-map (lambda (type) + (let ((type (string->symbol type))) + (match (lookup-service-types type) + (() (service-type-not-found type)) + ((one) (list one)) + (lst + (warning (N_ "~a: ~a matching service type~%" + "~a: ~a matching service types~%" + (length lst)) + type (length lst)) + lst)))) + args))) + (spawn-editor (filter-map service-type-location types)))) |