diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-09-24 22:18:07 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-09-24 22:18:07 +0200 |
commit | 1007b6bf0bef3f662f65ffdd0d4383179dd07355 (patch) | |
tree | 4a9b2a4baa2d82434e12fe4aacc8f28e3266793e /guix | |
parent | 12cd4dd3a9052491e3912ffeecbe8854ea9b971a (diff) | |
parent | a7a4fd9a7cd02e4897e7b2156bd9ecc7e72e9818 (diff) | |
download | gnu-guix-1007b6bf0bef3f662f65ffdd0d4383179dd07355.tar gnu-guix-1007b6bf0bef3f662f65ffdd0d4383179dd07355.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/download.scm | 36 | ||||
-rw-r--r-- | guix/profiles.scm | 22 | ||||
-rw-r--r-- | guix/ui.scm | 5 |
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." |