Merge remote-tracking branch 'origin/master' into core-updates

9 files changed, 81 insertions, 31 deletions

diff --git a/guix/base64.scm b/guix/base64.scm
index e4d2ec589b..4bd5dc5e1b 100644
--- a/guix/base64.scm
+++ b/guix/base64.scm
@@ -6,8 +6,6 @@
 ;;
 ;; Some optimizations made by Ludovic Courtès <ludo@gnu.org>, 2015.
 ;;
-;; Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
-;;
 ;; This program 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
@@ -20,6 +18,30 @@
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; This file incorporates work covered by the following copyright and  
+;; permission notice:
+;;
+;;   Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
+;;
+;;   Permission is hereby granted, free of charge, to any person obtaining a
+;;   copy of this software and associated documentation files (the "Software"),
+;;   to deal in the Software without restriction, including without limitation
+;;   the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;;   and/or sell copies of the Software, and to permit persons to whom the
+;;   Software is furnished to do so, subject to the following conditions:
+;;
+;;   The above copyright notice and this permission notice shall be included in
+;;   all copies or substantial portions of the Software.
+;;
+;;   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;;   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;;   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+;;   THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;;   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;;   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;   DEALINGS IN THE SOFTWARE.
+
 #!r6rs
 
 ;; RFC 4648 Base-N Encodings
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 44e004b084..93cd0f0fa5 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -22,7 +22,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (guix hash)
   #:use-module (guix base32)
-  #:use-module (guix licenses)
+  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix utils)
   #:use-module ((guix build download) #:prefix build:)
   #:export (factorize-uri
@@ -112,12 +112,12 @@ recursively apply the procedure to the sub-list."
 (define (string->license str)
   "Convert the string STR into a license object."
   (match str
-    ("GNU LGPL" lgpl2.0)
-    ("GPL" gpl3)
-    ((or "BSD" "BSD License") bsd-3)
-    ((or "MIT" "MIT license" "Expat license") expat)
-    ("Public domain" public-domain)
-    ((or "Apache License, Version 2.0" "Apache 2.0") asl2.0)
+    ("GNU LGPL" license:lgpl2.0)
+    ("GPL" license:gpl3)
+    ((or "BSD" "BSD License") license:bsd-3)
+    ((or "MIT" "MIT license" "Expat license") license:expat)
+    ("Public domain" license:public-domain)
+    ((or "Apache License, Version 2.0" "Apache 2.0") license:asl2.0)
     (_ #f)))
 
 (define (license->symbol license)
@@ -125,12 +125,12 @@ recursively apply the procedure to the sub-list."
 to in the (guix licenses) module, or #f if there is no such known license."
   ;; TODO: Traverse list public variables in (guix licenses) instead so we
   ;; don't have to maintain a list manualy.
-  (assoc-ref `((,lgpl2.0 . lgpl2.0)
-               (,gpl3 . gpl3)
-               (,bsd-3 . bsd-3)
-               (,expat . expat)
-               (,public-domain . public-domain)
-               (,asl2.0 . asl2.0))
+  (assoc-ref `((,license:lgpl2.0 . license:lgpl2.0)
+               (,license:gpl3 . license:gpl3)
+               (,license:bsd-3 . license:bsd-3)
+               (,license:expat . license:expat)
+               (,license:public-domain . license:public-domain)
+               (,license:asl2.0 . license:asl2.0))
              license))
 
 (define (snake-case str)
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