me/guix
Archived
1
0
Fork 0
Code Activity

diagnostics: Factorize 'absolute-location'.

Browse source 
* guix/scripts/style.scm (absolute-location): Move to...
* guix/diagnostics.scm (absolute-location): ... here.
* guix/upstream.scm (update-package-source): Use it.
This commit is contained in:
Ludovic Courtès 2023-05-17 15:28:54 +02:00
parent e6223017d9
commit 9f3ea03516
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 21 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
guix/diagnostics.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,6 +36,7 @@
location-file location-file
location-line location-line
location-column location-column
absolute-location
source-properties->location source-properties->location
location->source-properties location->source-properties
location->string location->string
@ -340,6 +341,23 @@ number of arguments in ARGS matches the escapes in FORMAT."
(&formatted-message (format str) (&formatted-message (format str)
(arguments (list args ...)))))))))) (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 (define guix-warning-port
(make-parameter (current-warning-port))) (make-parameter (current-warning-port)))

17
guix/scripts/style.scm
View file

@ -226,23 +226,6 @@ doing it."
(G_ "would be edited~%"))) (G_ "would be edited~%")))
str))) str)))
(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 (trivial-package-arguments? package) (define (trivial-package-arguments? package)
"Return true if PACKAGE has zero arguments or only \"trivial\" arguments "Return true if PACKAGE has zero arguments or only \"trivial\" arguments
guaranteed not to refer to input labels." guaranteed not to refer to input labels."

4
guix/upstream.scm
View file

@ -637,8 +637,8 @@ new version string if an update was made, and #f otherwise."
;; function of the person who uploads the package. Note that ;; function of the person who uploads the package. Note that
;; package definitions usually concatenate fragments of the URL, ;; package definitions usually concatenate fragments of the URL,
;; which is why we only attempt to replace a subset of the URL. ;; which is why we only attempt to replace a subset of the URL.
(let ((properties (assq-set! (location->source-properties loc) (let ((properties (location->source-properties
'filename file)) (absolute-location loc)))
(replacements `((,old-version . ,version) (replacements `((,old-version . ,version)
(,old-hash . ,hash) (,old-hash . ,hash)
,@(if (and old-commit new-commit) ,@(if (and old-commit new-commit)