[Emacs-diffs] feature/integrated-elpa dad684e 10/23: Refactor new files

[Phillip Lord]

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

    Refactor new files
---
 packages/admin/assess-discover.el  |   63 +++++++++++++++++++
 packages/admin/package-archive.el  |  119 ++++++++++++++++++++++++++++++++++++
 packages/admin/package-build.el    |   15 +++++
 packages/admin/package-makefile.el |   28 +++++++++
 packages/gnumakefile.mk            |    6 ++
 5 files changed, 231 insertions(+)

diff --git a/packages/admin/assess-discover.el 
b/packages/admin/assess-discover.el
new file mode 100644
index 0000000..cbbbfb3
--- /dev/null
+++ b/packages/admin/assess-discover.el
@@ -0,0 +1,63 @@
+;; This is a hacked version, needs to be merged in with main (probably
+;; this version is correct!)
+
+(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)
+  (let ((loads
+         (assess-discover-tests directory)))
+    (mapc
+     'load
+     loads)))
+
+(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
+   (concat default-directory
+           directory))
+  (ert-run-tests-batch-and-exit selector))
diff --git a/packages/admin/package-archive.el 
b/packages/admin/package-archive.el
new file mode 100644
index 0000000..3942e08
--- /dev/null
+++ b/packages/admin/package-archive.el
@@ -0,0 +1,119 @@
+(require 'package)
+(require 'lisp-mnt)
+
+;; these functions are stolen from ELPA and need be de-duplicated
+(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)))))
+
+(defun archive--refresh-pkg-file ()
+  (let* ((dir (directory-file-name default-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)))))
+
+
+
+;; PWL: this is my addition because it gives a good entry point
+(defun archive-refresh-pkg-file (directory)
+  (let* ((dir (directory-file-name directory))
+         (pkg (file-name-nondirectory dir)))
+    (apply #'archive--write-pkg-file dir pkg
+           (cdr (archive--metadata dir pkg)))))
+
+
+;; TODO:
+;; URLs being added are just wrong
+;; not namespace clean
+
+(provide 'package-archive)
diff --git a/packages/admin/package-build.el b/packages/admin/package-build.el
new file mode 100644
index 0000000..05b246c
--- /dev/null
+++ b/packages/admin/package-build.el
@@ -0,0 +1,15 @@
+(require 'package-archive)
+
+(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)))
diff --git a/packages/admin/package-makefile.el 
b/packages/admin/package-makefile.el
new file mode 100644
index 0000000..c832350
--- /dev/null
+++ b/packages/admin/package-makefile.el
@@ -0,0 +1,28 @@
+(defvar package-makefile-archives
+  '("core")
+  "List of directories with packages in them.
+
+Directories can be either relative to the \"packages\" directory
+or absolute. The order is important because we want to only build
+packages which occur earlier in the list.")
+
+(defvar package-makefile--packages-seen nil
+  "List of packages we have already seen.")
+
+(defun package-makefile--package-dirs (directory)
+  (directory-files directory nil "[^.].*"))
+
+;; example: core/example/example-pkg.el
+;; core/example/example-pkg.el
+;;     $(EMACS) --batch --load package-build.el --eval '(package-build-prepare 
"core/example"")'
+
+;; core: core/core-pkg.el
+
+;; core/core-pkg.el:
+
+;;     $(EMACS) --batch --load package-build.el --eval '(package-build-prepare 
"core")'
+
+;; core-test:
+;;     $(EMACS) --batch --load package-test.el --eval 
'(assess-discover-run-and-exit-batch-dir "core")'
+
+;; Rest of core not done yet
diff --git a/packages/admin/package-test.el b/packages/admin/package-test.el
new file mode 100644
index 0000000..e69de29
diff --git a/packages/gnumakefile.mk b/packages/gnumakefile.mk
new file mode 100644
index 0000000..a6f350a
--- /dev/null
+++ b/packages/gnumakefile.mk
@@ -0,0 +1,6 @@
+example: core/example/example-pkg.el
+
+core/example/example-pkg.el:
+       $(EMACS) --batch --directory=admin \
+               --load admin/package-build.el \
+               --eval '(package-build-prepare "core/example"")'