[bot] "built_in_updates" Sat Aug 27 08:46:27 UTC 2022
This commit is contained in:
parent
d6c3482663
commit
1ed08595bf
3 changed files with 72 additions and 48 deletions
|
@ -171,6 +171,12 @@ disallowed."
|
||||||
(car (process-lines "hg" "config" "extensions.purge")))))
|
(car (process-lines "hg" "config" "extensions.purge")))))
|
||||||
(and value (not (string-prefix-p "!" value)))))
|
(and value (not (string-prefix-p "!" value)))))
|
||||||
|
|
||||||
|
(defvar package-build--inhibit-fetch nil
|
||||||
|
"Whether to inhibit fetching. Useful for testing purposes.")
|
||||||
|
|
||||||
|
(defvar package-build--inhibit-checkout nil
|
||||||
|
"Whether to inhibit checkout. Useful for testing purposes.")
|
||||||
|
|
||||||
;;; Generic Utilities
|
;;; Generic Utilities
|
||||||
|
|
||||||
(defun package-build--message (format-string &rest args)
|
(defun package-build--message (format-string &rest args)
|
||||||
|
@ -195,13 +201,8 @@ Otherwise do nothing. FORMAT-STRING and ARGS are as per that function."
|
||||||
version)))
|
version)))
|
||||||
|
|
||||||
(defun package-build-get-timestamp-version (rcp)
|
(defun package-build-get-timestamp-version (rcp)
|
||||||
(let* ((rev (and (cl-typep rcp 'package-git-recipe)
|
(pcase-let ((`(,hash . ,time) (package-build--get-timestamp rcp)))
|
||||||
(or (oref rcp commit)
|
(cons hash
|
||||||
(when-let ((branch (oref rcp branch)))
|
|
||||||
(concat "origin/" branch))
|
|
||||||
"origin/HEAD")))
|
|
||||||
(time (package-build--get-timestamp rcp rev)))
|
|
||||||
(cons (package-build--get-commit rcp rev)
|
|
||||||
;; We remove zero-padding of the HH portion, as
|
;; We remove zero-padding of the HH portion, as
|
||||||
;; that is lost when stored in archive-contents.
|
;; that is lost when stored in archive-contents.
|
||||||
(concat (format-time-string "%Y%m%d." time t)
|
(concat (format-time-string "%Y%m%d." time t)
|
||||||
|
@ -278,10 +279,6 @@ is used instead."
|
||||||
(package-build--message "Fetcher: %s" (package-recipe--fetcher rcp))
|
(package-build--message "Fetcher: %s" (package-recipe--fetcher rcp))
|
||||||
(package-build--message "Source: %s\n" (package-recipe--upstream-url rcp)))
|
(package-build--message "Source: %s\n" (package-recipe--upstream-url rcp)))
|
||||||
|
|
||||||
(cl-defmethod package-build--checkout-1 :before ((_rcp package-recipe) rev)
|
|
||||||
(when rev
|
|
||||||
(package-build--message "Checking out %s" rev)))
|
|
||||||
|
|
||||||
;;;; Git
|
;;;; Git
|
||||||
|
|
||||||
(cl-defmethod package-build--checkout ((rcp package-git-recipe))
|
(cl-defmethod package-build--checkout ((rcp package-git-recipe))
|
||||||
|
@ -293,13 +290,14 @@ is used instead."
|
||||||
(cond
|
(cond
|
||||||
((and (file-exists-p (expand-file-name ".git" dir))
|
((and (file-exists-p (expand-file-name ".git" dir))
|
||||||
(string-equal (package-build--used-url rcp) url))
|
(string-equal (package-build--used-url rcp) url))
|
||||||
(package-build--message "Updating %s" dir)
|
(unless package-build--inhibit-fetch
|
||||||
(package-build--run-process dir nil "git" "fetch" "-f" "--all" "--tags")
|
(package-build--message "Updating %s" dir)
|
||||||
;; We might later checkout "origin/HEAD". Sadly "git fetch"
|
(package-build--run-process dir nil "git" "fetch" "-f" "--all" "--tags")
|
||||||
;; cannot be told to keep it up-to-date, so we have to make
|
;; We might later checkout "origin/HEAD". Sadly "git fetch"
|
||||||
;; a second request.
|
;; cannot be told to keep it up-to-date, so we have to make
|
||||||
(package-build--run-process dir nil "git" "remote" "set-head"
|
;; a second request.
|
||||||
"origin" "--auto"))
|
(package-build--run-process dir nil "git" "remote" "set-head"
|
||||||
|
"origin" "--auto")))
|
||||||
(t
|
(t
|
||||||
(when (file-exists-p dir)
|
(when (file-exists-p dir)
|
||||||
(delete-directory dir t))
|
(delete-directory dir t))
|
||||||
|
@ -318,25 +316,32 @@ is used instead."
|
||||||
version)))
|
version)))
|
||||||
|
|
||||||
(cl-defmethod package-build--checkout-1 ((rcp package-git-recipe) rev)
|
(cl-defmethod package-build--checkout-1 ((rcp package-git-recipe) rev)
|
||||||
(let ((dir (package-recipe--working-tree rcp)))
|
(unless package-build--inhibit-checkout
|
||||||
(package-build--run-process dir nil "git" "reset" "--hard" rev)
|
(package-build--message "Checking out %s" rev)
|
||||||
(package-build--run-process dir nil "git" "submodule" "sync" "--recursive")
|
(let ((dir (package-recipe--working-tree rcp)))
|
||||||
(package-build--run-process dir nil "git" "submodule" "update"
|
(package-build--run-process dir nil "git" "reset" "--hard" rev))))
|
||||||
"--init" "--recursive")))
|
|
||||||
|
|
||||||
(cl-defmethod package-build--list-tags ((rcp package-git-recipe))
|
(cl-defmethod package-build--list-tags ((rcp package-git-recipe))
|
||||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||||
(process-lines "git" "tag")))
|
(process-lines "git" "tag")))
|
||||||
|
|
||||||
(cl-defmethod package-build--get-timestamp ((rcp package-git-recipe) rev)
|
(cl-defmethod package-build--get-timestamp ((rcp package-git-recipe))
|
||||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
(pcase-let*
|
||||||
;; `package-build-expand-files-spec' expects REV to be checked out.
|
((default-directory (package-recipe--working-tree rcp))
|
||||||
(package-build--checkout-1 rcp rev)
|
(commit (oref rcp commit))
|
||||||
(string-to-number
|
(branch (oref rcp branch))
|
||||||
(car (apply #'process-lines
|
(branch (and branch (concat "origin/" branch)))
|
||||||
"git" "log" "-n1" "--first-parent"
|
(rev (or commit branch "origin/HEAD"))
|
||||||
"--pretty=format:%cd" "--date=unix"
|
;; `package-build-expand-files-spec' expects REV to be checked out.
|
||||||
rev "--" (mapcar #'car (package-build-expand-files-spec rcp)))))))
|
(_ (package-build--checkout-1 rcp rev))
|
||||||
|
(`(,hash ,time)
|
||||||
|
(split-string
|
||||||
|
(car (apply #'process-lines
|
||||||
|
"git" "log" "-n1" "--first-parent"
|
||||||
|
"--pretty=format:%H %cd" "--date=unix" rev
|
||||||
|
"--" (mapcar #'car (package-build-expand-files-spec rcp))))
|
||||||
|
" ")))
|
||||||
|
(cons hash (string-to-number time))))
|
||||||
|
|
||||||
(cl-defmethod package-build--get-commit-time ((rcp package-git-recipe) rev)
|
(cl-defmethod package-build--get-commit-time ((rcp package-git-recipe) rev)
|
||||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||||
|
@ -360,9 +365,10 @@ is used instead."
|
||||||
(cond
|
(cond
|
||||||
((and (file-exists-p (expand-file-name ".hg" dir))
|
((and (file-exists-p (expand-file-name ".hg" dir))
|
||||||
(string-equal (package-build--used-url rcp) url))
|
(string-equal (package-build--used-url rcp) url))
|
||||||
(package-build--message "Updating %s" dir)
|
(unless package-build--inhibit-fetch
|
||||||
(package-build--run-process dir nil "hg" "pull")
|
(package-build--message "Updating %s" dir)
|
||||||
(package-build--run-process dir nil "hg" "update"))
|
(package-build--run-process dir nil "hg" "pull")
|
||||||
|
(package-build--run-process dir nil "hg" "update")))
|
||||||
(t
|
(t
|
||||||
(when (file-exists-p dir)
|
(when (file-exists-p dir)
|
||||||
(delete-directory dir t))
|
(delete-directory dir t))
|
||||||
|
@ -374,7 +380,8 @@ is used instead."
|
||||||
version)))
|
version)))
|
||||||
|
|
||||||
(cl-defmethod package-build--checkout-1 ((rcp package-hg-recipe) rev)
|
(cl-defmethod package-build--checkout-1 ((rcp package-hg-recipe) rev)
|
||||||
(when rev
|
(when (and (not package-build--inhibit-checkout) rev)
|
||||||
|
(package-build--message "Checking out %s" rev)
|
||||||
(package-build--run-process (package-recipe--working-tree rcp)
|
(package-build--run-process (package-recipe--working-tree rcp)
|
||||||
nil "hg" "update" rev)))
|
nil "hg" "update" rev)))
|
||||||
|
|
||||||
|
@ -386,15 +393,19 @@ is used instead."
|
||||||
(match-string 0))
|
(match-string 0))
|
||||||
(process-lines "hg" "tags"))))
|
(process-lines "hg" "tags"))))
|
||||||
|
|
||||||
(cl-defmethod package-build--get-timestamp ((rcp package-hg-recipe) rev)
|
(cl-defmethod package-build--get-timestamp ((rcp package-hg-recipe))
|
||||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
(pcase-let*
|
||||||
(string-to-number
|
((default-directory (package-recipe--working-tree rcp))
|
||||||
(car (split-string ; "hgdate" is "<unix-date> <timezone>"
|
(rev nil) ; TODO Respect commit and branch properties.
|
||||||
(car (apply #'process-lines
|
(`(,hash ,time ,_timezone)
|
||||||
"hg" "log" "--limit" "1" "--template" "{date|hgdate}\n"
|
(split-string
|
||||||
`(,@(and rev (list "--rev" rev))
|
(car (apply #'process-lines
|
||||||
,@(mapcar #'car (package-build-expand-files-spec rcp)))))
|
"hg" "log" "--limit" "1"
|
||||||
" ")))))
|
"--template" "{node} {date|hgdate}\n"
|
||||||
|
`(,@(and rev (list "--rev" rev))
|
||||||
|
,@(mapcar #'car (package-build-expand-files-spec rcp)))))
|
||||||
|
" ")))
|
||||||
|
(cons hash (string-to-number time))))
|
||||||
|
|
||||||
(cl-defmethod package-build--get-commit-time ((rcp package-hg-recipe) rev)
|
(cl-defmethod package-build--get-commit-time ((rcp package-hg-recipe) rev)
|
||||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||||
|
|
|
@ -51,8 +51,7 @@
|
||||||
"Create a new recipe for the package named NAME using FETCHER."
|
"Create a new recipe for the package named NAME using FETCHER."
|
||||||
(interactive
|
(interactive
|
||||||
(list (read-string "Package name: ")
|
(list (read-string "Package name: ")
|
||||||
(intern (completing-read "Fetcher: "
|
(intern (completing-read "Fetcher: " package-recipe--fetchers
|
||||||
(list "git" "github" "gitlab" "hg")
|
|
||||||
nil t nil nil "github"))))
|
nil t nil nil "github"))))
|
||||||
(let ((recipe-file (expand-file-name name package-build-recipes-dir)))
|
(let ((recipe-file (expand-file-name name package-build-recipes-dir)))
|
||||||
(when (file-exists-p recipe-file)
|
(when (file-exists-p recipe-file)
|
||||||
|
|
|
@ -69,6 +69,12 @@
|
||||||
(cl-defmethod package-recipe--fetcher ((rcp package-recipe))
|
(cl-defmethod package-recipe--fetcher ((rcp package-recipe))
|
||||||
(substring (symbol-name (eieio-object-class rcp)) 8 -7))
|
(substring (symbol-name (eieio-object-class rcp)) 8 -7))
|
||||||
|
|
||||||
|
(defconst package-recipe--forge-fetchers
|
||||||
|
'(github gitlab codeberg sourcehut))
|
||||||
|
|
||||||
|
(defconst package-recipe--fetchers
|
||||||
|
(append '(git hg) package-recipe--forge-fetchers))
|
||||||
|
|
||||||
;;;; Git
|
;;;; Git
|
||||||
|
|
||||||
(defclass package-git-recipe (package-recipe) ())
|
(defclass package-git-recipe (package-recipe) ())
|
||||||
|
@ -81,6 +87,14 @@
|
||||||
((url-format :initform "https://gitlab.com/%s.git")
|
((url-format :initform "https://gitlab.com/%s.git")
|
||||||
(repopage-format :initform "https://gitlab.com/%s")))
|
(repopage-format :initform "https://gitlab.com/%s")))
|
||||||
|
|
||||||
|
(defclass package-codeberg-recipe (package-git-recipe)
|
||||||
|
((url-format :initform "https://codeberg.org/%s.git")
|
||||||
|
(repopage-format :initform "https://codeberg.org/%s")))
|
||||||
|
|
||||||
|
(defclass package-sourcehut-recipe (package-git-recipe)
|
||||||
|
((url-format :initform "https://git.sr.ht/~%s")
|
||||||
|
(repopage-format :initform "https://git.sr.ht/~%s")))
|
||||||
|
|
||||||
;;;; Mercurial
|
;;;; Mercurial
|
||||||
|
|
||||||
(defclass package-hg-recipe (package-recipe) ())
|
(defclass package-hg-recipe (package-recipe) ())
|
||||||
|
@ -137,7 +151,7 @@ file is invalid, then raise an error."
|
||||||
(cl-assert (memq thing all-keys) nil "Unknown keyword %S" thing)))
|
(cl-assert (memq thing all-keys) nil "Unknown keyword %S" thing)))
|
||||||
(let ((fetcher (plist-get plist :fetcher)))
|
(let ((fetcher (plist-get plist :fetcher)))
|
||||||
(cl-assert fetcher nil ":fetcher is missing")
|
(cl-assert fetcher nil ":fetcher is missing")
|
||||||
(if (memq fetcher '(github gitlab))
|
(if (memq fetcher package-recipe--forge-fetchers)
|
||||||
(progn
|
(progn
|
||||||
(cl-assert (plist-get plist :repo) ":repo is missing")
|
(cl-assert (plist-get plist :repo) ":repo is missing")
|
||||||
(cl-assert (not (plist-get plist :url)) ":url is redundant"))
|
(cl-assert (not (plist-get plist :url)) ":url is redundant"))
|
||||||
|
|
Reference in a new issue