github/melpa
1
0
Fork 0
mirror of https://github.com/correl/melpa.git synced 2024-11-24 19:19:52 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #1839 from Fanael/master

Browse source 
Enable stable package building for Mercurial.
This commit is contained in:
Steve Purcell 2014-07-11 18:33:27 +01:00
commit c4d5630e19
1 changed files with 38 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
package-build.el
View file

@ -151,15 +151,19 @@ function for access to this function")
(concat (format-time-string "%Y%m%d." time) (concat (format-time-string "%Y%m%d." time)
(format "%d" (or (string-to-number (format-time-string "%H%M" time)) 0))))) (format "%d" (or (string-to-number (format-time-string "%H%M" time)) 0)))))
(defun pb/string-match-all (regex str &optional group) (defun pb/string-match-all (regex str &rest groups)
"Find every match for `REGEX' within `STR', returning a list containing the full match string and match for group `GROUP'. "Find every match for `REGEX' within `STR', returning a list containing the full match string and match for groups `GROUPS'.
The return list is of the form ((FULL GROUP) ...) where FULL is the complete regexp match and GROUP is the regex group specified by the `GROUP' argument. If `GROUP' is nil then FULL and GROUP will be identical." The return list is of the form ((FULL GROUP1 GROUP2 ...) ...) where FULL is the complete regexp match and GROUP1, GROUP2, ... are the regex groups specified by the `GROUPS' argument. If `GROUPS' is nil then FULL and GROUP1 will be identical."
(let (result (let (result
(pos 0) (pos 0)
(group (or group 0))) (groups (or groups '(0))))
(while (string-match regex str pos) (while (string-match regex str pos)
(push (list (match-string 0 str) (match-string group str)) result) (push (cons (match-string 0 str) (mapcar
(setq pos (match-end group))) (lambda (group)
(match-string group str))
groups))
result)
(setq pos (match-end 0)))
result)) result))
(defun pb/find-parse-time (regex &optional bound) (defun pb/find-parse-time (regex &optional bound)
@ -171,14 +175,14 @@ The return list is of the form ((FULL GROUP) ...) where FULL is the complete reg
"Returns true if STR is a valid version, otherwise return nil." "Returns true if STR is a valid version, otherwise return nil."
(ignore-errors (version-to-list str))) (ignore-errors (version-to-list str)))
(defun pb/find-tag-version-newest (regex &optional bound) (defun pb/find-tag-version-newest (regex &optional bound &rest additional-groups)
"Find the newest version matching REGEX, optionally looking only as far as BOUND." "Find the newest version matching REGEX, optionally looking only as far as BOUND."
(let* ((text (buffer-substring-no-properties (let* ((text (buffer-substring-no-properties
(or bound (point-min)) (point))) (or bound (point-min)) (point)))
(tags (cl-remove-if-not (tags (cl-remove-if-not
(lambda (tag-version) (lambda (tag-version)
(pb/valid-version-string (cadr tag-version))) (pb/valid-version-string (cadr tag-version)))
(pb/string-match-all regex text 1)))) (apply 'pb/string-match-all regex text 1 additional-groups))))
(car (nreverse (sort tags (lambda (v1 v2) (car (nreverse (sort tags (lambda (v1 v2)
(version< (cadr v1) (cadr v2)))))))) (version< (cadr v1) (cadr v2))))))))
@ -526,21 +530,32 @@ Return a cons cell whose `car' is the root and whose `cdr' is the repository."
(defun pb/checkout-hg (name config dir) (defun pb/checkout-hg (name config dir)
"Check package NAME with config CONFIG out of hg into DIR." "Check package NAME with config CONFIG out of hg into DIR."
(unless package-build-stable (let ((repo (plist-get config :url)))
(let ((repo (plist-get config :url))) (with-current-buffer (get-buffer-create "*package-build-checkout*")
(with-current-buffer (get-buffer-create "*package-build-checkout*") (goto-char (point-max))
(goto-char (point-max)) (cond
(cond ((and (file-exists-p (expand-file-name ".hg" dir))
((and (file-exists-p (expand-file-name ".hg" dir)) (string-equal (pb/hg-repo dir) repo))
(string-equal (pb/hg-repo dir) repo)) (pb/princ-exists dir)
(pb/princ-exists dir) (pb/run-process dir "hg" "pull")
(pb/run-process dir "hg" "pull") (pb/run-process dir "hg" "update"))
(pb/run-process dir "hg" "update")) (t
(t (when (file-exists-p dir)
(when (file-exists-p dir) (delete-directory dir t))
(delete-directory dir t)) (pb/princ-checkout repo dir)
(pb/princ-checkout repo dir) (pb/run-process nil "hg" "clone" repo dir)))
(pb/run-process nil "hg" "clone" repo dir))) (if package-build-stable
(let* ((bound (goto-char (point-max)))
(tag-version (and (pb/run-process dir "hg" "tags")
(or (pb/find-tag-version-newest
"^\\(?:v[.-]?\\)?\\([0-9]+[^ \t\n]*\\)[ \t]*[0-9]+:\\([[:xdigit:]]+\\)$"
bound
2)
(error
"No valid stable versions found for %s"
name)))))
(pb/run-process dir "hg" "update" (nth 2 tag-version))
(cadr tag-version))
(apply 'pb/run-process dir "hg" "log" "--style" "compact" "-l1" (apply 'pb/run-process dir "hg" "log" "--style" "compact" "-l1"
(pb/expand-source-file-list dir config)) (pb/expand-source-file-list dir config))
(pb/find-parse-time (pb/find-parse-time