[elpa] elpa-admin 7d65683 356/357: * admin/archive-contents.el: Fix wrong cgit links and support :core somewhat

[Stefan Monnier]

branch: elpa-admin
commit 7d65683be180b2f04771a963288d1ff2bb0aee67
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * admin/archive-contents.el: Fix wrong cgit links and support :core somewhat
    
    (archive--make-one-tarball): Take `pkg-spec` rather than `pkgname` arg.
    Follow links when building tarball.  Compress `.el` files as well.
    (batch-make-all-packages): Adjust accordingly.
    (batch-make-one-package): Loop over all cmdline args.
    (archive--make-one-package):
    Take `pkg-spec` rather than `pkgname` arg.
    Use `archive--core-package-sync` for :core packages.
    (archive--read-externals-list): Delete function.
    (archive--insert-repolinks): Take `pkg-spec` rather than `name` arg.
    Drop unused args `srcdir` and `mainsrcfile`.
    (archive--html-make-pkg): Take additional `pkg-spec` arg.
    (batch-html-make-index): Fetch specs from `externals-list`.
    (archive--pull): Undo local changes to `<pkg>-pkg.el` before pulling.
    (archive-add/remove/update-externals): Use `batch-archive-update-worktrees`.
    (batch-archive-update-worktrees): Add support for :core packages.
    (archive-gitignore-externals): Delete function.
---
 .gitignore    |   1 +
 elpa-admin.el | 254 +++++++++++++++++++++++++++++++---------------------------
 2 files changed, 135 insertions(+), 120 deletions(-)

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c531d98
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.elc
diff --git a/elpa-admin.el b/elpa-admin.el
index 817340c..b4b5e34 100644
--- a/elpa-admin.el
+++ b/elpa-admin.el
@@ -1,4 +1,4 @@
-;;; elpa-admin.el --- Auto-generate an Emacs Lisp package archive.  -*- 
lexical-binding:t -*-
+;;; elpa-admin.el --- Auto-generate an Emacs Lisp package archive  -*- 
lexical-binding:t -*-
 
 ;; Copyright (C) 2011-2020  Free Software Foundation, Inc
 
@@ -19,12 +19,26 @@
 
 ;;; Commentary:
 
