[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] master 50a4dd3 2/3: Initial commit; copy files from elpa.git
|
From: |
Stefan Monnier |
|
Subject: |
[nongnu] master 50a4dd3 2/3: Initial commit; copy files from elpa.git |
|
Date: |
Sat, 21 Nov 2020 01:14:44 -0500 (EST) |
branch: master
commit 50a4dd3e15552f08a0c86c1f198b9f24d7b13ddf
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Initial commit; copy files from elpa.git
---
.gitignore | 15 +
GNUmakefile | 238 ++++++++++++
admin/archive-contents.el | 905 ++++++++++++++++++++++++++++++++++++++++++++++
admin/ert-support.el | 55 +++
admin/forward-diffs.py | 438 ++++++++++++++++++++++
admin/hv.sh | 47 +++
admin/update-archive.sh | 235 ++++++++++++
7 files changed, 1933 insertions(+)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6e08e36
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,15 @@
+*.elc
+*.orig
+.dir-locals?.el
+*~
+\#*\#
+ChangeLog
+core
+/emacs
+/packages/
+/archive/
+
+# Testing file
+/archive
+*.log
+*.buildlog
diff --git a/GNUmakefile b/GNUmakefile
new file mode 100644
index 0000000..816bb19
--- /dev/null
+++ b/GNUmakefile
@@ -0,0 +1,238 @@
+# Makefile for GNU Emacs Lisp Package Archive.
+#
+
+EMACS=emacs --batch
+
+ARCHIVE_TMP=archive-tmp
+SITE_DIR=site
+
+.PHONY: archive-tmp changelogs process-archive archive-full org-fetch clean
all do-it
+
+all: all-in-place .gitignore
+
+CR_EXCEPTIONS=copyright_exceptions
+.PHONY: check_copyrights
+check_copyrights:
+ @echo "Compute exceptions >$(CR_EXCEPTIONS)~"
+ @export LC_ALL=C; \
+ (cd packages && \
+ find . -name '.git' -prune -o \
+ -name 'test' -prune -o \
+ -name '*.el' -print0 | \
+ xargs -0 grep -L 'Free Software Foundation, Inc' | \
+ grep -v '\(\.dir-locals\|.-\(pkg\|autoloads\)\)\.el$$'; \
+ find . -name '.git' -prune -o -name '*.el' -type f -print | \
+ while read f; do \
+ fquoted="$$(echo $$f|tr '|' '_')"; \
+ sed -n -e '/[Cc]opyright.*, *[1-9][-0-9]*,\?$$/N' \
+ -e '/Free Software Foundation/d' \
+ -e "s|^\\(.*;.*[Cc]opyright\\)|$$fquoted:\\1|p" \
+ "$$f"; \
+ done) | sort >$(CR_EXCEPTIONS)~
+ diff -u "$(CR_EXCEPTIONS)" "$(CR_EXCEPTIONS)~"
+
+## Deploy the package archive to archive/, with packages in
+## archive/packages/:
+archive: archive-tmp
+ $(MAKE) $(MFLAGS) process-archive
+
+archive-tmp: packages
+ -rm -r $(ARCHIVE_TMP)
+ mkdir -p $(ARCHIVE_TMP)
+ cp -a packages/. $(ARCHIVE_TMP)/packages
+
+# Use && after the cd commands, not ;, to ensure the build fails
+# immediately if the directory $(ARCHIVE_TMP)/packages does not exist.
+# For process-archive this is crucial; otherwise batch-make-archive in
+# archive-contents.el will interpret directories in the current
+# directory as unreleased packages, and recursively delete them,
+# including .git. Prior to using &&, running "make process-archive"
+# could silently delete all local git history!
+process-archive:
+ # FIXME, we could probably speed this up significantly with
+ # rules like "%.tar: ../%/ChangeLog" so we only rebuild the packages
+ # that have indeed changed.
+ cd $(ARCHIVE_TMP)/packages && \
+ $(EMACS) -l $(CURDIR)/admin/archive-contents.el \
+ -f batch-make-archive
+ @cd $(ARCHIVE_TMP)/packages && \
+ for pt in *; do \
+ if [ -f "$${pt}/.elpaignore" ]; then \
+ ignore="$${pt}/.elpaignore"; \
+ else \
+ ignore="/dev/null"; \
+ fi; \
+ if [ -d $$pt ]; then \
+ echo "Creating tarball $${pt}.tar" && \
+ tar --exclude-vcs -X "$$ignore" -chf $${pt}.tar $$pt; \
+ rm -rf $${pt}; \
+ fi; \
+ done
+ mkdir -p archive/packages
+ mv archive/packages archive/packages-old
+ mv $(ARCHIVE_TMP)/packages archive/packages
+ chmod -R a+rX archive/packages
+ rm -rf archive/packages-old
+ rm -rf $(ARCHIVE_TMP)
+
+## Deploy the package archive to archive/ including the Org daily:
+archive-full: archive-tmp org-fetch
+ $(MAKE) $(MFLAGS) process-archive
+ #mkdir -p archive/admin
+ #cp admin/* archive/admin/
+
+.gitignore: externals-list
+ $(EMACS) -l $(CURDIR)/admin/archive-contents.el \
+ --eval '(archive-gitignore-externals "$<" "$@")'
+
+# FIXME: Turn it into an `external', which will require adding the notion of
+# "snapshot" packages.
+org-fetch: archive-tmp
+ -cd $(ARCHIVE_TMP)/packages &&
\
+ pkgname=`wget -q -O- https://orgmode.org/elpa/|perl -ne 'push @f, $$1
if m/(org-\d{8})\.tar/; END { @f = sort @f; print "$$f[-1]\n"}'`; \
+ wget -q https://orgmode.org/elpa/$${pkgname}.tar -O $${pkgname}.tar;
\
+ if [ -f $${pkgname}.tar ]; then
\
+ tar xf $${pkgname}.tar;
\
+ rm -f $${pkgname}.tar;
\
+ mv $${pkgname} org;
\
+ fi
+
+clean:
+ rm -rf archive $(ARCHIVE_TMP) $(SITE_DIR)
+
+########## Rules for in-place installation ####################################
+pkgs := $(foreach pkg, $(wildcard packages/*), \
+ $(if $(shell [ -d "$(pkg)" ] && echo true), $(pkg)))
+
+define SET-diff
+$(shell $(file > .tmp.setdiff, $(1)) \
+ $(file >> .tmp.setdiff, $(2)) \
+ $(file >> .tmp.setdiff, $(2)) \
+ tr ' ' '\n' < .tmp.setdiff | sort | uniq -u ; rm .tmp.setdiff)
+endef
+
+define FILTER-nonsrc
+$(filter-out %-autoloads.el %-pkg.el %/.dir-locals.el, $(1))
+endef
+
+define RULE-srcdeps
+$(1): $$(call FILTER-nonsrc, $$(wildcard $$(dir $(1))/*.el))
+endef
+
+# Compute the set of autolods files and their dependencies.
+autoloads := $(foreach pkg, $(pkgs), $(pkg)/$(notdir $(pkg))-autoloads.el)
+
+# FIXME: In 99% of the cases, autoloads can be generated in any order.
+# But the `names' package is an exception because it sets up an advice that
+# changes the way autload.el operates, and that advice is needed when creating
+# the autoloads file of packages that use `names'.
+# The right solution is to check the Package-Requires and create the autoloads
+# files in topological order, but for now we can just do it the ad-hoc way and
+# add hand-made dependencies between autoloads files, and explicitly
+# load the names-autoloads file when building autoloads files. An example entry
+# is commented below, this is what should be done if a package depends on
Names.
+
+# packages/aggressive-indent/aggressive-indent-autoloads.el: \
+# packages/names/names-autoloads.el
+
+$(foreach al, $(autoloads), $(eval $(call RULE-srcdeps, $(al))))
+%-autoloads.el:
+ @#echo 'Generating autoloads for $@'
+ @cd $(dir $@) && \
+ $(EMACS) -l $(CURDIR)/admin/archive-contents.el \
+ --eval "(require 'package)" \
+ --eval "(load (expand-file-name \"../names/names-autoloads.el\")
t t)" \
+ --eval "(package-generate-autoloads \"$$(basename $$(pwd))\" \
+ \"$$(pwd)\")"
+
+# Put into elcs the set of elc files we need to keep up-to-date.
+# I.e. one for each .el file in each package root, except for the -pkg.el,
+# the -autoloads.el, the .el files that are marked "no-byte-compile", and
+# files matching patterns in packages' .elpaignore files.
+included_els := $(shell tar -cvhf /dev/null --exclude-ignore=.elpaignore \
+ --exclude-vcs packages 2>&1 | grep '\.el$$')
+
+# included_els := $(wildcard packages/*/*.el)
+
+# els := $(call FILTER-nonsrc, $(wildcard packages/*/*.el \
+# packages/*/*/*.el \
+# packages/*/*/*/*.el \
+# packages/*/*/*/*/*.el))
+els := $(call FILTER-nonsrc, $(included_els))
+naive_elcs := $(patsubst %.el, %.elc, $(els))
+current_elcs := $(shell find packages -name '*.elc' -print)
+
+extra_els := $(call SET-diff, $(els), $(patsubst %.elc, %.el, $(current_elcs)))
+nbc_els := $(foreach el, $(extra_els), \
+ $(if $(shell grep '^;.*no-byte-compile: *t' "$(el)"), $(el)))
+elcs := $(call SET-diff, $(naive_elcs), $(patsubst %.el, %.elc, $(nbc_els)))
+
+# '(dolist (al (quote ($(patsubst %, "%", $(autoloads))))) (load
(expand-file-name al) nil t))'
+%.elc: %.el
+ @echo 'Byte compiling $<'
+ @$(EMACS) \
+ --eval "(setq package-directory-list nil \
+ load-prefer-newer t \
+ package-user-dir \"$(abspath packages)\")" \
+ -f package-initialize \
+ -L $(dir $@) -f batch-byte-compile $<
+
+.PHONY: elcs
+elcs: $(elcs)
+
+# Remove .elc files that don't have a corresponding .el file any more.
+extra_elcs := $(call SET-diff, $(current_elcs), $(naive_elcs))
+.PHONY: $(extra_elcs)
+$(extra_elcs):; rm $@
+
+# # Put into single_pkgs the set of -pkg.el files we need to keep up-to-date.
+# # I.e. all the -pkg.el files for the single-file packages.
+pkg_descs:=$(foreach pkg, $(pkgs), $(pkg)/$(notdir $(pkg))-pkg.el)
+#$(foreach al, $(single_pkgs), $(eval $(call RULE-srcdeps, $(al))))
+%-pkg.el: %.el
+ @echo 'Generating description file $@'
+ @$(EMACS) \
+ --eval '(require (quote package))' \
+ --eval '(setq b (find-file-noselect "$<"))' \
+ --eval '(setq d (with-current-buffer b (package-buffer-info)))' \
+ --eval '(package-generate-description-file d "$@")'
+
+.PHONY: all-in-place
+# Use order-only prerequisites, so that autoloads are done first.
+all-in-place: | $(extra_elcs) $(autoloads) $(pkg_descs) elcs
+
+
+############### Rules to prepare the externals ################################
+
+.PHONY:
+externals:
+ $(EMACS) -l admin/archive-contents.el \
+ -f archive-add/remove/update-externals
+
+
+
+
+################### Testing ###############
+
+PACKAGE_DIRS = $(shell find packages -maxdepth 1 -type d)
+PACKAGES=$(subst /,,$(subst packages,,$(PACKAGE_DIRS)))
+
+TOP =$(shell pwd)
+
+define test_template
+$(1)-test:
+ cd packages/$(1);\
+ $(EMACS) -l $(TOP)/admin/ert-support.el \
+ --eval "(ert-support-test-package \"$(TOP)\" '$(1))" \
+
+$(1)-test-log:
+ $(MAKE) $(1)-test > packages/$(1)/$(1).log 2>&1 || { stat=ERROR; }
+endef
+
+$(foreach package,$(PACKAGES),$(eval $(call test_template,$(package))))
+
+PACKAGES_TESTS=$(addsuffix -test-log,$(PACKAGES))
+PACKAGES_LOG=$(foreach package,$(PACKAGES),packages/$(package)/$(package).log)
+
+check: $(PACKAGES_TESTS)
+ $(EMACS) -l ert -f ert-summarize-tests-batch-and-exit $(PACKAGES_LOG)
diff --git a/admin/archive-contents.el b/admin/archive-contents.el
new file mode 100644
index 0000000..0ee3fc2
--- /dev/null
+++ b/admin/archive-contents.el
@@ -0,0 +1,905 @@
+;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive. -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2011-2019 Free Software Foundation, Inc
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'lisp-mnt)
+(require 'package)
+(require 'pcase)
+
+(defconst archive-contents-subdirectory-regexp
+
"\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)")
+
+(defconst archive-re-no-dot "\\`\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
+ "Regular expression matching all files except \".\" and \"..\".")
+
+(defun archive--version-to-list (vers)
+ (when vers
+ (let ((l (version-to-list vers)))
+ ;; Signal an error for things like "1.02" which is parsed as "1.2".
+ (cl-assert (equal vers (package-version-join l)) nil
+ "Unsupported version syntax %S" vers)
+ l)))
+
+(defun archive--convert-require (elt)
+ (let ((vers (archive--version-to-list (car (cdr elt)))))
+ (if vers
+ (list (car elt) vers)
+ (list (car elt)))))
+
+(defun archive--dirname (dir &optional base)
+ (file-name-as-directory (expand-file-name dir base)))
+
+(defun archive--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))
+ (cond ((file-directory-p f)
+ (archive--delete-elc-files f))
+ ((or (and (string-match "\\.elc\\'" f)
+ (not (and only-orphans
+ (file-readable-p (replace-match ".el" t t f)))))
+ (backup-file-name-p f))
+ (delete-file f)))))
+
+(defun 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))
+ (condition-case v
+ (if (not (file-directory-p dir))
+ (message "Skipping non-package file %s" dir)
+ (let* ((pkg (file-name-nondirectory dir))
+ (autoloads-file (expand-file-name (concat pkg
"-autoloads.el") dir)))
+ ;; Omit autoloads and .elc files from the package.
+ (when (file-exists-p autoloads-file)
+ (delete-file autoloads-file))
+ (archive--delete-elc-files dir)
+ (let ((metadata (or (with-demoted-errors
+ ;;(format "batch-make-archive %s: %%s" dir)
+ (archive--metadata dir pkg))
+ '(nil "0"))))
+ ;; (nth 1 metadata) is nil for "org" which is the only package
+ ;; still using the "org-pkg.el file to specify the metadata.
+ (if (and (nth 1 metadata)
+ (or (equal (nth 1 metadata) "0")
+ ;; Old deprecated convention.
+ (< (string-to-number (nth 1 metadata)) 0)))
+ (progn ;; Negative version: don't publish this package yet!
+ (message "Package %s not released yet!" dir)
+ (delete-directory dir 'recursive))
+ (push (if (car metadata)
+ (apply #'archive--process-simple-package
+ dir pkg (cdr metadata))
+ (when (nth 1 metadata)
+ (archive--write-pkg-file dir pkg metadata))
+ (archive--process-multi-file-package dir pkg))
+ packages)))))
+ ((debug error) (error "Error in %s: %S" dir v))))
+ (with-temp-buffer
+ (pp (nreverse packages) (current-buffer))
+ (write-region nil nil "archive-contents"))))
+
+(defun archive-call (destination program &rest args)
+ "Like ‘call-process’ for PROGRAM, DESTINATION, ARGS.
+The INFILE and DISPLAY arguments are fixed as nil."
+ (apply #'call-process program nil destination nil args))
+
+(defconst archive--revno-re "[0-9a-f]+")
+
+(defun archive-prepare-packages (srcdir)
+ "Prepare the `packages' directory inside the Git checkout.
+Expects to be called from within the `packages' directory.
+\"Prepare\" here is for subsequent construction of the packages and archive,
+so it is meant to refresh any generated files we may need.
+Currently only refreshes the ChangeLog files."
+ (setq srcdir (archive--dirname srcdir))
+ (let* ((wit ".changelog-witness")
+ (prevno (with-temp-buffer
+ (insert-file-contents wit)
+ (if (looking-at (concat archive--revno-re "$"))
+ (match-string 0)
+ (error "Can't find previous revision name"))))
+ (new-revno
+ (or (with-temp-buffer
+ (let ((default-directory srcdir))
+ (archive-call '(t) "git" "rev-parse" "HEAD")
+ (goto-char (point-min))
+ (when (looking-at (concat archive--revno-re "$"))
+ (match-string 0))))
+ (error "Couldn't find the current revision's name")))
+ (pkgs '()))
+ (unless (equal prevno new-revno)
+ (with-temp-buffer
+ (let ((default-directory srcdir))
+ (unless (zerop (archive-call '(t) "git" "diff"
+ "--dirstat=cumulative,0"
+ prevno))
+ (error "Error signaled by git diff --dirstat %d" prevno)))
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t.0-9%]* packages/\\([-[:alnum:]]+\\)/$"
+ nil t)
+ (push (match-string 1) pkgs))))
+ (let ((default-directory (expand-file-name "packages/")))
+ (dolist (pkg pkgs)
+ (condition-case v
+ (when (file-directory-p pkg)
+ (archive--make-changelog pkg (expand-file-name "packages/"
+ srcdir)))
+ (error (message
+ "Error in archive-prepare-packages for package %S:\n %S"
+ pkg v)))))
+ (write-region new-revno nil wit nil 'quiet)
+ ;; Also update the ChangeLog of external packages.
+ (let ((default-directory (expand-file-name "packages/")))
+ (dolist (dir (directory-files "."))
+ (and (not (member dir '("." "..")))
+ (file-directory-p dir)
+ (let* ((gitdir (expand-file-name
+ (concat "packages/" dir "/.git")
+ srcdir))
+ (index (cond
+ ((file-directory-p gitdir)
+ (expand-file-name
+ (concat "packages/" dir "/.git/index")
+ srcdir))
+ ((file-readable-p gitdir)
+ (with-temp-buffer
+ (insert-file-contents gitdir)
+ (goto-char (point-min))
+ (if (looking-at "gitdir:[ \t]*")
+ (progn
+ (delete-region (match-beginning 0)
+ (match-end 0))
+ (expand-file-name "index"
(buffer-string)))
+ (message "Can't find gitdir in %S" gitdir)
+ nil)))
+ (t nil)))
+ (cl (expand-file-name "ChangeLog" dir)))
+ (and index
+ (file-exists-p index)
+ (or (not (file-exists-p cl))
+ (file-newer-than-file-p index cl))))
+ (archive--make-changelog
+ dir (expand-file-name "packages/" srcdir)))))
+ ))
+
+(defconst archive-default-url-format "http://elpa.gnu.org/packages/%s.html";)
+(defconst archive-default-url-re (format archive-default-url-format ".*"))
+
+(defun archive--metadata (dir pkg)
+ "Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS),
+where SIMPLE is non-nil if the package is simple;
+VERSION is the version string of the simple package;
+DESCRIPTION is the brief description of the package;
+REQ is a list of requirements;
+EXTRAS is an alist with additional metadata.
+
+PKG is the name of the package and DIR is the directory where it is."
+ (let* ((mainfile (expand-file-name (concat pkg ".el") dir))
+ (files (directory-files dir nil "\\`dir\\'\\|\\.el\\'")))
+ (setq files (delete (concat pkg "-pkg.el") files))
+ (setq files (delete (concat pkg "-autoloads.el") files))
+ (cond
+ ((file-exists-p mainfile)
+ (with-temp-buffer
+ (insert-file-contents mainfile)
+ (goto-char (point-min))
+ (let* ((pkg-desc (package-buffer-info))
+ (extras (package-desc-extras pkg-desc))
+ (version (package-desc-version pkg-desc))
+ (keywords (lm-keywords-list))
+ ;; (_ (archive--version-to-list version)) ; Sanity check!
+ (pt (lm-header "package-type"))
+ (simple (if pt (equal pt "simple") (= (length files) 1)))
+ (found-url (alist-get :url extras))
+ (found-keywords (alist-get :keywords extras)))
+
+ (when (and keywords (not found-keywords))
+ ;; Using an old package-buffer-info which doesn't include
+ ;; keywords. Fix it by hand.
+ (push (cons :keywords keywords) extras))
+ (unless found-url
+ ;; Provide a good default URL.
+ (push (cons :url (format archive-default-url-format pkg)) extras))
+ (list simple
+ (package-version-join version)
+ (package-desc-summary pkg-desc)
+ (package-desc-reqs pkg-desc)
+ extras))))
+ (t
+ (error "Can't find main file %s file in %s" mainfile dir)))))
+
+(defun archive--process-simple-package (dir pkg vers desc req extras)
+ "Deploy the contents of DIR into the archive as a simple package.
+Rename DIR/PKG.el to PKG-VERS.el, delete DIR, and return the descriptor."
+ ;; Write DIR/foo.el to foo-VERS.el and delete DIR
+ (let ((src (expand-file-name (concat pkg ".el") dir)))
+ (funcall (if (file-symlink-p src) #'copy-file #'rename-file)
+ src (concat pkg "-" vers ".el")))
+ ;; Add the content of the ChangeLog.
+ (let ((cl (expand-file-name "ChangeLog" dir)))
+ (with-current-buffer (find-file-noselect (concat pkg "-" vers ".el"))
+ (goto-char (point-max))
+ (re-search-backward "^;;;.*ends here")
+ (re-search-backward "^(provide")
+ (skip-chars-backward " \t\n")
+ (insert "\n\n;;;; ChangeLog:\n\n")
+ (let* ((start (point))
+ (end (copy-marker start t)))
+ (condition-case nil
+ (insert-file-contents cl)
+ (file-error (message "Can't find %S's ChangeLog file" pkg)))
+ (goto-char end)
+ (unless (bolp) (insert "\n"))
+ (while (progn (forward-line -1) (>= (point) start))
+ (insert ";; ")))
+ (set (make-local-variable 'backup-inhibited) t)
+ (basic-save-buffer) ;Less chatty than save-buffer.
+ (kill-buffer)))
+ (delete-directory dir t)
+ (cons (intern pkg) (vector (archive--version-to-list vers)
+ req desc 'single extras)))
+
+(defun archive--make-changelog (dir srcdir)
+ "Export Git log info of DIR into a ChangeLog file."
+ (message "Refreshing ChangeLog in %S" dir)
+ (let ((default-directory (archive--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 (archive--dirname dir srcdir)))
+ (archive-call (current-buffer) ; hmm, why not use ‘t’ here? --ttn
+ "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 archive--alist-to-plist-args (alist)
+ (mapcar (lambda (x)
+ (if (and (not (consp x))
+ (or (keywordp x)
+ (not (symbolp x))
+ (memq x '(nil t))))
+ x `',x))
+ (apply #'nconc
+ (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
+
+(defun archive--plist-args-to-alist (plist)
+ (let (alist)
+ (while plist
+ (let ((value (cadr plist)))
+ (when value
+ (cl-assert (keywordp (car plist)))
+ (push (cons (car plist)
+ (if (eq 'quote (car-safe value)) (cadr value) value))
+ alist)))
+ (setq plist (cddr plist)))
+ alist))
+
+(defun archive--process-multi-file-package (dir pkg)
+ "Deploy the contents of DIR into the archive as a multi-file package.
+Rename DIR/ to PKG-VERS/, and return the descriptor."
+ (let* ((exp (archive--multi-file-package-def dir pkg))
+ (vers (nth 2 exp))
+ (req-exp (nth 4 exp))
+ (req (mapcar #'archive--convert-require
+ (if (eq 'quote (car-safe req-exp)) (nth 1 req-exp)
+ (when req-exp
+ (error "REQ should be a quoted constant: %S"
+ req-exp)))))
+ (extras (archive--plist-args-to-alist (nthcdr 5 exp))))
+ (unless (equal (nth 1 exp) pkg)
+ (error (format "Package name %s doesn't match file name %s"
+ (nth 1 exp) pkg)))
+ (rename-file dir (concat pkg "-" vers))
+ (cons (intern pkg) (vector (archive--version-to-list vers)
+ req (nth 3 exp) 'tar extras))))
+
+(defun archive--form-from-file-contents (filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ ;; This is unnecessary because ‘with-temp-buffer’ generates a new
+ ;; (empty) buffer, and ‘insert-file-contents’ inserts after point.
+ ;; In other words, point is alraedy at bob.
+ ;;- (goto-char (point-min))
+ (read (current-buffer))))
+
+(defun archive--multi-file-package-def (dir pkg)
+ "Return the `define-package' form in the file DIR/PKG-pkg.el."
+ (let ((pkg-file (expand-file-name (concat pkg "-pkg.el") dir)))
+ (unless (file-exists-p pkg-file)
+ (error "File not found: %s" pkg-file))
+ (archive--form-from-file-contents pkg-file)))
+
+(defun archive-refresh-pkg-file ()
+ ;; Note: Used via --batch by GNUmakefile rule.
+ (let* ((dir (directory-file-name default-directory))
+ (pkg (file-name-nondirectory dir)))
+ (archive--write-pkg-file dir pkg (archive--metadata dir pkg))))
+
+(defun archive--write-pkg-file (pkg-dir name metadata)
+ ;; FIXME: Use package-generate-description-file!
+ (let ((pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir))
+ (print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat (format ";; Generated package description from %s.el -*-
no-byte-compile: t -*-\n"
+ name)
+ (prin1-to-string
+ (cl-destructuring-bind (version desc requires extras)
+ (cdr metadata)
+ (nconc
+ (list 'define-package
+ name
+ version
+ desc
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires)))
+ (archive--alist-to-plist-args extras))))
+ "\n")
+ nil
+ pkg-file)))
+
+;;; Make the HTML pages for online browsing.
+
+(defun archive--html-header (title &optional header)
+ (format "<!DOCTYPE HTML PUBLIC>
+<html lang=\"en\" xml:lang=\"en\">
+ <head>
+ <title>%s</title>
+ <meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">
+ <link rel=\"shortcut icon\" type=\"image/png\" href=\"../favicon.png\">
+ <link rel=\"stylesheet\"
href=\"//code.cdn.mozilla.net/fonts/fira.css\">
+ <link rel=\"stylesheet\" type=\"text/css\" href=\"../layout.css\">
+ <script src=\"../javascript/jquery.min.js\"
type=\"text/javascript\"></script>
+ <script src=\"../javascript/jquery.filtertable.min.js\"
type=\"text/javascript\"></script>
+ <script src=\"../javascript/package-search.js\"
type=\"text/javascript\"></script>
+ <meta name=\"viewport\"
content=\"initial-scale=1.0,maximum-scale=1.0,width=device-width\" />
+ </head>
+ <body>
+
+ <div class=\"wrapper\">
+
+ <div class=\"header small\">
+ <div class=\"container\">
+ <h1>%s</h1>
+ </div>
+ </div>
+
+ <div class=\"container\">\n"
+ title (or header title)))
+
+(defun archive--html-bytes-format (bytes) ;Aka memory-usage-format.
+ (setq bytes (/ bytes 1024.0))
+ (let ((units '("KiB" "MiB" "GiB" "TiB")))
+ (while (>= bytes 1024)
+ (setq bytes (/ bytes 1024.0))
+ (setq units (cdr units)))
+ (cond
+ ((>= bytes 100) (format "%4.0f %s" bytes (car units)))
+ ((>= bytes 10) (format "%4.1f %s" bytes (car units)))
+ (t (format "%4.2f %s" bytes (car units))))))
+
+(defun archive--get-prop (prop name srcdir mainsrcfile)
+ (let ((kprop (intern (format ":%s" (downcase prop)))))
+ (or
+ (let ((pkgdescfile (expand-file-name (format "%s-pkg.el" name)
+ srcdir)))
+ (when (file-readable-p pkgdescfile)
+ (let ((desc (archive--form-from-file-contents pkgdescfile)))
+ (plist-get (cdr desc) kprop))))
+ (when (file-readable-p mainsrcfile)
+ (with-temp-buffer
+ (insert-file-contents mainsrcfile)
+ (lm-header prop))))))
+
+(defun archive--get-section (hsection fsection srcdir mainsrcfile)
+ (when (consp fsection)
+ (while (cdr-safe fsection)
+ (setq fsection
+ (if (file-readable-p (expand-file-name (car fsection) srcdir))
+ (car fsection)
+ (cdr fsection))))
+ (when (consp fsection) (setq fsection (car fsection))))
+ (cond
+ ((file-readable-p (expand-file-name fsection srcdir))
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name fsection srcdir))
+ (buffer-string)))
+ ((file-readable-p mainsrcfile)
+ (with-temp-buffer
+ (insert-file-contents mainsrcfile)
+ (emacs-lisp-mode) ;lm-section-start needs the outline-mode setting.
+ (let ((start (lm-section-start hsection)))
+ (when start
+ (insert
+ (prog1
+ (buffer-substring start (lm-section-end hsection))
+ (erase-buffer)))
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (delete-region (point) (line-beginning-position 2))
+ (uncomment-region (point-min) (point-max))
+ (when (looking-at "^\\([ \t]*\n\\)+")
+ (replace-match ""))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (delete-region (point) (point-max))
+ (buffer-string)))))))
+
+(defun archive--quote (txt)
+ (replace-regexp-in-string "<" "<"
+ (replace-regexp-in-string "&" "&" txt)))
+
+(defun archive--read-externals-list (&optional dir)
+ (archive--form-from-file-contents
+ (expand-file-name "externals-list" dir)))
+
+(defun archive--insert-repolinks (name srcdir _mainsrcfile url)
+ (when url
+ (insert (format "<dt>Home page</dt> <dd><a href=%S>%s</a></dd>\n"
+ url (archive--quote url)))
+ (when (string-match archive-default-url-re url)
+ (setq url nil)))
+ (let* ((externals (archive--read-externals-list
+ (expand-file-name "../../../elpa" srcdir)))
+ (extern-desc (assoc name externals))
+ (git-sv "http://git.savannah.gnu.org/";)
+ (urls
+ (if (eq (nth 1 extern-desc) :core)
+ (let* ((files (nth 2 extern-desc))
+ (file (if (listp files)
+ (directory-file-name
+ (file-name-directory
+ (try-completion "" files)))
+ files)))
+ (mapcar (lambda (s) (concat s file))
+ `("cgit/emacs.git/tree/"
+ ,(if (listp files)
+ "gitweb/?p=emacs.git;a=tree;f="
+ "gitweb/?p=emacs.git;a=blob;f="))))
+ (mapcar (lambda (s) (concat s name))
+ (if (eq (nth 1 extern-desc) :external)
+ '("cgit/emacs/elpa.git/?h=externals/"
+
"gitweb/?p=emacs/elpa.git;a=shortlog;h=refs/heads/externals/")
+ '("cgit/emacs/elpa.git/tree/packages/"
+ "gitweb/?p=emacs/elpa.git;a=tree;f=packages/"))))))
+ (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")
+ (concat git-sv (nth 0 urls))
+ 'CGit
+ (concat git-sv (nth 1 urls))
+ 'Gitweb))))
+
+(defun archive--html-make-pkg (pkg files)
+ (let* ((name (symbol-name (car pkg)))
+ (latest (package-version-join (aref (cdr pkg) 0)))
+ (srcdir (expand-file-name name "../../build/packages"))
+ (mainsrcfile (expand-file-name (format "%s.el" name) srcdir))
+ (desc (aref (cdr pkg) 2)))
+ (with-temp-buffer
+ (insert (archive--html-header
+ (format "GNU ELPA - %s" name)
+ (format "<a href=\"index.html\">GNU ELPA</a> - %s" name)))
+ (insert (format "<h2 class=\"package\">%s</h2>" name))
+ (insert "<dl>")
+ (insert (format "<dt>Description</dt><dd>%s</dd>\n" (archive--quote
desc)))
+ (if (zerop (length latest))
+ (insert "<dd>This package "
+ (if files "is not in GNU ELPA any more"
+ "has not been released yet")
+ ".</dd>\n")
+ (let* ((file (cdr (assoc latest files)))
+ (attrs (file-attributes file)))
+ (insert (format "<dt>Latest</dt> <dd><a href=%S>%s</a>, %s,
%s</dd>\n"
+ file (archive--quote file)
+ (format-time-string "%Y-%b-%d" (nth 5 attrs))
+ (archive--html-bytes-format (nth 7 attrs))))))
+ (let ((maint (archive--get-prop "Maintainer" name srcdir mainsrcfile)))
+ (when maint
+ (insert (format "<dt>Maintainer</dt> <dd>%s</dd>\n" (archive--quote
maint)))))
+ (archive--insert-repolinks
+ name srcdir mainsrcfile
+ (or (cdr (assoc :url (aref (cdr pkg) 4)))
+ (archive--get-prop "URL" name srcdir mainsrcfile)))
+ (insert "</dl>")
+ (insert (format "<p>To install this package, run in Emacs:</p>
+ <pre>M-x <span class=\"kw\">package-install</span> RET
<span class=\"kw\">%s</span> RET</pre>"
+ name))
+ (let ((rm (archive--get-section
+ "Commentary" '("README" "README.rst"
+ ;; Most README.md files seem to be currently
+ ;; worse than the Commentary: section :-(
+ ;; "README.md"
+ "README.org")
+ srcdir mainsrcfile)))
+ (when rm
+ (write-region rm nil (concat name "-readme.txt"))
+ (insert "<h2>Full description</h2><pre>\n" (archive--quote rm)
+ "\n</pre>\n")))
+ (unless (< (length files) (if (zerop (length latest)) 1 2))
+ (insert (format "<h2>Old versions</h2><table>\n"))
+ (dolist (file
+ (sort files (lambda (f1 f2) (version< (car f2) (car f1)))))
+ (unless (equal (pop file) latest)
+ (let ((attrs (file-attributes file)))
+ (insert (format "<tr><td><a
href=%S>%s</a></td><td>%s</td><td>%s</td>\n"
+ file (archive--quote file)
+ (format-time-string "%Y-%b-%d" (nth 5 attrs))
+ (archive--html-bytes-format (nth 7 attrs)))))))
+ (insert "</table>\n"))
+ (let ((news (archive--get-section
+ "News" '("NEWS" "NEWS.rst" "NEWS.md" "NEWS.org")
+ srcdir mainsrcfile)))
+ (when news
+ (insert "<h2>News</h2><pre>\n" (archive--quote news) "\n</pre>\n")))
+ (insert "</body>\n")
+ (write-region (point-min) (point-max) (concat name ".html")))))
+
+(defun archive--html-make-index (pkgs)
+ (with-temp-buffer
+ (insert (archive--html-header "GNU ELPA Packages"))
+ (insert "<table>\n")
+ (insert "<tr><th>Package</th><th>Version</th><th>Description</th></tr>\n")
+ (dolist (pkg pkgs)
+ (insert (format "<tr><td><a
href=\"%s.html\">%s</a></td><td>%s</td><td>%s</td></tr>\n"
+ (car pkg) (car pkg)
+ (package-version-join (aref (cdr pkg) 0))
+ (aref (cdr pkg) 2))))
+ (insert " </table>
+ </div>
+ <div class=\"push\"></div>
+ </div>
+
+ <div class=\"footer\">
+ <div class=\"container\">
+ <p>Copyright 2016 <a href=\"https://fsf.org\";>Free Software
Foundation</a>, Inc.</p>
+ <p>Design provided by <a
href=\"http://nicolas.petton.fr\";>Nicolas Petton</a></p>
+ <p>
+ This website is licensed under the
+ <a
href=\"https://creativecommons.org/licenses/by-nd/3.0/us/\";>CC BY-ND 3.0</a>
+ US License.
+ </p>
+ </div>
+ </div>
+
+</body>\n")
+ (write-region (point-min) (point-max) "index.html")))
+
+(defun batch-html-make-index ()
+ (let ((packages (make-hash-table :test #'equal))
+ (archive-contents
+ ;; Skip the first element which is a version number.
+ (cdr (archive--form-from-file-contents "archive-contents"))))
+ (dolist (subdir (directory-files "../../build/packages" nil))
+ (cond
+ ((member subdir '("." ".." "elpa.rss" "index.html" "archive-contents")))
+ (t (puthash subdir nil packages))))
+ (dolist (file (directory-files default-directory nil))
+ (cond
+ ((member file '("." ".." "elpa.rss" "index.html" "archive-contents")))
+ ((string-match "\\.html\\'" file))
+ ((string-match "\\.sig\\'" file))
+ ((string-match "-readme\\.txt\\'" file)
+ (let ((name (substring file 0 (match-beginning 0))))
+ (puthash name (gethash name packages) packages)))
+ ((string-match "-\\([0-9][^-]*\\)\\.\\(tar\\|el\\)\\'" file)
+ (let ((name (substring file 0 (match-beginning 0)))
+ (version (match-string 1 file)))
+ (push (cons version file) (gethash name packages))))
+ (t (message "Unknown file %S" file))))
+ (maphash (lambda (pkg-name files)
+ (archive--html-make-pkg
+ (let ((pkg (intern pkg-name)))
+ (or (assq pkg archive-contents)
+ ;; Add entries for packages that are either not yet
+ ;; released or not released any more.
+ ;; FIXME: Get actual description!
+ (let ((entry (cons pkg (vector nil nil "" nil nil))))
+ (setq archive-contents
+ ;; Add entry at the end.
+ (nconc archive-contents (list entry)))
+ entry)))
+ files))
+ packages)
+ (archive--html-make-index archive-contents)))
+
+(defun archive--pull (dirname)
+ (let ((default-directory (archive--dirname dirname)))
+ (with-temp-buffer
+ (cond
+ ((file-directory-p ".git")
+ (message "Running git pull in %S" default-directory)
+ (archive-call t "git" "pull"))
+ ((file-exists-p ".git")
+ (unless (with-temp-buffer
+ (archive-call t "git" "status" "--branch" "--porcelain=2")
+ (goto-char (point-min))
+ ;; Nothing to pull (nor push, actually).
+ (search-forward "\n# branch.ab +0 -0" nil t))
+ (message "Updating worktree in %S" default-directory)
+ (archive-call t "git" "merge")))
+ (t (error "No .git in %S" default-directory)))
+ (unless (and (eobp) (bobp))
+ (message "Updated %s:%s%s" dirname
+ (if (and (eobp) (bolp)
+ (eq (line-beginning-position 0) (point-min)))
+ " " "\n")
+ (buffer-string))))))
+
+;;; Maintain external packages.
+
+(defconst archive--elpa-git-url "git://git.sv.gnu.org/emacs/elpa")
+(defconst archive--emacs-git-url "git://git.sv.gnu.org/emacs.git")
+
+(defun archive--sync-emacs-repo ()
+ "Sync Emacs repository, if applicable.
+Return non-nil if there's an \"emacs\" repository present."
+ ;; Support for :core packages is important for elpa.gnu.org, but for other
+ ;; cases such as "in-place installation", it's rather secondary since
+ ;; those users can just as well use a development version of Emacs to get
+ ;; those packages.
+ ;; So make the handling of :core packages depend on whether or not the user
+ ;; has setup a clone of Emacs under the "emacs" subdirectory.
+ (let ((emacs-repo-root (expand-file-name "emacs")))
+ (if (not (file-directory-p emacs-repo-root))
+ (progn (message "No \"emacs\" subdir: will skip :core packages")
+ nil)
+ (archive--pull emacs-repo-root)
+ t)))
+
+(defun archive--find-non-trivial-file (dir)
+ (catch 'found-important-file
+ (dolist (file (directory-files-recursively dir ".*"))
+ (unless (or (member file '("." ".."))
+ (string-match "\\.elc\\'" file)
+ (string-match "-autoloads.el\\'" file)
+ (string-match "-pkg.el\\'" file)
+ (file-symlink-p file))
+ (throw 'found-important-file file)))
+ nil))
+
+(defun archive--cleanup-packages (externals-list with-core)
+ "Remove unknown subdirectories of `packages/'.
+This is any subdirectory inside `packages/' that's not under
+version control nor listed in EXTERNALS-LIST.
+If WITH-CORE is non-nil, it means we manage :core packages as well."
+ (let ((default-directory (expand-file-name "packages/")))
+ (dolist (dir (directory-files "."))
+ (cond
+ ((file-symlink-p dir)
+ ;; There are normally no such thing, but the user may elect to
+ ;; add symlinks to other projects. If so, update them, as if they
+ ;; were "externals".
+ (when (file-directory-p (expand-file-name ".git" dir))
+ (archive--pull dir)))
+ ((or (not (file-directory-p dir)) )
+ ;; We only add/remove plain directories in elpa/packages (not
+ ;; symlinks).
+ nil)
+ ((member dir '("." "..")) nil)
+ ((assoc dir externals-list) nil)
+ ((file-directory-p (expand-file-name (format "%s/.git" dir)))
+ (let ((status
+ (with-temp-buffer
+ (let ((default-directory (archive--dirname dir)))
+ (archive-call t "git" "status" "--porcelain")
+ (buffer-string)))))
+ (if (zerop (length status))
+ (progn (delete-directory dir 'recursive t)
+ (message "Deleted all of %s" dir))
+ (message "Keeping leftover unclean %s:\n%s" dir status))))
+ ;; Check if `dir' is under version control.
+ ((and with-core
+ (not (zerop (archive-call nil "git" "ls-files"
+ "--error-unmatch" dir))))
+ ;; Not under version control. Check if it only contains
+ ;; symlinks and generated files, in which case it is probably
+ ;; a leftover :core package that can safely be deleted.
+ ;; (let ((file (archive--find-non-trivial-file dir)))
+ ;; (if file
+ ;; (message "Keeping %s for non-trivial file \"%s\"" dir file)
+ ;; (progn
+ ;; (message "Deleted untracked package %s" dir)
+ ;; (delete-directory dir 'recursive t))))
+ )))))
+
+(defvar archive--use-worktree nil)
+(defun archive--use-worktree-p ()
+ (unless archive--use-worktree
+ (setq archive--use-worktree
+ (list
+ (ignore-errors
+ (zerop (call-process "git" nil nil nil "worktree" "list"))))))
+ (car archive--use-worktree))
+
+(defun archive--external-package-sync (name)
+ "Sync external package named NAME."
+ (let ((default-directory (expand-file-name "packages/")))
+ (cond ((not (file-exists-p name))
+ (let* ((branch (concat "externals/" name))
+ (output
+ (with-temp-buffer
+ (if (archive--use-worktree-p)
+ (archive-call t "git" "worktree" "add"
+ "-B" branch
+ name (concat "origin/" branch))
+ (archive-call t "git" "clone"
+ "--reference" ".." "--single-branch"
+ "--branch" branch
+ archive--elpa-git-url name))
+ (buffer-string))))
+ (message "Cloning branch %s:\n%s" name output)))
+ ((not (file-exists-p (concat name "/.git")))
+ (message "%s is in the way of an external, please remove!" name))
+ (t (archive--pull name)))))
+
+(defun archive--core-package-empty-dest-p (dest)
+ "Return non-nil if DEST is an empty variant."
+ (member dest (list "" "." nil)))
+
+(defun archive--core-package-link-file
+ (source dest emacs-repo-root package-root exclude-regexp)
+ "Link file from SOURCE to DEST ensuring subdirectories."
+ (unless (string-match-p exclude-regexp source)
+ (let* ((absolute-package-file-name
+ (if (equal "" dest)
+ ;; Calling expand-file-name would remove the trailing / !
+ package-root
+ (expand-file-name dest package-root)))
+ (absolute-core-file-name
+ (expand-file-name source emacs-repo-root))
+ (directory (file-name-directory absolute-package-file-name)))
+ (when (fboundp 'file-name-quote) ;Not yet available on elpa.gnu.org
+ (setq directory (file-name-quote directory)))
+ (unless (file-directory-p directory)
+ (make-directory directory t))
+ (condition-case err
+ (make-symbolic-link absolute-core-file-name
+ absolute-package-file-name t)
+ (file-error
+ (message "Error: can't symlink to %S from %S:\n %S"
+ absolute-core-file-name absolute-package-file-name err)
+ (copy-file absolute-core-file-name
+ (if (file-directory-p absolute-package-file-name)
+ (file-name-as-directory absolute-package-file-name)
+ absolute-package-file-name)))))
+ (message " %s -> %s" source (if (archive--core-package-empty-dest-p dest)
+ (file-name-nondirectory source)
+ dest))))
+
+(defun archive--core-package-link-directory
+ (source dest emacs-repo-root package-root exclude-regexp)
+ "Link directory files from SOURCE to DEST ensuring subdirectories."
+ (let ((stack (list source))
+ (base source)
+ (absolute-source))
+ (while stack
+ (setq source (pop stack)
+ absolute-source (expand-file-name source emacs-repo-root))
+ (if (file-directory-p absolute-source)
+ (dolist (file (directory-files absolute-source))
+ (unless (member file (list "." ".."))
+ (push (concat (file-name-as-directory source) file) stack)))
+ (let* ((base (file-name-as-directory base))
+ (source-sans-base (substring source (length base)))
+ (package-file-name
+ (if (archive--core-package-empty-dest-p dest)
+ ;; Link to root with its original filename.
+ source-sans-base
+ (concat
+ ;; Prepend the destination, allowing for directory rename.
+ (file-name-as-directory dest) source-sans-base))))
+ (archive--core-package-link-file
+ source package-file-name
+ emacs-repo-root package-root exclude-regexp))))))
+
+(defun archive--core-package-sync (definition)
+ "Sync core package from DEFINITION."
+ (pcase-let*
+ ((`(,name . (:core ,file-patterns :excludes ,excludes)) definition)
+ (emacs-repo-root (expand-file-name "emacs"))
+ (package-root (file-name-as-directory
+ (expand-file-name name "packages")))
+ (default-directory package-root)
+ (exclude-regexp
+ (mapconcat #'identity
+ (mapcar #'wildcard-to-regexp
+ (append '("*.elc" "*~") excludes nil))
+ "\\|"))
+ (file-patterns
+ (mapcar
+ (lambda (file-pattern)
+ (pcase file-pattern
+ ((pred (stringp)) (cons file-pattern ""))
+ (`(,file ,dest . ,_) (cons file dest))
+ (_ (error "Unrecognized file format for package %s: %S"
+ name file-pattern))))
+ (if (stringp file-patterns)
+ ;; Files may be just a string, normalize.
+ (list file-patterns)
+ file-patterns))))
+ (message "Linking files for package: %s" name)
+ (when (file-directory-p package-root)
+ (delete-directory package-root t))
+ (make-directory package-root t)
+ (dolist (file-pattern file-patterns)
+ (pcase-let* ((`(,file . ,dest) file-pattern))
+ (if (file-directory-p (expand-file-name file emacs-repo-root))
+ (archive--core-package-link-directory
+ file dest emacs-repo-root package-root exclude-regexp)
+ (archive--core-package-link-file
+ file dest emacs-repo-root package-root exclude-regexp))))))
+
+(defun archive-add/remove/update-externals ()
+ "Remove non-package directories and fetch external packages."
+ (let ((externals-list (archive--read-externals-list)))
+ (let ((with-core (archive--sync-emacs-repo)))
+ (archive--cleanup-packages externals-list with-core)
+ (pcase-dolist ((and definition `(,name ,kind ,_url)) externals-list)
+ (pcase kind
+ (`:subtree nil) ;Nothing to do.
+ (`:external (archive--external-package-sync name))
+ (`:core (when with-core (archive--core-package-sync definition)))
+ (_ (message "Unknown external package kind `%S' for %s"
+ kind name)))))))
+
+;;; Manage .gitignore
+
+(defun archive-gitignore-externals (elf gf)
+ (let ((pkgs (cl-loop
+ for (name kind . _) in (archive--read-externals-list
+ (file-name-directory elf))
+ when (memq kind '(:external :core))
+ collect name)))
+ (with-current-buffer (find-file-noselect gf)
+ (goto-char (point-min))
+ (when (re-search-forward
+ "#.*External.*git.*\n\\(packages/[^*/\n]+/?\n\\)+"
+ nil 'move)
+ (replace-match ""))
+ (insert "# External packages with their own .git tree [autogenerated].\n"
+ (mapconcat (lambda (p) (format "packages/%s/\n" p))
+ (sort pkgs #'string<)
+ ""))
+ (save-buffer))))
+
+(provide 'archive-contents)
+;;; archive-contents.el ends here
diff --git a/admin/ert-support.el b/admin/ert-support.el
new file mode 100644
index 0000000..a0ff9ab
--- /dev/null
+++ b/admin/ert-support.el
@@ -0,0 +1,55 @@
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2016-2017, Free Software Foundation, Inc.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(defun ert-support-package-install (top-directory package)
+ ;; blitz default value and set up from elpa.
+ (setq package-archives
+ `(("local-elpa"
+ . ,(expand-file-name "archive/packages" top-directory)))
+ package-user-dir (make-temp-file "elpa-test" t))
+ (package-initialize)
+ (package-refresh-contents)
+ (package-install package))
+
+(defun ert-support-test-find-tests (package-directory package)
+ (append
+ `(,(expand-file-name
+ (concat (symbol-name package) "-autoloads.el") package-directory))
+ (or
+ (directory-files package-directory t ".*-test.el$")
+ (directory-files package-directory t ".*-tests.el$")
+ (let ((dir-test (expand-file-name "test" package-directory)))
+ (when (file-directory-p dir-test)
+ (directory-files dir-test t directory-files-no-dot-files-regexp)))
+ (let ((dir-tests (expand-file-name "tests" package-directory)))
+ (when (file-directory-p dir-tests)
+ (directory-files dir-tests t directory-files-no-dot-files-regexp))))))
+
+(defun ert-support-load-tests (package-directory package)
+ (mapc
+ (lambda (file)
+ (let ((force-load-messages t))
+ (load-file file)))
+ (ert-support-test-find-tests package-directory package)))
+
+(defun ert-support-test-package (top-directory package)
+ (ert-support-package-install top-directory package)
+ (ert-support-load-tests
+ (expand-file-name (concat "packages/" (symbol-name package)) top-directory)
+ package)
+
+ (ert-run-tests-batch-and-exit t))
diff --git a/admin/forward-diffs.py b/admin/forward-diffs.py
new file mode 100755
index 0000000..c0c330d
--- /dev/null
+++ b/admin/forward-diffs.py
@@ -0,0 +1,438 @@
+#!/usr/bin/python
+### forward-diffs.py --- forward emacs-diffs mails to maintainers
+
+## Copyright (C) 2012-2014 Free Software Foundation, Inc.
+
+## Author: Glenn Morris <rgm@gnu.org>
+## Maintainer: emacs-devel@gnu.org
+
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+
+## You should have received a copy of the GNU General Public License
+## along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+### Commentary:
+
+## Forward emails from an emacs-diffs style mailing list to the
+## maintainer(s) of the modified files.
+
+## Two modes of operation:
+
+## 1) Create the maintfile (really this is just an optimization):
+## forward-diffs.py --create -p packagesdir -m maintfile
+
+## You can start with an empty maintfile and normal operation in 2)
+## will append information as needed.
+
+## 2) Call from eg procmail to forward diffs. Example usage:
+
+## :0c
+## * ^TO_emacs-elpa-diffs@gnu\.org
+## | forward-diffs.py -p packagedir -m maintfile -l logfile \
+## -o overmaint -s sender
+
+## where
+
+## packagedir = /path/to/packages
+## sender = your email address
+## logfile = file to write log to (you might want to rotate/compress/examine
it)
+## maintfile = file listing files and their maintainers, with format:
+##
+## package1/file1 email1
+## package2/file2 email2,email3
+## package3 email4
+##
+## Use "nomail" for the email field to not send a mail.
+## An entry that is a directory applies to all files in that directory
+## that do not have specific maintainers.
+##
+## overmaint = like maintfile, but takes precedence over it.
+
+### Code:
+
+import optparse
+import sys
+import re
+import email
+import smtplib
+import datetime
+import os
+
+
+## Scan FILE for Author or Maintainer (preferred) headers.
+## Return a list of all email addresses found in MAINTS.
+def scan_file(file, maints):
+
+ try:
+ fd = open( file, 'r')
+ except Exception as err:
+ lfile.write('Error opening file %s: %s\n' % (file, str(err)))
+ return 1
+
+ ## Max number of lines to scan looking for a maintainer.
+ ## (20 seems to be the highest at present).
+ max_lines = 50
+ nline = 0
+ cont = 0
+ type = ""
+
+ for line in fd:
+
+ nline += 1
+
+ if ( nline > max_lines ): break
+
+ ## Try and de-obfuscate. Worth it?
+ line = re.sub( '(?i) AT ', '@', line )
+ line = re.sub( '(?i) DOT ', '.', line )
+
+ if cont: # continued header?
+ reg = re.match( ('%s[ \t]+[^:]*?<?([\w.-]+@[\w.-]+)>?' % prefix),
line, re.I )
+ if not reg: # not a continued header
+ cont = 0
+ prefix = ""
+ if ( type == "maint" ): break
+ type = ""
+
+ ## Check for one header immediately after another.
+ if not cont:
+ reg = re.match( '([^ ]+)? *(Author|Maintainer)s?:
.*?<?([\w.-]+@[\w.-]+)>?', line, re.I )
+
+
+ if not reg: continue
+
+ if cont:
+ email = reg.group(1)
+ maints.append(email)
+ else:
+ cont = 1
+ prefix = reg.group(1) or ""
+ type = reg.group(2)
+ email = reg.group(3)
+ type = "maint" if re.search( 'Maintainer', type, re.I ) else "auth"
+ ## maints = [] does the wrong thing.
+ if type == "maint": del maints[:]
+ maints.append(email)
+
+ fd.close()
+
+
+## Scan all the files under dir for maintainer information.
+## Write to stdout, or optional argument outfile (which is overwritten).
+def scan_dir(dir, outfile=None):
+
+ dir = re.sub( '/+$', '', dir) + '/' # ensure trailing /
+
+ if not os.path.isdir(dir):
+ sys.stderr.write('No such directory: %s\n' % dir)
+ sys.exit(1)
+
+ fd = 0
+ if outfile:
+ try:
+ fd = open( outfile, 'w' )
+ except Exception as err:
+ sys.stderr.write("Error opening `%s': %s\n" % (outfile, str(err)))
+ sys.exit(1)
+
+
+ for dirpath, dirnames, filenames in os.walk(dir):
+ for file in filenames:
+ path = os.path.join(dirpath, file)
+ maints = []
+ scan_file(path, maints)
+ ## This would skip printing empty maints.
+ ## That would mean we would scan the file each time for no reason.
+ ## But empty maintainers are an error at present.
+ if not maints: continue
+ path = re.sub( '^%s' % dir, '', path )
+ string = "%-50s %s\n" % (path, ",".join(maints))
+ if fd:
+ fd.write(string)
+ else:
+ print string,
+
+ if fd: fd.close()
+
+
+usage="""usage: %prog <-p /path/to/packages> <-m maintfile>
+ <-l logfile -s sender|--create> [-o overmaintfile] [--prefix prefix]
+ [--sendmail] [--debug]
+Take an emacs-diffs mail on stdin, and forward it to the maintainer(s)."""
+
+parser = optparse.OptionParser()
+parser.set_usage ( usage )
+parser.add_option( "-m", dest="maintfile", default=None,
+ help="file listing packages and maintainers")
+parser.add_option( "-l", dest="logfile", default=None,
+ help="file to append output to")
+parser.add_option( "-o", dest="overmaintfile", default=None,
+ help="override file listing packages and maintainers")
+parser.add_option( "-p", dest="packagedir", default=None,
+ help="path to packages directory")
+parser.add_option( "-s", dest="sender", default=None,
+ help="sender address for forwards")
+parser.add_option( "--create", dest="create", default=False,
+ action="store_true", help="create maintfile")
+parser.add_option( "--no-scan", dest="noscan", default=True,
+ action="store_true",
+ help="don't scan for maintainers; implies --no-update")
+parser.add_option( "--no-update", dest="noupdate", default=False,
+ action="store_true",
+ help="do not update the maintfile")
+parser.add_option( "--prefix", dest="prefix", default="packages/",
+ help="prefix to remove from modified file name [default:
%default]")
+parser.add_option( "--sendmail", dest="sendmail", default=False,
+ action="store_true", help="use sendmail rather than smtp")
+parser.add_option( "--debug", dest="debug", default=False,
+ action="store_true", help="debug only, do not send mail")
+
+
+( opts, args ) = parser.parse_args()
+
+
+if not opts.maintfile:
+ parser.error('No maintfile specified')
+
+if not opts.packagedir:
+ parser.error('No packagedir specified')
+
+if not os.path.isdir(opts.packagedir):
+ sys.stderr.write('No such directory: %s\n' % opts.packagedir)
+ sys.exit(1)
+
+
+if not opts.create:
+ if not opts.logfile:
+ parser.error('No logfile specified')
+
+ if not opts.sender:
+ parser.error('No sender specified')
+
+
+try:
+ lfile = open( opts.logfile, 'a' )
+except Exception as err:
+ sys.stderr.write('Error opening logfile: %s\n' % str(err))
+ sys.exit(1)
+
+
+try:
+ mfile = open( opts.maintfile, 'r' )
+except Exception as err:
+ lfile.write('Error opening maintfile: %s\n' % str(err))
+ sys.exit(1)
+
+## Create the maintfile.
+if opts.create:
+ scan_dir( opts.packagedir, opts.maintfile )
+ sys.exit()
+
+
+## Each element is package/file: maint1, maint2, ...
+maints = {}
+
+for line in mfile:
+ if re.match( '#| *$', line ): continue
+ ## FIXME error here if empty maintainer.
+ (pfile, maint) = line.split()
+ maints[pfile] = maint.split(',')
+
+mfile.close()
+
+
+if opts.overmaintfile:
+ try:
+ ofile = open( opts.overmaintfile, 'r' )
+ except Exception as err:
+ lfile.write('Error opening overmaintfile: %s\n' % str(err))
+ sys.exit(1)
+
+ for line in ofile:
+ if re.match( '#| *$', line ): continue
+ (pfile, maint) = line.split()
+ maints[pfile] = maint.split(',')
+
+ ofile.close()
+
+
+stdin = sys.stdin
+
+text = stdin.read()
+
+
+resent_via = 'GNU Emacs diff forwarder'
+
+message = email.message_from_string( text )
+
+(msg_name, msg_from) = email.utils.parseaddr( message['from'] )
+
+lfile.write('\nDate: %s\n' % str(datetime.datetime.now()))
+lfile.write('Message-ID: %s\n' % message['message-id'])
+lfile.write('From: %s\n' % msg_from)
+
+if resent_via == message['x-resent-via']:
+ lfile.write('Mail loop; aborting\n')
+ sys.exit(1)
+
+
+start = False
+pfiles_seen = []
+maints_seen = []
+
+for line in text.splitlines():
+
+ # Look for and process things that look like (Git):
+ #
+ # Summary of changes:
+ # packages/vlf/vlf.el | 2 +-
+ # 1 files changed, 1 insertions(+), 1 deletions(-)
+ #
+ # or things that look like (Git):
+ #
+ # ---
+ # packages/vlf/vlf.el | 2 +-
+ # 1 files changed, 1 insertions(+), 1 deletions(-)
+
+ #BZR: if re.match( 'modified:$', line ):
+ if re.match( '---|Summary of changes:$', line ):
+ start = True
+ continue
+
+ if not start: continue
+
+ ## An empty line or a line with non-empty first character.
+ if re.match( '( *$|[^ ])', line ): break
+ # Any line that doesn't match the diffstat format (Git).
+ if not re.match( ' [^ ]+ +\| ', line ):
+ lfile.write('Stop scanning at: %s\n' % line)
+ break
+
+ if opts.prefix:
+ #BZR: reg = re.match( '%s([^ ]+)' % opts.prefix, line.strip() )
+ reg = re.match( ' %s([^ ]+)' % opts.prefix, line )
+ if not reg:
+ lfile.write('Skip: %s\n' % line)
+ continue
+ pfile = reg.group(1)
+ else:
+ pfile = line.strip()
+
+
+ lfile.write('File: %s\n' % pfile)
+
+ ## Should not be possible for files (rather than packages)...
+ if pfile in pfiles_seen:
+ lfile.write('Already seen this file\n')
+ continue
+
+ pfiles_seen.append(pfile)
+
+
+ if not pfile in maints:
+
+ lfile.write('Unknown maintainer\n')
+
+ if not opts.noscan:
+
+ lfile.write('Scanning file...\n')
+ thismaint = []
+ thisfile = os.path.join( opts.packagedir, pfile )
+ # scan_file( thisfile, thismaint )
+
+ if thismaint:
+ maints[pfile] = thismaint
+
+ ## Append maintainer to file.
+ if not opts.noupdate:
+ try:
+ mfile = open( opts.maintfile, 'a' )
+ string = "%-50s %s\n" % (pfile, ",".join(thismaint))
+ mfile.write(string)
+ mfile.close()
+ lfile.write('Appended to maintfile\n')
+ except Exception as err:
+ lfile.write('Error appending to maintfile: %s\n' %
+ str(err))
+
+ ## Didn't scan, or scanning did not work.
+ ## Look for a directory maintainer.
+ if not pfile in maints:
+ lfile.write('No file maintainer, trying directories...\n')
+ while True:
+ (pfile, tail) = os.path.split(pfile)
+ if not pfile: break
+ if pfile in maints: break
+
+
+ if not pfile in maints:
+ lfile.write('No maintainer, skipping\n')
+ continue
+
+
+ for maint in maints[pfile]:
+
+ lfile.write('Maint: %s\n' % maint)
+
+
+ if maint in maints_seen:
+ lfile.write('Already seen this maintainer\n')
+ continue
+
+ maints_seen.append(maint)
+
+
+ if maint == "nomail":
+ lfile.write('Not resending, no mail is requested\n')
+ continue
+
+
+ if maint == msg_from:
+ lfile.write('Not resending, since maintainer = committer\n')
+ continue
+
+
+ forward = message
+ forward.add_header('X-Resent-Via', resent_via)
+ forward.add_header('Resent-To', maint)
+ forward.add_header('Resent-From', opts.sender)
+
+ lfile.write('Resending via %s...\n' % ('sendmail'
+ if opts.sendmail else 'smtp') )
+
+
+ if opts.debug: continue
+
+
+ if opts.sendmail:
+ s = os.popen("/usr/sbin/sendmail -i -f %s %s" %
+ (opts.sender, maint), "w")
+ s.write(forward.as_string())
+ status = s.close()
+ if status:
+ lfile.write('Sendmail exit status: %s\n' % status)
+
+ else:
+
+ try:
+ s = smtplib.SMTP('localhost')
+ except Exception as err:
+ lfile.write('Error opening smtp: %s\n' % str(err))
+ sys.exit(1)
+
+ try:
+ s.sendmail(opts.sender, maint, forward.as_string())
+ except Exception as err:
+ lfile.write('Error sending smtp: %s\n' % str(err))
+
+ s.quit()
+
+### forward-diffs.py ends here
diff --git a/admin/hv.sh b/admin/hv.sh
new file mode 100644
index 0000000..9a45c92
--- /dev/null
+++ b/admin/hv.sh
@@ -0,0 +1,47 @@
+# hv.sh
+#
+# Author: Thien-Thi Nguyen <ttn@gnu.org>
+# License: Public Domain
+##
+# Usage: version=VERSION ; . hv.sh
+#
+# This file is not executable. Instead, it is meant
+# to be sourced (i.e., "." in sh, or "source" in bash).
+#
+# It sets shell variable ‘me’ to the basename(1) of $0,
+# then checks $1 for either ‘--help’ or ‘--version’.
+#
+# If ‘--help’, it scans $0 for the flush-left comment block w/ form:
+# ##
+# # HELP-TEXT
+# # ...
+# ##
+# formats it to stdout, and exits successfully (status 0). More precisely,
+# the first and last comment lines are ‘##’ (double-hash) and are omitted,
+# as are the ‘#’ (hash) at the beginning of each line. HELP-TEXT can be
+# multiline, including blank lines. It's customary to start HELP-TEXT w/
+# "Usage:" or "Synopsis:", like a manpage, but that is not required.
+#
+# If $1 is ‘--version’, this file displays to stdout
+# PROGNAME VERSION
+# and exits successfully (status 0). PROGNAME and VERSION are the values
+# of the ‘me’ and ‘version’ shell variables, respectively. This is why
+# ‘version’ must be set prior to sourcing the file. If ‘version’ is not
+# set or is the empty string, display "VERSION UNKNOWN" for VERSION.
+#
+# Any other value of $1 is silently ignored.
+##
+
+me=`basename "$0"`
+
+if [ x"$1" = x--help ] ; then
+ sed '/^##/,/^##/!d;/^##/d;s/^# //g;s/^#$//g' "$0"
+ exit 0
+fi
+
+if [ x"$1" = x--version ] ; then
+ echo "$me" "${version:-VERSION UNKNOWN}"
+ exit 0
+fi
+
+# hv.sh ends here
diff --git a/admin/update-archive.sh b/admin/update-archive.sh
new file mode 100755
index 0000000..6560748
--- /dev/null
+++ b/admin/update-archive.sh
@@ -0,0 +1,235 @@
+#!/bin/sh
+
+# TODO: Author
+
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+##
+# Usage: update-archive.sh [options]
+#
+# Update the archive. This involves several steps,
+# some performed in the "buildir" (cwd at invocation),
+# which should be a sibling of the elpa/ dir.
+#
+# Options:
+# --announce EMAIL -- also send announcement to EMAIL address
+# --batch -- write std{out,err} to make.log (in buildir)
+#
+# Preconditions:
+# - Installed software: /usr/sbin/sendmail, git, rsync, make, emacs.
+# - Internet connection (for ‘git pull’, sending mail).
+# - There should be a sibling directory of elpa/: staging/.
+#
+# Gory operation details follow (for maintainers).
+#
+# * Flow (see Cahoots for ‘[N]’)
+#
+# First, in sibling dir ../elpa, fetch changes (via ‘git pull’),
+# set up and update external packages[1], and check copyrights[2].
+# Signal error if any sub-step fails.
+#
+# Back in $buildir, snapshot ../elpa/packages/* as packages/*,
+# excluding some files such as ChangeLog, .git/, *.elc, and so on;
+# refresh the ChangeLog files[3]; wipe and recreate dir archive/[4].
+# Some of these sub-steps signal error on failure.
+#
+# In $buildir/archive/, make emacs-packages-latest.tgz from subdir
+# $buildir/archive/packages/ (unpacking creates ./package/*).
+#
+# In parent dir of $buildir, ensure existence of directories
+# staging/packages/ and staging-old/ -- that is, $buildir has
+# two sibling dirs staging/ and staging-old/ -- and then snapshot
+# staging/* to staging-old/* [which all kind of implies that
+# staging/ is persistent (is not a temporary dir), right? --ttn].
+# To populate staging/packages/ (here, called ‘dst’), iterate over
+# $buildir/archive/packages/* (here, called ‘src’) and do one of:
+# (a) for */archive-contents, *-readme.txt, mv directly
+# (b) if $dst/PV already exists, delete $src/PV
+# (c) mv $src/PV $dst/PV and announce it (if ‘--announce’)
+# Afterwards, mv $buildir/archive/emacs-packages-latest.tgz to staging/
+# and delete $buildir/archive/ (and all its subdirs).
+#
+# Lastly, in ../staging/packages/, make the HTML and readme.txt files[5].
+#
+# * Cahoots
+#
+# These programs are in cahoots w/ update-archive.sh -- here,
+# "lisp" means Emacs Lisp function found in archive-contents.el,
+# and "make" means makefile target found in ../GNUmakefile.
+# [1] lisp ‘archive-add/remove/update-externals’
+# [2] make ‘check_copyrights’
+# [3] lisp ‘archive-prepare-packages’
+# [4] make ‘archive-full’
+# [5] lisp ‘batch-html-make-index’
+#
+# * Miscellaneous
+#
+# "Signal error" means report an error and exit w/ status 1.
+# If invoked w/ ‘--batch’, reporting means mailing the log file
+# to emacs-elpa-diffs (a gnu dot org mailing list) using the
+# error message as title. Otherwise, reporting means displaying
+# the error message to stdout.
+#
+# Mail sender (From) is "ELPA update" w/ bogus address.
+#
+# "Snapshot" means use ‘rsync -av’ (plus other options).
+##
+# [NB: I inferred these from VCS logs. Corrections welcome! --ttn]
+# 0.x -- release from the previous VCS
+# 1.0 -- initial release from this VCS (Git)
+# 1.1 -- add ‘--announce EMAIL’ support
+# 1.2 -- fix externals maintenance
+# 1.3 -- fix ‘--announce EMAIL’ support
+# 1.4 -- use sendmail(8) and rsync(1)
+# 1.5 -- make staging operations less brittle
+# 1.6 -- support ‘--help’, ‘--version’
+# 1.7 -- fix DANGEROUS bug; make less noisy; name bash explicitly
+# 1.8 -- revert "name bash explicitly"
+version='1.8'
+# If $0 is a symlink, `dirname $0`/hv.sh might not be available,
+# and even if it IS available, how can we be sure it's bonafide?
+test -L "$0" || { hv=`dirname "$0"`/hv.sh ; test -r "$hv" && . "$hv" ; }
+
+# TODO: (here) Validate args.
+
+set -x
+
+makelog=""
+buildir="$(pwd)"
+
+announce=no
+a_email="" #info-gnu-emacs@gnu.org
+
+export LANG=C
+while [ $# -gt 0 ]; do
+ case "$1" in
+ "--announce") announce=yes; a_email="$2"; shift ;;
+ "--batch")
+ makelog="$(pwd)/make.log"
+ exec >"$makelog" 2>&1
+ ;;
+ esac
+ shift
+done
+
+send_mail () {
+ to="$1"; shift
+ title="$*"
+ (cat <<ENDDOC
+From: ELPA update <do.not.reply@elpa.gnu.org>
+To: $to
+Subject: $title
+
+ENDDOC
+ cat -) | /usr/sbin/sendmail "$to"
+}
+
+# Send an email to warn about a problem.
+signal_error () {
+ title="$*"
+ if [ "" = "$makelog" ]; then
+ echo "Error: $title"
+ else
+ send_mail "emacs-elpa-diffs@gnu.org" "$title" <"$makelog"
+ fi
+ exit 1
+}
+
+announce_new () {
+ if [ "yes" != "$announce" ]; then return; fi
+ pv="$1"
+ pkg="$(echo "$pv" | sed -e 's/^\(.*\)-\([^-]*\)\.[^-.]*$/\1/')"
+ ver="$(echo "$pv" | sed -e 's/^\(.*\)-\([^-]*\)\.[^-.]*$/\2/')"
+ if [ -z "$pkg" ] || [ -z "$ver" ]; then signal_error "bad PKG-VER: $pv"; fi
+ send_mail "$a_email" "[GNU ELPA] $pkg version $ver" <<ENDDOC
+Version $ver of GNU ELPA package $pkg has just been released.
+You can now find it in M-x package-list RET.
+
+More at http://elpa.gnu.org/packages/$pkg.html
+ENDDOC
+}
+
+cd ../elpa || exit
+
+# Fetch changes.
+git pull || signal_error "git pull failed"
+
+# Remember we're inside the "elpa" branch which we don't want to trust,
+# So always refer to the makefile and admins files from $builddir".
+
+# Setup and update externals.
+emacs --batch -l "$buildir/admin/archive-contents.el" \
+ -f archive-add/remove/update-externals
+
+make -f "$buildir/GNUmakefile" check_copyrights ||
+ signal_error "check_copyright failed"
+
+cd "$buildir" || exit
+
+rsync -av --delete \
+ --exclude=ChangeLog \
+ --exclude=.git \
+ --exclude='*.elc' \
+ --exclude='*~' \
+ --exclude='/*/*/*-autoloads.el' \
+ ../elpa/packages ./
+
+# Refresh the ChangeLog files. This needs to be done in
+# the source tree, because it needs the VCS data!
+emacs -batch -l admin/archive-contents.el \
+ -eval '(archive-prepare-packages "../elpa")'
+
+
+rm -rf archive # In case there's one left over!
+make archive-full || {
+ signal_error "make archive-full failed"
+}
+latest="emacs-packages-latest.tgz"
+(cd archive || exit
+ GZIP=--best tar zcf "$latest" packages)
+(cd ../
+ mkdir -p staging/packages
+ # Not sure why we have `staging-old', but let's keep it for now.
+ mkdir -p staging-old
+ rsync -av --inplace --delete staging/. staging-old/.
+ # Move new files into place but don't throw out old package versions.
+ for f in "$buildir"/archive/packages/*; do
+ # PKG-VER
+ pv=$(basename "$f")
+ dst="staging/packages/$pv"
+ # Actually, let's never overwrite an existing version. So changes can
+ # be installed without causing a new package to be built until the
+ # version field is changed. Some files need to be excluded from the
+ # "immutable" policy, most importantly "archive-contents"
+ # and "*-readme.txt".
+ case $dst in
+ */archive-contents | *-readme.txt ) mv "$f" "$dst" ;;
+ * ) if [ -r "$dst" ]
+ then rm "$f"
+ else
+ mv "$f" "$dst"
+ # FIXME: Add a tag to remember the precise code used.
+ announce_new "$pv"
+ fi ;;
+ esac
+ done
+ mv "$buildir"/archive/"$latest" staging/
+ rm -rf "$buildir"/archive)
+
+# Make the HTML and readme.txt files.
+(cd ../staging/packages || exit
+ emacs --batch -l "$buildir"/admin/archive-contents.el \
+ --eval '(batch-html-make-index)')
+
+# update-archive.sh ends here