From d4e858763c4303764729133c547b0a6dfe2354f9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Apr 2022 15:38:16 +0200 Subject: 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. --- 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 567c822c73..3fd36c68ef 100644 --- a/guix/colors.scm +++ b/guix/colors.scm @@ -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 +." + (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 @@ #: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 +;;; Copyright © 2017-2019, 2022 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; ;;; 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 @@ #: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 -." - (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)) -- cgit v1.2.3