From dad684e2d2b8e9c0646a17b86660a03542be651f Mon Sep 17 00:00:00 2001 From: Phillip Lord Date: Tue, 13 Sep 2016 09:37:21 +0100 Subject: [PATCH] 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/admin/package-test.el | 0 packages/gnumakefile.mk | 6 ++ 6 files changed, 231 insertions(+) create mode 100644 packages/admin/assess-discover.el create mode 100644 packages/admin/package-archive.el create mode 100644 packages/admin/package-build.el create mode 100644 packages/admin/package-makefile.el create mode 100644 packages/admin/package-test.el create mode 100644 packages/gnumakefile.mk diff --git a/packages/admin/assess-discover.el b/packages/admin/assess-discover.el new file mode 100644 index 00000000000..cbbbfb31fb7 --- /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 00000000000..3942e080455 --- /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 00000000000..05b246c57e8 --- /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 00000000000..c83235099e4 --- /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 00000000000..e69de29bb2d diff --git a/packages/gnumakefile.mk b/packages/gnumakefile.mk new file mode 100644 index 00000000000..a6f350a227e --- /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"")' -- 2.39.5