[Emacs-diffs] master d4fb269: Get long package description for installed packages from installed files

[Stephen Leake]

branch: master
commit d4fb2690702fbd348977fc94a9f7a99c00cc3010
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>

    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.
---
 doc/lispref/package.texi              | 33 ++++++++++++--
 lisp/emacs-lisp/package.el            | 85 ++++++++++++++++++++++++++---------
 test/lisp/emacs-lisp/package-tests.el | 19 ++++++--
 3 files changed, 109 insertions(+), 28 deletions(-)

diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index 37c1ee6..730decc 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -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;
address@hidden 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}.
+
address@hidden Archive Web Server
address@hidden Interfacing to an archive web server
address@hidden archive web server
+
+A web server providing access to a package archive must support the
+following queries:
+
address@hidden @asis
address@hidden 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.
+
address@hidden <package name>-readme.txt
+Return the long description of the package.
+
address@hidden <file name>.sig
+Return the signature for the file.
+
address@hidden <file name>
+Return the file. This will be the tarball for a multi-file
+package, or the single file for a simple package.
+
address@hidden table
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index dcede1a..1752c7e 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -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)))
diff --git a/test/lisp/emacs-lisp/package-tests.el 
b/test/lisp/emacs-lisp/package-tests.el
index f08bc92..17431f3 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -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."