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

10 files changed, 237 insertions, 48 deletions

diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm
index be6a600c28..2c82390ba6 100644
--- a/guix/build-system/r.scm
+++ b/guix/build-system/r.scm
@@ -61,7 +61,7 @@ release corresponding to NAME and VERSION."
                          "/src/contrib/"
                          name "_" version ".tar.gz")
           ;; TODO: use %bioconductor-version from (guix import cran)
-          (string-append "https://bioconductor.org/packages/3.13"
+          (string-append "https://bioconductor.org/packages/3.14"
                          type-url-part
                          "/src/contrib/"
                          name "_" version ".tar.gz"))))
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 9387a82065..420cd3b63a 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -155,9 +155,9 @@ package definition."
 (define %cran-canonical-url "https://cran.r-project.org/package=")
 (define %bioconductor-url "https://bioconductor.org/packages/")
 
-;; The latest Bioconductor release is 3.13.  Bioconductor packages should be
+;; The latest Bioconductor release is 3.14.  Bioconductor packages should be
 ;; updated together.
-(define %bioconductor-version "3.13")
+(define %bioconductor-version "3.14")
 
 (define* (bioconductor-packages-list-url #:optional type)
   (string-append "https://bioconductor.org/packages/"
diff --git a/guix/import/egg.scm b/guix/import/egg.scm
index 75b7659944..0b88020554 100644
--- a/guix/import/egg.scm
+++ b/guix/import/egg.scm
@@ -52,10 +52,10 @@
 ;;;
 ;;; The following happens under the hood:
 ;;;
-;;; * <git://code.call-cc.org/eggs-5-latest> is a Git repository that contains
-;;;   the latest version of all CHICKEN eggs.  We look clone this repository
-;;;   and retrieve the latest version number, and the PACKAGE.egg file, which
-;;;   contains a list of lists containing metadata about the egg.
+;;; * <git://code.call-cc.org/eggs-5-all> is a Git repository that contains
+;;;   all versions of all CHICKEN eggs.  We look clone this repository and, by
+;;;   default, retrieve the latest version number, and the PACKAGE.egg file,
+;;;   which contains a list of lists containing metadata about the egg.
 ;;;
 ;;; * All the eggs are stored as tarballs at
 ;;;   <https://code.call-cc.org/egg-tarballs/5>, so we grab the tarball for
@@ -97,7 +97,7 @@ NAME."
 (define (eggs-repository)
   "Update or fetch the latest version of the eggs repository and return the path
 to the repository."
-  (let* ((url "git://code.call-cc.org/eggs-5-latest")
+  (let* ((url "git://code.call-cc.org/eggs-5-all")
          (directory commit _ (update-cached-checkout url)))
     directory))
 
@@ -113,12 +113,13 @@ to the repository."
         (last directory)
         #f)))
 
-(define* (egg-metadata name #:optional file)
-  "Return the package metadata file for the egg NAME, or if FILE is specified,
-return the package metadata in FILE."
+(define* (egg-metadata name #:key (version #f) (file #f))
+  "Return the package metadata file for the egg NAME at version VERSION, or if
+FILE is specified, return the package metadata in FILE."
   (call-with-input-file (or file
                             (string-append (egg-directory name) "/"
-                                           (find-latest-version name)
+                                           (or version
+                                               (find-latest-version name))
                                            "/" name ".egg"))
     read))
 
@@ -174,10 +175,11 @@ return the package metadata in FILE."
 ;;; Egg importer.
 ;;;
 
-(define* (egg->guix-package name #:key (file #f) (source #f))
-  "Import a CHICKEN egg called NAME from either the given .egg FILE, or from
-the latest NAME metadata downloaded from the official repository if FILE is #f.
-Return a <package> record or #f on failure.
+(define* (egg->guix-package name version #:key (file #f) (source #f))
+  "Import a CHICKEN egg called NAME from either the given .egg FILE, or from the
+latest NAME metadata downloaded from the official repository if FILE is #f.
+Return a <package> record or #f on failure.  If VERSION is specified, import
+the particular version from the egg repository.
 
 SOURCE is a ``file-like'' object containing the source code corresponding to
 the egg.  If SOURCE is not specified, the latest tarball for egg NAME will be
@@ -187,8 +189,8 @@ Specifying the SOURCE argument is mainly useful for developing a CHICKEN egg
 locally.  Note that if FILE and SOURCE are specified, recursive import will
 not work."
   (define egg-content (if file
-                          (egg-metadata name file)
-                          (egg-metadata name)))
+                          (egg-metadata name #:file file)
+                          (egg-metadata name #:version version)))
   (if (not egg-content)
       (values #f '())                    ; egg doesn't exist
       (let* ((version* (or (assoc-ref egg-content 'version)
@@ -324,10 +326,11 @@ not work."
 (define egg->guix-package/m                   ;memoized variant
   (memoize egg->guix-package))
 
-(define (egg-recursive-import package-name)
+(define* (egg-recursive-import package-name #:optional version)
   (recursive-import package-name
+                    #:version version
                     #:repo->guix-package (lambda* (name #:key version repo)
-                                           (egg->guix-package/m name))
+                                           (egg->guix-package/m name version))
                     #:guix-name egg-name->guix-name))
 
 
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 05b4a45f2f..d20e274db7 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -337,9 +337,10 @@ the package named PACKAGE-NAME."
 type '<elpa-package>'."
 
   (define melpa-recipe
-    (if (eq? repo 'melpa)
-        (package-name->melpa-recipe (elpa-package-name pkg))
-        #f))
+    ;; XXX: Call 'identity' to work around a Guile 3.0.[5-7] compiler bug:
+    ;; <https://bugs.gnu.org/48368>.
+    (and (eq? (identity repo) 'melpa)
+         (package-name->melpa-recipe (elpa-package-name pkg))))
 
   (define name (elpa-package-name pkg))
 
diff --git a/guix/profiles.scm b/guix/profiles.scm
index aad23c0c0e..dcd0d30de1 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1682,11 +1682,119 @@ the entries in MANIFEST."
                     `((type . profile-hook)
                       (hook . manual-database))))
 
+(define (manual-database/optional manifest)
+  "Return a derivation to build the manual database of MANIFEST, but only if
+MANIFEST contains the \"man-db\" package.  Otherwise, return #f."
+  ;; Building the man database (for "man -k") is expensive and rarely used.
+  ;; Build it only if the profile also contains "man-db".
+  (mlet %store-monad ((man-db (manifest-lookup-package manifest "man-db")))
+    (if man-db
+        (manual-database manifest)
+        (return #f))))
+
+(define (texlive-configuration manifest)
+  "Return a derivation that builds a TeXlive configuration for the entries in
+MANIFEST."
+  (define entry->texlive-input
+    (match-lambda
+      (($ <manifest-entry> name version output thing deps)
+       (if (string-prefix? "texlive-" name)
+           (cons (gexp-input thing output)
+                 (append-map entry->texlive-input deps))
+           '()))))
+  (define texlive-bin
+    (module-ref (resolve-interface '(gnu packages tex)) 'texlive-bin))
+  (define coreutils
+    (module-ref (resolve-interface '(gnu packages base)) 'coreutils))
+  (define sed
+    (module-ref (resolve-interface '(gnu packages base)) 'sed))
+  (define updmap.cfg
+    (module-ref (resolve-interface '(gnu packages tex))
+                'texlive-default-updmap.cfg))
+  (define build
+    (with-imported-modules '((guix build utils)
+                             (guix build union))
+      #~(begin
+          (use-modules (guix build utils)
+                       (guix build union)
+                       (ice-9 popen))
+
+          ;; Build a modifiable union of all texlive inputs.  We do this so
+          ;; that TeX live can resolve the parent and grandparent directories
+          ;; correctly.  There might be a more elegant way to accomplish this.
+          (union-build #$output
+                       '#$(append-map entry->texlive-input
+                                      (manifest-entries manifest))
+                       #:create-all-directories? #t
+                       #:log-port (%make-void-port "w"))
+          (let ((texmf.cnf (string-append
+                            #$output
+                            "/share/texmf-dist/web2c/texmf.cnf")))
+            (when (file-exists? texmf.cnf)
+              (substitute* texmf.cnf
+                (("^TEXMFROOT = .*")
+                 (string-append "TEXMFROOT = " #$output "/share\n"))
+                (("^TEXMF = .*")
+                 "TEXMF = $TEXMFROOT/share/texmf-dist\n"))
+
+              ;; XXX: This is annoying, but it's necessary because texlive-bin
+              ;; does not provide wrapped executables.
+              (setenv "PATH"
+                      (string-append #$(file-append coreutils "/bin")
+                                     ":"
+                                     #$(file-append sed "/bin")))
+              (setenv "PERL5LIB" #$(file-append texlive-bin "/share/tlpkg"))
+              (setenv "TEXMF" (string-append #$output "/share/texmf-dist"))
+
+              ;; Remove invalid maps from config file.
+              (let* ((web2c (string-append #$output "/share/texmf-config/web2c/"))
+                     (maproot (string-append #$output "/share/texmf-dist/fonts/map/"))
+                     (updmap.cfg (string-append web2c "updmap.cfg")))
+                (mkdir-p web2c)
+
+                ;; Some profiles may already have this file, which prevents us
+                ;; from copying it.  Since we need to generate it from scratch
+                ;; anyway, we delete it here.
+                (when (file-exists? updmap.cfg)
+                  (delete-file updmap.cfg))
+                (copy-file #$updmap.cfg updmap.cfg)
+                (make-file-writable updmap.cfg)
+                (let* ((port (open-pipe* OPEN_WRITE
+                                         #$(file-append texlive-bin "/bin/updmap-sys")
+                                         "--syncwithtrees"
+                                         "--nohash"
+                                         "--force"
+                                         (string-append "--cnffile=" web2c "updmap.cfg"))))
+                  (display "Y\n" port)
+                  (when (not (zero? (status:exit-val (close-pipe port))))
+                    (error "failed to filter updmap.cfg")))
+
+                ;; Generate font maps.
+                (invoke #$(file-append texlive-bin "/bin/updmap-sys")
+                        (string-append "--cnffile=" web2c "updmap.cfg")
+                        (string-append "--dvipdfmxoutputdir="
+                                       maproot "updmap/dvipdfmx/")
+                        (string-append "--dvipsoutputdir="
+                                       maproot "updmap/dvips/")
+                        (string-append "--pdftexoutputdir="
+                                       maproot "updmap/pdftex/")))))
+          #t)))
+
+  (mlet %store-monad ((texlive-base (manifest-lookup-package manifest "texlive-base")))
+    (if texlive-base
+        (gexp->derivation "texlive-configuration" build
+                          #:substitutable? #f
+                          #:local-build? #t
+                          #:properties
+                          `((type . profile-hook)
+                            (hook . texlive-configuration)))
+        (return #f))))
+
 (define %default-profile-hooks
   ;; This is the list of derivation-returning procedures that are called by
   ;; default when making a non-empty profile.
   (list info-dir-file
-        manual-database
+        manual-database/optional
         fonts-dir-file
         ghc-package-cache-file
         ca-certificate-bundle
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index cca0ad991b..8176de4a5e 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -34,6 +34,7 @@
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix transformations)
+  #:autoload   (ice-9 ftw) (scandir)
   #:autoload   (gnu build linux-container) (call-with-container %namespaces
                                             user-namespace-supported?
                                             unprivileged-user-namespace-supported?
@@ -401,7 +402,12 @@ regexps in WHITE-LIST."
 
   (match command
     ((program . args)
-     (apply execlp program program args))))
+     (catch 'system-error
+       (lambda ()
+         (apply execlp program program args))
+       (lambda _
+         ;; Following established convention, exit with 127 upon ENOENT.
+         (primitive-_exit 127))))))
 
 (define (child-shell-environment shell profile manifest)
   "Create a child process, load PROFILE and MANIFEST, and then run SHELL in
@@ -552,6 +558,38 @@ running in a \"container\", immune to the issue described above."))
         (info (G_ "All is good!  The shell gets correct environment \
 variables.~%")))))
 
+(define (suggest-command-name profile command)
+  "COMMAND was not found in PROFILE so display a hint suggesting the closest
+command name."
+  (define not-dot?
+    (match-lambda
+      ((or "." "..") #f)
+      (_ #t)))
+
+  (match (scandir (string-append profile "/bin") not-dot?)
+    (() #f)
+    (available
+     (match command
+       ((executable _ ...)
+        ;; Look for a suggestion with a high threshold: a suggestion is
+        ;; usually better than no suggestion.
+        (let ((closest (string-closest executable available
+                                       #:threshold 12)))
+          (unless (or (not closest) (string=? closest executable))
+            (display-hint (format #f (G_ "Did you mean '~a'?~%")
+                                  closest)))))))))
+
+(define (validate-exit-status profile command status)
+  "When STATUS, an integer as returned by 'waitpid', is 127, raise a \"command
+not found\" error.  Otherwise return STATUS."
+  ;; Most likely, exit value 127 means ENOENT.
+  (when (eqv? (status:exit-val status) 127)
+    (report-error (G_ "~a: command not found~%")
+                  (first command))
+    (suggest-command-name profile command)
+    (exit 1))
+  status)
+
 (define* (launch-environment/fork command profile manifest
                                   #:key pure? (white-list '()))
   "Run COMMAND in a new process with an environment containing PROFILE, with
@@ -563,7 +601,8 @@ regexps in WHITE-LIST."
                            #:pure? pure?
                            #:white-list white-list))
     (pid (match (waitpid pid)
-           ((_ . status) status)))))
+           ((_ . status)
+            (validate-exit-status profile command status))))))
 
 (define* (launch-environment/container #:key command bash user user-mappings
                                        profile manifest link-profile? network?
@@ -584,6 +623,9 @@ WHILE-LIST."
     (and (file-exists? (file-system-mapping-source mapping))
          (file-system-mapping->bind-mount mapping)))
 
+  (define (exit/status* status)
+    (exit/status (validate-exit-status profile command status)))
+
   (mlet %store-monad ((reqs (inputs->requisites
                              (list (direct-store-path bash) profile))))
     (return
@@ -640,7 +682,7 @@ WHILE-LIST."
                                       '())
                                   (map file-system-mapping->bind-mount
                                        mappings))))
-       (exit/status
+       (exit/status*
         (call-with-container file-systems
           (lambda ()
             ;; Setup global shell.
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index 7a7712dd96..fbf89069a7 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -27,6 +27,9 @@
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 popen)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (import-manifest
@@ -56,12 +59,33 @@ FILE-NAME with \"-\", and return the basename of it."
   (define (destination-append path)
     (string-append destination-directory "/" path))
 
+  (define (bash-alias->pair line)
+    (if (string-prefix? "alias" line)
+        (let ((matched (string-match "alias (.+)=\"?'?([^\"']+)\"?'?" line)))
+          `(,(match:substring matched 1) . ,(match:substring matched 2)))
+        '()))
+  
+  (define (parse-aliases input)
+    (let loop ((line (read-line input))
+               (result '()))
+      (if (eof-object? line)
+          (reverse result)
+          (loop (read-line input)
+                (cons (bash-alias->pair line) result)))))
+
   (let ((rc (destination-append ".bashrc"))
         (profile (destination-append ".bash_profile"))
         (logout (destination-append ".bash_logout")))
     `((service home-bash-service-type
                (home-bash-configuration
                 ,@(if (file-exists? rc)
+                      `((aliases
+                         ',(let* ((port (open-pipe* OPEN_READ "bash" "-i" "-c" "alias"))
+                               (alist (parse-aliases port)))
+                           (close-port port)
+                           (filter (negate null?) alist))))
+                      '())
+                ,@(if (file-exists? rc)
                       `((bashrc
                          (list (local-file ,rc
                                            ,(basename+remove-dots rc)))))
diff --git a/guix/scripts/import/egg.scm b/guix/scripts/import/egg.scm
index 829cdc2ca0..6a9657d12c 100644
--- a/guix/scripts/import/egg.scm
+++ b/guix/scripts/import/egg.scm
@@ -26,6 +26,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-egg))
@@ -83,21 +84,24 @@ Import and convert the egg package for PACKAGE-NAME.\n"))
                             (_ #f))
                            (reverse opts))))
     (match args
-      ((package-name)
-       (if (assoc-ref opts 'recursive)
-           ;; Recursive import
-           (map (match-lambda
-                  ((and ('package ('name name) . rest) pkg)
-                   `(define-public ,(string->symbol name)
-                      ,pkg))
-                  (_ #f))
-                (egg-recursive-import package-name))
-           ;; Single import
-           (let ((sexp (egg->guix-package package-name)))
-             (unless sexp
-               (leave (G_ "failed to download meta-data for package '~a'~%")
-                      package-name))
-             sexp)))
+      ((spec)
+       (let ((name version (package-name->name+version spec)))
+         (if (assoc-ref opts 'recursive)
+             ;; Recursive import
+             (map (match-lambda
+                    ((and ('package ('name name) . rest) pkg)
+                     `(define-public ,(string->symbol name)
+                        ,pkg))
+                    (_ #f))
+                  (egg-recursive-import name version))
+             ;; Single import
+             (let ((sexp (egg->guix-package name version)))
+               (unless sexp
+                 (leave (G_ "failed to download meta-data for package '~a'~%")
+                        (if version
+                            (string-append name "@" version)
+                            name)))
+               sexp))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 5749485a44..bd62803cb1 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -387,8 +387,14 @@ echo ~a >> ~a
         (display-hint (G_ "Consider passing the @option{--check} option once
 to make sure your shell does not clobber environment variables."))) )
 
-  (let ((result (guix-environment* opts)))
-    (maybe-remove-expired-cache-entries (%profile-cache-directory)
-                                        cache-entries
-                                        #:entry-expiration entry-expiration)
-    result))
+  ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
+  ;; of cached profiles, and (2) cleanup actually happens, even when
+  ;; 'guix-environment*' calls 'exit'.
+  (add-hook! exit-hook
+             (lambda _
+               (maybe-remove-expired-cache-entries
+                (%profile-cache-directory)
+                cache-entries
+                #:entry-expiration entry-expiration)))
+
+  (guix-environment* opts))
diff --git a/guix/ui.scm b/guix/ui.scm
index b01bb3d587..bd999103ff 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -377,7 +377,8 @@ ARGS is the list of arguments received by the 'throw' handler."
                                       (+ 2 (string-contains message ": ")))))
            (format (current-error-port) (G_ "~amissing closing parenthesis~%")
                    location))
-         (apply throw args)))
+         (report-error (G_ "read error while loading '~a': ~a~%")
+                       file (apply format #f message args))))
     (('syntax-error proc message properties form subform . rest)
      (let ((loc (source-properties->location properties)))
        (report-error loc (G_ "~s: ~a~%")