diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-11-28 16:47:01 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-11-28 16:47:01 +0100 |
commit | 34f849a945d25daa76d93839dcf8768c8b45b636 (patch) | |
tree | 33cde8cf068593f29366ba3702aabdb75b5fa126 /guix | |
parent | 0897ad7fac04fc9d814e83eed46e88c7bf9740bc (diff) | |
parent | c09f598d94af81f326fe1d4cf2ab344d4e720679 (diff) |
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r-- | guix/lint.scm | 1 | ||||
-rwxr-xr-x | guix/scripts/substitute.scm | 26 | ||||
-rw-r--r-- | guix/ui.scm | 42 |
3 files changed, 45 insertions, 24 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 03a8e88225..629604e0e9 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -292,6 +292,7 @@ of a package, and INPUT-NAMES, a list of package specifications such as "intltool" "itstool" "qttools" + "yasm" "nasm" "fasm" "python-coverage" "python2-coverage" "python-cython" "python2-cython" "python-docutils" "python2-docutils" diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index ba2fb291d8..421561a4ea 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -526,6 +526,9 @@ initial connection on which HTTP requests are sent." (let connect ((port port) (requests requests) (result seed)) + (define batch + (at-most 1000 requests)) + ;; (format (current-error-port) "connecting (~a requests left)..." ;; (length requests)) (let ((p (or port (guix:open-connection-for-uri @@ -536,7 +539,7 @@ initial connection on which HTTP requests are sent." (when (file-port? p) (setvbuf p 'block (expt 2 16))) - ;; Send REQUESTS, up to a certain number, in a row. + ;; Send BATCH in a row. ;; XXX: Do our own caching to work around inefficiencies when ;; communicating over TLS: <http://bugs.gnu.org/22966>. (let-values (((buffer get) (open-bytevector-output-port))) @@ -544,16 +547,21 @@ initial connection on which HTTP requests are sent." (set-http-proxy-port?! buffer (http-proxy-port? p)) (for-each (cut write-request <> buffer) - (at-most 1000 requests)) + batch) (put-bytevector p (get)) (force-output p)) ;; Now start processing responses. - (let loop ((requests requests) - (result result)) - (match requests + (let loop ((sent batch) + (processed 0) + (result result)) + (match sent (() - (reverse result)) + (match (drop requests processed) + (() + (reverse result)) + (remainder + (connect port remainder result)))) ((head tail ...) (let* ((resp (read-response p)) (body (response-body-port resp)) @@ -564,9 +572,11 @@ initial connection on which HTTP requests are sent." (match (assq 'connection (response-headers resp)) (('connection 'close) (close-connection p) - (connect #f tail result)) ;try again + (connect #f ;try again + (append tail (drop requests processed)) + result)) (_ - (loop tail result)))))))))) ;keep going + (loop tail (+ 1 processed) result)))))))))) ;keep going (define (read-to-eof port) "Read from PORT until EOF is reached. The data are discarded." diff --git a/guix/ui.scm b/guix/ui.scm index 12611cb2bc..e31db33d3b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -111,6 +111,7 @@ package-specification->name+version+output supports-hyperlinks? + file-hyperlink location->hyperlink relevance @@ -1246,7 +1247,7 @@ documented at (string-append "\x1b]8;;" uri "\x1b\\" text "\x1b]8;;\x1b\\")) -(define (supports-hyperlinks? port) +(define* (supports-hyperlinks? #:optional (port (current-output-port))) "Return true if PORT is a terminal that supports hyperlink escapes." ;; Note that terminals are supposed to ignore OSC escapes they don't ;; understand (this is the case of xterm as of version 349, for instance.) @@ -1255,6 +1256,13 @@ documented at (and (isatty?* port) (not (getenv "INSIDE_EMACS")))) +(define* (file-hyperlink file #:optional (text file)) + "Return TEXT with escapes for a hyperlink to FILE." + (hyperlink (string-append "file://" (gethostname) + (encode-and-join-uri-path + (string-split file #\/))) + text)) + (define (location->hyperlink location) "Return a string corresponding to LOCATION, with escapes for a hyperlink." (let ((str (location->string location)) @@ -1262,10 +1270,7 @@ documented at (location-file location) (search-path %load-path (location-file location))))) (if file - (hyperlink (string-append "file://" (gethostname) - (encode-and-join-uri-path - (string-split file #\/))) - str) + (file-hyperlink file str) str))) (define* (package->recutils p port #:optional (width (%text-width)) @@ -1608,17 +1613,22 @@ DURATION-RELATION with the current time." (define (display-generation profile number) "Display a one-line summary of generation NUMBER of PROFILE." (unless (zero? number) - (let ((header (format #f (highlight (G_ "Generation ~a\t~a")) number - (date->string - (time-utc->date - (generation-time profile number)) - ;; TRANSLATORS: This is a format-string for date->string. - ;; Please choose a format that corresponds to the - ;; usual way of presenting dates in your locale. - ;; See https://www.gnu.org/software/guile/manual/html_node/SRFI_002d19-Date-to-string.html - ;; for details. - (G_ "~b ~d ~Y ~T")))) - (current (generation-number profile))) + (let* ((file (generation-file-name profile number)) + (link (if (supports-hyperlinks?) + (cut file-hyperlink file <>) + identity)) + (header (format #f (link (highlight (G_ "Generation ~a\t~a"))) + number + (date->string + (time-utc->date + (generation-time profile number)) + ;; TRANSLATORS: This is a format-string for date->string. + ;; Please choose a format that corresponds to the + ;; usual way of presenting dates in your locale. + ;; See https://www.gnu.org/software/guile/manual/html_node/SRFI_002d19-Date-to-string.html + ;; for details. + (G_ "~b ~d ~Y ~T")))) + (current (generation-number profile))) (if (= number current) ;; TRANSLATORS: The word "current" here is an adjective for ;; "Generation", as in "current generation". Use the appropriate |