ui: Produce hyperlinks for the 'location' field of search results.
This affects the output of 'guix show', 'guix search', and 'guix system search'. * guix/ui.scm (hyperlink, supports-hyperlinks?, location->hyperlink): New procedures. (package->recutils): Add #:hyperlinks? and honor it. (display-search-results): Pass #:hyperlinks? to PRINT. * guix/scripts/system/search.scm (service-type->recutils): Add #:hyperlinks? and honor it.
This commit is contained in:
parent
64bef450d9
commit
7f0f38b54c
@ -65,9 +65,12 @@ provided TYPE has a default value."
|
|||||||
|
|
||||||
(define* (service-type->recutils type port
|
(define* (service-type->recutils type port
|
||||||
#:optional (width (%text-width))
|
#:optional (width (%text-width))
|
||||||
#:key (extra-fields '()))
|
#:key
|
||||||
|
(extra-fields '())
|
||||||
|
(hyperlinks? (supports-hyperlinks? port)))
|
||||||
"Write to PORT a recutils record of TYPE, arranging to fit within WIDTH
|
"Write to PORT a recutils record of TYPE, arranging to fit within WIDTH
|
||||||
columns."
|
columns. When HYPERLINKS? is true, emit hyperlink escape sequences when
|
||||||
|
appropriate."
|
||||||
(define width*
|
(define width*
|
||||||
;; The available number of columns once we've taken into account space for
|
;; The available number of columns once we've taken into account space for
|
||||||
;; the initial "+ " prefix.
|
;; the initial "+ " prefix.
|
||||||
@ -84,7 +87,8 @@ columns."
|
|||||||
;; Note: Don't i18n field names so that people can post-process it.
|
;; Note: Don't i18n field names so that people can post-process it.
|
||||||
(format port "name: ~a~%" (service-type-name type))
|
(format port "name: ~a~%" (service-type-name type))
|
||||||
(format port "location: ~a~%"
|
(format port "location: ~a~%"
|
||||||
(or (and=> (service-type-location type) location->string)
|
(or (and=> (service-type-location type)
|
||||||
|
(if hyperlinks? location->hyperlink location->string))
|
||||||
(G_ "unknown")))
|
(G_ "unknown")))
|
||||||
|
|
||||||
(format port "extends: ~a~%"
|
(format port "extends: ~a~%"
|
||||||
|
55
guix/ui.scm
55
guix/ui.scm
@ -69,6 +69,7 @@
|
|||||||
#:autoload (system base compile) (compile-file)
|
#:autoload (system base compile) (compile-file)
|
||||||
#: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)
|
||||||
@ -108,6 +109,9 @@
|
|||||||
package->recutils
|
package->recutils
|
||||||
package-specification->name+version+output
|
package-specification->name+version+output
|
||||||
|
|
||||||
|
supports-hyperlinks?
|
||||||
|
location->hyperlink
|
||||||
|
|
||||||
relevance
|
relevance
|
||||||
package-relevance
|
package-relevance
|
||||||
display-search-results
|
display-search-results
|
||||||
@ -1234,10 +1238,42 @@ 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? 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 (location->hyperlink location)
|
||||||
|
"Return a string corresponding to LOCATION, with escapes for a hyperlink."
|
||||||
|
(let ((str (location->string location))
|
||||||
|
(file (if (string-prefix? "/" (location-file location))
|
||||||
|
(location-file location)
|
||||||
|
(search-path %load-path (location-file location)))))
|
||||||
|
(if file
|
||||||
|
(hyperlink (string-append "file://" (gethostname)
|
||||||
|
(encode-and-join-uri-path
|
||||||
|
(string-split file #\/)))
|
||||||
|
str)
|
||||||
|
str)))
|
||||||
|
|
||||||
(define* (package->recutils p port #:optional (width (%text-width))
|
(define* (package->recutils p port #:optional (width (%text-width))
|
||||||
#:key (extra-fields '()))
|
#:key
|
||||||
|
(hyperlinks? (supports-hyperlinks? port))
|
||||||
|
(extra-fields '()))
|
||||||
"Write to PORT a `recutils' record of package P, arranging to fit within
|
"Write to PORT a `recutils' record of package P, arranging to fit within
|
||||||
WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit."
|
WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit. When
|
||||||
|
HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
|
||||||
(define width*
|
(define width*
|
||||||
;; The available number of columns once we've taken into account space for
|
;; The available number of columns once we've taken into account space for
|
||||||
;; the initial "+ " prefix.
|
;; the initial "+ " prefix.
|
||||||
@ -1265,7 +1301,8 @@ WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit."
|
|||||||
(((labels inputs . _) ...)
|
(((labels inputs . _) ...)
|
||||||
(dependencies->recutils (filter package? inputs)))))
|
(dependencies->recutils (filter package? inputs)))))
|
||||||
(format port "location: ~a~%"
|
(format port "location: ~a~%"
|
||||||
(or (and=> (package-location p) location->string)
|
(or (and=> (package-location p)
|
||||||
|
(if hyperlinks? location->hyperlink location->string))
|
||||||
(G_ "unknown")))
|
(G_ "unknown")))
|
||||||
|
|
||||||
;; Note: Starting from version 1.6 or recutils, hyphens are not allowed in
|
;; Note: Starting from version 1.6 or recutils, hyphens are not allowed in
|
||||||
@ -1398,11 +1435,13 @@ them. If PORT is a terminal, print at most a full screen of results."
|
|||||||
(let loop ((matches matches))
|
(let loop ((matches matches))
|
||||||
(match matches
|
(match matches
|
||||||
(((package . score) rest ...)
|
(((package . score) rest ...)
|
||||||
(let ((text (call-with-output-string
|
(let* ((links? (supports-hyperlinks? port))
|
||||||
(lambda (port)
|
(text (call-with-output-string
|
||||||
(print package port
|
(lambda (port)
|
||||||
#:extra-fields
|
(print package port
|
||||||
`((relevance . ,score)))))))
|
#:hyperlinks? links?
|
||||||
|
#:extra-fields
|
||||||
|
`((relevance . ,score)))))))
|
||||||
(if (and max-rows
|
(if (and max-rows
|
||||||
(> (port-line port) first-line) ;print at least one result
|
(> (port-line port) first-line) ;print at least one result
|
||||||
(> (+ 4 (line-count text) (port-line port))
|
(> (+ 4 (line-count text) (port-line port))
|
||||||
|
Loading…
Reference in New Issue
Block a user