aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-28 13:12:39 +0100
committerLudovic Courtès <ludo@gnu.org>2019-11-28 13:30:53 +0100
commit055f052574c440aab5c9235c8277c5348c969c24 (patch)
treedcb71c7bde6433f54cb46d1fc72eab60007f04cf
parentfa983b825748bedb795a8105fad53c8548ca57d3 (diff)
downloadpatches-055f052574c440aab5c9235c8277c5348c969c24.tar
patches-055f052574c440aab5c9235c8277c5348c969c24.tar.gz
ui: 'display-generation' emits a hyperlink for the generation.
* guix/ui.scm (supports-hyperlinks?): Make 'port' optional. (display-generation): Use 'file-hyperlink' for the heading when 'supports-hyperlinks?' returns true.
-rw-r--r--guix/ui.scm29
1 files changed, 17 insertions, 12 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index afa6d94829..e31db33d3b 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1247,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.)
@@ -1613,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