diff options
author | Ludovic Courtès <ludo@gnu.org> | 2023-05-17 15:28:54 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2023-05-31 23:25:25 +0200 |
commit | 9f3ea03516b506d7c0440867b9db08898390a981 (patch) | |
tree | 4460150ecc85e968f16cd3bd57af549f0b712b96 /guix/diagnostics.scm | |
parent | e6223017d95bc615b2648f0798d9a3904d5b5f57 (diff) | |
download | guix-9f3ea03516b506d7c0440867b9db08898390a981.tar guix-9f3ea03516b506d7c0440867b9db08898390a981.tar.gz |
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.
Diffstat (limited to 'guix/diagnostics.scm')
-rw-r--r-- | guix/diagnostics.scm | 20 |
1 files changed, 19 insertions, 1 deletions
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 <ludo@gnu.org> +;;; Copyright © 2012-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; 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))) |