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:
parent
a62873af7c
commit
d4e858763c
@ -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))
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
27
guix/ui.scm
27
guix/ui.scm
@ -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))
|
||||
|
Loading…
Reference in New Issue
Block a user