@@ -27,7 +27,7 @@
#:use-module (rnrs io ports)
#:export (union-build
- warn-about-collision
+ default-collision-resolver
relative-file-name
symlink-relative))
@@ -102,10 +102,11 @@ identical, #f otherwise."
;; applications via 'glib-or-gtk-build-system'.
'("icon-theme.cache" "gschemas.compiled"))
-(define (warn-about-collision files)
- "Handle the collision among FILES by emitting a warning and choosing the
-first one of THEM."
- (let ((file (first files)))
+(define (resolve-collision/pick-first files)
+ (first files))
+
+(define (resolve-collision-and-maybe-warn files resolver)
+ (let ((file (resolver files)))
(unless (member (basename file) %harmless-collisions)
(format (current-error-port)
"~%warning: collision encountered:~%~{ ~a~%~}"
@@ -113,11 +114,14 @@ first one of THEM."
(format (current-error-port) "warning: choosing ~a~%" file))
file))
+(define (default-collision-resolver files)
+ (resolve-collision-and-maybe-warn files resolve-collision/pick-first))
+
(define* (union-build output inputs
#:key (log-port (current-error-port))
(create-all-directories? #f)
(symlink symlink)
- (resolve-collision warn-about-collision))
+ (resolve-collision default-collision-resolver))
"Build in the OUTPUT directory a symlink tree that is the union of all the
INPUTS, using SYMLINK to create symlinks. As a special case, if
CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to
@@ -1983,7 +1983,7 @@ This yields an 'etc' directory containing these two files."
(define* (directory-union name things
#:key (copy? #f) (quiet? #f)
- (resolve-collision 'warn-about-collision))
+ (resolve-collision 'default-collision-resolver))
"Return a directory that is the union of THINGS, where THINGS is a list of
file-like objects denoting directories. For example: