diff options
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/archive.scm | 2 | ||||
-rw-r--r-- | guix/scripts/build.scm | 2 | ||||
-rw-r--r-- | guix/scripts/edit.scm | 13 | ||||
-rw-r--r-- | guix/scripts/environment.scm | 2 | ||||
-rw-r--r-- | guix/scripts/lint.scm | 13 | ||||
-rw-r--r-- | guix/scripts/package.scm | 3 | ||||
-rw-r--r-- | guix/scripts/system.scm | 25 |
7 files changed, 44 insertions, 16 deletions
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index e06c38aaab..8c7322d617 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -162,7 +162,7 @@ Export/import one or more packages from/to the store.\n")) (alist-cons 'expression arg result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) + (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) %standard-build-options)) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index a02a0d5792..9a113b4ebe 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -541,7 +541,7 @@ must be one of 'package', 'all', or 'transitive'~%") (alist-cons 'file arg result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) + (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index ce3ac4146d..555796a69c 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mathieu Lirzin <mthl@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -74,9 +74,16 @@ line." (define (guix-edit . args) + (define (parse-arguments) + ;; Return the list of package names. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + cons + '())) + (with-error-handling - (let* ((specs (parse-command-line args %options '(()) - #:argument-handler cons)) + (let* ((specs (reverse (parse-arguments))) (packages (map specification->package specs))) (for-each (lambda (package) (unless (package-location package) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 9f72b7bf24..0c69bfc9d3 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -226,7 +226,7 @@ COMMAND or an interactive shell in that environment.\n")) (alist-cons 'ad-hoc? #t result))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) + (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 51191e7e7b..eac3214bbf 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -161,6 +161,18 @@ markup is valid return a plain-text version of DESCRIPTION, otherwise #f." 'description) #f))) + (define (check-trademarks description) + "Check that DESCRIPTION does not contain '™' or '®' characters. See +http://www.gnu.org/prep/standards/html_node/Trademarks.html." + (match (string-index description (char-set #\™ #\®)) + ((and (? number?) index) + (emit-warning package + (format #f (_ "description should not contain ~ +trademark sign '~a' at ~d") + (string-ref description index) index) + 'description)) + (else #t))) + (define (check-proper-start description) (unless (or (properly-starts-sentence? description) (string-prefix-ci? (package-name package) description)) @@ -191,6 +203,7 @@ by two spaces; possible infraction~p at ~{~a~^, ~}") (if (string? description) (begin (check-not-empty description) + (check-trademarks description) ;; Use raw description for this because Texinfo rendering ;; automatically fixes end of sentence space. (check-end-of-sentence-space description) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 2a751a4552..fd42cdb36e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -486,7 +486,8 @@ kind of search path~%") #f))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result arg-handler) - (values (alist-cons 'dry-run? #t result) + (values (alist-cons 'dry-run? #t + (alist-cons 'graft? #f result)) #f))) (option '("bootstrap") #f #f (lambda (opt name arg result arg-handler) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 209ebf9752..a9fe7d5975 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -52,6 +52,7 @@ #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) #:export (guix-system read-operating-system)) @@ -397,6 +398,9 @@ it atomically, and then run OS's activation script." read-boot-parameters)) (label (boot-parameters-label params)) (root (boot-parameters-root-device params)) + (root-device (if (bytevector? root) + (uuid->string root) + root)) (kernel (boot-parameters-kernel params)) (kernel-arguments (boot-parameters-kernel-arguments params))) (menu-entry @@ -405,7 +409,7 @@ it atomically, and then run OS's activation script." (seconds->string time) ")")) (linux kernel) (linux-arguments - (cons* (string-append "--root=" root) + (cons* (string-append "--root=" root-device) #~(string-append "--system=" #$system) #~(string-append "--load=" #$system "/boot") kernel-arguments)) @@ -473,18 +477,21 @@ list of services." #:optional (profile %system-profile)) "Display a summary of system generation NUMBER in a human-readable format." (unless (zero? number) - (let* ((generation (generation-file-name profile number)) - (param-file (string-append generation "/parameters")) - (params (call-with-input-file param-file read-boot-parameters)) - (label (boot-parameters-label params)) - (root (boot-parameters-root-device params)) - (kernel (boot-parameters-kernel params))) + (let* ((generation (generation-file-name profile number)) + (param-file (string-append generation "/parameters")) + (params (call-with-input-file param-file read-boot-parameters)) + (label (boot-parameters-label params)) + (root (boot-parameters-root-device params)) + (root-device (if (bytevector? root) + (uuid->string root) + root)) + (kernel (boot-parameters-kernel params))) (display-generation profile number) (format #t (_ " file name: ~a~%") generation) (format #t (_ " canonical file name: ~a~%") (readlink* generation)) ;; TRANSLATORS: Please preserve the two-space indentation. (format #t (_ " label: ~a~%") label) - (format #t (_ " root device: ~a~%") root) + (format #t (_ " root device: ~a~%") root-device) (format #t (_ " kernel: ~a~%") kernel)))) (define* (list-generations pattern #:optional (profile %system-profile)) @@ -743,7 +750,7 @@ Build the operating system declared in FILE according to ACTION.\n")) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) - (alist-cons 'dry-run? #t result))) + (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg |