Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 1 Apr 2022 15:01:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Ludovic Courtès <ludo <at> gnu.org> To: 54668 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [bug#54668] [PATCH 1/3] ui: Move hyperlink facilities to (guix colors). Date: Fri, 1 Apr 2022 17:01:44 +0200
* 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 <at> gnu.org>
+;;; Copyright © 2017-2019, 2022 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.