branch: elpa-admin
commit 7d65683be180b2f04771a963288d1ff2bb0aee67
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@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 "<" "<"
(replace-regexp-in-string "&" "&" 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
