diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-04-20 22:52:35 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-04-20 22:52:35 +0200 |
commit | 3e31ec827a887eda2d13f5fb7b7f61e222b2169d (patch) | |
tree | 70125ea496e8a5b2987068153851c0723c5df2ff | |
parent | b3129f2b761a371105e6d213519e5c71930cb419 (diff) | |
download | guix-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.scm | 19 |
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))) |