branch: elpa-admin
commit 4b508adaa30ce66789cf4563258b59d37412eac7
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
* elpa-admin.el: Allow site-local config
Turn defconsts into defvars.
(elpaa--debug): Default to nil.
(elpaa-read-config): New function. Call it for all batch entry points.
(elpaa--make-tar-transform, elpaa--make-one-tarball): Allow + in
package names.
(elpaa--make-one-tarball): Fix typo.
(elpaa-batch-make-all-packages): Demote errors even when debug-on-error
is non-nil.
(elpaa--make-one-package): Another typo.
(elpaa--revno-re): Remove constant, unused.
(elpaa--default-url-format, elpaa--default-url-re): Turn into function,
so it obeys the current setting of elpaa--url.
(elpaa--make-changelog): Delete unused function.
(elpaa--elpa-git-url, elpaa--emacs-git-url): Delete unused constants.
(elpaa--copyright-files): Don't ignore symlinks to files.
---
elpa-admin.el | 120 +++++++++++++++++++++++++++-------------------------------
1 file changed, 55 insertions(+), 65 deletions(-)
diff --git a/elpa-admin.el b/elpa-admin.el
index 5d49621..e0d34b0 100644
--- a/elpa-admin.el
+++ b/elpa-admin.el
@@ -21,17 +21,9 @@
;;;; TODO
-;; Missing from GNU ELPA script:
-;; - Support for :core (seems to be partly working, actually, tho it likely
-;; doesn't select the right release revision).
-;; - Support for Org's package (including building the Info file)
-;; - Fix archive name and URL
-
-;; Missing more generally:
-;; - support for rebuilding index.html, archive-contents, and <pkg>.html
-;; - support for building the Info files
+;; - support for conveniently rebuilding individual files like
+;; index.html, archive-contents, or <pkg>.html
;; - render the README and News in the HTML rather than as <pre> block!
-;; - support for Tramp as core?
;;; Code:
@@ -40,29 +32,48 @@
(require 'package)
-(defconst elpaa--release-subdir "archive/"
+(defvar elpaa--release-subdir "archive/"
"Subdirectory where the ELPA release files (tarballs, ...) will be placed.")
-(defconst elpaa--devel-subdir "archive-devel/"
+(defvar elpaa--devel-subdir "archive-devel/"
"Subdirectory where the ELPA bleeding edge files (tarballs, ...) will be
placed.")
-(defconst elpaa--name "NonGNU")
-(defconst elpaa--gitrepo "emacs/nongnu.git")
-(defconst elpaa--url "https://elpa.gnu.org/nongnu/";)
+(defvar elpaa--name "NonGNU")
+(defvar elpaa--gitrepo "emacs/nongnu.git")
+(defvar elpaa--url "https://elpa.gnu.org/nongnu/";)
-(defconst elpaa--branch-prefix "externals/")
-(defconst elpaa--release-branch-prefix "externals-release/")
+(defvar elpaa--branch-prefix "externals/")
+(defvar elpaa--release-branch-prefix "externals-release/")
-(defconst elpaa--specs-file "externals-list")
-(defconst elpaa--copyright-file "copyright_exceptions")
-(defconst elpaa--email-to nil) ;;"gnu-emacs-sour...@gnu.org"
-(defconst elpaa--email-from nil) ;;"ELPA update <do.not.re...@elpa.gnu.org>"
+(defvar elpaa--specs-file "externals-list")
+(defvar elpaa--copyright-file "copyright_exceptions")
+(defvar elpaa--email-to nil) ;;"gnu-emacs-sour...@gnu.org"
+(defvar elpaa--email-from nil) ;;"ELPA update <do.not.re...@elpa.gnu.org>"
-(defconst elpaa--sandbox t
+(defvar elpaa--sandbox t
"If non-nil, run some of the less trusted commands in a sandbox.
This is recommended when building packages from untrusted sources,
but this requires Bubblewrap to be installed and has only been tested
on some Debian systems.")
-(defvar elpaa--debug t)
+(defvar elpaa--debug nil)
+
+(defun elpaa-read-config (&optional file)
+ (let ((config (elpaa--form-from-file-contents (or file "elpa-config"))))
+ (pcase-dolist (`(,var ,val) config)
+ (cl-assert (or (stringp val) (booleanp val)) t)
+ (setf (pcase-exhaustive var
+ ('name elpaa--name)
+ ('gitrepo elpaa--gitrepo)
+ ('url elpaa--url)
+ ('branch-prefix elpaa--branch-prefix)
+ ('release-branch-prefix elpaa--release-branch-prefix)
+ ('specs-file elpaa--specs-file)
+ ('copyright-file elpaa--copyright-file)
+ ('email-to elpaa--email-to)
+ ('email-from elpaa--email-from)
+ ('sandbox elpaa--sandbox)
+ ('debug elpaa--debug))
+ val))))
+
(defun elpaa--message (&rest args)
(when elpaa--debug (apply #'message args)))
@@ -222,8 +233,8 @@ Do it without leaving the current branch."
(defun elpaa--make-tar-transform (pkgname r)
(let ((from (nth 0 r)) (to (nth 1 r)))
- (cl-assert (not (string-match "[][*+\\|?]" from)))
- (cl-assert (not (string-match "[][*+\\|?]" to)))
+ (cl-assert (not (string-match "[][*\\|?]" from)))
+ (cl-assert (not (string-match "[][*\\|?]" to)))
(format "--transform=s|^packages/%s/%s|packages/%s/%s|"
pkgname
(if (string-match "/\\'" from)
@@ -321,8 +332,8 @@ Return non-nil if a new tarball was created."
(elpaa--make pkg-spec dir)
(elpaa--write-pkg-file dir pkgname metadata)
;; FIXME: Allow renaming files or selecting a subset of the files!
- (cl-assert (not (string-match "[][*+\\|?]" pkgname)))
- (cl-assert (not (string-match "[][*+\\|?]" vers)))
+ (cl-assert (not (string-match "[][*\\|?]" pkgname)))
+ (cl-assert (not (string-match "[][*\\|?]" vers)))
(apply #'elpaa--call
nil "tar"
`("--exclude-vcs"
@@ -330,7 +341,7 @@ Return non-nil if a new tarball was created."
(ignores
(mapcar (lambda (i) (format "--exclude=packages/%s/%s"
pkgname i))
ignores))
- ((file-readable-p elpaignore) `("-X" elpaignore)))
+ ((file-readable-p elpaignore) `("-X" ,elpaignore)))
,@(mapcar (lambda (r) (elpaa--make-tar-transform pkgname r))
renames)
"--transform"
,(format "s|^packages/%s|%s-%s|" pkgname pkgname vers)
@@ -407,13 +418,16 @@ Return non-nil if a new tarball was created."
(defun elpaa-batch-make-all-packages (&rest _)
"Check all the packages and build the relevant new tarballs."
+ (elpaa-read-config)
(let* ((specs (elpaa--get-specs)))
(dolist (spec specs)
- (with-demoted-errors "Build error: %S"
- (elpaa--make-one-package spec)))))
+ (condition-case err
+ (elpaa--make-one-package spec)
+ (error (message "Build error for %s: %S" (car spec) err))))))
(defun elpaa-batch-make-one-package (&rest _)
"Build the new tarballs (if needed) for one particular package."
+ (elpaa-read-config)
(while command-line-args-left
(elpaa--make-one-package (elpaa--get-package-spec
(pop command-line-args-left)))))
@@ -488,7 +502,7 @@ Return non-nil if a new tarball was created."
tarball dir pkg-spec metadata
(lambda ()
(elpaa--get-release-revision
- dir pkgname vers
+ dir pkg-spec vers
(plist-get (cdr pkg-spec) :version-map))))
(elpaa--release-email pkg-spec metadata dir))))))))
@@ -527,10 +541,8 @@ Signal an error if the command did not finish with exit
code 0."
(buffer-string))
(error "Error-indicating exit code in elpaa--call-sandboxed"))))))
-(defconst elpaa--revno-re "[0-9a-f]+")
-
-(defconst elpaa--default-url-format (concat elpaa--url "%s.html"))
-(defconst elpaa--default-url-re (format elpaa--default-url-format ".*"))
+(defun elpaa--default-url-format () (concat elpaa--url "%s.html"))
+(defun elpaa--default-url-re () (format (elpaa--default-url-format) ".*"))
(defun elpaa--override-version (pkg-spec orig-fun header)
@@ -597,7 +609,7 @@ PKG is the name of the package and DIR is the directory
where it is."
(push (cons :keywords keywords) extras))
(unless found-url
;; Provide a good default URL.
- (push (cons :url (format elpaa--default-url-format pkg)) extras))
+ (push (cons :url (format (elpaa--default-url-format) pkg)) extras))
(list simple
(package-version-join version)
(package-desc-summary pkg-desc)
@@ -606,29 +618,6 @@ PKG is the name of the package and DIR is the directory
where it is."
(t
(error "Can't find main file %s file in %s" mainfile dir)))))
-(defun elpaa--make-changelog (dir srcdir)
- "Export Git log info of DIR into a ChangeLog file."
- (message "Refreshing ChangeLog in %S" dir)
- (let ((default-directory (elpaa--dirname dir)))
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (when (file-readable-p "ChangeLog") (insert-file-contents "ChangeLog"))
- (let ((old-md5 (md5 (current-buffer))))
- (erase-buffer)
- (let ((default-directory (elpaa--dirname dir srcdir)))
- (elpaa--call t "git" "log" "--date=short"
- "--format=%cd %aN <%ae>%n%n%w(80,8,8)%B%n"
- "."))
- (tabify (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "\n\n\n+" nil t)
- (replace-match "\n\n"))
- (if (equal old-md5 (md5 (current-buffer)))
- (message "ChangeLog's md5 unchanged for %S" dir)
- (write-region (point-min) (point-max) "ChangeLog" nil 'quiet)))))))
-
(defun elpaa--alist-to-plist-args (alist)
(mapcar (lambda (x)
(if (and (not (consp x))
@@ -847,7 +836,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
(when url
(insert (format "<dt>Home page</dt> <dd><a href=%S>%s</a></dd>\n"
url (elpaa--html-quote url)))
- (when (string-match elpaa--default-url-re url)
+ (when (string-match (elpaa--default-url-re) url)
(setq url nil)))
(let* ((git-sv "http://git.savannah.gnu.org/";)
(urls
@@ -1003,9 +992,6 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
;;; Maintain external packages.
-(defconst elpaa--elpa-git-url "git://git.sv.gnu.org/emacs/elpa")
-(defconst elpaa--emacs-git-url "git://git.sv.gnu.org/emacs.git")
-
(defun elpaa--sync-emacs-repo ()
"Sync Emacs repository, if applicable.
Return non-nil if there's an \"emacs\" repository present."
@@ -1227,10 +1213,12 @@ 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."
+ (elpaa-read-config)
(let ((command-line-args-left '("-")))
(elpaa-batch-archive-update-worktrees)))
(defun elpaa-batch-archive-update-worktrees (&rest _)
+ (elpaa-read-config)
(let ((specs (elpaa--get-specs))
(pkgs command-line-args-left)
(with-core (elpaa--sync-emacs-repo)))
@@ -1266,8 +1254,7 @@ If WITH-CORE is non-nil, it means we manage :core
packages as well."
(while pending
(pcase (pop pending)
((pred (lambda (f) (member f ignores))))
- ((pred file-symlink-p))
- ((and (pred file-directory-p) d)
+ ((and d (guard (and (file-directory-p d) (not (file-symlink-p d)))))
(setq pending (nconc (mapcar (lambda (f) (concat d "/" f))
(funcall dir-files d))
pending)))
@@ -1322,6 +1309,7 @@ If WITH-CORE is non-nil, it means we manage :core
packages as well."
(error "Abort")))))
(defun elpaa-batch-copyright-check (&rest _)
+ (elpaa-read-config)
(let ((specs (elpaa--get-specs))
(pkgs command-line-args-left))
(setq command-line-args-left nil)
@@ -1529,9 +1517,11 @@ More at " elpaa--url pkgname ".html")
(elpaa--fetch pkg-spec k))))))
(defun elpaa-batch-fetch-and-show (&rest _)
+ (elpaa-read-config)
(elpaa--batch-fetch-and #'ignore))
(defun elpaa-batch-fetch-and-push (&rest _)
+ (elpaa-read-config)
(elpaa--batch-fetch-and #'elpaa--push))
;;; ERT test support
