05/07: ui: 'display-generation' emits a hyperlink for the generation.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 055f052574c440aab5c9235c8277c5348c969c24
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 28 13:12:39 2019 +0100

    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.
---
 guix/ui.scm | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index afa6d94..e31db33 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