Commit 9b8fe248 authored by Ludovic Courtès's avatar Ludovic Courtès

browse: Rewrite the package-to-variable-name reverse lookup.

'scheme-variable-name' was crashing for 'blis', for example, because the
definition was to be found below rather than above the 'package' form
that defines it.

* browse/www/pages/package.scm (scheme-variable-name): Remove.
(package->variable-name): New procedure.
(page-package): Use it.
parent 37d89d7c
......@@ -20,32 +20,31 @@
#:use-module (gnu packages)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (guix discovery)
#:use-module (guix memoization)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:use-module (ice-9 control)
#:use-module (texinfo)
#:use-module (texinfo html)
#:export (page-package))
(define (scheme-variable-name file line)
(define (search-path* path file)
"Like 'search-path' but exit if FILE is not found."
(let ((absolute-file-name (search-path path file)))
(unless absolute-file-name
;; Shouldn't happen unless somebody fiddled with the 'location' field.
(leave (G_ "file '~a' not found in search path ~s~%")
file path))
(define (get-definition port current-line target-line)
(let ((line (read-line port)))
(if (< current-line target-line)
(get-definition port (1+ current-line) target-line)
(cadr (string-split line #\ )))))
(let ((file (search-path* %load-path file)))
(call-with-input-file file
(lambda (port)
(get-definition port 2 line)))))
(define package->variable-name
(mlambdaq (package)
"Return the name of the variable that defines PACKAGE, a package object,
or #f if we failed to find it."
(let/ec return
(let loop ((modules (all-modules (%package-module-path))))
(match modules
(() #f)
((module . rest)
(module-map (lambda (symbol variable)
(let ((value (false-if-exception
(variable-ref variable))))
(and (eq? value package)
(return symbol))))
(loop rest)))))))
(define (package-description-shtml package)
"Return an SXML representation of PACKAGE description field with HTML
......@@ -84,9 +83,7 @@ vocabulary."
(td (strong "Symbol name"))
(td (code (@ (class "nobg"))
(location-file location)
(location-line location)))))
,(package->variable-name instance))))
(td (@ (style "width: 150pt")) (strong "Installation command"))
(td (pre (code (@ (class "bash"))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment