ui: Move hyperlink facilities to (guix colors).

* 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.
This commit is contained in:
Ludovic Courtès 2022-04-01 15:38:16 +02:00
parent a62873af7c
commit d4e858763c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 38 additions and 29 deletions

View File

@ -26,6 +26,7 @@
#: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?
@ -37,7 +38,11 @@
color-rules
color-output?
isatty?*))
isatty?*
supports-hyperlinks?
file-hyperlink
hyperlink))
;;; Commentary:
;;;
@ -192,3 +197,31 @@ on."
((_ (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))

View File

@ -45,6 +45,7 @@
#: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)

View File

@ -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)

View File

@ -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)

View File

@ -76,7 +76,6 @@
#: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 @@
package->recutils
package-specification->name+version+output
supports-hyperlinks?
hyperlink
file-hyperlink
location->hyperlink
pager-wrapped-port
@ -1488,29 +1484,6 @@ followed by \"+ \", which makes for a valid multi-line field value in the
'()
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))