Merge branch 'master' into core-updates

9 files changed, 132 insertions, 54 deletions

diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index c3d6c62404..705943eb73 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -48,7 +48,7 @@
   "Return a URI string for the Python package hosted on the Python Package
 Index (PyPI) corresponding to NAME and VERSION.  EXTENSION is the file name
 extension, such as '.tar.gz'."
-  (string-append "https://pypi.python.org/packages/source/"
+  (string-append "https://pypi.io/packages/source/"
                  (string-take name 1) "/" name "/"
                  name "-" version extension))
 
diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 1f17e0a22d..928bef5b9e 100644
--- a/guix/build/bournish.scm
+++ b/guix/build/bournish.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:export (%bournish-language))
 
@@ -103,6 +105,63 @@ characters."
        ((@ (guix build utils) dump-port) port (current-output-port))
        *unspecified*)))
 
+(define (lines+chars port)
+  "Return the number of lines and number of chars read from PORT."
+  (let loop ((lines 0) (chars 0))
+    (match (read-char port)
+      ((? eof-object?)              ;done!
+       (values lines chars))
+      (#\newline                    ;recurse
+       (loop (1+ lines) (1+ chars)))
+      (_                            ;recurse
+       (loop lines (1+ chars))))))
+
+(define (file-exists?* file)
+  "Like 'file-exists?' but emits a warning if FILE is not accessible."
+  (catch 'system-error
+    (lambda ()
+      (stat file))
+    (lambda args
+      (let ((errno (system-error-errno args)))
+        (format (current-error-port) "~a: ~a~%"
+                file (strerror errno))
+        #f))))
+
+(define (wc-print file)
+  (let-values (((lines chars)
+                (call-with-input-file file lines+chars)))
+              (format #t "~a ~a ~a~%" lines chars file)))
+
+(define (wc-l-print file)
+  (let-values (((lines chars)
+                (call-with-input-file file lines+chars)))
+              (format #t "~a ~a~%" lines file)))
+
+(define (wc-c-print file)
+  (let-values (((lines chars)
+                (call-with-input-file file lines+chars)))
+              (format #t "~a ~a~%" chars file)))
+
+(define (wc-command-implementation . files)
+  (for-each wc-print (filter file-exists?* files)))
+
+(define (wc-l-command-implementation . files)
+  (for-each wc-l-print (filter file-exists?* files)))
+
+(define (wc-c-command-implementation . files)
+  (for-each wc-c-print (filter file-exists?* files)))
+
+(define (wc-command . args)
+  "Emit code for the 'wc' command."
+  (cond ((member "-l" args)
+         `((@@ (guix build bournish) wc-l-command-implementation)
+           ,@(delete "-l" args)))
+        ((member "-c" args)
+         `((@@ (guix build bournish) wc-c-command-implementation)
+           ,@(delete "-c" args)))
+        (else
+         `((@@ (guix build bournish) wc-command-implementation) ,@args))))
+
 (define (help-command . _)
   (display "\
 Hello, this is Bournish, a minimal Bourne-like shell in Guile!
@@ -129,7 +188,8 @@ commands such as 'ls' and 'cd'; it lacks globbing, pipes---everything.\n"))
     ("help"   ,help-command)
     ("ls"     ,ls-command)
     ("which"  ,which-command)
-    ("cat"    ,cat-command)))
+    ("cat"    ,cat-command)
+    ("wc"     ,wc-command)))
 
 (define (read-bournish port env)
   "Read a Bournish expression from PORT, and return the corresponding Scheme
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index ab970012a7..44e8b0d31e 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,10 +154,11 @@ store in '.el' files."
 (define (emacs-inputs-el-directories dirs)
   "Build the list of Emacs Lisp directories from the Emacs package directory
 DIRS."
-  (map (lambda (d)
-         (string-append d %install-suffix "/"
-                        (store-directory->elpa-name-version d)))
-       dirs))
+  (append-map (lambda (d)
+                (list (string-append d "/share/emacs/site-lisp")
+                      (string-append d %install-suffix "/"
+                                     (store-directory->elpa-name-version d))))
+              dirs))
 
 (define (package-name-version->elpa-name-version name-ver)
   "Convert the Guix package NAME-VER to the corresponding ELPA name-version
diff --git a/guix/config.scm.in b/guix/config.scm.in
index d7df9f7d2b..adffa0cfec 100644
--- a/guix/config.scm.in
+++ b/guix/config.scm.in
@@ -59,8 +59,8 @@
   (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix"))
 
 (define %config-directory
-  ;; This must match `NIX_CONF_DIR' as defined in `nix/local.mk'.
-  (or (getenv "NIX_CONF_DIR") "@guix_sysconfdir@/guix"))
+  ;; This must match `GUIX_CONFIGURATION_DIRECTORY' as defined in `nix/local.mk'.
+  (or (getenv "GUIX_CONFIGURATION_DIRECTORY") "@guix_sysconfdir@/guix"))
 
 (define %guix-register-program
   ;; The 'guix-register' program.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 2bf1013b3c..b929b79c26 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -856,8 +856,10 @@ and in the current monad setting (system type, etc.)"
 
 (define %utils-module
   ;; This file provides 'mkdir-p', needed to implement 'imported-files' and
-  ;; other primitives below.
-  (local-file (search-path %load-path "guix/build/utils.scm")
+  ;; other primitives below.  Note: We give the file name relative to this
+  ;; file you are currently reading; 'search-path' could return a file name
+  ;; relative to the current working directory.
+  (local-file "build/utils.scm"
               "build-utils.scm"))
 
 (define* (imported-files files
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 70ef507666..efa69081ef 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -175,8 +175,10 @@ cannot determine package dependencies"))
                  (lambda (port)
                    (let* ((metadata (json->scm port))
                           (run_requires (hash-ref metadata "run_requires"))
-                          (requirements (hash-ref (list-ref run_requires 0)
-                                                  "requires")))
+                          (requirements (if run_requires
+                                            (hash-ref (list-ref run_requires 0)
+                                                       "requires")
+                                            '())))
                      (map (lambda (r)
                             (python->package-name (clean-requirement r)))
                           requirements)))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 81ce770dc5..5722aa821d 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -94,10 +94,15 @@
 ;;; Code:
 
 (define %narinfo-cache-directory
-  ;; A local cache of narinfos, to avoid going to the network.
-  (or (and=> (getenv "XDG_CACHE_HOME")
-             (cut string-append <> "/guix/substitute"))
-      (string-append %state-directory "/substitute/cache")))
+  ;; A local cache of narinfos, to avoid going to the network.  Most of the
+  ;; time, 'guix substitute' is called by guix-daemon as root and stores its
+  ;; cached data in /var/guix/….  However, when invoked from 'guix challenge'
+  ;; as a user, it stores its cache in ~/.cache.
+  (if (zero? (getuid))
+      (or (and=> (getenv "XDG_CACHE_HOME")
+                 (cut string-append <> "/guix/substitute"))
+          (string-append %state-directory "/substitute/cache"))
+      (string-append (cache-directory) "/substitute")))
 
 (define %allow-unauthenticated-substitutes?
   ;; Whether to allow unchecked substitutes.  This is useful for testing
@@ -501,17 +506,10 @@ indicates that PATH is unavailable at CACHE-URL."
               (value ,(and=> narinfo narinfo->string))))
 
   (let ((file (narinfo-cache-file cache-url path)))
-    (catch 'system-error
-      (lambda ()
-        (mkdir-p (dirname file))
-        (with-atomic-file-output file
-          (lambda (out)
-            (write (cache-entry cache-url narinfo) out))))
-      (lambda args
-        ;; We may not have write access to the local cache when called from an
-        ;; unprivileged process such as 'guix challenge'.
-        (unless (= EACCES (system-error-errno args))
-          (apply throw args)))))
+    (mkdir-p (dirname file))
+    (with-atomic-file-output file
+      (lambda (out)
+        (write (cache-entry cache-url narinfo) out))))
 
   narinfo)
 
diff --git a/guix/store.scm b/guix/store.scm
index a64016611d..276684e2fb 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1061,24 +1061,19 @@ Return #t on success.
 Use with care as it directly modifies the store!  This is primarily meant to
 be used internally by the daemon's build hook."
   ;; Currently this is implemented by calling out to the fine C++ blob.
-  (catch 'system-error
-    (lambda ()
-      (let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program
-                         `(,@(if prefix
-                                 `("--prefix" ,prefix)
-                                 '())
-                           ,@(if state-directory
-                                 `("--state-directory" ,state-directory)
-                                 '())))))
-        (and pipe
-             (begin
-               (format pipe "~a~%~a~%~a~%"
-                       path (or deriver "") (length references))
-               (for-each (cut format pipe "~a~%" <>) references)
-               (zero? (close-pipe pipe))))))
-    (lambda args
-      ;; Failed to run %GUIX-REGISTER-PROGRAM.
-      #f)))
+  (let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program
+                     `(,@(if prefix
+                             `("--prefix" ,prefix)
+                             '())
+                       ,@(if state-directory
+                             `("--state-directory" ,state-directory)
+                             '())))))
+    (and pipe
+         (begin
+           (format pipe "~a~%~a~%~a~%"
+                   path (or deriver "") (length references))
+           (for-each (cut format pipe "~a~%" <>) references)
+           (zero? (close-pipe pipe))))))
 
 
 ;;;
diff --git a/guix/utils.scm b/guix/utils.scm
index a642bd3d62..9e1b8ead0a 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -637,10 +637,11 @@ output port, and PROC's result is returned."
 
 (define (cache-directory)
   "Return the cache directory for Guix, by default ~/.cache/guix."
-  (or (getenv "XDG_CONFIG_HOME")
-      (and=> (or (getenv "HOME")
-                 (passwd:dir (getpwuid (getuid))))
-             (cut string-append <> "/.cache/guix"))))
+  (string-append (or (getenv "XDG_CACHE_HOME")
+                     (and=> (or (getenv "HOME")
+                                (passwd:dir (getpwuid (getuid))))
+                            (cut string-append <> "/.cache")))
+                 "/guix"))
 
 (define (readlink* file)
   "Call 'readlink' until the result is not a symlink."
@@ -702,6 +703,18 @@ output port, and PROC's result is returned."
 ;;; Source location.
 ;;;
 
+(define (absolute-dirname file)
+  "Return the absolute name of the directory containing FILE, or #f upon
+failure."
+  (match (search-path %load-path file)
+    (#f #f)
+    ((? string? file)
+     ;; If there are relative names in %LOAD-PATH, FILE can be relative and
+     ;; needs to be canonicalized.
+     (if (string-prefix? "/" file)
+         (dirname file)
+         (canonicalize-path (dirname file))))))
+
 (define-syntax current-source-directory
   (lambda (s)
     "Return the absolute name of the current directory, or #f if it could not
@@ -711,11 +724,16 @@ be determined."
        (match (assq 'filename (syntax-source s))
          (('filename . (? string? file-name))
           ;; If %FILE-PORT-NAME-CANONICALIZATION is 'relative, then FILE-NAME
-          ;; can be relative.  In that case, we try to find out the absolute
-          ;; file name by looking at %LOAD-PATH.
-          (if (string-prefix? "/" file-name)
-              (dirname file-name)
-              (and=> (search-path %load-path file-name) dirname)))
+          ;; can be relative.  In that case, we try to find out at run time
+          ;; the absolute file name by looking at %LOAD-PATH; doing this at
+          ;; run time rather than expansion time is necessary to allow files
+          ;; to be moved on the file system.
+          (cond ((not file-name)
+                 #f)                ;raising an error would upset Geiser users
+                ((string-prefix? "/" file-name)
+                 (dirname file-name))
+                (else
+                 #`(absolute-dirname #,file-name))))
          (_
           #f))))))