[Emacs-diffs] feature/integrated-elpa 6b13eac 03/23: Initial Support for ELPA packages in core

[Phillip Lord]

branch: feature/integrated-elpa
commit 6b13eacd522ce0a7867415ed9543e6a13ab3cd78
Author: Phillip Lord <address@hidden>
Commit: Phillip Lord <address@hidden>

    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.
---
 Makefile.in                 |    4 +-
 lisp/emacs-lisp/package.el  |    5 +-
 packages/GNUmakefile        |   34 +++++++++++
 packages/example/example.el |   11 ++++
 packages/package-build.el   |  134 +++++++++++++++++++++++++++++++++++++++++++
 packages/package-test.el    |   56 ++++++++++++++++++
 6 files changed, 241 insertions(+), 3 deletions(-)

diff --git a/Makefile.in b/Makefile.in
index 7aac403..3381387 100644
--- 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 540a0e9..baaa5e2 100644
--- 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
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
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
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
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))