aboutsummaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-24 22:18:07 +0200
committerLudovic Courtès <ludo@gnu.org>2015-09-24 22:18:07 +0200
commit1007b6bf0bef3f662f65ffdd0d4383179dd07355 (patch)
tree4a9b2a4baa2d82434e12fe4aacc8f28e3266793e /guix
parent12cd4dd3a9052491e3912ffeecbe8854ea9b971a (diff)
parenta7a4fd9a7cd02e4897e7b2156bd9ecc7e72e9818 (diff)
downloadgnu-guix-1007b6bf0bef3f662f65ffdd0d4383179dd07355.tar
gnu-guix-1007b6bf0bef3f662f65ffdd0d4383179dd07355.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r--guix/build/download.scm36
-rw-r--r--guix/profiles.scm22
-rw-r--r--guix/ui.scm5
3 files changed, 40 insertions, 23 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index d362fc1f26..4b7c53d2c6 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -101,27 +101,29 @@ width of the bar is BAR-WIDTH."
(define (string-pad-middle left right len)
"Combine LEFT and RIGHT with enough padding in the middle so that the
-resulting string has length at least LEN. This right justifies RIGHT."
- (string-append left
- (string-pad right (max 0 (- len (string-length left))))))
-
-(define (store-url-abbreviation url)
- "Return a friendlier version of URL for display."
- (let ((store-path (string-append (%store-directory) "/" (basename url))))
- ;; Take advantage of the implementation for store paths.
- (store-path-abbreviation store-path)))
+resulting string has length at least LEN (it may overflow). If the string
+does not overflow, the last char in RIGHT will be flush with the LEN
+column."
+ (let* ((total-used (+ (string-length left)
+ (string-length right)))
+ (num-spaces (max 1 (- len total-used)))
+ (padding (make-string num-spaces #\space)))
+ (string-append left padding right)))
(define* (store-path-abbreviation store-path #:optional (prefix-length 6))
- "Return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH
-characters of the hash."
- (let ((base (basename store-path)))
- (string-append (string-take base prefix-length)
- "…"
- (string-drop base 32))))
+ "If STORE-PATH is the file name of a store entry, return an abbreviation of
+STORE-PATH for display, showing PREFIX-LENGTH characters of the hash.
+Otherwise return STORE-PATH."
+ (if (string-prefix? (%store-directory) store-path)
+ (let ((base (basename store-path)))
+ (string-append (string-take base prefix-length)
+ "…"
+ (string-drop base 32)))
+ store-path))
(define* (progress-proc file size
#:optional (log-port (current-output-port))
- #:key (abbreviation identity))
+ #:key (abbreviation basename))
"Return a procedure to show the progress of FILE's download, which is SIZE
bytes long. The returned procedure is suitable for use as an argument to
`dump-port'. The progress report is written to LOG-PORT, with ABBREVIATION
@@ -519,7 +521,7 @@ on success."
(_ (list (string->uri url))))))
(define (fetch uri file)
- (format #t "starting download of `~a' from `~a'...~%"
+ (format #t "~%Starting download of ~a~%From ~a...~%"
file (uri->string uri))
(case (uri-scheme uri)
((http https)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index d19b49f6d2..0b417a64de 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -474,7 +474,9 @@ MANIFEST."
'#$(manifest-inputs manifest)))))
(gexp->derivation "info-dir" build
- #:modules '((guix build utils))))
+ #:modules '((guix build utils))
+ #:local-build? #t
+ #:substitutable? #f))
(define (ghc-package-cache-file manifest)
"Return a derivation that builds the GHC 'package.cache' file for all the
@@ -527,7 +529,8 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
(map manifest-entry-name (manifest-entries manifest)))
(gexp->derivation "ghc-package-cache" build
#:modules '((guix build utils))
- #:local-build? #t)
+ #:local-build? #t
+ #:substitutable? #f)
(return #f))))
(define (ca-certificate-bundle manifest)
@@ -591,7 +594,8 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx."
(gexp->derivation "ca-certificate-bundle" build
#:modules '((guix build utils))
- #:local-build? #t))
+ #:local-build? #t
+ #:substitutable? #f))
(define (gtk-icon-themes manifest)
"Return a derivation that unions all icon themes from manifest entries and
@@ -669,7 +673,8 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
(guix build profiles)
(guix search-paths)
(guix records))
- #:local-build? #t)
+ #:local-build? #t
+ #:substitutable? #f)
(return #f))))
(define %default-profile-hooks
@@ -727,7 +732,14 @@ the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
(guix build utils)
(guix search-paths)
(guix records))
- #:local-build? #t)))
+
+ ;; Not worth offloading.
+ #:local-build? #t
+
+ ;; Disable substitution because it would trigger a
+ ;; connection to the substitute server, which is likely
+ ;; to have no substitute to offer.
+ #:substitutable? #f)))
(define (profile-regexp profile)
"Return a regular expression that matches PROFILE's name and number."
diff --git a/guix/ui.scm b/guix/ui.scm
index 4a3630f242..67dd062a34 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -803,7 +803,10 @@ converted to a space; sequences of more than one line break are preserved."
(define (texi->plain-text str)
"Return a plain-text representation of texinfo fragment STR."
- (stexi->plain-text (texi-fragment->stexi str)))
+ ;; 'texi-fragment->stexi' uses a string port so make sure it's a
+ ;; Unicode-capable one (see <http://bugs.gnu.org/11197>.)
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (stexi->plain-text (texi-fragment->stexi str))))
(define (package-description-string package)
"Return a plain-text representation of PACKAGE description field."