From fa983b825748bedb795a8105fad53c8548ca57d3 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 28 Nov 2019 13:08:49 +0100
Subject: ui: Add 'file-hyperlink'.

* guix/ui.scm (file-hyperlink): New procedure.
(location->hyperlink): Use it.
---
 guix/ui.scm | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

(limited to 'guix/ui.scm')

diff --git a/guix/ui.scm b/guix/ui.scm
index 12611cb2bc..afa6d94829 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
@@ -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))
-- 
cgit v1.2.3