Initial Support for ELPA packages in core

Previously, Emacs packages in core were stored only in their own
directory structure. Here, we add support for packages following
conventions for ELPA to be added to the packages directory. These are
compiled, and loaded directly using package.el during start up.

diff --git a/Makefile.in b/Makefile.in
index 7aac403adac90210278e3a5f20aea04088f9c7da..338138731b43f7edd20b41c524a9b5b522ab2ddc 100644 (file)
--- a/Makefile.in
+++ b/Makefile.in
@@ -290,7 +290,7 @@ EMACS = ${EMACS_NAME}${EXEEXT}
 EMACSFULL = `echo emacs-${version} | sed '$(TRANSFORM)'`${EXEEXT}
 
 # Subdirectories to make recursively.
-SUBDIR = $(NTDIR) lib lib-src src lisp
+SUBDIR = $(NTDIR) lib lib-src src lisp packages
 
 # The subdir makefiles created by config.status.
 SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
@@ -381,7 +381,7 @@ src: lib-src
 lisp: src
 
 # These targets should be "${SUBDIR} without 'src'".
-lib lib-src lisp nt: Makefile
+lib lib-src lisp nt packages: Makefile
        $(MAKE) -C $@ all
 
 # Ideally, VCSWITNESS should be a file that is modified whenever the

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 540a0e902732f5c8ca42fc19896209204e75724a..baaa5e2a186d9f26d20a2b8324373c89c902e688 100644 (file)
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -292,7 +292,10 @@ packages in `package-directory-list'."
       (and (stringp f)
            (equal (file-name-nondirectory f) "site-lisp")
            (push (expand-file-name "elpa" f) result)))
-    (nreverse result))
+    (cons
+     ;; And the inbuild ELPA directory
+     (concat (expand-file-name "../packages" data-directory))
+     (nreverse result)))
   "List of additional directories containing Emacs Lisp packages.
 Each directory name should be absolute.
 

diff --git a/packages/GNUmakefile b/packages/GNUmakefile
new file mode 100644 (file)
index 0000000..73303cb
--- /dev/null
+++ b/packages/GNUmakefile
@@ -0,0 +1,34 @@
+## This file is called GNUmakefile because Makefile is git ignored. Rename
+## when this is autoconf'd
+
+
+EMACS=../src/emacs
+
+DIRS=$(filter-out .,$(subst ./,,$(shell find . -maxdepth 1 -type d)))
+
+## alas "all" is an ELPA package, so this is going to break
+all: $(DIRS)
+
+define package_template
+$(1): $(1)/$(1)-pkg.el
+
+$(1)/$(1)-pkg.el:
+       $$(EMACS) --batch --load package-build.el --eval '(package-build-prepare "$(1)")'
+
+endef
+
+$(foreach dir,$(DIRS),$(eval $(call package_template,$(dir))))
+
+define test_template
+$(1)-test:
+       $$(EMACS) --batch --load package-test.el --eval '(assess-discover-run-and-exit-batch-dir "$(1)")'
+endef
+
+$(foreach dir,$(DIRS),$(eval $(call test_template,$(dir))))
+
+test: $(patsubst %,%-test,$(DIRS))
+
+clean:
+       find . -name "*pkg.el" -exec rm -v {} \;
+       find . -name "*-autoloads.el" -exec rm -v {} \;
+       find . -name "*elc" -exec rm -v {} \;

diff --git a/packages/example/example.el b/packages/example/example.el
new file mode 100644 (file)
index 0000000..992aa0c
--- /dev/null
+++ b/packages/example/example.el
@@ -0,0 +1,11 @@
+;;; example.el --- Do nothing as an example
+
+;; Copyright (c) 2016 Free Software Foundation, Inc.
+
+;; Version: 1.0
+
+;;; Code:
+;;;###autoload
+(defun example-hello-world ()
+  (interactive)
+  (message "hello world"))

diff --git a/packages/package-build.el b/packages/package-build.el
new file mode 100644 (file)
index 0000000..57987b9
--- /dev/null
+++ b/packages/package-build.el
@@ -0,0 +1,134 @@
+(require 'package)
+(require 'lisp-mnt)
+
+;; these functions are stolen from ELPA
+(defun archive--metadata (dir pkg)
+  "Return a list (SIMPLE VERSION DESCRIPTION REQ EXTRAS),
+where SIMPLE is non-nil if the package is simple;
+VERSION is the version string of the simple package;
+DESCRIPTION is the brief description of the package;
+REQ is a list of requirements;
+EXTRAS is an alist with additional metadata.
+
+PKG is the name of the package and DIR is the directory where it is."
+  (let* ((mainfile (expand-file-name (concat pkg ".el") dir))
+         (files (directory-files dir nil "\\`dir\\'\\|\\.el\\'")))
+    (setq files (delete (concat pkg "-pkg.el") files))
+    (setq files (delete (concat pkg "-autoloads.el") files))
+    (cond
+     ((file-exists-p mainfile)
+      (with-temp-buffer
+       (insert-file-contents mainfile)
+       (goto-char (point-min))
+       (if (not (looking-at ";;;.*---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$"))
+            (error "Can't parse first line of %s" mainfile)
+          ;; Grab the other fields, which are not mandatory.
+          (let* ((description (match-string 1))
+                 (version
+                  (or (lm-header "package-version")
+                      (lm-header "version")
+                      (unless (equal pkg "org")
+                        (error "Missing `version' header"))))
+                 (_ (archive--version-to-list version)) ; Sanity check!
+                 (requires-str (lm-header "package-requires"))
+                 (pt (lm-header "package-type"))
+                 (simple (if pt (equal pt "simple") (= (length files) 1)))
+                 (keywords (lm-keywords-list))
+                 (url (or (lm-header "url")
+                          (format archive-default-url-format pkg)))
+                 (req
+                  (if requires-str
+                      (mapcar 'archive--convert-require
+                              (car (read-from-string requires-str))))))
+            (list simple version description req
+                  ;; extra parameters
+                  (list (cons :url url)
+                        (cons :keywords keywords)))))))
+     (t
+      (error "Can't find main file %s file in %s" mainfile dir)))))
+
+;; PWL: this is changed to give a clean entry point
+(defun archive--refresh-pkg-file (directory)
+  (let* ((dir directory)
+         (pkg (file-name-nondirectory dir)))
+    (apply #'archive--write-pkg-file dir pkg
+           (cdr (archive--metadata dir pkg)))))
+
+
+(defun archive--write-pkg-file (pkg-dir name version desc requires extras)
+  (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\n"
+                    name)
+            (prin1-to-string
+              (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 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)))
+
+(defconst archive-default-url-format "http://elpa.gnu.org/packages/%s.html")
+(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--convert-require (elt)
+  (list (car elt)
+       (archive--version-to-list (car (cdr elt)))))
+
+
+(defun package-build-dir (pkg)
+  (concat default-directory pkg))
+
+;; So this one does the business during build
+(defun package-build-prepare (dir)
+  (let ((descr
+           (package-desc-create :name (make-symbol dir)))
+          (location (package-build-dir dir)))
+      (archive--refresh-pkg-file location)
+      (setq descr (package-load-descriptor location))
+      (package-generate-autoloads (package-desc-name descr) location)
+      (package-activate descr)
+      (package--compile descr)))
+
+
+;; and this one does the business during the load
+(defun test-load (dir)
+  (setq descr
+        (package-load-descriptor
+         (test-dir dir)))
+  (package--load-files-for-activation descr nil))
+
+;; (test-prepare "all")
+;; (test-load "all")
+
+;; (test-prepare "metar")
+;; (test-load "metar")

