Merge branch 'master' into core-updates

9 files changed, 202 insertions, 104 deletions

diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index 49549c1b4b..fae1b47ec5 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -171,6 +172,12 @@ to the default GNU unpack strategy."
                 #:allow-other-keys)
   (apply invoke `("ant" ,build-target ,@make-flags)))
 
+(define (regular-jar-file-predicate file stat)
+  "Predicate returning true if FILE is ending on '.jar'
+and STAT indicates it is a regular file."
+    (and ((file-name-predicate "\\.jar$") file stat)
+         (eq? 'regular (stat:type stat))))
+
 (define* (generate-jar-indices #:key outputs #:allow-other-keys)
   "Generate file \"META-INF/INDEX.LIST\".  This file does not use word wraps
 and is preferred over \"META-INF/MANIFEST.MF\", which does use word wraps,
@@ -181,7 +188,10 @@ dependencies of this jar file."
     (invoke "jar" "-i" jar))
   (for-each (match-lambda
               ((output . directory)
-               (for-each generate-index (find-files directory "\\.jar$"))))
+               (for-each generate-index
+                         (find-files
+                          directory
+                          regular-jar-file-predicate))))
             outputs)
   #t)
 
@@ -222,7 +232,8 @@ repack them.  This is necessary to ensure that archives are reproducible."
 
   (for-each (match-lambda
               ((output . directory)
-               (for-each repack-archive (find-files directory "\\.jar$"))))
+               (for-each repack-archive
+                         (find-files directory regular-jar-file-predicate))))
             outputs)
   #t)
 
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index 4be5443083..8a8d74ee1b 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -40,21 +40,6 @@
 ;;
 ;; Code:
 
-;; TODO: Move this to (guix build cargo-utils). Will cause a full rebuild
-;; of all rust compilers.
-
-(define (generate-all-checksums dir-name)
-  (for-each
-    (lambda (filename)
-      (let* ((dir (dirname filename))
-             (checksum-file (string-append dir "/.cargo-checksum.json")))
-        (when (file-exists? checksum-file) (delete-file checksum-file))
-        (display (string-append
-                   "patch-cargo-checksums: generate-checksums for "
-                   dir "\n"))
-        (generate-checksums dir)))
-    (find-files dir-name "Cargo.toml$")))
-
 (define (manifest-targets)
   "Extract all targets from the Cargo.toml manifest"
   (let* ((port (open-input-pipe "cargo read-manifest"))
diff --git a/guix/build/cargo-utils.scm b/guix/build/cargo-utils.scm
index 79e5440378..5ac429a62a 100644
--- a/guix/build/cargo-utils.scm
+++ b/guix/build/cargo-utils.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
+;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,7 +23,8 @@
   #:use-module (guix build utils)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
-  #:export (generate-checksums))
+  #:export (generate-checksums
+            generate-all-checksums))
 
 ;; Commentary:
 ;;
@@ -66,3 +68,15 @@ the same directory."
         (display "},\"package\":" port)
         (write (file-sha256 "/dev/null") port)
         (display "}" port)))))
+
+(define (generate-all-checksums dir-name)
+  (for-each
+    (lambda (filename)
+      (let* ((dir (dirname filename))
+             (checksum-file (string-append dir "/.cargo-checksum.json")))
+        (when (file-exists? checksum-file) (delete-file checksum-file))
+        (display (string-append
+                   "patch-cargo-checksums: generate-checksums for "
+                   dir "\n"))
+        (generate-checksums dir)))
+    (find-files dir-name "Cargo.toml$")))
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index 06ed57c9d7..3781e148ce 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -39,25 +39,32 @@
 ;;;
 ;;; Code:
 
-(define %default-optimizations
-  ;; Default optimization options (equivalent to -O2 on Guile 2.2).
-  (append (if (defined? 'tree-il-default-optimization-options)
-              (tree-il-default-optimization-options) ;Guile 2.2
-              (tree-il-optimizations))               ;Guile 3
-          (if (defined? 'cps-default-optimization-options)
-              (cps-default-optimization-options)  ;Guile 2.2
-              (cps-optimizations))))              ;Guile 3
-
-(define %lightweight-optimizations
-  ;; Lightweight optimizations (like -O0, but with partial evaluation).
-  (let loop ((opts %default-optimizations)
-             (result '()))
-    (match opts
-      (() (reverse result))
-      ((#:partial-eval? _ rest ...)
-       (loop rest `(#t #:partial-eval? ,@result)))
-      ((kw _ rest ...)
-       (loop rest `(#f ,kw ,@result))))))
+(define optimizations-for-level
+  (or (and=> (false-if-exception
+              (resolve-interface '(system base optimize)))
+             (lambda (iface)
+               (module-ref iface 'optimizations-for-level))) ;Guile 3.0
+      (let ()                                                ;Guile 2.2
+        (define %default-optimizations
+          ;; Default optimization options (equivalent to -O2 on Guile 2.2).
+          (append (tree-il-default-optimization-options)
+                  (cps-default-optimization-options)))
+
+        (define %lightweight-optimizations
+          ;; Lightweight optimizations (like -O0, but with partial evaluation).
+          (let loop ((opts %default-optimizations)
+                     (result '()))
+            (match opts
+              (() (reverse result))
+              ((#:partial-eval? _ rest ...)
+               (loop rest `(#t #:partial-eval? ,@result)))
+              ((kw _ rest ...)
+               (loop rest `(#f ,kw ,@result))))))
+
+        (lambda (level)
+          (if (<= level 1)
+              %lightweight-optimizations
+              %default-optimizations)))))
 
 (define (supported-warning-type? type)
   "Return true if TYPE, a symbol, denotes a supported warning type."
@@ -80,8 +87,8 @@
 (define (optimization-options file)
   "Return the default set of optimizations options for FILE."
   (if (string-contains file "gnu/packages/")
-      %lightweight-optimizations                  ;build faster
-      '()))
+      (optimizations-for-level 1)                 ;build faster
+      (optimizations-for-level 3)))
 
 (define (scm->go file)
   "Strip the \".scm\" suffix from FILE, and append \".go\"."
diff --git a/guix/build/download.scm b/guix/build/download.scm
index a4c91550a6..141ef409d6 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -187,10 +187,13 @@ name decoding bug described at
 DIRECTORY.  Those authority certificates are checked when
 'peer-certificate-status' is later called."
   (let ((cred  (make-certificate-credentials))
-        (files (or (scandir directory
-                            (lambda (file)
-                              (string-suffix? ".pem" file)))
-                   '())))
+        (files (match (scandir directory (cut string-suffix? ".pem" <>))
+                 ((or #f ())
+                  ;; Some distros provide nothing but bundles (*.crt) under
+                  ;; /etc/ssl/certs, so look for them.
+                  (or (scandir directory (cut string-suffix? ".crt" <>))
+                      '()))
+                 (pem pem))))
     (for-each (lambda (file)
                 (let ((file (string-append directory "/" file)))
                   ;; Protect against dangling symlinks.
@@ -198,7 +201,7 @@ DIRECTORY.  Those authority certificates are checked when
                     (set-certificate-credentials-x509-trust-file!*
                      cred file
                      x509-certificate-format/pem))))
-              (or files '()))
+              files)
     cred))
 
 (define (peer-certificate session)
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index 47a9eda9e6..e2b792d3dc 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2016 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2018, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,11 +40,10 @@
 ;;
 ;; Code:
 
-;; Directory suffix where we install ELPA packages.  We avoid ".../elpa" as
-;; Emacs expects to find the ELPA repository 'archive-contents' file and the
-;; archive signature.
-(define %legacy-install-suffix "/share/emacs/site-lisp")
-(define %install-suffix (string-append %legacy-install-suffix "/guix.d"))
+;;; All the packages are installed directly under site-lisp, which means that
+;;; having that directory in the EMACSLOADPATH is enough to have them found by
+;;; Emacs.
+(define %install-dir "/share/emacs/site-lisp")
 
 ;; These are the default inclusion/exclusion regexps for the install phase.
 (define %default-include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
@@ -74,50 +73,23 @@ archive, a directory, or an Emacs Lisp file."
         #t)
       (gnu:unpack #:source source)))
 
-(define* (set-emacs-load-path #:key source inputs #:allow-other-keys)
-  (define (inputs->directories inputs)
-    "Extract the directory part from INPUTS."
-    (match inputs
-      (((names . directories) ...) directories)))
-
-  (define (input-directory->el-directory input-directory)
-    "Return the correct Emacs Lisp directory in INPUT-DIRECTORY or #f, if there
-is no Emacs Lisp directory."
-    (let ((legacy-elisp-directory (string-append input-directory %legacy-install-suffix))
-          (guix-elisp-directory
-           (string-append
-            input-directory %install-suffix "/"
-            (store-directory->elpa-name-version input-directory))))
-      (cond
-       ((file-exists? guix-elisp-directory) guix-elisp-directory)
-       ((file-exists? legacy-elisp-directory) legacy-elisp-directory)
-       (else #f))))
-
-  (define (input-directories->el-directories input-directories)
-    "Return the list of Emacs Lisp directories in INPUT-DIRECTORIES."
-    (filter-map input-directory->el-directory input-directories))
-
-  "Set the EMACSLOADPATH environment variable so that dependencies are found."
+(define* (add-source-to-load-path #:key dummy #:allow-other-keys)
+  "Augment the EMACSLOADPATH environment variable with the source directory."
   (let* ((source-directory (getcwd))
-         (input-elisp-directories (input-directories->el-directories
-                                   (inputs->directories inputs)))
-         (emacs-load-path-value
-          (string-join
-           (append input-elisp-directories (list source-directory))
-           ":" 'suffix)))
+         (emacs-load-path-value (string-append (getenv "EMACSLOADPATH") ":"
+                                               source-directory)))
     (setenv "EMACSLOADPATH" emacs-load-path-value)
-    (format #t "environment variable `EMACSLOADPATH' set to ~a\n"
-            emacs-load-path-value)))
+    (format #t "source directory ~s appended to the `EMACSLOADPATH' \
+environment variable\n" source-directory)))
 
 (define* (build #:key outputs inputs #:allow-other-keys)
   "Compile .el files."
   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
          (out (assoc-ref outputs "out"))
-         (elpa-name-ver (store-directory->elpa-name-version out))
-         (el-dir (string-append out %install-suffix "/" elpa-name-ver)))
+         (site-lisp (string-append out %install-dir)))
     (setenv "SHELL" "sh")
     (parameterize ((%emacs emacs))
-      (emacs-byte-compile-directory el-dir))))
+      (emacs-byte-compile-directory site-lisp))))
 
 (define* (patch-el-files #:key outputs #:allow-other-keys)
   "Substitute the absolute \"/bin/\" directory with the right location in the
@@ -134,9 +106,7 @@ store in '.el' files."
       #:binary #t))
 
   (let* ((out (assoc-ref outputs "out"))
-         (elpa-name-ver (store-directory->elpa-name-version out))
-         (el-dir (string-append out %install-suffix "/" elpa-name-ver))
-
+         (site-lisp (string-append out %install-dir))
          ;; (ice-9 regex) uses libc's regexp routines, which cannot deal with
          ;; strings containing NULs.  Filter out such files.  TODO: Remove
          ;; this workaround when <https://bugs.gnu.org/30116> is fixed.
@@ -150,7 +120,7 @@ store in '.el' files."
              (error "patch-el-files: unable to locate " cmd-name))
            (string-append "\"" cmd "\"")))))
 
