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