+;; Missing from GNU ELPA script:
+;; - check_copyrights
+;; - Support for :core (seems to be partly working, actually, tho it likely
+;;   doesn't select the right release revision).
+;; - Support for Org's package
+;; - Send email announcements
+;; - Fix archive name and URL
+
+;; TODO:
+;; - Eliminate hardcoded `build/packages' directory structure
+;; - support for rebuilding index.html, archive-contents, and <pkg>.html
+;; - support for building the Info files
+;; - support for README.md for some packages
+;; - support for Tramp as core
+
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
 (require 'lisp-mnt)
 (require 'package)
-(require 'pcase)
 
 
 (defconst elpaa--release-subdir "archive/"
@@ -41,7 +55,7 @@
 (defun elpaa--message (&rest args)
   (when elpaa--debug (apply #'message args)))
 
-(defconst archive-re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
+(defconst elpaa--re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
   "Regular expression matching all files except \".\" and \"..\".")
 
 (defun elpaa--version-to-list (vers)
@@ -64,7 +78,7 @@
 (defun elpaa--delete-elc-files (dir &optional only-orphans)
   "Recursively delete all .elc files in DIR.
 Delete backup files also."
-  (dolist (f (directory-files dir t archive-re-no-dot))
+  (dolist (f (directory-files dir t elpaa--re-no-dot))
     (cond ((file-directory-p f)
           (elpaa--delete-elc-files f))
          ((or (and (string-match "\\.elc\\'" f)
@@ -76,7 +90,7 @@ Delete backup files also."
 (defun elpaa-batch-make-archive ()
   "Process package content directories and generate the archive-contents file."
   (let ((packages '(1))) ; format-version.
-    (dolist (dir (directory-files default-directory nil archive-re-no-dot))
+    (dolist (dir (directory-files default-directory nil elpaa--re-no-dot))
       (condition-case v
          (if (not (file-directory-p dir))
              (message "Skipping non-package file %s" dir)
@@ -204,7 +218,8 @@ Assumes that the current worktree holds a snapshot version."
                   (cons (package-version-join vl) rev)))))))))))
 
 (defun elpaa--select-revision (dir pkgname rev)
-  "Checkout revision REV in DIR of PKGNAME."
+  "Checkout revision REV in DIR of PKGNAME.
+Do it without leaving the current branch."
   (let ((cur-rev (vc-working-revision
                   (expand-file-name (concat pkgname ".el") dir))))
     (if (equal rev cur-rev)
@@ -218,7 +233,7 @@ Assumes that the current worktree holds a snapshot version."
             (elpaa--message "Reverted to release revision %s\n%s"
                               rev (buffer-string))))))))
 
-(defun elpaa--make-one-tarball (tarball dir pkgname metadata
+(defun elpaa--make-one-tarball (tarball dir pkg-spec metadata
                                           &optional revision-function)
   "Create file TARBALL for PKGNAME if not done yet.
 Return non-nil if a new tarball was created."
@@ -230,11 +245,12 @@ Return non-nil if a new tarball was created."
         (elpaa--message "Tarball %s already built!" tarball)
         nil)
     (let* ((destdir (file-name-directory tarball))
+           (pkgname (car pkg-spec))
            (_ (unless (file-directory-p destdir) (make-directory destdir)))
            (vers (nth 1 metadata))
            (elpaignore (expand-file-name ".elpaignore" dir))
            (re (concat "\\`" (regexp-quote pkgname)
-                       "-\\(.*\\)\\.tar\\(\\.[a-z]*z\\)?"))
+                       "-\\([0-9].*\\)\\.\\(tar\\|el\\)\\(\\.[a-z]*z\\)?\\'"))
            (oldtarballs
             (mapcar
              (lambda (file)
@@ -253,7 +269,7 @@ Return non-nil if a new tarball was created."
                               elpaignore "/dev/null")
                      "--transform"
                      (format "s|^packages/%s|%s-%s|" pkgname pkgname vers)
-                     "-cf" tarball
+                     "-chf" tarball
                      (concat "packages/" pkgname))
       (let* ((pkgdesc
               ;; FIXME: `elpaa--write-pkg-file' wrote the metadata to
@@ -281,15 +297,17 @@ Return non-nil if a new tarball was created."
         (dolist (oldtarball oldtarballs)
           ;; lzip compress oldtarballs.
           (let ((file (cdr oldtarball)))
-            (when (string-match "\\.tar\\'" file)
-              (elpaa--call nil "lzip" (expand-file-name file destdir))
-              (setf (cdr oldtarball) (concat file ".lz")))))
+            (when (string-match "\\.\\(tar\\|el\\)\\'" file)
+              ;; Don't compress the file we just created.
+              (unless (equal file (file-name-nondirectory tarball))
+                (elpaa--call nil "lzip" (expand-file-name file destdir))
+                (setf (cdr oldtarball) (concat file ".lz"))))))
         (let* ((default-directory (expand-file-name destdir)))
           ;; Apparently this also creates the <pkg>-readme.txt file.
-          (elpaa--html-make-pkg pkgdesc
-                                  `((,vers . ,(file-name-nondirectory tarball))
-                                    . ,oldtarballs)
-                                  dir))
+          (elpaa--html-make-pkg pkgdesc pkg-spec
+                                `((,vers . ,(file-name-nondirectory tarball))
+                                  . ,oldtarballs)
+                                dir))
         (message "Built new package %s!" tarball)
         'new))))
 
@@ -329,81 +347,85 @@ Return non-nil if a new tarball was created."
   (let* ((specs (elpaa--form-from-file-contents "externals-list")))
     (dolist (spec specs)
       (with-demoted-errors "Build error: %S"
-        (elpaa--make-one-package (format "%s" (car spec)))))))
+        (elpaa--make-one-package spec)))))
 
 (defun elpaa-batch-make-one-package (&rest _)
-  "Build the new tarballs (if needed) for one particular package,"
-  (elpaa--make-one-package (pop command-line-args-left)))
-
-(defun elpaa--make-one-package (pkgname)
-  "Build the new tarballs (if needed) for PKGNAME."
-  (let* ((dir (expand-file-name pkgname "packages")))
-    (elpaa--message "Checking package %s for updates..." pkgname)
-    (let* ((pkg-spec (elpaa--get-package-spec pkgname))
-           (_ (elpaa--external-package-sync pkg-spec))
-           (_ (elpaa--message "pkg-spec for %s: %S" pkgname pkg-spec))
-           (metadata (elpaa--metadata dir pkg-spec))
-           (vers (nth 1 metadata)))
-      (elpaa--message "metadata = %S" metadata)
-      (if (null metadata)
-          (error "No metadata found for package: %s" pkgname)
-        ;; Disregard the simple/multi distinction.  This might have been useful
-        ;; in a distant past, but nowadays it's just unneeded extra complexity.
-        (setf (car metadata) nil)
-        ;; First, try and build the devel tarball
-        ;; Do it before building the release tarball, because building
-        ;; the release tarball may revert to some older commit.
-        (let* ((date-version (elpaa--get-devel-version dir))
-               ;; Add a ".0." so that when the version number goes from
-               ;; NN.MM to NN.MM.1 we don't end up with the devel build
-               ;; of NN.MM comparing as more recent than NN.MM.1.
-               ;; But be careful to turn "2.3" into "2.3.0.DATE"
-               ;; and "2.3b" into "2.3b0.DATE".
-               (devel-vers
-                (concat vers (if (string-match "[0-9]\\'" vers) ".")
-                        "0." date-version))
-               (tarball (concat elpaa--devel-subdir
-                                (format "%s-%s.tar" pkgname devel-vers)))
-               (new
-                (let ((elpaa--name (concat elpaa--name "-devel")))
-                  ;; Build the archive-devel tarball.
-                  (elpaa--make-one-tarball tarball
-                                             dir pkgname
-                                             `(nil ,devel-vers
-                                                   . ,(nthcdr 2 metadata))))))
-
-          ;; Try and build the latest release tarball.
+  "Build the new tarballs (if needed) for one particular package."
+  (while command-line-args-left
+    (elpaa--make-one-package (elpaa--get-package-spec
+                                (pop command-line-args-left)))))
+
+(defun elpaa--make-one-package (pkg-spec)
+  "Build the new tarballs (if needed) for PKG-SPEC."
+  (elpaa--message "Checking package %s for updates..." (car pkg-spec))
+  (let* ((pkgname (car pkg-spec))
+         (dir (expand-file-name pkgname "packages"))
+         (_ (if (eq (nth 1 pkg-spec) :core)
+                (elpaa--core-package-sync pkg-spec)
+              (elpaa--external-package-sync pkg-spec)))
+         (_ (elpaa--message "pkg-spec for %s: %S" pkgname pkg-spec))
+         (metadata (elpaa--metadata dir pkg-spec))
+         (vers (nth 1 metadata)))
+    (elpaa--message "metadata = %S" metadata)
+    (if (null metadata)
+        (error "No metadata found for package: %s" pkgname)
+      ;; Disregard the simple/multi distinction.  This might have been useful
+      ;; in a distant past, but nowadays it's just unneeded extra complexity.
+      (setf (car metadata) nil)
+      ;; First, try and build the devel tarball
+      ;; Do it before building the release tarball, because building
+      ;; the release tarball may revert to some older commit.
+      (let* ((date-version (elpaa--get-devel-version dir))
+             ;; Add a ".0." so that when the version number goes from
+             ;; NN.MM to NN.MM.1 we don't end up with the devel build
+             ;; of NN.MM comparing as more recent than NN.MM.1.
+             ;; But be careful to turn "2.3" into "2.3.0.DATE"
+             ;; and "2.3b" into "2.3b0.DATE".
+             (devel-vers
+              (concat vers (if (string-match "[0-9]\\'" vers) ".")
+                      "0." date-version))
+             (tarball (concat elpaa--devel-subdir
+                              (format "%s-%s.tar" pkgname devel-vers)))
+             (new
+              (let ((elpaa--name (concat elpaa--name "-devel")))
+                ;; Build the archive-devel tarball.
+                (elpaa--make-one-tarball tarball
+                                           dir pkg-spec
+                                           `(nil ,devel-vers
+                                                 . ,(nthcdr 2 metadata))))))
+
+        ;; Try and build the latest release tarball.
+        (cond
+         ((or (equal vers "0")
+              ;; -4 is used for "NN.MMsnapshot" and "NN.MM-git"
+              (member '-4 (version-to-list vers)))
           (cond
-           ((or (equal vers "0")
-                ;; -4 is used for "NN.MMsnapshot" and "NN.MM-git"
-                (member '-4 (version-to-list vers)))
-            (cond
-             ((equal vers "0")
-              (elpaa--message "Package %s not released yet!" pkgname))
-             ((not new)
-              (elpaa--message "Nothing new for package %s!" pkgname))
-             (t
-              ;; If this revision is a snapshot, check to see if there's
-              ;; a previous non-snapshot revision and build it if needed.
-              (let* ((last-rel (elpaa--get-last-release pkg-spec))
-                     (tarball (concat elpaa--release-subdir
-                                      (format "%s-%s.tar"
-                                              pkgname (car last-rel)))))
-                (if (not last-rel)
-                    (elpaa--message "Package %s not released yet!" pkgname)
-                  (elpaa--make-one-tarball
-                   tarball dir pkgname
-                   `(nil ,(car last-rel) . ,(nthcdr 2 metadata))
-                   (lambda () (cdr last-rel))))))))
+           ((equal vers "0")
+            (elpaa--message "Package %s not released yet!" pkgname))
+           ((not new)
+            (elpaa--message "Nothing new for package %s!" pkgname))
            (t
-            (let ((tarball (concat elpaa--release-subdir
-                                   (format "%s-%s.tar" pkgname vers))))
-              (elpaa--make-one-tarball
-               tarball dir pkgname metadata
-               (lambda ()
-                 (elpaa--get-release-revision
-                  dir pkgname vers
-                  (plist-get (cdr pkg-spec) :version-map))))))))))))
+            ;; If this revision is a snapshot, check to see if there's
+            ;; a previous non-snapshot revision and build it if needed.
+            (let* ((last-rel (elpaa--get-last-release pkg-spec))
+                   (tarball (concat elpaa--release-subdir
+                                    (format "%s-%s.tar"
+                                            pkgname (car last-rel)))))
+              (if (not last-rel)
+                  (elpaa--message "Package %s not released yet!" pkgname)
+                (elpaa--make-one-tarball
+                 tarball dir pkg-spec
+                 `(nil ,(car last-rel) . ,(nthcdr 2 metadata))
+                 (lambda () (cdr last-rel))))))))
+         (t
+          (let ((tarball (concat elpaa--release-subdir
+                                 (format "%s-%s.tar" pkgname vers))))
+            (elpaa--make-one-tarball
+             tarball dir pkg-spec metadata
+             (lambda ()
+               (elpaa--get-release-revision
+                dir pkgname vers
+                (plist-get (cdr pkg-spec) :version-map)))))))))))
 
 (defun elpaa--call (destination program &rest args)
   "Like ‘call-process’ for PROGRAM, DESTINATION, ARGS.
@@ -735,23 +757,16 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
   (replace-regexp-in-string "<" "&lt;"
                             (replace-regexp-in-string "&" "&amp;" txt)))
 
-(defun elpaa--read-externals-list (&optional dir)
-  (elpaa--form-from-file-contents
-   (expand-file-name "externals-list" dir)))
-
-(defun elpaa--insert-repolinks (name srcdir _mainsrcfile url)
+(defun elpaa--insert-repolinks (pkg-spec url)
   (when url
     (insert (format "<dt>Home page</dt> <dd><a href=%S>%s</a></dd>\n"
                     url (elpaa--quote url)))
     (when (string-match elpaa--default-url-re url)
       (setq url nil)))
-  (let* ((externals (elpaa--read-externals-list
-                     (expand-file-name "../../../elpa" srcdir)))
-         (extern-desc (assoc name externals))
-         (git-sv "http://git.savannah.gnu.org/";)
+  (let* ((git-sv "http://git.savannah.gnu.org/";)
          (urls
-          (if (eq (nth 1 extern-desc) :core)
-              (let* ((files (nth 2 extern-desc))
+          (if (eq (nth 1 pkg-spec) :core)
+              (let* ((files (nth 2 pkg-spec))
                      (file (if (listp files)
                                (directory-file-name
                                 (file-name-directory
@@ -762,12 +777,9 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
                           ,(if (listp files)
                                "gitweb/?p=emacs.git;a=tree;f="
                              "gitweb/?p=emacs.git;a=blob;f="))))
-            (mapcar (lambda (s) (format s elpaa--gitrepo name))
-                    (if (eq (nth 1 extern-desc) :external)
-                        '("cgit/%s/?h=externals/%s"
-                          "gitweb/?p=%s;a=shortlog;h=refs/heads/externals/%s")
-                      '("cgit/%s/tree/packages/%s"
-                        "gitweb/?p=%s;a=tree;f=packages/%s"))))))
+            (mapcar (lambda (s) (format s elpaa--gitrepo (car pkg-spec)))
+                    '("cgit/%s/?h=externals/%s"
+                      "gitweb/?p=%s;a=shortlog;h=refs/heads/externals/%s")))))
     (insert (format
              (concat (format "<dt>Browse %srepository</dt> <dd>" (if url 
"ELPA's " ""))
                      "<a href=%S>%s</a> or <a href=%S>%s</a></dd>\n")
@@ -776,13 +788,14 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
              (concat git-sv (nth 1 urls))
              'Gitweb))))
 
-(defun elpaa--html-make-pkg (pkg files &optional srcdir)
+(defun elpaa--html-make-pkg (pkg pkg-spec files &optional srcdir)
   (let* ((name (symbol-name (car pkg)))
          (latest (package-version-join (aref (cdr pkg) 0)))
          (srcdir (or srcdir
                      (expand-file-name name "../../build/packages")))
          (mainsrcfile (expand-file-name (format "%s.el" name) srcdir))
          (desc (aref (cdr pkg) 2)))
+    (cl-assert (equal name (car pkg-spec)))
     (with-temp-buffer
       (insert (elpaa--html-header
                (format "%s ELPA - %s" elpaa--name name)
@@ -810,7 +823,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
                                 "<" (cdr maint) ">")))
           (insert (format "<dt>Maintainer</dt> <dd>%s</dd>\n" (elpaa--quote 
maint)))))
       (elpaa--insert-repolinks
-       name srcdir mainsrcfile
+       pkg-spec
        (or (cdr (assoc :url (aref (cdr pkg) 4)))
            (elpaa--get-prop "URL" name srcdir mainsrcfile)))
       (insert "</dl>")
@@ -829,6 +842,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
           (write-region rm nil (concat name "-readme.txt"))
           (insert "<h2>Full description</h2><pre>\n" (elpaa--quote rm)
                   "\n</pre>\n")))
+      ;; (message "latest=%S; files=%S" latest files)
       (unless (< (length files) (if (zerop (length latest)) 1 2))
         (insert (format "<h2>Old versions</h2><table>\n"))
         (dolist (file
@@ -880,6 +894,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
 
 (defun elpaa-batch-html-make-index ()
   (let ((packages (make-hash-table :test #'equal))
+        (specs (elpaa--form-from-file-contents "externals-list"))
         (archive-contents
          ;; Skip the first element which is a version number.
          (cdr (elpaa--form-from-file-contents "archive-contents"))))
@@ -912,6 +927,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
                               ;; Add entry at the end.
                               (nconc archive-contents (list entry)))
                         entry)))
+                (assoc pkg-name specs)
                 files))
              packages)
     (elpaa--html-make-index archive-contents)))
@@ -919,6 +935,11 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
 (defun elpaa--pull (dirname)
   (let ((default-directory (elpaa--dirname dirname)))
     (with-temp-buffer
+      ;; Undo any local changes to `<pkg>-pkg.el', in case it's under
+      ;; version control.
+      (elpaa--call t "git" "checkout" "--"
+                     (concat (file-name-nondirectory dirname) "-pkg.el"))
+      (erase-buffer)              ;Throw away the error message we usually get.
       (cond
        ((file-directory-p ".git")
         (message "Running git pull in %S" default-directory)
@@ -1146,19 +1167,13 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
 
 (defun elpaa-add/remove/update-externals ()
   "Remove non-package directories and fetch external packages."
-  (let ((specs (elpaa--read-externals-list)))
-    (let ((with-core (elpaa--sync-emacs-repo)))
-      (elpaa--cleanup-packages specs with-core)
-      (pcase-dolist ((and pkg-spec `(,name ,kind ,_url)) specs)
-        (pcase kind
-          (`:external (elpaa--external-package-sync pkg-spec))
-          (`:core (when with-core (elpaa--core-package-sync pkg-spec)))
-          (_ (message "Unknown external package kind `%S' for %s"
-                      kind name)))))))
+  (let ((command-line-args-left '("-")))
+    (elpaa-batch-archive-update-worktrees)))
 
 (defun elpaa-batch-archive-update-worktrees (&rest _)
   (let ((specs (elpaa--form-from-file-contents "externals-list"))
-        (pkgs command-line-args-left))
+        (pkgs command-line-args-left)
+        (with-core (elpaa--sync-emacs-repo)))
     (setq command-line-args-left nil)
     (if (equal pkgs '("-")) (setq pkgs (mapcar #'car specs)))
     (dolist (pkg pkgs)
@@ -1166,11 +1181,10 @@ If WITH-CORE is non-nil, it means we manage :core 
packages as well."
              (kind (nth 1 pkg-spec)))
         (pcase kind
           (`:external (elpaa--external-package-sync pkg-spec))
-          ;; (`:core (when with-core (elpaa--core-package-sync definition)))
+          (`:core (when with-core (elpaa--core-package-sync pkg-spec)))
           (_ (if pkg-spec
-                 (message "Unknown external package kind `%S' for %s"
-                          kind pkg)
-               (message "Unknown external package %s" pkg))))))))
+                 (message "Unknown package kind `%S' for %s" kind pkg)
+               (message "Unknown package %s" pkg))))))))
 
 ;;; Fetch updates from upstream