-    (with-directory-excursion el-dir
+    (with-directory-excursion site-lisp
       ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still
       ;; ISO-8859-1-encoded.
       (unless (false-if-exception (substitute-program-names))
@@ -201,15 +171,14 @@ parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND."
            (not (any (cut match-stripped-file "excluded" <>) exclude)))))
 
   (let* ((out (assoc-ref outputs "out"))
-         (elpa-name-ver (store-directory->elpa-name-version out))
-         (target-directory (string-append out %install-suffix "/" elpa-name-ver))
+         (site-lisp (string-append out %install-dir))
          (files-to-install (find-files source install-file?)))
     (cond
      ((not (null? files-to-install))
       (for-each
        (lambda (file)
          (let* ((stripped-file (string-drop file (string-length source)))
-                (target-file (string-append target-directory stripped-file)))
+                (target-file (string-append site-lisp stripped-file)))
            (format #t "`~a' -> `~a'~%" file target-file)
            (install-file file (dirname target-file))))
        files-to-install)
@@ -223,14 +192,12 @@ parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND."
 (define* (move-doc #:key outputs #:allow-other-keys)
   "Move info files from the ELPA package directory to the info directory."
   (let* ((out (assoc-ref outputs "out"))
-         (elpa-name-ver (store-directory->elpa-name-version out))
-         (el-dir (string-append out %install-suffix "/" elpa-name-ver))
-         (name-ver (strip-store-file-name out))
+         (site-lisp (string-append out %install-dir))
          (info-dir (string-append out "/share/info/"))
-         (info-files (find-files el-dir "\\.info$")))
+         (info-files (find-files site-lisp "\\.info$")))
     (unless (null? info-files)
       (mkdir-p info-dir)
-      (with-directory-excursion el-dir
+      (with-directory-excursion site-lisp
         (when (file-exists? "dir") (delete-file "dir"))
         (for-each (lambda (f)
                     (copy-file f (string-append info-dir "/" (basename f)))
@@ -242,11 +209,11 @@ parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND."
   "Generate the autoloads file."
   (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
          (out (assoc-ref outputs "out"))
+         (site-lisp (string-append out %install-dir))
          (elpa-name-ver (store-directory->elpa-name-version out))
-         (elpa-name (package-name->name+version elpa-name-ver))
-         (el-dir (string-append out %install-suffix "/" elpa-name-ver)))
+         (elpa-name (package-name->name+version elpa-name-ver)))
     (parameterize ((%emacs emacs))
-      (emacs-generate-autoloads elpa-name el-dir))))
+      (emacs-generate-autoloads elpa-name site-lisp))))
 
 (define (emacs-package? name)
   "Check if NAME correspond to the name of an Emacs package."
@@ -269,7 +236,7 @@ second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
 (define %standard-phases
   (modify-phases gnu:%standard-phases
     (replace 'unpack unpack)
-    (add-after 'unpack 'set-emacs-load-path set-emacs-load-path)
+    (add-after 'unpack 'add-source-to-load-path add-source-to-load-path)
     (delete 'bootstrap)
     (delete 'configure)
     ;; Move the build phase after install: the .el files are byte compiled
diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
new file mode 100644
index 0000000000..46fcad7848
--- /dev/null
+++ b/guix/build/qt-build-system.scm
@@ -0,0 +1,109 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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 (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build qt-build-system)
+  #:use-module ((guix build cmake-build-system) #:prefix cmake:)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (%standard-phases
+            qt-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the standard Qt build procedure.
+;;
+;; Code:
+
+(define (variables-for-wrapping base-directories)
+
+  (define (collect-sub-dirs base-directories subdirectory)
+    (filter-map
+     (lambda (dir)
+       (let ((directory (string-append dir subdirectory)))
+         (if (directory-exists? directory) directory #f)))
+     base-directories))
+
+  (filter
+   (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
+   (map
+    (lambda (var-spec)
+      `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec))))
+    (list
+     ;; these shall match the search-path-specification for Qt and KDE
+     ;; libraries
+     '("XDG_DATA_DIRS" "/share")
+     '("XDG_CONFIG_DIRS" "/etc/xdg")
+     '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
+     '("QML2_IMPORT_PATH" "/lib/qt5/qml")))))
+
+(define* (wrap-all-programs #:key inputs outputs
+                            (qt-wrap-excluded-outputs '())
+                            #:allow-other-keys)
+  "Implement phase \"qt-wrap\": look for GSettings schemas and
+gtk+-v.0 libraries and create wrappers with suitably set environment variables
+if found.
+
+Wrapping is not applied to outputs whose name is listed in
+QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
+to contain any Qt binaries, and where wrapping would gratuitously
+add a dependency of that output on Qt."
+  (define (find-files-to-wrap directory)
+    (append-map
+     (lambda (dir)
+       (if (directory-exists? dir) (find-files dir ".*") (list)))
+     (list (string-append directory "/bin")
+           (string-append directory "/sbin")
+           (string-append directory "/libexec")
+           (string-append directory "/lib/libexec"))))
+
+  (define input-directories
+    ;; FIXME: Filter out unwanted inputs, e.g. cmake
+    (match inputs
+           (((_ . dir) ...)
+            dir)))
+
+  (define handle-output
+    (match-lambda
+     ((output . directory)
+      (unless (member output qt-wrap-excluded-outputs)
+        (let ((bin-list     (find-files-to-wrap directory))
+              (vars-to-wrap (variables-for-wrapping
+                             (append (list output)
+                                         input-directories))))
+          (when (not (null? vars-to-wrap))
+            (for-each (cut apply wrap-program <> vars-to-wrap)
+                      bin-list)))))))
+
+  (for-each handle-output outputs)
+  #t)
+
+(define %standard-phases
+  (modify-phases cmake:%standard-phases
+    (add-after 'install 'qt-wrap wrap-all-programs)))
+
+(define* (qt-build #:key inputs (phases %standard-phases)
+                   #:allow-other-keys #:rest args)
+  "Build the given package, applying all of PHASES in order."
+  (apply cmake:cmake-build #:inputs inputs #:phases phases args))
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index 48a32674e9..d2486ee86c 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -26,9 +26,9 @@
       (if env-val (string-append env-val ":" path) path)))
 
   (let ((qml-path        (suffix "QML2_IMPORT_PATH"
-                                 (string-append out "/qml")))
+                                 (string-append out "/lib/qt5/qml")))
         (plugin-path     (suffix "QT_PLUGIN_PATH"
-                                 (string-append out "/plugins")))
+                                 (string-append out "/lib/qt5/plugins")))
         (xdg-data-path   (suffix "XDG_DATA_DIRS"
                                  (string-append out "/share")))
         (xdg-config-path (suffix "XDG_CONFIG_DIRS"
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index a5a9c92a42..ce7999b433 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1127,7 +1127,9 @@ exception if it's already taken."
                 (lambda (key . args)
                   (match key
                     ('flock-error
-                     (handler args))
+                     (apply handler args)
+                     ;; No open port to the lock, so return #f.
+                     #f)
                     ('system-error
                       ;; When using the statically-linked Guile in the initrd,
                       ;; 'fcntl-flock' returns ENOSYS unconditionally.  Ignore