[bug#54668] [PATCH 0/3] Turn diagnostic locations into hyperlinks

[bug#54668] [PATCH 0/3] Turn diagnostic locations into hyperlinks

[Ludovic Courtès]

Hello Guix!

This patch series shuffles things around and turns diagnostic
locations into hyperlinks.  That is, on terminals that support
it (GNOME Terminal, Terminology, Kitty, etc.¹), every time you see,
say:

  gnu/packages/foo.scm:300:42: warning: something's wrong

… the location prefix is now clickable.

I did not reexport the bindings moved to (guix diagnostics).  To
authors of software that uses Guix (GWL in particular), lemme know
if that’s a problem!

Ludo’.

¹ For some reasons xfce4-terminal no longer supports it; I think
  it used to.

Ludovic Courtès (3):
  ui: Move hyperlink facilities to (guix colors).
  ui: Move 'location->hyperlink' to (guix diagnostics).
  diagnostics: Turn diagnostic locations into hyperlinks.

 guix/colors.scm                | 35 +++++++++++++++++++++++++++++-
 guix/diagnostics.scm           | 16 +++++++++++++-
 guix/scripts/home.scm          |  1 +
 guix/scripts/system.scm        |  1 +
 guix/scripts/system/search.scm |  4 +++-
 guix/ui.scm                    | 39 ----------------------------------
 6 files changed, 54 insertions(+), 42 deletions(-)


base-commit: fc94e93c4b60addfda3c1eddfb85907e9459a8af
-- 
2.34.0

[bug#54668] [PATCH 1/3] ui: Move hyperlink facilities to (guix colors).

[Ludovic Courtès]

* guix/ui.scm (supports-hyperlinks?, file-hyperlink, hyperlink): Move to...
* guix/colors.scm: ... here.
* guix/scripts/home.scm, guix/scripts/system.scm,
guix/scripts/system/search.scm: Adjust imports accordingly.
---
 guix/colors.scm                | 35 +++++++++++++++++++++++++++++++++-
 guix/scripts/home.scm          |  1 +
 guix/scripts/system.scm        |  1 +
 guix/scripts/system/search.scm |  3 ++-
 guix/ui.scm                    | 27 --------------------------
 5 files changed, 38 insertions(+), 29 deletions(-)

diff --git a/guix/colors.scm b/guix/colors.scm
index ae0a583d94..2b3a7c9032 100644
--- a/guix/colors.scm
+++ b/guix/colors.scm
@@ -26,6 +26,7 @@ (define-module (guix colors)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:autoload   (web uri) (encode-and-join-uri-path)
   #:export (color
             color?
 
@@ -36,7 +37,11 @@ (define-module (guix colors)
 
             color-rules
             color-output?
-            isatty?*))
+            isatty?*
+
+            supports-hyperlinks?
+            file-hyperlink
+            hyperlink))
 
 ;;; Commentary:
 ;;;
@@ -191,3 +196,31 @@ (define-syntax color-rules
     ((_ (regexp colors ...) ...)
      (colorize-matches `((,(make-regexp regexp) ,(color colors) ...)
                          ...)))))
+
+\f
+;;;
+;;; Hyperlinks.
+;;;
+
+(define (hyperlink uri text)
+  "Return a string that denotes a hyperlink using an OSC escape sequence as
+documented at
+<https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda>."
+  (string-append "\x1b]8;;" uri "\x1b\\"
+                 text "\x1b]8;;\x1b\\"))
+
+(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.)
+  ;; However, Emacs comint as of 26.3 does not ignore it and instead lets it
+  ;; through, hence the 'INSIDE_EMACS' special case below.
+  (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))
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index af2643014d..341d83943d 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -45,6 +45,7 @@ (define-module (guix scripts home)
   #:use-module (guix channels)
   #:use-module (guix derivations)
   #:use-module (guix ui)
+  #:autoload   (guix colors) (supports-hyperlinks? file-hyperlink)
   #:use-module (guix grafts)
   #:use-module (guix packages)
   #:use-module (guix profiles)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 067bf999f1..73e3c299c1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -29,6 +29,7 @@
 (define-module (guix scripts system)
   #:use-module (guix config)
   #:use-module (guix ui)
+  #:autoload   (guix colors) (supports-hyperlinks? file-hyperlink)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module (guix store)
   #:autoload   (guix base16) (bytevector->base16-string)
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index bf49ea2341..ff2ea7652c 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017-2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,6 +20,7 @@
 (define-module (guix scripts system search)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:autoload   (guix colors) (supports-hyperlinks?)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (srfi srfi-1)
diff --git a/guix/ui.scm b/guix/ui.scm
index 6c194eb3c9..6f2fe62784 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -76,7 +76,6 @@ (define-module (guix ui)
   #:autoload   (ice-9 popen) (open-pipe* close-pipe)
   #:autoload   (system repl repl)  (start-repl)
   #:autoload   (system repl debug) (make-debug stack->vector)
-  #:autoload   (web uri) (encode-and-join-uri-path)
   #:use-module (texinfo)
   #:use-module (texinfo plain-text)
   #:use-module (texinfo string-utils)
@@ -119,9 +118,6 @@ (define-module (guix ui)
             package->recutils
             package-specification->name+version+output
 
-            supports-hyperlinks?
-            hyperlink
-            file-hyperlink
             location->hyperlink
 
             pager-wrapped-port
@@ -1488,29 +1484,6 @@ (define (string->recutils str)
                       '()
                       str)))
 
-(define (hyperlink uri text)
-  "Return a string that denotes a hyperlink using an OSC escape sequence as
-documented at
-<https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda>."
-  (string-append "\x1b]8;;" uri "\x1b\\"
-                 text "\x1b]8;;\x1b\\"))
-
-(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.)
-  ;; However, Emacs comint as of 26.3 does not ignore it and instead lets it
-  ;; through, hence the 'INSIDE_EMACS' special case below.
-  (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))
-- 
2.34.0

[bug#54668] [PATCH 2/3] ui: Move 'location->hyperlink' to (guix diagnostics).

[Ludovic Courtès]

* guix/ui.scm (location->hyperlink): Move to...
* guix/diagnostics.scm: ... here.
* guix/scripts/system/search.scm: Adjust imports accordingly.
---
 guix/diagnostics.scm           | 11 +++++++++++
 guix/scripts/system/search.scm |  1 +
 guix/ui.scm                    | 12 ------------
 3 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm
index 337a73c1a2..2b8cee1ccb 100644
--- a/guix/diagnostics.scm
+++ b/guix/diagnostics.scm
@@ -39,6 +39,7 @@ (define-module (guix diagnostics)
             source-properties->location
             location->source-properties
             location->string
+            location->hyperlink
 
             &error-location
             error-location?
@@ -259,6 +260,16 @@ (define (location->string loc)
     (($ <location> file line column)
      (format #f "~a:~a:~a" file line column))))
 
+(define (location->hyperlink location)
+  "Return a string corresponding to LOCATION, with escapes for a hyperlink."
+  (let ((str  (location->string location))
+        (file (if (string-prefix? "/" (location-file location))
+                  (location-file location)
+                  (search-path %load-path (location-file location)))))
+    (if file
+        (file-hyperlink file str)
+        str)))
+
 (define-condition-type &error-location &error
   error-location?
   (location  error-location))                     ;<location>
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index ff2ea7652c..93c9fc5644 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -21,6 +21,7 @@ (define-module (guix scripts system search)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:autoload   (guix colors) (supports-hyperlinks?)
+  #:autoload   (guix diagnostics) (location->hyperlink)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (srfi srfi-1)
diff --git a/guix/ui.scm b/guix/ui.scm
index 6f2fe62784..37d24030e4 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -118,8 +118,6 @@ (define-module (guix ui)
             package->recutils
             package-specification->name+version+output
 
-            location->hyperlink
-
             pager-wrapped-port
             with-paginated-output-port
             relevance
@@ -1484,16 +1482,6 @@ (define (string->recutils str)
                       '()
                       str)))
 
-(define (location->hyperlink location)
-  "Return a string corresponding to LOCATION, with escapes for a hyperlink."
-  (let ((str  (location->string location))
-        (file (if (string-prefix? "/" (location-file location))
-                  (location-file location)
-                  (search-path %load-path (location-file location)))))
-    (if file
-        (file-hyperlink file str)
-        str)))
-
 (define* (package->recutils p port #:optional (width (%text-width))
                             #:key
                             (hyperlinks? (supports-hyperlinks? port))
-- 
2.34.0

[bug#54668] [PATCH 3/3] diagnostics: Turn diagnostic locations into hyperlinks.

[Ludovic Courtès]

* guix/diagnostics.scm (print-diagnostic-prefix): Use
'location->hyperlink' when 'supports-hyperlinks?' returns true.
---
 guix/diagnostics.scm | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm
index 2b8cee1ccb..bf1ced8140 100644
--- a/guix/diagnostics.scm
+++ b/guix/diagnostics.scm
@@ -204,7 +204,10 @@ (define prefix-color
                     (gettext prefix %gettext-domain))))
     (if location
         (format (guix-warning-port) "~a: ~a"
-                (location-color (location->string location))
+                (location-color
+                 (if (supports-hyperlinks? (guix-warning-port))
+                     (location->hyperlink location)
+                     (location->string location)))
                 (prefix-color prefix))
         (format (guix-warning-port) "~:[~*~;guix ~a: ~]~a"
                 (program-name) (program-name)
-- 
2.34.0

[bug#54668] [PATCH 1/3] ui: Move hyperlink facilities to (guix colors).

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 512 bytes --]

Ludovic Courtès schreef op vr 01-04-2022 om 17:01 [+0200]:
> 
> +(define (hyperlink uri text)
> +  "Return a string that denotes a hyperlink using an OSC escape sequence as
> +documented at
> +<https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda>."
> +  (string-append "\x1b]8;;" uri "\x1b\\"
> +                 text "\x1b]8;;\x1b\\"))

What if 'uri' contains the character #\x1b, e.g.
"file://home/foo/\x15.scm"?  Does it need to be escaped?

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#54668] [PATCH 0/3] Turn diagnostic locations into hyperlinks

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> Ludovic Courtès schreef op vr 01-04-2022 om 17:01 [+0200]:
>> 
>> +(define (hyperlink uri text)
>> +  "Return a string that denotes a hyperlink using an OSC escape sequence as
>> +documented at
>> +<https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda>."
>> +  (string-append "\x1b]8;;" uri "\x1b\\"
>> +                 text "\x1b]8;;\x1b\\"))

(This code was already there.)

> What if 'uri' contains the character #\x1b, e.g.
> "file://home/foo/\x15.scm"?  Does it need to be escaped?

Good question.  I checked the spec linked above and it reads:

  URI is the target of the hyperlink in URI-encoded form.

So I guess we should pass ‘uri’ through ‘uri-encode’.  I’ll do that in a
separate patch.

Thanks,
Ludo’.

bug#54668: [PATCH 0/3] Turn diagnostic locations into hyperlinks

[Ludovic Courtès]

Hi,

Pushed as 13307c198bcd1fbd9364bcb7ef4c6d19d287cf2c!

Ludovic Courtès <ludo@gnu.org> skribis:

> Maxime Devos <maximedevos@telenet.be> skribis:
>
>> Ludovic Courtès schreef op vr 01-04-2022 om 17:01 [+0200]:
>>> 
>>> +(define (hyperlink uri text)
>>> +  "Return a string that denotes a hyperlink using an OSC escape sequence as
>>> +documented at
>>> +<https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda>."
>>> +  (string-append "\x1b]8;;" uri "\x1b\\"
>>> +                 text "\x1b]8;;\x1b\\"))
>
> (This code was already there.)
>
>> What if 'uri' contains the character #\x1b, e.g.
>> "file://home/foo/\x15.scm"?  Does it need to be escaped?
>
> Good question.  I checked the spec linked above and it reads:
>
>   URI is the target of the hyperlink in URI-encoded form.
>
> So I guess we should pass ‘uri’ through ‘uri-encode’.  I’ll do that in a
> separate patch.

Actually this is already done by ‘file-hyperlink’ a few lines below, so
we’re fine.

Thanks,
Ludo’.

[bug#54668] [PATCH 0/3] Turn diagnostic locations into hyperlinks

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 859 bytes --]

Ludovic Courtès schreef op za 09-04-2022 om 00:02 [+0200]:
> > So I guess we should pass ‘uri’ through ‘uri-encode’.  I’ll do that
> > in a
> > separate patch.
> 
> Actually this is already done by ‘file-hyperlink’ a few lines
> below, so we’re fine.

FWIW, (guix ui) doesn't seem to do this for license links:

            ((? license? license)
             (let ((text (license-name license))
                   (uri  (license-uri license)))
               (if (and hyperlinks? uri (string-prefix? "http" uri))
                   (hyperlink uri text)
                   text)))

Likewise for (guix scripts describe), though it might not be a problem
there yet given the limited set of URIs.

I think it's a bit less fragile to move the uri-encoding from 'file-
hyperlink' to 'hyperlink', WDYT?

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]