[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] master 2f1f7bb 2/4: * GNUmakefile, admin: Move files to the `el
|
From: |
Stefan Monnier |
|
Subject: |
[nongnu] master 2f1f7bb 2/4: * GNUmakefile, admin: Move files to the `elpa-admin` branch |
|
Date: |
Thu, 10 Dec 2020 18:19:11 -0500 (EST) |
branch: master
commit 2f1f7bb69deb98d1bd5b55808342499cef0162e9
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* GNUmakefile, admin: Move files to the `elpa-admin` branch
---
GNUmakefile | 281 ----------
admin/archive-contents.el | 1364 ---------------------------------------------
admin/ert-support.el | 55 --
admin/forward-diffs.py | 438 ---------------
admin/hv.sh | 47 --
admin/update-archive.sh | 235 --------
6 files changed, 2420 deletions(-)
diff --git a/GNUmakefile b/GNUmakefile
deleted file mode 100644
index 1b53f4e..0000000
--- a/GNUmakefile
+++ /dev/null
@@ -1,281 +0,0 @@
-# Makefile for GNU Emacs Lisp Package Archive.
-#
-
-EMACS=emacs --batch
-
-ARCHIVE_TMP=archive-tmp
-
-.PHONY: archive-tmp changelogs process-archive archive-full org-fetch clean
all do-it
-
-all: all-in-place
-
-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)~"
-
-build/%:
- $(EMACS) -l $(CURDIR)/admin/archive-contents.el \
- -f batch-make-one-package $*
-
-build-all:
- $(EMACS) -l $(CURDIR)/admin/archive-contents.el \
- -f batch-make-all-packages
-
-## 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/
-
-# 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)
- rm -f packages/*/*-autoloads.el
- find packages -name '*.elc' -print0 | xargs -0 rm -f
-
-########## 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) -l admin/archive-contents.el \
- -f batch-generate-description-file "$@"
-
-.PHONY: all-in-place
-# Use order-only prerequisites, so that autoloads are done first.
-all-in-place: | $(extra_elcs) $(autoloads) $(pkg_descs) elcs
-
-
-#### `make package/<pkgname>` to compile the files of a single package ####
-
-define RULE-singlepkg
-$(filter $(1)/%, $(elcs)): $1/$(notdir $(1))-pkg.el \
- $1/$(notdir $(1))-autoloads.el
-$(1): $(filter $(1)/%, $(elcs))
-endef
-$(foreach pkg, $(pkgs), $(eval $(call RULE-singlepkg, $(pkg))))
-
-
-#### `make package/<pkgname>` to populate one package's subdirectory ####
-
-MISSING_script := (sed -ne 's|^.("\([^"]*\)".*|packages/\1|p' externals-list; \
- ls -1d packages/*; ls -1d packages/*) \
- | sort | uniq -u
-MISSING_PKGS := $(shell $(MISSING_script))
-
-$(MISSING_PKGS):
- $(EMACS) -l admin/archive-contents.el \
- -f batch-archive-update-worktrees "$(@F)"
-
-
-#### Fetching updates from upstream ####
-
-.PHONY: fetch/%
-fetch/%:
- $(EMACS) -l admin/archive-contents.el -f batch-fetch-and-show "$*"
-
-.PHONY: fetch-all
-fetch-all:
- $(EMACS) -l admin/archive-contents.el -f batch-fetch-and-show "-"
-
-.PHONY: sync/%
-sync/%:
- $(EMACS) -l admin/archive-contents.el -f batch-fetch-and-push "$*"
-
-.PHONY: sync-all
-sync-all:
- $(EMACS) -l admin/archive-contents.el -f batch-fetch-and-push "-"
-
-
-############### 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
deleted file mode 100644
index 2853a42..0000000
--- a/admin/archive-contents.el
+++ /dev/null
@@ -1,1364 +0,0 @@
-;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive. -*-
lexical-binding:t -*-
-
-;; Copyright (C) 2011-2020 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:
-
-;; 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 archive--release-subdir "archive/"
- "Subdirectory where the ELPA release files (tarballs, ...) will be placed.")
-(defconst archive--devel-subdir "archive-devel/"
- "Subdirectory where the ELPA bleeding edge files (tarballs, ...) will be
placed.")
-(defconst archive--name "NonGNU")
-(defconst archive--gitrepo "emacs/nongnu.git")
-(defconst archive--url "http://elpa.gnu.org/nongnu/";)
-
-
-
-(defvar archive--debug nil)
-(defun archive--message (&rest args)
- (when archive--debug (apply #'message args)))
-
-(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))
- (pkg-spec (archive--get-package-spec pkg))
- (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-spec))
- '(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--update-archive-contents (pkg-desc dir)
- "Update the `archive-contents' file in DIR with new package PKG-DESC."
- (let* ((filename (expand-file-name "archive-contents" dir))
- (ac (if (file-exists-p filename)
- (archive--form-from-file-contents filename)
- '(1))))
- (archive--message "current AC: %S" ac)
- (setf (alist-get (car pkg-desc) (cdr ac)) (cdr pkg-desc))
- (setf (cdr ac) (sort (cdr ac)
- (lambda (x y)
- (string-lessp (symbol-name (car x)) (symbol-name
(car y))))))
- (archive--message "new AC: %S" ac)
- (with-temp-buffer
- (pp ac (current-buffer))
- (write-region nil nil filename)
- (let ((default-directory (expand-file-name dir)))
- (archive--html-make-index (cdr ac))))))
-
-(defun archive--get-release-revision (dir pkgname &optional vers version-map)
- "Get the REVISION that corresponds to current release.
-This is either found from VERS in VERSION-MAP or by looking at the last
-commit which modified the \"Version:\" pseudo header."
- (while (and version-map
- (not (member vers (car version-map))))
- (pop version-map))
- (or (nth 2 (car version-map))
- (let* ((default-directory (archive--dirname dir))
- (release-rev
- (with-temp-buffer
- (if (equal 0 ;Don't signal an error if call errors out.
- (archive--call
- (current-buffer)
- "git" "log" "-n1" "--oneline" "--no-patch"
- "--pretty=format:%H"
- "-L" (concat "/^;;* *\\(Package-\\)\\?Version:/,+1:"
- pkgname ".el")))
- (buffer-string)
- (cons 'error (buffer-string))))))
- (if (stringp release-rev)
- (progn
- (archive--message "Found release rev: %S" release-rev)
- release-rev)
- (archive--message "Can't find release rev: %s" (cdr release-rev))
- nil))))
-
-(defun archive--get-last-release (pkg-spec)
- "Return (VERSION . REV) of the last release.
-Assumes that the current worktree holds a snapshot version."
- (with-temp-buffer
- (setq default-directory (archive--dirname (car pkg-spec) "packages"))
- (if (not (equal 0 ;Don't signal an error if call errors out.
- (archive--call
- (current-buffer)
- "git" "log" "-n1" "--oneline" "--no-patch"
- "--pretty=format:%H"
- "-L" (concat "/^;;* *\\(Package-\\)\\?Version:/,+1:"
- (car pkg-spec) ".el"))))
- (progn
- (archive--message "Error in git-log:\n" (buffer-string))
- nil)
- (goto-char (point-min))
- (let ((last-chg-rev (buffer-substring (point) (line-end-position))))
- (erase-buffer)
- (if (not (equal 0 ;Don't signal an error if call errors
out.
- (archive--call
- (current-buffer)
- "git" "log" "-n1" "--oneline"
- "--pretty=format:%H"
- "-L" (concat "/^;;* *\\(Package-\\)\\?Version:/,+1:"
- (car pkg-spec) ".el")
- (concat last-chg-rev "~1"))))
- (progn
- (archive--message "Error in git-log:\n" (buffer-string))
- nil)
- (goto-char (point-min))
- (let ((rev (buffer-substring (point) (line-end-position)))
- (case-fold-search t))
- (if (not (re-search-forward "^\\+.*Version:[ \t]*\\(.+?\\)[ \t]*$"
- nil t))
- (archive--message "No previous release version found")
- (let* ((vers (match-string 1))
- (vl (condition-case err (version-to-list vers)
- (error (archive--message "Error: %S" err) nil))))
- (cond
- ((null vl)
- (archive--message "Invalid previous release version"))
- ((member -4 vl)
- (archive--message "Previous version was also snapshot"))
- (t
- (cons (package-version-join vl) rev)))))))))))
-
-(defun archive--select-revision (dir pkgname rev)
- "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)
- (archive--message "Current revision is already desired revision!")
- (with-temp-buffer
- (let ((default-directory (archive--dirname dir)))
- (archive--call (current-buffer) "git" "status" "--porcelain")
- (if (not (zerop (buffer-size)))
- (error "git-status not clean:\n%s" (buffer-string))
- (archive--call (current-buffer) "git" "reset" "--merge" rev)
- (archive--message "Reverted to release revision %s\n%s"
- rev (buffer-string))))))))
-
-(defun archive--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."
- (archive--message "Building tarball %s..." tarball)
- (if (or (file-readable-p tarball)
- (file-readable-p (replace-regexp-in-string
- "\\.tar\\'" ".el" tarball)))
- (progn
- (archive--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)
- "-\\([0-9].*\\)\\.\\(tar\\|el\\)\\(\\.[a-z]*z\\)?\\'"))
- (oldtarballs
- (mapcar
- (lambda (file)
- (string-match re file)
- (cons (match-string 1 file) file))
- (directory-files destdir nil re))))
- (delete-file (expand-file-name (format "%s-pkg.el" pkgname) dir))
- (when revision-function
- (archive--select-revision dir pkgname (funcall revision-function)))
- ;; FIXME: Build Info files and corresponding `dir' file.
- (archive--write-pkg-file dir pkgname metadata)
- ;; FIXME: Allow renaming files or selecting a subset of the files!
- (archive--call nil "tar"
- "--exclude-vcs"
- "-X" (if (file-readable-p elpaignore)
- elpaignore "/dev/null")
- "--transform"
- (format "s|^packages/%s|%s-%s|" pkgname pkgname vers)
- "-chf" tarball
- (concat "packages/" pkgname))
- (let* ((pkgdesc
- ;; FIXME: `archive--write-pkg-file' wrote the metadata to
- ;; <pkg>-pkg.el and then `archive--process-multi-file-package'
- ;; reads it back. We could/should skip the middle man.
- (archive--process-multi-file-package
- dir pkgname 'dont-rename)))
- (archive--message "%s: %S" pkgname pkgdesc)
- (archive--update-archive-contents pkgdesc destdir)
- (when (and nil revision-function) ;FIXME: Circumstantial evidence.
- ;; Various problems:
- ;; - If "make build/foo" is used by the developers in order to test
- ;; the build of their package, they'll end up with those spurious
- ;; tags which may end up spreading to unintended places.
- ;; - The tags created in elpa.gnu.org won't spread to nongnu.git
- ;; because that account can't push to git.sv.gnu.org anyway.
- (let ((default-directory (archive--dirname dir)))
- (archive--call nil "git" "tag" "-f"
- (format "%s-release/%s-%s"
- archive--name pkgname vers))))
- ;; FIXME: Send email announcement!
- (let ((link (expand-file-name (format "%s.tar" pkgname) destdir)))
- (when (file-exists-p link) (delete-file link))
- (make-symbolic-link (file-name-nondirectory tarball) link))
- (dolist (oldtarball oldtarballs)
- ;; lzip compress oldtarballs.
- (let ((file (cdr oldtarball)))
- (when (string-match "\\.\\(tar\\|el\\)\\'" file)
- ;; Don't compress the file we just created.
- (unless (equal file (file-name-nondirectory tarball))
- (archive--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.
- (archive--html-make-pkg pkgdesc pkg-spec
- `((,vers . ,(file-name-nondirectory tarball))
- . ,oldtarballs)
- dir))
- (message "Built new package %s!" tarball)
- 'new))))
-
-(defun archive--get-devel-version (dir)
- "Compute the date-based pseudo-version used for devel builds."
- (let* ((default-directory (archive--dirname dir))
- (gitdate
- (with-temp-buffer
- (archive--call (current-buffer)
- "git" "show" "--pretty=format:%cI" "--no-patch")
- (buffer-string)))
- (verdate
- ;; Convert Git's date into something that looks like a version
number.
- ;; While we're at it, convert Git's date into its UTC equivalent,
- ;; to try and make sure time-versions are monotone.
- (let ((process-environment (cons "TZ=UTC" process-environment)))
- (with-temp-buffer
- (archive--call (current-buffer)
- "date" "-d" gitdate "+%Y%m%d.%H%M%S")
- (buffer-string)))))
- ;; Get rid of leading zeros since ELPA's version numbers don't allow them.
- (replace-regexp-in-string "\\(?:\\`\\|[^0-9]\\)0+" "\\1"
- ;; Remove trailing newline or anything untoward.
- (replace-regexp-in-string "[^.0-9]+" ""
- verdate))))
-
-(defun archive--get-package-spec (pkgname)
- "Retrieve the property list for PKGNAME from `externals-list'."
- (let* ((specs (archive--form-from-file-contents "externals-list"))
- (spec (assoc pkgname specs)))
- (if (null spec)
- (error "Unknown package `%S`" pkgname)
- spec)))
-
-(defun batch-make-all-packages (&rest _)
- "Check all the packages and build the relevant new tarballs."
- (let* ((specs (archive--form-from-file-contents "externals-list")))
- (dolist (spec specs)
- (with-demoted-errors "Build error: %S"
- (archive--make-one-package spec)))))
-
-(defun batch-make-one-package (&rest _)
- "Build the new tarballs (if needed) for one particular package."
- (while command-line-args-left
- (archive--make-one-package (archive--get-package-spec
- (pop command-line-args-left)))))
-
-(defun archive--make-one-package (pkg-spec)
- "Build the new tarballs (if needed) for PKG-SPEC."
- (archive--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)
- (archive--core-package-sync pkg-spec)
- (archive--external-package-sync pkg-spec)))
- (_ (archive--message "pkg-spec for %s: %S" pkgname pkg-spec))
- (metadata (archive--metadata dir pkg-spec))
- (vers (nth 1 metadata)))
- (archive--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 (archive--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 archive--devel-subdir
- (format "%s-%s.tar" pkgname devel-vers)))
- (new
- (let ((archive--name (concat archive--name "-devel")))
- ;; Build the archive-devel tarball.
- (archive--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
- ((equal vers "0")
- (archive--message "Package %s not released yet!" pkgname))
- ((not new)
- (archive--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 (archive--get-last-release pkg-spec))
- (tarball (concat archive--release-subdir
- (format "%s-%s.tar"
- pkgname (car last-rel)))))
- (if (not last-rel)
- (archive--message "Package %s not released yet!" pkgname)
- (archive--make-one-tarball
- tarball dir pkg-spec
- `(nil ,(car last-rel) . ,(nthcdr 2 metadata))
- (lambda () (cdr last-rel))))))))
- (t
- (let ((tarball (concat archive--release-subdir
- (format "%s-%s.tar" pkgname vers))))
- (archive--make-one-tarball
- tarball dir pkg-spec metadata
- (lambda ()
- (archive--get-release-revision
- dir pkgname vers
- (plist-get (cdr pkg-spec) :version-map)))))))))))
-
-(defun archive--call (destination program &rest args)
- "Like ‘call-process’ for PROGRAM, DESTINATION, ARGS.
-The INFILE and DISPLAY arguments are fixed as nil."
- ;; (message "call-process %s %S" program args)
- (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 (concat archive--url "%s.html"))
-(defconst archive-default-url-re (format archive-default-url-format ".*"))
-
-
-(defun archive--override-version (pkg-spec orig-fun header)
- (let ((str (funcall orig-fun header)))
- (or (if (or (equal header "version")
- (and str (equal header "package-version")))
- (let ((version-map (plist-get (cdr pkg-spec) :version-map))
- (dont-release (plist-get (cdr pkg-spec) :dont-release)))
- (or (cadr (assoc str version-map))
- (and str dont-release
- (string-match dont-release str)
- (replace-match "snapshot" t t str)))))
- str)))
-
-;; Some packages use version numbers which `version-to-list' doesn't
-;; recognize out of the box. So here we help.
-
-(add-to-list 'version-regexp-alist '("^[-.+ ]*beta-?$" . -2)) ;"1.0.0-beta-3"
-(add-to-list 'version-regexp-alist '("^[-.+ ]*dev$" . -4)) ;2.5-dev
-
-(defun archive--metadata (dir pkg-spec)
- "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* ((pkg (car pkg-spec))
- (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
- (unwind-protect
- (progn
- (when (or (plist-get (cdr pkg-spec) :version-map)
- (plist-get (cdr pkg-spec) :dont-release))
- (advice-add 'lm-header :around
- (apply-partially
- #'archive--override-version
- pkg-spec)))
- (package-buffer-info))
- (advice-remove 'lm-header
- #'archive--override-version)))
- (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 &optional dont-rename)
- "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)))
- (unless dont-rename (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))
- (pkg-spec (archive--get-package-spec pkg)))
- (archive--write-pkg-file dir pkg (archive--metadata dir pkg-spec))))
-
-(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)))
-
-(defun batch-generate-description-file (&rest _)
- "(Re)build the <PKG>-pkg.el file for particular packages."
- (while command-line-args-left
- (let* ((file (pop command-line-args-left))
- (dir (file-name-directory file))
- (pkg (file-name-nondirectory (directory-file-name dir)))
- (pkg-spec (archive--get-package-spec pkg)))
- (archive--write-pkg-file dir pkg
- (archive--metadata dir pkg-spec)))))
-
-;;; 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))
- (val-exp (plist-get (cdr desc) kprop)))
- (if (eq 'quote (car-safe val-exp))
- (cadr val-exp)
- val-exp))))
- (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--insert-repolinks (pkg-spec 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* ((git-sv "http://git.savannah.gnu.org/";)
- (urls
- (if (eq (nth 1 pkg-spec) :core)
- (let* ((files (nth 2 pkg-spec))
- (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) (format s archive--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")
- (concat git-sv (nth 0 urls))
- 'CGit
- (concat git-sv (nth 1 urls))
- 'Gitweb))))
-
-(defun archive--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 (archive--html-header
- (format "%s ELPA - %s" archive--name name)
- (format "<a href=\"index.html\">%s ELPA</a> - %s"
- archive--name 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 (concat "is not in " archive--name " 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
- (when (consp maint)
- (archive--message "maint=%S" maint)
- (setq maint (concat (if (car maint) (concat (car maint) " "))
- "<" (cdr maint) ">")))
- (insert (format "<dt>Maintainer</dt> <dd>%s</dd>\n" (archive--quote
maint)))))
- (archive--insert-repolinks
- pkg-spec
- (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))
- ;; FIXME: Use README.md for some packages (such as markdown-mode).
- (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")))
- ;; (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
- (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 (concat archive--name " 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))
- (specs (archive--form-from-file-contents "externals-list"))
- (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)))
- (assoc pkg-name specs)
- files))
- packages)
- (archive--html-make-index archive-contents)))
-
-(defun archive--pull (dirname)
- (let ((default-directory (archive--dirname dirname)))
- (with-temp-buffer
- ;; Undo any local changes to `<pkg>-pkg.el', in case it's under
- ;; version control.
- (archive--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)
- (archive--call t "git" "pull"))
- ((file-exists-p ".git")
- (if (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 "%s up-to-date" dirname)
- (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."
- (when (file-directory-p (expand-file-name "packages/"))
- (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))))
- ))))))
-
-
-(defun archive--external-package-sync (pkg-spec)
- "Sync external package named PKG-SPEC."
- (let ((name (car pkg-spec))
- (default-directory (expand-file-name "packages/")))
- (unless (file-directory-p default-directory)
- (make-directory default-directory))
- (cond ((not (file-exists-p name))
- (let* ((branch (concat "externals/" name))
- (output
- (with-temp-buffer
- (cond
- ((archive--git-branch-p (archive--ortb pkg-spec))
- (archive--call t "git" "worktree" "add"
- "-B" branch
- name (archive--ortb pkg-spec)))
- ((archive--git-branch-p branch)
- (archive--call t "git" "worktree" "add" name branch))
- ((archive--git-branch-p (archive--urtb pkg-spec))
- (archive--call t "git" "worktree" "add"
- "-B" branch "--no-track"
- name (archive--urtb pkg-spec)))
- (t (error "No branch %s for the worktree of %s"
- branch 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 (archive--dirname 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 ((command-line-args-left '("-")))
- (batch-archive-update-worktrees)))
-
-(defun batch-archive-update-worktrees (&rest _)
- (let ((specs (archive--form-from-file-contents "externals-list"))
- (pkgs command-line-args-left)
- (with-core (archive--sync-emacs-repo)))
- (setq command-line-args-left nil)
- (if (equal pkgs '("-")) (setq pkgs (mapcar #'car specs)))
- (dolist (pkg pkgs)
- (let* ((pkg-spec (assoc pkg specs))
- (kind (nth 1 pkg-spec)))
- (pcase kind
- (`:external (archive--external-package-sync pkg-spec))
- (`:core (when with-core (archive--core-package-sync pkg-spec)))
- (_ (if pkg-spec
- (message "Unknown package kind `%S' for %s" kind pkg)
- (message "Unknown package %s" pkg))))))))
-
-;;; Fetch updates from upstream
-
-(defun archive--branch (pkg-spec)
- (or (plist-get (cdr pkg-spec) :branch) "master"))
-
-(defun archive--urtb (pkg-spec)
- "Return our upstream remote tracking branch for PKG-SPEC."
- (format "refs/remotes/upstream/%s/%s" (car pkg-spec)
- (archive--branch pkg-spec)))
-
-(defun archive--ortb (pkg-spec)
- "Return our origin remote tracking branch for PKG-SPEC."
- ;; We can't use the shorthand "origin/externals/%s" when we pass it to
- ;; `git-show-ref'.
- (format "refs/remotes/origin/externals/%s" (car pkg-spec)))
-
-(defun archive--git-branch-p (branch)
- "Return non-nil iff BRANCH is an existing branch."
- (equal 0 (archive--call t "git" "show-ref" "--verify" "--quiet" branch)))
-
-(defun archive--fetch (pkg-spec &optional k)
- (let* ((pkg (car pkg-spec))
- (url (plist-get (cdr pkg-spec) :external))
- (branch (archive--branch pkg-spec))
- (urtb (archive--urtb pkg-spec))
- (refspec (format "refs/heads/%s:%s" branch urtb)))
- (if (not url)
- (message "Missing upstream URL in externals-list for %s" pkg)
- (message "Fetching updates for %s..." pkg)
- (with-temp-buffer
- (cond
- ((not (equal 0 (archive--call t "git" "fetch" "--no-tags"
- url refspec)))
- (message "Fetch error for %s:\n%s" pkg (buffer-string)))
- ((let* ((ortb (archive--ortb pkg-spec))
- (exists (archive--git-branch-p ortb)))
- (not (equal 0 (archive--call t "git" "log"
- (if exists
- (format "%s...%s" ortb urtb)
- urtb)))))
- (message "Log error for %s:\n%s" pkg (buffer-string)))
- ((eq (point-min) (point-max))
- (message "No pending upstream changes for %s" pkg))
- (t (message "%s" (buffer-string))
- (when k (funcall k pkg-spec))))))))
-
-(defun archive--push (pkg-spec)
- (let* ((pkg (car pkg-spec))
- ;; (url (plist-get (cdr pkg-spec) :external))
- ;; (branch (archive--branch pkg-spec))
- (ortb (archive--ortb pkg-spec))
- (urtb (archive--urtb pkg-spec)))
- ;; FIXME: Arrange to merge if it's not a fast-forward.
- (with-temp-buffer
- (cond
- ((zerop (archive--call t "git" "merge-base" "--is-ancestor" urtb ortb))
- (message "Nothing to push for %s" pkg))
- ((and
- (not (zerop (archive--call t "git" "merge-base" "--is-ancestor"
- ortb urtb)))
- (archive--git-branch-p ortb))
- (message "Can't push %s: not a fast-forward" pkg))
- ((not (equal 0 (archive--call t "git" "push" "--set-upstream"
- "origin"
- (format "%s:refs/heads/externals/%s"
- urtb pkg))))
- (message "Fetch error for %s:\n%s" pkg (buffer-string)))
- (t
- (message "Pushed %s successfully:\n%s" pkg (buffer-string))
- (archive--external-package-sync pkg-spec))))))
-
-(defun archive--batch-fetch-and (k)
- (let ((specs (archive--form-from-file-contents "externals-list"))
- (pkgs command-line-args-left))
- (setq command-line-args-left nil)
- (if (equal pkgs '("-")) (setq pkgs (mapcar #'car specs)))
- (dolist (pkg pkgs)
- (let* ((pkg-spec (assoc pkg specs)))
- (if (not pkg-spec) (message "Unknown package: %s" pkg)
- ;; (unless (file-directory-p (expand-file-name pkg "packages"))
- ;; (archive--external-package-sync pkg-spec))
- (archive--fetch pkg-spec k))))))
-
-(defun batch-fetch-and-show (&rest _)
- (archive--batch-fetch-and #'ignore))
-
-(defun batch-fetch-and-push (&rest _)
- (archive--batch-fetch-and #'archive--push))
-
-(provide 'archive-contents)
-;;; archive-contents.el ends here
diff --git a/admin/ert-support.el b/admin/ert-support.el
deleted file mode 100644
index a0ff9ab..0000000
--- a/admin/ert-support.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;; 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
deleted file mode 100755
index c0c330d..0000000
--- a/admin/forward-diffs.py
+++ /dev/null
@@ -1,438 +0,0 @@
-#!/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
deleted file mode 100644
index 9a45c92..0000000
--- a/admin/hv.sh
+++ /dev/null
@@ -1,47 +0,0 @@
-# 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
deleted file mode 100755
index 6560748..0000000
--- a/admin/update-archive.sh
+++ /dev/null
@@ -1,235 +0,0 @@
-#!/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