emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] elpa-admin 5b91341 226/357: Merge branch 'master' of git.sv.gnu.o


From: Stefan Monnier
Subject: [elpa] elpa-admin 5b91341 226/357: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs/elpa
Date: Thu, 10 Dec 2020 18:06:48 -0500 (EST)

branch: elpa-admin
commit 5b913417068e2b8c5905b888f47af5727bfdbdea
Merge: 4d58120 62629ab
Author: rocky <rocky@gnu.org>
Commit: rocky <rocky@gnu.org>

    Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs/elpa
---
 GNUmakefile               |  83 +++++++++++----
 README                    | 146 +++++++++++++++++++++++----
 admin/archive-contents.el | 250 ++++++++++++++++++++++++++++++++++++----------
 admin/ert-support.el      |  54 ++++++++++
 4 files changed, 438 insertions(+), 95 deletions(-)

diff --git a/GNUmakefile b/GNUmakefile
index e35b82d..d23d523 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -1,4 +1,5 @@
 # Makefile for GNU Emacs Lisp Package Archive.
+#
 
 EMACS=emacs --batch
 
@@ -13,18 +14,20 @@ CR_EXCEPTIONS=copyright_exceptions
 .PHONY: check_copyrights
 check_copyrights:
        @echo "Compute exceptions >$(CR_EXCEPTIONS)~"
