diff mbox series

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

Message ID 20220401150146.32529-1-ludo@gnu.org
State Accepted
Headers show
Series Turn diagnostic locations into hyperlinks | expand

Commit Message

Ludovic Courtès April 1, 2022, 3:01 p.m. UTC
* 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(-)

Comments

M April 1, 2022, 3:44 p.m. UTC | #1
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.
Ludovic Courtès April 4, 2022, 12:10 p.m. UTC | #2
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’.
Ludovic Courtès April 8, 2022, 10:02 p.m. UTC | #3
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’.
M April 9, 2022, 9:27 a.m. UTC | #4
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.
diff mbox series

Patch

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) ...)
                          ...)))))
+
+
+;;;
+;;; 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))