From 9f3ea03516b506d7c0440867b9db08898390a981 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 17 May 2023 15:28:54 +0200 Subject: diagnostics: Factorize 'absolute-location'. * guix/scripts/style.scm (absolute-location): Move to... * guix/diagnostics.scm (absolute-location): ... here. * guix/upstream.scm (update-package-source): Use it. --- guix/diagnostics.scm | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'guix/diagnostics.scm') diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 9f0d558f2f..3f1f527b43 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2021, 2023 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +36,7 @@ location-file location-line location-column + absolute-location source-properties->location location->source-properties location->string @@ -340,6 +341,23 @@ number of arguments in ARGS matches the escapes in FORMAT." (&formatted-message (format str) (arguments (list args ...)))))))))) +(define (absolute-location loc) + "Replace the file name in LOC by an absolute location." + (location (if (string-prefix? "/" (location-file loc)) + (location-file loc) + + ;; 'search-path' might return #f in obscure cases, such as + ;; when %LOAD-PATH includes "." or ".." and LOC comes from a + ;; file in a subdirectory thereof. + (match (search-path %load-path (location-file loc)) + (#f + (raise (formatted-message + (G_ "file '~a' not found on load path") + (location-file loc)))) + (str str))) + (location-line loc) + (location-column loc))) + (define guix-warning-port (make-parameter (current-warning-port))) -- cgit v1.2.3