Merge branch 'master' into core-updates

8 files changed, 80 insertions, 57 deletions

diff --git a/guix/git-download.scm b/guix/git-download.scm
index 5019a3e62f..7397cbe7f5 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -191,7 +191,12 @@ absolute file name and STAT is the result of 'lstat'."
                                                 result)))
                                vlist-null
                                files))
-         (prefix-length  (+ 1 (string-length (canonicalize-path directory))))
+
+         ;; Note: For this to work we must *not* call 'canonicalize-path' on
+         ;; DIRECTORY or we would get discrepancies of the returned lambda is
+         ;; called with a non-canonical file name.
+         (prefix-length  (+ 1 (string-length directory)))
+
          (status         (close-pipe pipe)))
     (and (zero? status)
          (lambda (file stat)
diff --git a/guix/graph.scm b/guix/graph.scm
index d7fd5f3e4b..5b650f5448 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017 Roel Janssen <roel@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@
   #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix sets)
+  #:use-module (guix packages)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -170,9 +172,9 @@ typically returned by 'node-edges' or 'node-back-edges'."
           name))
 (define (emit-epilogue port)
   (display "\n}\n" port))
-(define (emit-node id label port)
+(define (emit-node id node port)
   (format port "  \"~a\" [label = \"~a\", shape = box, fontname = Helvetica];~%"
-          id label))
+          id (package-full-name node)))
 (define (emit-edge id1 id2 port)
   (format port "  \"~a\" -> \"~a\" [color = ~a];~%"
           id1 id2 (pop-color id1)))
@@ -213,11 +215,11 @@ var nodes = {},
   (format port "</script><script type=\"text/javascript\" src=\"~a\"></script></body></html>"
           (search-path %load-path "graph.js")))
 
-(define (emit-d3js-node id label port)
+(define (emit-d3js-node id node port)
   (format port "\
 nodes[\"~a\"] = {\"id\": \"~a\", \"label\": \"~a\", \"index\": nodeArray.length};
 nodeArray.push(nodes[\"~a\"]);~%"
-          id id label id))
+          id id (package-full-name node) id))
 
 (define (emit-d3js-edge id1 id2 port)
   (format port "links.push({\"source\": \"~a\", \"target\": \"~a\"});~%"
@@ -241,9 +243,9 @@ nodeArray.push(nodes[\"~a\"]);~%"
 (define (emit-cypher-epilogue port)
   (format port ""))
 
-(define (emit-cypher-node id label port)
+(define (emit-cypher-node id node port)
   (format port "MERGE (p:Package { id: ~s }) SET p.name = ~s;~%"
-          id label ))
+          id (package-name node)))
 
 (define (emit-cypher-edge id1 id2 port)
   (format port "MERGE (a:Package { id: ~s });~%" id1)
@@ -296,7 +298,7 @@ true, draw reverse arrows."
                                         (ids          (mapm %store-monad
                                                             node-identifier
                                                             dependencies)))
-                     (emit-node id (node-label head) port)
+                     (emit-node id head port)
                      (for-each (lambda (dependency dependency-id)
                                  (if reverse-edges?
                                      (emit-edge dependency-id id port)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 04ab852999..aceafc674d 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -878,24 +878,39 @@ move to the previous or next line")
                                    #:key (reporters %formatting-reporters))
   "Report white-space issues in FILE starting from STARTING-LINE, and report
 them for PACKAGE."
-  (define last-line
-    ;; Number of the presumed last line.
-    ;; XXX: Ideally we'd stop at the boundaries of the surrounding sexp, but
-    ;; for now just use this simple heuristic.
-    (+ starting-line 60))
+  (define (sexp-last-line port)
+    ;; Return the last line of the sexp read from PORT or an estimate thereof.
+    (define &failure (list 'failure))
+
+    (let ((start      (ftell port))
+          (start-line (port-line port))
+          (sexp       (catch 'read-error
+                        (lambda () (read port))
+                        (const &failure))))
+      (let ((line (port-line port)))
+        (seek port start SEEK_SET)
+        (set-port-line! port start-line)
+        (if (eq? sexp &failure)
+            (+ start-line 60)                     ;conservative estimate
+            line))))
 
   (call-with-input-file file
     (lambda (port)
-      (let loop ((line-number 1))
+      (let loop ((line-number 1)
+                 (last-line #f))
         (let ((line (read-line port)))
           (or (eof-object? line)
-              (> line-number last-line)
-              (begin
-                (unless (< line-number starting-line)
-                  (for-each (lambda (report)
-                              (report package line line-number))
-                            reporters))
-                (loop (+ 1 line-number)))))))))
+              (and last-line (> line-number last-line))
+              (if (and (= line-number starting-line)
+                       (not last-line))
+                  (loop (+ 1 line-number)
+                        (+ 1 (sexp-last-line port)))
+                  (begin
+                    (unless (< line-number starting-line)
+                      (for-each (lambda (report)
+                                  (report package line line-number))
+                                reporters))
+                    (loop (+ 1 line-number) last-line)))))))))
 
 (define (check-formatting package)
   "Check the formatting of the source code of PACKAGE."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 8da7a3fd3a..fa45bd48a6 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -486,6 +486,11 @@ Install, remove, or upgrade packages in a single transaction.\n"))
                              arg-handler))))
          (option '(#\u "upgrade") #f #t
                  (lambda (opt name arg result arg-handler)
+                   (when (and arg (string-prefix? "-" arg))
+                     (warning (G_ "upgrade regexp '~a' looks like a \
+command-line option~%")
+                              arg)
+                     (warning (G_ "is this intended?~%")))
                    (let arg-handler ((arg arg) (result result))
                      (values (alist-cons 'upgrade arg
                                          ;; Delete any prior "upgrade all"
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 35282f9027..0d36997bc4 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -113,7 +113,7 @@
       (or (and=> (getenv "XDG_CACHE_HOME")
                  (cut string-append <> "/guix/substitute"))
           (string-append %state-directory "/substitute/cache"))
-      (string-append (cache-directory) "/substitute")))
+      (string-append (cache-directory #:ensure? #f) "/substitute")))
 
 (define %allow-unauthenticated-substitutes?
   ;; Whether to allow unchecked substitutes.  This is useful for testing
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0fcb6a9b0f..5a2811e75b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -431,8 +431,6 @@ generation as its default entry.  STORE is an open connection to the store."
   "Re-install bootloader for existing system profile generation NUMBER.
 STORE is an open connection to the store."
   (let* ((generation (generation-file-name %system-profile number))
-         (params (unless-file-not-found
-                  (read-boot-parameters-file generation)))
          ;; Detect the bootloader used in %system-profile.
          (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
 
@@ -442,10 +440,12 @@ STORE is an open connection to the store."
                              (bootloader bootloader)))
 
          ;; Make the specified system generation the default entry.
-         (entries (profile-boot-parameters %system-profile (list number)))
+         (params (profile-boot-parameters %system-profile (list number)))
          (old-generations (delv number (generation-numbers %system-profile)))
-         (old-entries (profile-boot-parameters
-                       %system-profile old-generations)))
+         (old-params (profile-boot-parameters
+                       %system-profile old-generations))
+         (entries (map boot-parameters->menu-entry params))
+         (old-entries (map boot-parameters->menu-entry old-params)))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg ((bootloader-configuration-file-generator bootloader)
@@ -657,7 +657,8 @@ output when building a system derivation, such as a disk image."
                       os
                       (if (eq? 'init action)
                           '()
-                          (profile-boot-parameters)))))
+                          (map boot-parameters->menu-entry
+                               (profile-boot-parameters))))))
        (bootcfg-file -> (bootloader-configuration-file bootloader))
        (bootloader-installer
         (let ((installer (bootloader-installer bootloader))
diff --git a/guix/ui.scm b/guix/ui.scm
index 4bad00e8cf..b0108d0705 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,7 +36,6 @@
   #:use-module (guix combinators)
   #:use-module (guix build-system)
   #:use-module (guix serialization)
-  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module ((guix licenses) #:select (license? license-name))
   #:use-module ((guix build syscalls)
                 #:select (free-disk-space terminal-columns))
@@ -79,7 +78,6 @@
             read/eval
             read/eval-package-expression
             location->string
-            config-directory
             fill-paragraph
             texi->plain-text
             package-description-string
@@ -856,25 +854,6 @@ replacement if PORT is not Unicode-capable."
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
-(define* (config-directory #:key (ensure? #t))
-  "Return the name of the configuration directory, after making sure that it
-exists if ENSURE? is true.  Honor the XDG specs,
-<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
-  (let ((dir (and=> (or (getenv "XDG_CONFIG_HOME")
-                        (and=> (getenv "HOME")
-                               (cut string-append <> "/.config")))
-                    (cut string-append <> "/guix"))))
-    (catch 'system-error
-      (lambda ()
-        (when ensure?
-          (mkdir-p dir))
-        dir)
-      (lambda args
-        (let ((err (system-error-errno args)))
-          ;; ERR is necessarily different from EEXIST.
-          (leave (G_ "failed to create configuration directory `~a': ~a~%")
-                 dir (strerror err)))))))
-
 (define* (fill-paragraph str width #:optional (column 0))
   "Fill STR such that each line contains at most WIDTH characters, assuming
 that the first character is at COLUMN.
diff --git a/guix/utils.scm b/guix/utils.scm
index 9bf1cc893f..ab43ed4008 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -33,7 +33,7 @@
   #:autoload   (rnrs io ports) (make-custom-binary-input-port)
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module (guix memoization)
-  #:use-module ((guix build utils) #:select (dump-port))
+  #:use-module ((guix build utils) #:select (dump-port mkdir-p))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
   #:use-module (ice-9 format)
   #:autoload   (ice-9 popen)  (open-pipe*)
@@ -81,7 +81,10 @@
             call-with-temporary-output-file
             call-with-temporary-directory
             with-atomic-file-output
+
+            config-directory
             cache-directory
+
             readlink*
             edit-expression
 
@@ -598,13 +601,26 @@ output port, and PROC's result is returned."
         (false-if-exception (delete-file template))
         (close-port out)))))
 
-(define (cache-directory)
-  "Return the cache directory for Guix, by default ~/.cache/guix."
-  (string-append (or (getenv "XDG_CACHE_HOME")
-                     (and=> (or (getenv "HOME")
-                                (passwd:dir (getpwuid (getuid))))
-                            (cut string-append <> "/.cache")))
-                 "/guix"))
+(define* (xdg-directory variable suffix #:key (ensure? #t))
+  "Return the name of the XDG directory that matches VARIABLE and SUFFIX,
+after making sure that it exists if ENSURE? is true.  VARIABLE is an
+environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like
+\"/.config\".  Honor the XDG specs,
+<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
+  (let ((dir (and=> (or (getenv variable)
+                        (and=> (or (getenv "HOME")
+                                   (passwd:dir (getpwuid (getuid))))
+                               (cut string-append <> suffix)))
+                    (cut string-append <> "/guix"))))
+    (when ensure?
+      (mkdir-p dir))
+    dir))
+
+(define config-directory
+  (cut xdg-directory "XDG_CONFIG_HOME" "/.config" <...>))
+
+(define cache-directory
+  (cut xdg-directory "XDG_CACHE_HOME" "/.cache" <...>))
 
 (define (readlink* file)
   "Call 'readlink' until the result is not a symlink."