summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/font-build-system.scm8
-rw-r--r--guix/build/gnu-bootstrap.scm32
-rw-r--r--guix/build/minetest-build-system.scm9
-rw-r--r--guix/build/python-build-system.scm6
-rw-r--r--guix/build/qt-utils.scm10
-rw-r--r--guix/build/utils.scm35
6 files changed, 64 insertions, 36 deletions
diff --git a/guix/build/font-build-system.scm b/guix/build/font-build-system.scm
index 6726595fe1..e4784bc17d 100644
--- a/guix/build/font-build-system.scm
+++ b/guix/build/font-build-system.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2017, 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2017 Alex Griffin <a@ajgrf.com>
;;;
;;; This file is part of GNU Guix.
@@ -41,8 +41,7 @@ archive, or a font file."
(begin
(mkdir "source")
(chdir "source")
- (copy-file source (strip-store-file-name source))
- #t)
+ (copy-file source (strip-store-file-name source)))
(gnu:unpack #:source source)))
(define* (install #:key outputs #:allow-other-keys)
@@ -54,7 +53,8 @@ archive, or a font file."
(find-files source "\\.(ttf|ttc)$"))
(for-each (cut install-file <> (string-append fonts "/opentype"))
(find-files source "\\.(otf|otc)$"))
- #t))
+ (for-each (cut install-file <> (string-append fonts "/web"))
+ (find-files source "\\.(woff|woff2)$"))))
(define %standard-phases
(modify-phases gnu:%standard-phases
diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm
index 1cb9dc5512..b4257a3717 100644
--- a/guix/build/gnu-bootstrap.scm
+++ b/guix/build/gnu-bootstrap.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2020, 2022 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,17 +25,18 @@
(define-module (guix build gnu-bootstrap)
#:use-module (guix build utils)
+ #:use-module (srfi srfi-1)
#:use-module (system base compile)
#:export (bootstrap-configure
bootstrap-build
bootstrap-install))
-(define (bootstrap-configure version modules scripts)
+(define (bootstrap-configure name version modules scripts)
"Create a procedure that configures an early bootstrap package. The
-procedure will search the MODULES directory and configure all of the
-'.in' files with VERSION. It will then search the SCRIPTS directory and
-configure all of the '.in' files with the bootstrap Guile and its module
-and object directories."
+procedure will search each directory in MODULES and configure all of the
+'.in' files with NAME and VERSION. It will then search the SCRIPTS
+directory and configure all of the '.in' files with the bootstrap
+Guile and its module and object directories."
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(guile-dir (assoc-ref inputs "guile"))
@@ -50,10 +51,10 @@ and object directories."
(let ((target (string-drop-right template 3)))
(copy-file template target)
(substitute* target
+ (("@PACKAGE_NAME@") name)
(("@VERSION@") version))))
- (find-files modules
- (lambda (fn st)
- (string-suffix? ".in" fn))))
+ (append-map (lambda (dir) (find-files dir "\\.in$"))
+ modules))
(for-each (lambda (template)
(format #t "Configuring ~a~%" template)
(let ((target (string-drop-right template 3)))
@@ -70,7 +71,7 @@ and object directories."
(define (bootstrap-build modules)
"Create a procedure that builds an early bootstrap package. The
-procedure will search the MODULES directory and compile all of the
+procedure will search each directory in MODULES and compile all of the
'.scm' files."
(lambda _
(add-to-load-path (getcwd))
@@ -80,13 +81,15 @@ procedure will search the MODULES directory and compile all of the
(dir (dirname scm)))
(format #t "Compiling ~a~%" scm)
(compile-file scm #:output-file go)))
- (find-files modules "\\.scm$"))
+ (append-map (lambda (dir) (find-files dir "\\.scm$"))
+ modules))
#t))
(define (bootstrap-install modules scripts)
"Create a procedure that installs an early bootstrap package. The
-procedure will install all of the '.scm' and '.go' files in the MODULES
-directory, and all the executable files in the SCRIPTS directory."
+procedure will install all of the '.scm' and '.go' files in each of the
+directories in MODULES, and all the executable files in the SCRIPTS
+directory."
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(guile-dir (assoc-ref inputs "guile"))
@@ -104,7 +107,8 @@ directory, and all the executable files in the SCRIPTS directory."
(install-file scm (string-append moddir "/" dir))
(format #t "Installing ~a~%" go)
(install-file go (string-append godir "/" dir))))
- (find-files modules "\\.scm$"))
+ (append-map (lambda (dir) (find-files dir "\\.scm$"))
+ modules))
(for-each (lambda (script)
(format #t "Installing ~a~%" script)
(install-file script (string-append out "/bin")))
diff --git a/guix/build/minetest-build-system.scm b/guix/build/minetest-build-system.scm
index 5f68686067..4a7a87ab83 100644
--- a/guix/build/minetest-build-system.scm
+++ b/guix/build/minetest-build-system.scm
@@ -91,15 +91,6 @@ If it is unknown, make an educated guess."
#:install-plan (mod-install-plan (apply guess-mod-name arguments))
arguments))
-(define %png-magic-bytes
- ;; Magic bytes of PNG images, see ‘5.2 PNG signatures’ in
- ;; ‘Portable Network Graphics (PNG) Specification (Second Edition)’
- ;; on <https://www.w3.org/TR/PNG/>.
- #vu8(137 80 78 71 13 10 26 10))
-
-(define png-file?
- ((@@ (guix build utils) file-header-match) %png-magic-bytes))
-
(define* (minimise-png #:key inputs native-inputs #:allow-other-keys)
"Minimise PNG images found in the working directory."
(define optipng (which "optipng"))
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 08871f60cd..aa04664b25 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -68,7 +68,7 @@
;; downloading the package source from PyPI (the Python Package Index). Both
;; of them import setuptools and execute the "setup.py" file under their
;; control. Thus the "setup.py" behaves as if the developer had imported
-;; setuptools within setup.py - even is still using only distutils.
+;; setuptools within setup.py - even if it is still using only distutils.
;;
;; Setuptools' "install" command (to be more precise: the "easy_install"
;; command which is called by "install") will put the path of the currently
@@ -176,8 +176,8 @@ without errors."
(define (site-packages inputs outputs)
"Return the path of the current output's Python site-package."
- (let* ((out (python-output outputs))
- (python (assoc-ref inputs "python")))
+ (let ((out (python-output outputs))
+ (python (assoc-ref inputs "python")))
(string-append out "/lib/python" (python-version python) "/site-packages")))
(define (add-installed-pythonpath inputs outputs)
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index 2e47f1bc02..b8ecfedd43 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -98,7 +98,7 @@
`("QTWEBENGINEPROCESS_PATH" = regular
,(format #f "/lib/qt~a/libexec/QtWebEngineProcess" qt-major-version)))))
-(define* (wrap-qt-program* program #:key inputs output-dir
+(define* (wrap-qt-program* program #:key sh inputs output-dir
qt-wrap-excluded-inputs
(qt-major-version %default-qt-major-version))
@@ -115,9 +115,9 @@
output-dir
#:qt-major-version qt-major-version)))
(when (not (null? vars-to-wrap))
- (apply wrap-program program vars-to-wrap))))
+ (apply wrap-program program #:sh sh vars-to-wrap))))
-(define* (wrap-qt-program program-name #:key inputs output
+(define* (wrap-qt-program program-name #:key (sh (which "bash")) inputs output
(qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
(qt-major-version %default-qt-major-version))
"Wrap the specified program (which must reside in the OUTPUT's \"/bin\"
@@ -126,11 +126,12 @@ directory) with suitably set environment variables.
This is like qt-build-systems's phase \"qt-wrap\", but only the named program
is wrapped."
(wrap-qt-program* (string-append output "/bin/" program-name)
+ #:sh sh
#:output-dir output #:inputs inputs
#:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
#:qt-major-version qt-major-version))
-(define* (wrap-all-qt-programs #:key inputs outputs
+(define* (wrap-all-qt-programs #:key (sh (which "bash")) inputs outputs
qtbase
(qt-wrap-excluded-outputs '())
(qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
@@ -169,6 +170,7 @@ add a dependency of that output on Qt."
((output . output-dir)
(unless (member output qt-wrap-excluded-outputs)
(for-each (cut wrap-qt-program* <>
+ #:sh sh
#:output-dir output-dir #:inputs inputs
#:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
#:qt-major-version qt-major-version)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index dd5a91f52f..5ea3b98353 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -3,11 +3,11 @@
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2015, 2018, 2021 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2022 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;;
;;; This file is part of GNU Guix.
@@ -60,8 +60,11 @@
directory-exists?
executable-file?
symbolic-link?
+ switch-symlinks
call-with-temporary-output-file
call-with-ascii-input-file
+ file-header-match
+ png-file?
elf-file?
ar-file?
gzip-file?
@@ -238,6 +241,25 @@ introduce the version part."
"Return #t if FILE is a symbolic link (aka. \"symlink\".)"
(eq? (stat:type (lstat file)) 'symlink))
+(define (switch-symlinks link target)
+ "Atomically switch LINK, a symbolic link, to point to TARGET. Works
+both when LINK already exists and when it does not."
+ (let ((pivot (string-append link ".new")))
+ ;; Create pivot link, deleting it if it already exists. This can
+ ;; happen if a previous switch-symlinks was interrupted.
+ (let symlink/remove-old ()
+ (catch 'system-error
+ (lambda ()
+ (symlink target pivot))
+ (lambda args
+ (if (= (system-error-errno args) EEXIST)
+ (begin
+ ;; Remove old link and retry.
+ (delete-file pivot)
+ (symlink/remove-old))
+ (apply throw args)))))
+ (rename-file pivot link)))
+
(define (call-with-temporary-output-file proc)
"Call PROC with a name of a temporary file and open output port to that
file; close the file and delete it when leaving the dynamic extent of this
@@ -291,6 +313,15 @@ with the bytes in HEADER, a bytevector."
#f ;FILE is a directory
(apply throw args))))))
+(define %png-magic-bytes
+ ;; Magic bytes of PNG images, see ‘5.2 PNG signatures’ in
+ ;; ‘Portable Network Graphics (PNG) Specification (Second Edition)’
+ ;; on <https://www.w3.org/TR/PNG/>.
+ #vu8(137 80 78 71 13 10 26 10))
+
+(define png-file?
+ (file-header-match %png-magic-bytes))
+
(define %elf-magic-bytes
;; Magic bytes of ELF files. See <elf.h>.
(u8-list->bytevector (map char->integer (string->list "\x7FELF"))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-22 16:39:21 +0000