aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-04-20 22:52:35 +0200
committerLudovic Courtès <ludo@gnu.org>2016-04-20 22:52:35 +0200
commit3e31ec827a887eda2d13f5fb7b7f61e222b2169d (patch)
tree70125ea496e8a5b2987068153851c0723c5df2ff
parentb3129f2b761a371105e6d213519e5c71930cb419 (diff)
downloadguix-3e31ec827a887eda2d13f5fb7b7f61e222b2169d.tar.gz
guix-3e31ec827a887eda2d13f5fb7b7f61e222b2169d.zip
download: 'uri-abbreviation' can abbreviate the URI's basename.
* guix/build/download.scm (uri-abbreviation): Use 'ellipsis' instead of "...". Abbreviate the basename of PATH if needed.
-rw-r--r--guix/build/download.scm19
1 files changed, 12 insertions, 7 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index e00fa04e35..fe7a453c89 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -202,13 +202,18 @@ abbreviation of URI showing the scheme, host, and basename of the file."
(uri->string uri))
(define (elide-path)
- (let ((path (uri-path uri)))
- (string-append (symbol->string (uri-scheme uri)) "://"
-
- ;; `file' URIs have no host part.
- (or (uri-host uri) "")
-
- (string-append "/.../" (basename path)))))
+ (let* ((path (uri-path uri))
+ (base (basename path))
+ (prefix (string-append (symbol->string (uri-scheme uri)) "://"
+
+ ;; `file' URIs have no host part.
+ (or (uri-host uri) "")
+
+ (string-append "/" (ellipsis) "/"))))
+ (if (> (+ (string-length prefix) (string-length base)) max-length)
+ (string-append prefix (ellipsis)
+ (string-drop base (quotient (string-length base) 2)))
+ (string-append prefix base))))
(if (> (string-length uri-as-string) max-length)
(let ((short (elide-path)))