mirror of
https://github.com/correl/melpa.git
synced 2024-11-14 19:19:32 +00:00
Enable stable package building for git.
Builds in the plumbing for checking out stable versions of git/github packages. Contributions by @Bruce-Connor and @Wilfred.
This commit is contained in:
Donald Curtis
parent
a4cba97e11
commit
b350df249c
2 changed files with 217 additions and 183 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -1,5 +1,6 @@
|
|||
/sync
|
||||
/packages/*
|
||||
/packages-stable/*
|
||||
/working/*
|
||||
/epkgs
|
||||
**.elc
|
||||
|
|
|
|||
|
|
@ -137,6 +137,18 @@ function for access to this function")
|
|||
(pb/parse-time (progn (re-search-backward regex bound)
|
||||
(match-string-no-properties 1))))
|
||||
|
||||
(defun pb/valid-version-string (str)
|
||||
"Returns true if STR is a valid version, otherwise return nil."
|
||||
(ignore-errors (version-to-list str)))
|
||||
|
||||
(defun pb/find-parse-version-newest (regex &optional bound)
|
||||
"Find the newest version matching REGEX, optionally looking only as far as BOUND."
|
||||
(let* ((text (buffer-substring-no-properties
|
||||
(or bound (point-min)) (point)))
|
||||
(times (cl-remove-if-not 'pb/valid-version-string
|
||||
(pb/string-match-all regex text 1))))
|
||||
(car (nreverse (sort times 'version<)))))
|
||||
|
||||
(defun pb/find-parse-time-latest (regex &optional bound)
|
||||
"Find the latest timestamp matching REGEX, optionally looking only as far as BOUND."
|
||||
(let* ((text (buffer-substring-no-properties
|
||||
|
|
@ -245,13 +257,14 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
|
|||
|
||||
(defun pb/checkout-wiki (name config dir)
|
||||
"Checkout package NAME with config CONFIG from the EmacsWiki into DIR."
|
||||
(unless package-build-stable
|
||||
(with-current-buffer (get-buffer-create "*package-build-checkout*")
|
||||
(unless (file-exists-p dir)
|
||||
(make-directory dir))
|
||||
(let ((files (or (plist-get config :files)
|
||||
(list (format "%s.el" name))))
|
||||
(default-directory dir))
|
||||
(car (nreverse (sort (mapcar 'pb/grab-wiki-file files) 'string-lessp))))))
|
||||
(car (nreverse (sort (mapcar 'pb/grab-wiki-file files) 'string-lessp)))))))
|
||||
|
||||
(defun pb/darcs-repo (dir)
|
||||
"Get the current darcs repo for DIR."
|
||||
|
|
@ -259,6 +272,7 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
|
|||
|
||||
(defun pb/checkout-darcs (name config dir)
|
||||
"Check package NAME with config CONFIG out of darcs into DIR."
|
||||
(unless package-build-stable
|
||||
(let ((repo (plist-get config :url)))
|
||||
(with-current-buffer (get-buffer-create "*package-build-checkout*")
|
||||
(cond
|
||||
|
|
@ -274,7 +288,7 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
|
|||
(apply 'pb/run-process dir "darcs" "changes" "--max-count" "1"
|
||||
(pb/expand-source-file-list dir config))
|
||||
(pb/find-parse-time
|
||||
"\\([a-zA-Z]\\{3\\} [a-zA-Z]\\{3\\} \\( \\|[0-9]\\)[0-9] [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\} [A-Za-z]\\{3\\} [0-9]\\{4\\}\\)"))))
|
||||
"\\([a-zA-Z]\\{3\\} [a-zA-Z]\\{3\\} \\( \\|[0-9]\\)[0-9] [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\} [A-Za-z]\\{3\\} [0-9]\\{4\\}\\)")))))
|
||||
|
||||
(defun pb/svn-repo (dir)
|
||||
"Get the current svn repo for DIR."
|
||||
|
|
@ -296,6 +310,7 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
|
|||
|
||||
(defun pb/checkout-svn (name config dir)
|
||||
"Check package NAME with config CONFIG out of svn into DIR."
|
||||
(unless package-build-stable
|
||||
(with-current-buffer (get-buffer-create "*package-build-checkout*")
|
||||
(let ((repo (pb/trim (plist-get config :url) ?/))
|
||||
(bound (goto-char (point-max))))
|
||||
|
|
@ -312,7 +327,8 @@ seconds; the server cuts off after 10 requests in 20 seconds.")
|
|||
(apply 'pb/run-process dir "svn" "info"
|
||||
(pb/expand-source-file-list dir config))
|
||||
(or (pb/find-parse-time-latest "Last Changed Date: \\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)" bound)
|
||||
(error "No valid timestamps found!")))))
|
||||
(error "No valid timestamps found!"))))))
|
||||
|
||||
|
||||
(defun pb/cvs-repo (dir)
|
||||
"Get the current CVS root and repository for DIR.
|
||||
|
|
@ -325,6 +341,7 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
|
||||
(defun pb/checkout-cvs (name config dir)
|
||||
"Check package NAME with config CONFIG out of cvs into DIR."
|
||||
(unless package-build-stable
|
||||
(with-current-buffer (get-buffer-create "*package-build-checkout*")
|
||||
(let ((root (pb/trim (plist-get config :url) ?/))
|
||||
(repo (or (plist-get config :module) (symbol-name name)))
|
||||
|
|
@ -354,7 +371,8 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
(or (pb/find-parse-time-latest "date: \\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)" bound)
|
||||
(pb/find-parse-time-latest "date: \\([0-9]\\{4\\}/[0-9]\\{2\\}/[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\);" bound)
|
||||
(error "No valid timestamps found!"))
|
||||
)))
|
||||
))))
|
||||
|
||||
|
||||
(defun pb/git-repo (dir)
|
||||
"Get the current git repo for DIR."
|
||||
|
|
@ -387,13 +405,25 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
(delete-directory dir t))
|
||||
(pb/princ-checkout repo dir)
|
||||
(pb/run-process nil "git" "clone" repo dir)))
|
||||
(if package-build-stable
|
||||
(let ((bound (goto-char (point-max)))
|
||||
version-tag)
|
||||
(pb/run-process dir "git" "tag")
|
||||
(setq version-tag
|
||||
(or (pb/find-parse-version-newest "^\\([^ \t\n]+\\)$" bound)
|
||||
(error "No valid stable versions found for %s" name)))
|
||||
;; Using reset --hard here to comply with what's used for
|
||||
;; unstable, but maybe this should be a checkout?
|
||||
(pb/run-process dir "git" "reset" "--hard" (concat "tags/" version-tag))
|
||||
(pb/run-process dir "git" "submodule" "update" "--init" "--recursive")
|
||||
version-tag)
|
||||
(pb/run-process dir "git" "reset" "--hard"
|
||||
(or commit (concat "origin/" (pb/git-head-branch dir))))
|
||||
(pb/run-process dir "git" "submodule" "update" "--init" "--recursive")
|
||||
(apply 'pb/run-process dir "git" "log" "--first-parent" "-n1" "--pretty=format:'\%ci'"
|
||||
(pb/expand-source-file-list dir config))
|
||||
(pb/find-parse-time
|
||||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)"))))
|
||||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)")))))
|
||||
|
||||
(defun pb/checkout-github (name config dir)
|
||||
"Check package NAME with config CONFIG out of github into DIR."
|
||||
|
|
@ -410,6 +440,7 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
|
||||
(defun pb/checkout-bzr (name config dir)
|
||||
"Check package NAME with config CONFIG out of bzr into DIR."
|
||||
(unless package-build-stable
|
||||
(let ((repo (pb/bzr-expand-repo (plist-get config :url))))
|
||||
(with-current-buffer (get-buffer-create "*package-build-checkout*")
|
||||
(goto-char (point-max))
|
||||
|
|
@ -426,7 +457,7 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
(apply 'pb/run-process dir "bzr" "log" "-l1"
|
||||
(pb/expand-source-file-list dir config))
|
||||
(pb/find-parse-time
|
||||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)"))))
|
||||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)")))))
|
||||
|
||||
(defun pb/hg-repo (dir)
|
||||
"Get the current hg repo for DIR."
|
||||
|
|
@ -434,6 +465,7 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
|
||||
(defun pb/checkout-hg (name config dir)
|
||||
"Check package NAME with config CONFIG out of hg into DIR."
|
||||
(unless package-build-stable
|
||||
(let ((repo (plist-get config :url)))
|
||||
(with-current-buffer (get-buffer-create "*package-build-checkout*")
|
||||
(goto-char (point-max))
|
||||
|
|
@ -451,7 +483,7 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
|
|||
(apply 'pb/run-process dir "hg" "log" "--style" "compact" "-l1"
|
||||
(pb/expand-source-file-list dir config))
|
||||
(pb/find-parse-time
|
||||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)"))))
|
||||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}\\( [+-][0-9]\\{4\\}\\)?\\)")))))
|
||||
|
||||
(defun pb/dump (data file &optional pretty-print)
|
||||
"Write DATA to FILE as a Lisp sexp.
|
||||
|
|
@ -825,7 +857,8 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
|
|||
(make-directory package-build-archive-dir))
|
||||
|
||||
(pb/message "\n;;; %s\n" file-name)
|
||||
(let* ((version (package-build-checkout name rcp pkg-working-dir))
|
||||
(let* ((version (or (package-build-checkout name rcp pkg-working-dir)
|
||||
(error "No valid package version found!")))
|
||||
(default-directory package-build-working-dir)
|
||||
(start-time (current-time))
|
||||
(archive-entry (package-build-package (symbol-name name)
|
||||
|
|
@ -921,7 +954,8 @@ Returns the archive entry for the package."
|
|||
|
||||
|
||||
(pb/copy-package-files files source-dir pkg-tmp-dir)
|
||||
(pb/write-pkg-file (expand-file-name pkg-file
|
||||
(pb/write-pkg-file target-dir
|
||||
(expand-file-name pkg-file
|
||||
(file-name-as-directory pkg-tmp-dir))
|
||||
pkg-info)
|
||||
|
||||
|
|
@ -934,11 +968,10 @@ Returns the archive entry for the package."
|
|||
pkg-dir-name))
|
||||
|
||||
(let ((default-directory source-dir))
|
||||
(pb/write-pkg-readme target-dir
|
||||
(pb/find-package-commentary pkg-source)
|
||||
(pb/write-pkg-readme (pb/find-package-commentary pkg-source)
|
||||
package-name))
|
||||
|
||||
(delete-directory pkg-tmp-dir t)
|
||||
(delete-directory pkg-tmp-dir t nil)
|
||||
(pb/archive-entry pkg-info 'tar)))
|
||||
|
||||
(t (error "Unable to find files matching recipe patterns")))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue