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 (srfi srfi-9 gnu)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
|
#:autoload (web uri) (encode-and-join-uri-path)
|
||||||
#:export (color
|
#:export (color
|
||||||
color?
|
color?
|
||||||
|
|
||||||
@ -37,7 +38,11 @@
|
|||||||
|
|
||||||
color-rules
|
color-rules
|
||||||
color-output?
|
color-output?
|
||||||
isatty?*))
|
isatty?*
|
||||||
|
|
||||||
|
supports-hyperlinks?
|
||||||
|
file-hyperlink
|
||||||
|
hyperlink))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
@ -192,3 +197,31 @@ on."
|
|||||||
((_ (regexp colors ...) ...)
|
((_ (regexp colors ...) ...)
|
||||||
(colorize-matches `((,(make-regexp regexp) ,(color 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 channels)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
|
#:autoload (guix colors) (supports-hyperlinks? file-hyperlink)
|
||||||
#:use-module (guix grafts)
|
#:use-module (guix grafts)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
|
@ -29,6 +29,7 @@
|
|||||||
(define-module (guix scripts system)
|
(define-module (guix scripts system)
|
||||||
#:use-module (guix config)
|
#:use-module (guix config)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
|
#:autoload (guix colors) (supports-hyperlinks? file-hyperlink)
|
||||||
#:use-module ((guix status) #:select (with-status-verbosity))
|
#:use-module ((guix status) #:select (with-status-verbosity))
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:autoload (guix base16) (bytevector->base16-string)
|
#:autoload (guix base16) (bytevector->base16-string)
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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>
|
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
@ -20,6 +20,7 @@
|
|||||||
(define-module (guix scripts system search)
|
(define-module (guix scripts system search)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
|
#:autoload (guix colors) (supports-hyperlinks?)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (srfi srfi-1)
|
#: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 (ice-9 popen) (open-pipe* close-pipe)
|
||||||
#:autoload (system repl repl) (start-repl)
|
#:autoload (system repl repl) (start-repl)
|
||||||
#:autoload (system repl debug) (make-debug stack->vector)
|
#:autoload (system repl debug) (make-debug stack->vector)
|
||||||
#:autoload (web uri) (encode-and-join-uri-path)
|
|
||||||
#:use-module (texinfo)
|
#:use-module (texinfo)
|
||||||
#:use-module (texinfo plain-text)
|
#:use-module (texinfo plain-text)
|
||||||
#:use-module (texinfo string-utils)
|
#:use-module (texinfo string-utils)
|
||||||
@ -119,9 +118,6 @@
|
|||||||
package->recutils
|
package->recutils
|
||||||
package-specification->name+version+output
|
package-specification->name+version+output
|
||||||
|
|
||||||
supports-hyperlinks?
|
|
||||||
hyperlink
|
|
||||||
file-hyperlink
|
|
||||||
location->hyperlink
|
location->hyperlink
|
||||||
|
|
||||||
pager-wrapped-port
|
pager-wrapped-port
|
||||||
@ -1488,29 +1484,6 @@ followed by \"+ \", which makes for a valid multi-line field value in the
|
|||||||
'()
|
'()
|
||||||
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)
|
(define (location->hyperlink location)
|
||||||
"Return a string corresponding to LOCATION, with escapes for a hyperlink."
|
"Return a string corresponding to LOCATION, with escapes for a hyperlink."
|
||||||
(let ((str (location->string location))
|
(let ((str (location->string location))
|
||||||
|
Loading…
Reference in New Issue
Block a user