diff --git a/packages/package-test.el b/packages/package-test.el
new file mode 100644 (file)
index 0000000..c453f29
--- /dev/null
+++ b/packages/package-test.el
@@ -0,0 +1,56 @@
+(defun assess-discover-tests (directory)
+  "Discover tests in directory.
+
+Tests must conform to one (and only one!) of several naming
+schemes.
+
+ - End with -test.el
+ - End with -tests.el
+ - Start with test-
+ - Any .el file in a directory called test
+ - Any .el file in a directory called tests
+
+Each of these is tried until one matches. So, a top-level file
+called \"blah-test.el\" will prevent discovery of files in a
+tests directory."
+  (or
+   ;; files with
+   (directory-files directory nil ".*-test.el$")
+   (directory-files directory nil ".*-tests.el$")
+   (directory-files directory nil "test-.*.el$")
+   (let ((dir-test
+          (concat directory "test/")))
+     (when (file-exists-p dir-test)
+       (mapcar
+        (lambda (file)
+          (concat dir-test file))
+        (directory-files dir-test nil ".*.el"))))
+   (let ((dir-tests
+          (concat directory "tests/")))
+     (when (file-exists-p dir-tests)
+       (mapcar
+        (lambda (file)
+          (concat dir-tests file))
+        (directory-files dir-tests nil ".*.el"))))))
+
+(defun assess-discover--load-all-tests (directory)
+  (mapc
+   'load
+   (assess-discover-tests directory)))
+
+(defun assess-discover-load-tests ()
+  (interactive)
+  (assess-discover--load-all-tests default-directory))
+
+;;;###autoload
+(defun assess-discover-run-batch (&optional selector)
+  (assess-discover--load-all-tests default-directory)
+  (ert-run-tests-batch selector))
+
+;;;###autoload
+(defun assess-discover-run-and-exit-batch (&optional selector)
+  (assess-discover-run-and-exit-batch-dir default-directory))
+
+(defun assess-discover-run-and-exit-batch-dir (directory &optional selector)
+  (assess-discover--load-all-tests directory)
+  (ert-run-tests-batch-and-exit selector))