diff options
author | Marius Bakke <marius@gnu.org> | 2021-05-09 21:29:46 +0200 |
---|---|---|
committer | Marius Bakke <marius@gnu.org> | 2021-05-09 21:29:46 +0200 |
commit | f03426420497cd9839f5fb3cb547dbecd8d6053b (patch) | |
tree | 220cdbab5b58b27c63d2df3ee711ad4bfdda074b /guix/build | |
parent | 3cf1afb7e7249992b2db2f4f00899fd22237e89a (diff) | |
parent | 069399ee9dbf75b7c89583f03346a63b2cfe4ac6 (diff) | |
download | guix-patches-f03426420497cd9839f5fb3cb547dbecd8d6053b.tar guix-patches-f03426420497cd9839f5fb3cb547dbecd8d6053b.tar.gz |
Merge branch 'master' into core-updates
Conflicts:
gnu/local.mk
gnu/packages/bioinformatics.scm
gnu/packages/django.scm
gnu/packages/gtk.scm
gnu/packages/llvm.scm
gnu/packages/python-web.scm
gnu/packages/python.scm
gnu/packages/tex.scm
guix/build-system/asdf.scm
guix/build/emacs-build-system.scm
guix/profiles.scm
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/asdf-build-system.scm | 15 | ||||
-rw-r--r-- | guix/build/download.scm | 84 | ||||
-rw-r--r-- | guix/build/emacs-build-system.scm | 79 |
3 files changed, 133 insertions, 45 deletions
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 6ad855cab2..7f1037c4f9 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca> -;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net> +;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,12 +52,13 @@ (string-append %source-install-prefix "/systems")) (define (main-system-name output) - (let ((package-name (package-name->name+version - (strip-store-file-name output))) - (lisp-prefix (string-append (%lisp-type) "-"))) - (if (string-prefix? lisp-prefix package-name) - (string-drop package-name (string-length lisp-prefix)) - package-name))) + ;; FIXME: Find a more reliable way to get the main system name. + (let* ((full-name (strip-store-file-name output)) + (lisp-prefix (string-append (%lisp-type) "-")) + (package-name (if (string-prefix? lisp-prefix full-name) + (string-drop full-name (string-length lisp-prefix)) + full-name))) + (package-name->name+version package-name))) (define (lisp-source-directory output name) (string-append output (%lisp-source-install-prefix) "/" name)) diff --git a/guix/build/download.scm b/guix/build/download.scm index a22d4064ca..b14db42352 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,6 +35,8 @@ #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:autoload (ice-9 ftw) (scandir) + #:autoload (guix base16) (bytevector->base16-string) + #:autoload (guix swh) (swh-download-directory) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (open-socket-for-uri @@ -626,10 +629,54 @@ Return a list of URIs." (else (list uri)))) +(define* (disarchive-fetch/any uris file + #:key (timeout 10) (verify-certificate? #t)) + "Fetch a Disarchive specification from any of URIS, assemble it, +and write the output to FILE." + (define (fetch-specification uris) + (any (lambda (uri) + (false-if-exception* + (let-values (((port size) (http-fetch uri + #:verify-certificate? + verify-certificate? + #:timeout timeout))) + (let ((specification (read port))) + (close-port port) + specification)))) + uris)) + + (define (resolve addresses output) + (any (match-lambda + (('swhid swhid) + (match (string-split swhid #\:) + (("swh" "1" "dir" id) + (format #t "Downloading ~a from Software Heritage...~%" file) + (false-if-exception* + (swh-download-directory id output))) + (_ #f))) + (_ #f)) + addresses)) + + (format #t "Trying to use Disarchive to assemble ~a...~%" file) + (match (and=> (resolve-module '(disarchive) #:ensure #f) + (lambda (disarchive) + (cons (module-ref disarchive '%disarchive-log-port) + (module-ref disarchive 'disarchive-assemble)))) + (#f (format #t "could not load Disarchive~%") + #f) + ((%disarchive-log-port . disarchive-assemble) + (match (fetch-specification uris) + (#f (format #t "could not find its Disarchive specification~%") + #f) + (spec (parameterize ((%disarchive-log-port (current-output-port))) + (false-if-exception* + (disarchive-assemble spec file #:resolver resolve)))))))) + (define* (url-fetch url file #:key (timeout 10) (verify-certificate? #t) (mirrors '()) (content-addressed-mirrors '()) + (disarchive-mirrors '()) (hashes '()) print-build-trace?) "Fetch FILE from URL; URL may be either a single string, or a list of @@ -693,6 +740,18 @@ otherwise simply ignore them." hashes)) content-addressed-mirrors)) + (define disarchive-uris + (append-map (match-lambda + ((? string? mirror) + (map (match-lambda + ((hash-algo . hash) + (string->uri + (string-append mirror + (symbol->string hash-algo) "/" + (bytevector->base16-string hash))))) + hashes))) + disarchive-mirrors)) + ;; Make this unbuffered so 'progress-report/file' works as expected. 'line ;; means '\n', not '\r', so it's not appropriate here. (setvbuf (current-output-port) 'none) @@ -705,15 +764,20 @@ otherwise simply ignore them." (or (fetch uri file) (try tail))) (() - (format (current-error-port) "failed to download ~s from ~s~%" - file url) - - ;; Remove FILE in case we made an incomplete download, for example due - ;; to ENOSPC. - (catch 'system-error - (lambda () - (delete-file file)) - (const #f)) - #f)))) + ;; If we are looking for a software archive, one last thing we + ;; can try is to use Disarchive to assemble it. + (or (disarchive-fetch/any disarchive-uris file + #:verify-certificate? verify-certificate? + #:timeout timeout) + (begin + (format (current-error-port) "failed to download ~s from ~s~%" + file url) + ;; Remove FILE in case we made an incomplete download, for + ;; example due to ENOSPC. + (catch 'system-error + (lambda () + (delete-file file)) + (const #f)) + #f)))))) ;;; download.scm ends here diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm index 79a1a42c4a..ba2c1b4aad 100644 --- a/guix/build/emacs-build-system.scm +++ b/guix/build/emacs-build-system.scm @@ -26,13 +26,16 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (ice-9 format) + #:use-module (ice-9 ftw) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) #:export (%standard-phases %default-include %default-exclude - emacs-build)) + emacs-build + elpa-directory)) ;; Commentary: ;; @@ -40,9 +43,12 @@ ;; ;; Code: -;;; 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. +;;; The location in which Emacs looks for packages. Emacs Lisp code that is +;;; installed there directly will be found when that directory is added to +;;; EMACSLOADPATH. To avoid clashes between packages (particularly considering +;;; auxiliary files), we install them one directory level below, however. +;;; This indirection is handled by ‘expand-load-path’ during build and a +;;; profile hook otherwise. (define %install-dir "/share/emacs/site-lisp") ;; These are the default inclusion/exclusion regexps for the install phase. @@ -73,40 +79,51 @@ archive, a directory, or an Emacs Lisp file." #t) (gnu:unpack #:source source))) -(define* (add-source-to-load-path #:key dummy #:allow-other-keys) - "Augment the EMACSLOADPATH environment variable with the source directory." +(define* (expand-load-path #:key (prepend-source? #t) #:allow-other-keys) + "Expand EMACSLOADPATH, so that inputs, whose code resides in subdirectories, +are properly found. +If @var{prepend-source?} is @code{#t} (the default), also add the current +directory to EMACSLOADPATH in front of any other directories." (let* ((source-directory (getcwd)) (emacs-load-path (string-split (getenv "EMACSLOADPATH") #\:)) - ;; XXX: Make sure the Emacs core libraries appear at the end of - ;; EMACSLOADPATH, to avoid shadowing any other libraries depended - ;; upon. - (emacs-load-path-non-core (filter (cut string-contains <> - "/share/emacs/site-lisp") - emacs-load-path)) + (emacs-load-path* + (map + (lambda (dir) + (match (scandir dir (negate (cute member <> '("." "..")))) + ((sub) (string-append dir "/" sub)) + (_ dir))) + emacs-load-path)) (emacs-load-path-value (string-append - (string-join (cons source-directory - emacs-load-path-non-core) - ":") + (string-join + (if prepend-source? + (cons source-directory emacs-load-path*) + emacs-load-path*) + ":") ":"))) (setenv "EMACSLOADPATH" emacs-load-path-value) - (format #t "source directory ~s prepended to the `EMACSLOADPATH' \ -environment variable\n" source-directory))) + (when prepend-source? + (format #t "source directory ~s prepended to the `EMACSLOADPATH' \ +environment variable\n" source-directory)) + (let ((diff (lset-difference string=? emacs-load-path* emacs-load-path))) + (unless (null? diff) + (format #t "expanded load paths for ~{~a~^, ~}\n" + (map basename diff)))))) (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")) - (site-lisp (string-append out %install-dir))) + (out (assoc-ref outputs "out"))) (setenv "SHELL" "sh") (parameterize ((%emacs emacs)) - (emacs-byte-compile-directory site-lisp)))) + (emacs-byte-compile-directory (elpa-directory out))))) (define* (patch-el-files #:key outputs #:allow-other-keys) "Substitute the absolute \"/bin/\" directory with the right location in the store in '.el' files." (let* ((out (assoc-ref outputs "out")) - (site-lisp (string-append out %install-dir)) + (elpa-name-ver (store-directory->elpa-name-version out)) + (el-dir (string-append out %install-dir "/" elpa-name-ver)) (el-files (find-files (getcwd) "\\.el$"))) (define (substitute-program-names) (substitute* el-files @@ -116,7 +133,7 @@ store in '.el' files." (error "patch-el-files: unable to locate " cmd-name)) (string-append "\"" cmd "\""))))) - (with-directory-excursion site-lisp + (with-directory-excursion el-dir ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still ;; ISO-8859-1-encoded. (unless (false-if-exception (substitute-program-names)) @@ -167,14 +184,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")) - (site-lisp (string-append out %install-dir)) + (el-dir (elpa-directory out)) (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 site-lisp stripped-file))) + (target-file (string-append el-dir stripped-file))) (format #t "`~a' -> `~a'~%" file target-file) (install-file file (dirname target-file)))) files-to-install) @@ -205,11 +222,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))) + (elpa-name (package-name->name+version elpa-name-ver)) + (el-dir (elpa-directory out))) (parameterize ((%emacs emacs)) - (emacs-generate-autoloads elpa-name site-lisp)))) + (emacs-generate-autoloads elpa-name el-dir)))) (define* (enable-autoloads-compilation #:key outputs #:allow-other-keys) "Remove the NO-BYTE-COMPILATION local variable embedded in the generated @@ -244,10 +261,16 @@ second hyphen. This corresponds to 'name-version' as used in ELPA packages." strip-store-file-name) store-dir)) +(define (elpa-directory store-dir) + "Given the store directory STORE-DIR return the absolute install directory +for libraries following the ELPA convention." + (string-append store-dir %install-dir "/" + (store-directory->elpa-name-version store-dir))) + (define %standard-phases (modify-phases gnu:%standard-phases (replace 'unpack unpack) - (add-after 'unpack 'add-source-to-load-path add-source-to-load-path) + (add-after 'unpack 'expand-load-path expand-load-path) (delete 'bootstrap) (delete 'configure) (delete 'build) |