Commit d4fb2690 authored by Stephen Leake's avatar Stephen Leake

Get long package description for installed packages from installed files

* doc/lispref/package.texi (Archive Web Server): New; document web
server interface.

* lisp/emacs-lisp/package.el (package--get-description): New; get long
description from installed files.
(describe-package-1): Use it, improve comments. No longer writing
NAME-readme.txt.

* test/lisp/emacs-lisp/package-tests.el:
(package-test-describe-package): There is now a description for an
installed package.
(package-test-describe-installed-multi-file-package): New test.
parent 87bef630
Pipeline #275 failed with stage
in 5 minutes and 54 seconds
......@@ -22,6 +22,7 @@ user-level features of the packaging system.
* Simple Packages:: How to package a single .el file.
* Multi-file Packages:: How to package multiple files.
* Package Archives:: Maintaining package archives.
* Archive Web Server:: Interfacing to an archive web server.
@end menu
@node Packaging Basics
......@@ -249,7 +250,8 @@ dependency's version (a string).
@end defun
If the content directory contains a file named @file{README}, this
file is used as the long description.
file is used as the long description (overriding any @samp{;;;
Commentary:} section).
If the content directory contains a file named @file{dir}, this is
assumed to be an Info directory file made with @command{install-info}.
......@@ -311,8 +313,8 @@ access. Such local archives are mainly useful for testing.
A package archive is simply a directory in which the package files,
and associated files, are stored. If you want the archive to be
reachable via HTTP, this directory must be accessible to a web server.
How to accomplish this is beyond the scope of this manual.
reachable via HTTP, this directory must be accessible to a web server;
@xref{Archive Web Server}.
A convenient way to set up and update a package archive is via the
@code{package-x} library. This is included with Emacs, but not loaded
......@@ -393,3 +395,28 @@ manual. For more information on cryptographic keys and signing,
@pxref{Top,, GnuPG, gnupg, The GNU Privacy Guard Manual}. Emacs comes
with an interface to GNU Privacy Guard, @pxref{Top,, EasyPG, epa,
Emacs EasyPG Assistant Manual}.
@node Archive Web Server
@section Interfacing to an archive web server
@cindex archive web server
A web server providing access to a package archive must support the
following queries:
@table @asis
@item archive-contents
Return a lisp form describing the archive contents. The form is a list
of 'package-desc' structures (see @file{package.el}), except the first
element of the list is the archive version.
@item <package name>-readme.txt
Return the long description of the package.
@item <file name>.sig
Return the signature for the file.
@item <file name>
Return the file. This will be the tarball for a multi-file
package, or the single file for a simple package.
@end table
......@@ -2123,6 +2123,9 @@ If NOSAVE is non-nil, the package is not removed from
(add-hook 'post-command-hook #'package-menu--post-refresh)
(delete-directory dir t)
;; Remove NAME-VERSION.signed and NAME-readme.txt files.
;;
;; NAME-readme.txt files are no longer created, but they
;; may be left around from an earlier install.
(dolist (suffix '(".signed" "readme.txt"))
(let* ((version (package-version-join (package-desc-version pkg-desc)))
(file (concat (if (string= suffix ".signed")
......@@ -2233,6 +2236,45 @@ Otherwise no newline is inserted."
(declare-function lm-commentary "lisp-mnt" (&optional file))
(defun package--get-description (desc)
"Return a string containing the long description of the package DESC.
The description is read from the installed package files."
;; Installed packages have nil for kind, so we look for README
;; first, then fall back to the Commentary header.
;; We don’t include README.md here, because that is often the home
;; page on a site like github, and not suitable as the package long
;; description.
(let ((files '("README-elpa" "README-elpa.md" "README" "README.rst" "README.org"))
file
(srcdir (package-desc-dir desc))
result)
(while (and files
(not result))
(setq file (pop files))
(when (file-readable-p (expand-file-name file srcdir))
;; Found a README.
(with-temp-buffer
(insert-file-contents (expand-file-name file srcdir))
(setq result (buffer-string)))))
(or
result
;; Look for Commentary header.
(let ((mainsrcfile (expand-file-name (format "%s.el" (package-desc-name desc))
srcdir)))
(when (file-readable-p mainsrcfile)
(with-temp-buffer
(insert (or (lm-commentary mainsrcfile) ""))
(goto-char (point-min))
(when (re-search-forward "^;;; Commentary:\n" nil t)
(replace-match ""))
(while (re-search-forward "^\\(;+ ?\\)" nil t)
(replace-match ""))
(buffer-string))))
)))
(defun describe-package-1 (pkg)
(require 'lisp-mnt)
(let* ((desc (or
......@@ -2406,7 +2448,8 @@ Otherwise no newline is inserted."
(insert "\n")
(if built-in
;; For built-in packages, insert the commentary.
;; For built-in packages, get the description from the
;; Commentary header.
(let ((fn (locate-file (format "%s.el" name) load-path
load-file-rep-suffixes))
(opoint (point)))
......@@ -2417,27 +2460,25 @@ Otherwise no newline is inserted."
(replace-match ""))
(while (re-search-forward "^\\(;+ ?\\)" nil t)
(replace-match ""))))
(let* ((basename (format "%s-readme.txt" name))
(readme (expand-file-name basename package-user-dir))
readme-string)
;; For elpa packages, try downloading the commentary. If that
;; fails, try an existing readme file in `package-user-dir'.
(cond ((and (package-desc-archive desc)
(package--with-response-buffer (package-archive-base desc)
:file basename :noerror t
(save-excursion
(goto-char (point-max))
(unless (bolp)
(insert ?\n)))
(write-region nil nil
(expand-file-name readme package-user-dir)
nil 'silent)
(setq readme-string (buffer-string))
t))
(insert readme-string))
((file-readable-p readme)
(insert-file-contents readme)
(goto-char (point-max))))))))
(if (package-installed-p desc)
;; For installed packages, get the description from the installed files.
(insert (package--get-description desc))
;; For non-built-in, non-installed packages, get description from the archive.
(let* ((basename (format "%s-readme.txt" name))
readme-string)
(package--with-response-buffer (package-archive-base desc)
:file basename :noerror t
(save-excursion
(goto-char (point-max))
(unless (bolp)
(insert ?\n)))
(setq readme-string (buffer-string))
t)
(insert readme-string))
))))
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
......
......@@ -435,11 +435,24 @@ Must called from within a `tar-mode' buffer."
(save-excursion (should (search-forward "Summary: A single-file package with no dependencies" nil t)))
(save-excursion (should (search-forward "Homepage: http://doodles.au" nil t)))
(save-excursion (should (re-search-forward "Keywords: \\[?frobnicate\\]?" nil t)))
;; No description, though. Because at this point we don't know
;; what archive the package originated from, and we don't have
;; its readme file saved.
(save-excursion (should (search-forward "This package provides a minor mode to frobnicate"
nil t)))
)))
(ert-deftest package-test-describe-installed-multi-file-package ()
"Test displaying of the readme for installed multi-file package."
(with-package-test ()
(package-initialize)
(package-refresh-contents)
(package-install 'multi-file)
(with-fake-help-buffer
(describe-package 'multi-file)
(goto-char (point-min))
(should (search-forward "Homepage: http://puddles.li" nil t))
(should (search-forward "This is a bare-bones readme file for the multi-file"
nil t)))))
(ert-deftest package-test-describe-non-installed-package ()
"Test displaying of the readme for non-installed package."
......
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