-       @export LANG=C;                                                 \
-       (cd packages;                                                   \
-       find . -name '.git' -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' -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";                                               \
+       @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)~"
 
@@ -38,14 +41,21 @@ archive-tmp: packages
        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;                             \
+       cd $(ARCHIVE_TMP)/packages &&                           \
          $(EMACS) -l $(CURDIR)/admin/archive-contents.el       \
                   -f batch-make-archive
-       @cd $(ARCHIVE_TMP)/packages;                            \
+       @cd $(ARCHIVE_TMP)/packages &&                          \
          for pt in *; do                                       \
              if [ -f "$${pt}/.elpaignore" ]; then              \
                  ignore="$${pt}/.elpaignore";                  \
@@ -54,7 +64,7 @@ process-archive:
              fi;                                               \
              if [ -d $$pt ]; then                              \
                  echo "Creating tarball $${pt}.tar" &&         \
-                 tar -cf $${pt}.tar $$pt --exclude-vcs -X "$$ignore";  \
+                 tar -chf $${pt}.tar $$pt --exclude-vcs -X "$$ignore"; \
                  rm -rf $${pt};                                \
              fi;                                               \
          done
@@ -74,7 +84,7 @@ archive-full: archive-tmp org-fetch
 # FIXME: Turn it into an `external', which will require adding the notion of
 # "snapshot" packages.
 org-fetch: archive-tmp
-       cd $(ARCHIVE_TMP)/packages; \
+       cd $(ARCHIVE_TMP)/packages && \
        pkgname=`curl -s http://orgmode.org/elpa/|perl -ne 'push @f, $$1 if 
m/(org-\d{8})\.tar/; END { @f = sort @f; print "$$f[-1]\n"}'`; \
        wget -q http://orgmode.org/elpa/$${pkgname}.tar -O $${pkgname}.tar; \
        if [ -f $${pkgname}.tar ]; then \
@@ -108,19 +118,20 @@ 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', such as `aggressive-indent'.
+# 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'll just do it the ad-hoc way
+# 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.
+# 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
+# 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 $@); \
+       @cd $(dir $@) && \
          $(EMACS) -l $(CURDIR)/admin/archive-contents.el \
              --eval "(archive--refresh-pkg-file)" \
              --eval "(require 'package)" \
@@ -180,3 +191,31 @@ all-in-place: $(extra_elcs) $(autoloads) $(pkg_descs)
 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/README b/README
index a688040..7c5cd36 100644
--- a/README
+++ b/README
@@ -1,8 +1,8 @@
-Copyright (C) 2010-2011, 2014 Free Software Foundation, Inc.
+Copyright (C) 2010-2011, 2014, 2015 Free Software Foundation, Inc.
 See the end of the file for license conditions.
 
 
-This branch contains the sources, deployment scripts, and auxilliary
+This branch contains the sources, deployment scripts, and auxiliary
 files for the Emacs Lisp package archive (elpa.gnu.org).
 
 This file explains the branch layout, how to add and edit packages,
@@ -34,18 +34,69 @@ safely work on the next version here without worrying about 
the unstable
 code making it to GNU ELPA, and simply update the "version" when you want to
 release the new code.
 
-** To add a package:
+** To add a package: (submission, submit)
 
-*** Add a simple (1-file) package as packages/NAME/NAME.el.
+Adding a basic package is very simple. There are thorough
+instructional, but the gist is that you:
 
-The file needs to follow the usual coding conventions (most importantly
-start with ";;; <file> --- <description>") and have a "Version:" and
-"Maintainer:" pseudo-header.
+1. Notify emacs-devel@gnu.org.
+2. Place all files inside `packages/<pkg-name>/'.
+3. `git add', `git commit' and `git push'.
 
-*** Add a multi-file package as a directory, packages/NAME.
+If you don't have push access to the repository, someone will do steps
+2 and 3 for you.
 
-It needs to have a file named packages/NAME/NAME.el which follows the same
-rules as above.
+*** Notify emacs-devel@gnu.org
+
+There is no approval process for GNU Elpa packages.  Still,
+you must send an email to emacs-devel for several reasons:
+
+- Notifying other developers;
+- Making sure the package doesn't break FSF rules;
+- Checking if the package is not reinventing the wheel;
+- Ensuring that first-time developers are doing it right.
+
+Before doing anything, please ensure your package follows the
+conventions described in the `** Format' section.  Then, send an email
+to the list with the subject:
+    [ELPA] New package: <pkg-name>
+
+Start your message with an explanation about the package.  A
+copy-paste of the package's Summary and Commentary is perfectly fine
+here, but you can write more or less than that if you'd like.
+
+At the bottom of the message contents include the changes you're going
+to make (the patch).  For a single-file package this can be the
+package file itself instead of the patch.  If you prefer (and if you
+have push access), you can push your changes to a branch called
+`scratch/<pkg-name>', and mention the branch in your message.
+
+After 48h, or once any issues have been addressed, someone will push
+your changes for you.  You should probably also subscribe to
+emacs-devel@gnu.org, since that's where we discuss about GNU Elpa, and
+to bug-gnu-emacs@gnu.org, since that's where people will report bugs
+about your package.
+
+*** Add a simple (1-file) package as packages/<pkg-name>/<pkg-name>.el.
+
+The file needs to follow the usual coding conventions (most
+importantly start with ";;; <file> --- <description>") and have a
+"Version:" and "Maintainer:" pseudo-header (see the "Format"
+subsection below).
+
+For some examples, see
+    (info "(elisp) Simple Packages")
+
+*** Add a multi-file package as a directory, packages/<pkg-name>.
+
+It needs to have a file named packages/<pkg-name>/<pkg-name>.el which follows 
the
+same rules as above.
+
+It additionally follows the same guidelines described in
+    (info "(elisp) Multi-file Packages")
+with the exception that it is not a tar package (it's a plain
+directory) and it must not contain a "<pkg-name>-pkg.el" file (this
+will be created for you).
 
 *** Commit your changes the usual way ("git add", "git commit", etc).
 
@@ -60,8 +111,8 @@ header changes.
 Each package should follow the ELPA packaging conventions, but there are
 some differences due to the way the deployment script creates the packages
 and the web-pages from this source code:
-- Multi-file packages put the package metadata in the main <pkg>.el file
-  in the format used for single-file packages: the <pkg>-pkg.el file is
+- Multi-file packages put the package metadata in the main <pkg-name>.el file
+  in the format used for single-file packages: the <pkg-name>-pkg.el file is
   auto-generated from it.
 - Every package should have both a "Version:" *and* a "Maintainer:".
 - the "URL:" header can be used to specify the home page
@@ -78,20 +129,70 @@ and the web-pages from this source code:
 
 ** External branches
 
-Some packages are maintained in external branches.  These should be
-appropriately listed in the `externals-list' file.
-There are two different cases: subtrees and externals.
+The above instructions are enough to add regular packages, those that
+are maintained primarily here in the repository.  The instructions
+below are for those maintainers who prefer to use a dedicated
+repository or branch for the package.
+
+There are two ways to do that: subtrees and externals.
+
+Either way, such packages should always be listed in the
+`externals-list' file.
+
+In both cases, a copy of the code is kept in the `elpa' repository
+(not necessarily in the master branch) and should be sync'd with the
+upstream every once in a while.  This copy may include local changes,
+although these should be kept to a minimum.
+
+If know you don't want a local package, but don't know which of these
+two options you prefer, then use a subtree.
+
+*** Subtrees
+
+In the `subtree' case, the copy of the code is kept here in the master
+branch, inside its corresponding `packages/<pkg-name>' directory just
+as if it were a local package.
+
+In fact, a subtree package is essentially indistinguishable from a
+local package.  The only difference is that, instead of developing it
+here, you do it in some remote repository and pull in the changes.
+
+Instead of manually creating the directory, you should be able to use:
+
+    git subtree add --prefix=packages/<pkg-name> <remote-repo> <remote-branch>
+
+Later, when you make some changes to the remote and want to publish
+them here, simply do:
+
+    git subtree pull --prefix=packages/<pkg-name> <remote-repo> <remote-branch>
+
+On older git versions "git subtree" might not be available.  You can
+try "git merge -s subtree", or just update git.
+
+- <remote-repo> is the remote's URL.  If you've previously used "git
+  remote add", then this can be the remote's name.
+- <remote-branch> is the branch you want to pull (probably "master").
+
+If you want the local code to be slightly different from the remote,
+simply commit further changes to it here.  Of course, this may trigger
+merge conflicts when you do a "subtree pull" in the future, so it's
+best to avoid these local changes.
+
+If someone makes changes to your package here on elpa.git and you want
+to push them to your remote, it's easiest to just copy these changes
+over to the remote repo.  Trying to push a subtree with git is likely
+to induce headache.
+
+**** When you're adding and pulling, DO NOT --SQUASH!!
 
-In both cases, a copy of the code is kept in the `elpa' repository and
-should be sync'd with the upstream every once in a while.  This copy may
-include local changes, tho ideally these should be kept to a minimum.
+Don't worry about flooding elpa.git's commit log with your package's
+commit messages.  Your package is part of elpa.git.  Squashing doesn't
+help and only gets in the way.
 
-In the `subtree' case, the copy of the code is kept here in the
-corresponding `packages/<pkg>' directory.  You should be able to "git
-merge -s subtree" from the upstream branch.
+*** Externals
 
 In the `external' case, the copy of the code is not kept here but in the
-`externals/<pkg>' branch in the `elpa' repository.
+`externals/<pkg-name>' branch in the `elpa' repository.
 
 You can check out all the external packages into the `packages' directory
 with the command:
@@ -136,6 +237,7 @@ packages/ directory.  You can then add that directory, e.g. 
with:
 ** To deploy the package repository as a remotely-accessible archive:
 
    git clone .../elpa
+   (cd elpa; git clone .../emacs)    #If you want to generate :core packages.
    mkdir build
    cd build
    (cd ../elpa; git log --format=%H | tail -n 1) >.changelog-witness
diff --git a/admin/archive-contents.el b/admin/archive-contents.el
index c53f4ba..8f054ad 100755
--- a/admin/archive-contents.el
+++ b/admin/archive-contents.el
@@ -1,6 +1,6 @@
 ;;; archive-contents.el --- Auto-generate an Emacs Lisp package archive.  -*- 
lexical-binding:t -*-
 
-;; Copyright (C) 2011-2014  Free Software Foundation, Inc
+;; Copyright (C) 2011-2015  Free Software Foundation, Inc
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 
@@ -179,7 +179,6 @@ PKG is the name of the package and DIR is the directory 
where it is."
             (error "Can't parse first line of %s" mainfile)
           ;; Grab the other fields, which are not mandatory.
           (let* ((description (match-string 1))
-                 (pv )
                  (version
                   (or (lm-header "package-version")
                       (lm-header "version")
@@ -207,8 +206,9 @@ PKG is the name of the package and DIR is the directory 
where it is."
   "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
-  (rename-file (expand-file-name (concat pkg ".el") dir)
-              (concat pkg "-" vers ".el"))
+  (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"))
@@ -420,7 +420,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
   (replace-regexp-in-string "<" "&lt;"
                             (replace-regexp-in-string "&" "&amp;" txt)))
 
-(defun archive--insert-repolinks (name srcdir mainsrcfile url)
+(defun archive--insert-repolinks (name srcdir _mainsrcfile url)
   (when url
     (insert (format "<p>Home page: <a href=%S>%s</a></p>\n"
                     url (archive--quote url)))
@@ -531,6 +531,7 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
       (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)))
@@ -558,54 +559,201 @@ Rename DIR/ to PKG-VERS/, and return the descriptor."
 ;;; 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)
+      (let ((default-directory emacs-repo-root))
+        (message "Running git pull in %S" default-directory)
+        (call-process "git" nil t nil "pull")
+        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 subdirectories of `packages/' that do not correspond to known 
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
+       ((or (not (file-directory-p dir)) (file-symlink-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 (file-name-as-directory
+                                           (expand-file-name dir))))
+                   (call-process "git" nil t nil "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 (call-process "git" nil nil nil
+                                       "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 (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
+                     ;; FIXME: Use git-new-workdir!
+                     (call-process "git" nil t nil "clone"
+                                   "--reference" ".." "--single-branch"
+                                   "--branch" branch
+                                   archive--elpa-git-url name)
+                     (buffer-string))))
+             (message "Cloning branch %s:\n%s" name output)))
+          ((not (file-directory-p (concat name "/.git")))
+           (message "%s is in the way of an external, please remove!" name))
+          (t
+           (let ((default-directory (file-name-as-directory
+                                     (expand-file-name name))))
+             (with-temp-buffer
+               (message "Running git pull in %S" default-directory)
+               (call-process "git" nil t nil "pull")
+               (message "Updated %s:%s" name (buffer-string))))))))
+
+(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
+            (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)))
+      (unless (file-directory-p directory)
+        (make-directory directory t))
+      (condition-case nil
+         (make-symbolic-link absolute-core-file-name
+                             absolute-package-file-name t)
+       (file-error
+        (copy-file absolute-core-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 (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 ()
-  (let ((exts (with-current-buffer (find-file-noselect "externals-list")
-                (goto-char (point-min))
-                (read (current-buffer)))))
-    (let ((default-directory (expand-file-name "packages/")))
-      ;; Remove "old/odd" externals.
-      (dolist (dir (directory-files "."))
-        (cond
-         ((member dir '("." "..")) nil)
-         ((assoc dir exts) nil)
-         ((file-directory-p (expand-file-name (format "%s/.git" dir)))
-          (let ((status
-                 (with-temp-buffer
-                   (let ((default-directory (file-name-as-directory
-                                             (expand-file-name dir))))
-                     (call-process "git" nil t nil "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))))))
-      (pcase-dolist (`(,dir ,kind ,_url) exts)
-        (cond
-         ((eq kind :subtree) nil)       ;Nothing to do.
-         ((not (eq kind :external))
-          (message "Unknown external package kind `%S' for %s" kind dir))
-         ((not (file-exists-p dir))
-          (let* ((branch (concat "externals/" dir))
-                 (output
-                  (with-temp-buffer
-                    ;; FIXME: Use git-new-workdir!
-                    (call-process "git" nil t nil "clone"
-                                  "--reference" ".." "--single-branch"
-                                  "--branch" branch
-                                  archive--elpa-git-url dir)
-                    (buffer-string))))
-            (message "Cloning branch %s:\n%s" dir output)))
-         ((not (file-directory-p (concat dir "/.git")))
-          (message "%s is in the way of an external, please remove!" dir))
-         (t
-          (let ((default-directory (file-name-as-directory
-                                    (expand-file-name dir))))
-            (with-temp-buffer
-              (message "Running git pull in %S" default-directory)
-              (call-process "git" nil t nil "pull")
-              (message "Updated %s:%s" dir (buffer-string))))
-          ))))))
+  "Remove non-package directories and fetch external packages."
+  (let ((externals-list
+         (with-current-buffer (find-file-noselect "externals-list")
+           (read (buffer-string)))))
+    (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)))))))
 
 (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..93d1af8
--- /dev/null
+++ b/admin/ert-support.el
@@ -0,0 +1,54 @@
+;; The contents of this file are subject to the GPL License, Version 3.0.
+
+;; Copyright (C) 2016, 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" . ,(concat top-directory "/archive/packages"))))
+  (setq 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)
+  (or
+   (directory-files package-directory nil ".*-test.el$")
+   (directory-files package-directory nil ".*-tests.el$")
+   (let ((dir-test
+          (concat package-directory "/test")))
+     (when (file-exists-p dir-test)
+       (directory-files dir-test)))
+   (let ((dir-tests
+          (concat package-directory "/tests")))
+     (when (file-exists-p dir-tests)
+       (directory-files dir-tests)))))
+
+(defun ert-support-load-tests (package-directory package)
+  (mapc
+   (lambda(file)
+     (message "Loading test file... %s" (concat package-directory file))
+     (load-file (concat package-directory 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
+   (concat top-directory "/packages/" (symbol-name package) "/")
+   package)
+
+  (ert-run-tests-batch-and-exit t))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]