From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Philip Kaludercic Newsgroups: gmane.emacs.devel Subject: Re: feature/package+vc 04c4c578c7 3/4: Allow for packages to be installed directly from VCS Date: Sun, 30 Oct 2022 13:06:30 +0000 Message-ID: <87ilk1bgvd.fsf@posteo.net> References: <164484721900.31751.1453162457552427931@vcs2.savannah.gnu.org> <834jw33rmx.fsf@gnu.org> <87pmer0xtz.fsf@posteo.net> <83wn8z2aze.fsf@gnu.org> <878rle1i0k.fsf@posteo.net> <87ilkelc10.fsf@posteo.net> <878rl6syg8.fsf@posteo.net> <87zgdjqcu0.fsf@posteo.net> <87zgdivc3f.fsf@posteo.net> <874jvqv2u3.fsf@posteo.net> <875yg6qtbl.fsf@posteo.net> <87ilk33lqk.fsf@posteo.net> <87mt9epqlk.fsf@posteo.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="38454"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Richard Stallman , emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org+ged-emacs-devel=m.gmane-mx.org@gnu.org Sun Oct 30 14:07:35 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1op82I-0009nX-7L for ged-emacs-devel@m.gmane-mx.org; Sun, 30 Oct 2022 14:07:34 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1op81W-0005if-4J; Sun, 30 Oct 2022 09:06:46 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1op81U-0005hz-LJ for emacs-devel@gnu.org; Sun, 30 Oct 2022 09:06:44 -0400 Original-Received: from mout01.posteo.de ([185.67.36.65]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1op81R-0004On-NI for emacs-devel@gnu.org; Sun, 30 Oct 2022 09:06:44 -0400 Original-Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id C13A2240028 for ; Sun, 30 Oct 2022 14:06:39 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1667135199; bh=hnlW+4Saek6/TNsuvv2TyUZNiYVeGq/sRosREDEINRE=; h=From:To:Cc:Subject:Autocrypt:Date:From; b=hRpRY7rj2/zb8Jm0RyekocbIca15TUl3KSGSYzanQgtgGD0UOl/PXyhd37RxXdEwb 0pZDujojqbJ2LpvrIHwjv1Dvliswx4A6VzNELI+P0agsijKjjVOWUwcyrkaNXDo6Eh UP+EoJP6qLJf6dQJHM+vJV2csmGpzJensyoji63D/djct4P+V3HBA8nq6eiedv026X kafE9gP+Jq8heqOZAjIjUIAiLVj3/kIm0vP4n09mmk7l7+YLOfnCzujGtYp0HuI42L uMsvUvM3onjMdKyzq0T6jHHpoSEoWYa6Og5M5dFWtbkix601cXwqTG9lMx2NCljfxi uWyUgiHzY4Yjg== Original-Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4N0c4G5DsTz9rxG; Sun, 30 Oct 2022 14:06:35 +0100 (CET) In-Reply-To: (Stefan Monnier's message of "Sat, 29 Oct 2022 12:57:49 -0400") Autocrypt: addr=philipk@posteo.net; prefer-encrypt=nopreference; keydata= mDMEYHHqUhYJKwYBBAHaRw8BAQdAp3GdmYJ6tm5McweY6dEvIYIiry+Oz9rU4MH6NHWK0Ee0QlBo aWxpcCBLYWx1ZGVyY2ljIChnZW5lcmF0ZWQgYnkgYXV0b2NyeXB0LmVsKSA8cGhpbGlwa0Bwb3N0 ZW8ubmV0PoiQBBMWCAA4FiEEDM2H44ZoPt9Ms0eHtVrAHPRh1FwFAmBx6lICGwMFCwkIBwIGFQoJ CAsCBBYCAwECHgECF4AACgkQtVrAHPRh1FyTkgEAjlbGPxFchvMbxzAES3r8QLuZgCxeAXunM9gh io0ePtUBALVhh9G6wIoZhl0gUCbQpoN/UJHI08Gm1qDob5zDxnIHuDgEYHHqUhIKKwYBBAGXVQEF AQEHQNcRB+MUimTMqoxxMMUERpOR+Q4b1KgncDZkhrO2ql1tAwEIB4h4BBgWCAAgFiEEDM2H44Zo Pt9Ms0eHtVrAHPRh1FwFAmBx6lICGwwACgkQtVrAHPRh1Fw1JwD/Qo7kvtib8jy7puyWrSv0MeTS g8qIxgoRWJE/KKdkCLEA/jb9b9/g8nnX+UcwHf/4VfKsjExlnND3FrBviXUW6NcB Received-SPF: pass client-ip=185.67.36.65; envelope-from=philipk@posteo.net; helo=mout01.posteo.de X-Spam_score_int: -43 X-Spam_score: -4.4 X-Spam_bar: ---- X-Spam_report: (-4.4 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: "Emacs-devel" Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:298811 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: >>> We're not there yet, but the above adds info which we >>> can (and do in `elpa-admin.el`) extract from the VCS, so it's going >>> "backward". IOW, it's making things worse rather than better. >> >> You mean the addition of :release-rev, right? > > Yes. > >> Yes, it could be extracted from the VCS, but finding a generic system >> is tricky as you have mentioned. How about a new VC method >> `last-change' that takes a region and returns the last revision that >> affected it. Any backend that supports `annotate' ought to be able to >> determine it, right? > > Fine by me. As mentioned earlier, there's a good chance that if you use > a different VCS than Git, this method will sometimes end up selecting > a different commit than `elpa-admin.el`, but if we insist on supporting > a local VCS different from the one used by `elpa-admin.el`, then we > probably have to live with that. I guess so. Here is a possible patch that should behave close enough to elpa-admin.el using "blame" (an obvious exception is the missing handler for the new :merge property, but I have been wondering if it might also be fair to always add "--first-parent" for Git). The default handler just wraps vc-annotate, so it is a bit more fragile. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Extract-last-source-package-release-from-local-VCS-d.patch >From 30f1e7c1e93dda496412f76f70b2f49b30407b11 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 30 Oct 2022 11:43:11 +0100 Subject: [PATCH] Extract last source package release from local VCS data * lisp/emacs-lisp/package-vc.el (package-vc-archive-spec-alist): Unmention :release-rev (package-vc-desc->spec): Fall back on other archives if a specification is missing. (package-vc-main-file): Add new function, copying the behaviour of elpa-admin.el. (package-vc-generate-description-file): Use 'package-vc-main-file'. (package-vc-unpack): Handle special value ':last-release'. (package-vc-release-rev): Add new function using 'last-change'. (package-vc-install): Pass ':last-release' as REV instead of a release. * lisp/vc/vc-git.el (vc-git-last-change): Add Git 'last-change' implementation. * lisp/vc/vc.el (vc-default-last-change): Add default 'last-change' implementation. This attempts to replicate the behaviour of elpa-admin.el's "elpaa--get-last-release-commit". --- lisp/emacs-lisp/package-vc.el | 88 +++++++++++++++++++++++------------ lisp/vc/vc-git.el | 17 +++++++ lisp/vc/vc.el | 18 +++++++ 3 files changed, 94 insertions(+), 29 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 3816c6152d..6597989777 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -139,12 +139,6 @@ package-vc-archive-spec-alist metadata. If not given, the assumed default is the package named with \".el\" concatenated to the end. - `:release-rev' (string) - -A revision string indicating the revision used for the current -release in the package archive. If missing or nil, no release -was made. - `:vc-backend' (symbol) A symbol indicating what the VC backend to use for cloning a @@ -179,8 +173,10 @@ package-vc-desc->spec name for PKG-DESC." (alist-get (or name (package-desc-name pkg-desc)) - (alist-get (intern (package-desc-archive pkg-desc)) - package-vc-archive-spec-alist) + (if (package-desc-archive pkg-desc) + (alist-get (intern (package-desc-archive pkg-desc)) + package-vc-archive-spec-alist) + (mapcan #'append (mapcar #'cdr package-vc-archive-spec-alist))) nil nil #'string=)) (define-inline package-vc-query-spec (pkg-desc prop) @@ -258,6 +254,20 @@ package-vc-version return it finally return "0")) +(defun package-vc-main-file (pkg-desc) + "Return the main file for PKG-DESC." + (cl-assert (package-vc-p pkg-desc)) + (let ((pkg-spec (package-vc-desc->spec pkg-desc))) + (or (plist-get pkg-spec :main-file) + (expand-file-name + (format "%s.el" (package-desc-name pkg-desc)) + (file-name-concat + (or (package-desc-dir pkg-desc) + (expand-file-name + (package-desc-name pkg-desc) + package-user-dir)) + (plist-get pkg-spec :lisp-dir)))))) + (defun package-vc-generate-description-file (pkg-desc pkg-file) "Generate a package description file for PKG-DESC. The output is written out into PKG-FILE." @@ -265,18 +275,13 @@ package-vc-generate-description-file ;; Infer the subject if missing. (unless (package-desc-summary pkg-desc) (setf (package-desc-summary pkg-desc) - (or (package-desc-summary pkg-desc) - (and-let* ((pkg (cadr (assq name package-archive-contents)))) - (package-desc-summary pkg)) - (and-let* ((pkg-spec (package-vc-desc->spec pkg-desc)) - (main-file (plist-get pkg-spec :main-file))) - (lm-summary main-file)) - (and-let* ((main-file (expand-file-name - (format "%s.el" name) - (package-desc-dir pkg-desc))) - ((file-exists-p main-file))) - (lm-summary main-file)) - package--default-summary))) + (let ((main-file (package-vc-main-file pkg-desc))) + (or (package-desc-summary pkg-desc) + (and-let* ((pkg (cadr (assq name package-archive-contents)))) + (package-desc-summary pkg)) + (and main-file (file-exists-p main-file) + (lm-summary main-file)) + package--default-summary)))) (let ((print-level nil) (print-quoted t) (print-length nil)) @@ -424,9 +429,16 @@ package-vc-unpack nil nil #'string=) :vc-backend) package-vc-default-backend))) - (unless (vc-clone url backend repo-dir (or rev branch)) + (unless (vc-clone url backend repo-dir + (or (and (not (eq rev :last-release)) rev) branch)) (error "Failed to clone %s from %s" name url)))) + ;; Check out the latest release if requested + (when (eq rev :last-release) + (if-let ((release-rev (package-vc-release-rev pkg-desc))) + (vc-retrieve-tag pkg-dir release-rev) + (message "No release revision was found, continuing..."))) + (unless (eq pkg-dir repo-dir) ;; Link from the right position in `repo-dir' to the package ;; directory in the ELPA store. @@ -466,6 +478,22 @@ package-vc--archives-initialize (unless package-vc-archive-data-alist (package-vc--download-and-read-archives))) +(defun package-vc-release-rev (pkg-desc) + "Find the latest revision that bumps the \"Version\" tag for PKG-DESC. +If no such revision can be found, return nil." + (with-current-buffer (find-file-noselect (package-vc-main-file pkg-desc)) + (vc-buffer-sync) + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (when (re-search-forward (concat (lm-get-header-re "version") ".*$") + (lm-code-start) t) + (ignore-error vc-not-supported + (vc-call-backend (vc-backend (buffer-file-name)) + 'last-change + (match-beginning 0) + (match-end 0)))))))) + ;;;###autoload (defun package-vc-install (name-or-url &optional name rev backend) "Fetch the source of NAME-OR-URL. @@ -477,9 +505,11 @@ package-vc-install metadata will be consulted for the URL. An explicit revision can be requested using REV. If the command is invoked with a prefix argument, the revision used for the last release in the package -archive is used. If a NAME-OR-URL is a URL, that is to say a -string, the VC backend used to clone the repository can be set by -BACKEND. If missing, `package-vc-guess-backend' will be used." +archive is used. This can also be reproduced by passing the +special value `:last-release' as REV. If a NAME-OR-URL is a URL, +that is to say a string, the VC backend used to clone the +repository can be set by BACKEND. If missing, +`package-vc-guess-backend' will be used." (interactive (progn ;; Initialize the package system to get the list of package @@ -490,11 +520,7 @@ package-vc-install "Fetch package source (name or URL): " packages)) (name (file-name-base input))) (list input (intern (string-remove-prefix "emacs-" name)) - (and current-prefix-arg - (or (package-vc-query-spec - (cadr (assoc input package-archive-contents #'string=)) - :release-rev) - (user-error "No release revision was found"))))))) + (and current-prefix-arg :last-release))))) (package-vc--archives-initialize) (cond ((and-let* ((stringp name-or-url) @@ -511,6 +537,10 @@ package-vc-install (setf (package-desc-kind copy) 'vc) copy) (or (package-vc-desc->spec (cadr desc)) + (and-let* ((extras (package-desc-extras (cadr desc))) + (url (alist-get :url extras)) + (backend (package-vc-guess-backend url))) + (list :vc-backend backend :url url)) (user-error "Package has no VC data")) rev))) ((user-error "Unknown package to fetch: %s" name-or-url)))) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 6137ce75ce..cd62effd08 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1632,6 +1632,23 @@ vc-git-annotate-extract-revision-at-line (expand-file-name fname (vc-git-root default-directory)))) revision))))) +(defun vc-git-last-change (from to) + (vc-buffer-sync) + (let ((file (file-relative-name + (buffer-file-name) + (vc-git-root (buffer-file-name)))) + (start (line-number-at-pos from t)) + (end (line-number-at-pos to t))) + (with-temp-buffer + (when (vc-git--out-ok + "blame" "--porcelain" + (format "-L%d,%d" start end) + file) + (goto-char (point-min)) + (save-match-data + (when (looking-at "\\`\\([[:alnum:]]+\\)[[:space:]]+") + (match-string 1))))))) + ;;; TAG/BRANCH SYSTEM (declare-function vc-read-revision "vc" diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 38209ef39e..c8d28c144b 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -448,6 +448,11 @@ ;; - mergebase (rev1 &optional rev2) ;; ;; Return the common ancestor between REV1 and REV2 revisions. +;; +;; - last-change (from to) +;; +;; Return the most recent revision that made a change between FROM +;; and TO. ;; TAG/BRANCH SYSTEM ;; @@ -3584,6 +3589,19 @@ vc-clone remote directory rev))) (throw 'ok res))))))) +(declare-function log-view-current-tag "log-view" (&optional pos)) +(defun vc-default-last-change (_backend from to) + "Default `last-change' implementation. +FROM and TO are used as region markers" + (save-window-excursion + (let* ((buf (window-buffer (vc-region-history from to))) + (proc (get-buffer-process buf))) + (cl-assert (processp proc)) + (while (accept-process-output proc)) + (with-current-buffer buf + (prog1 (log-view-current-tag) + (kill-buffer)))))) + ;; These things should probably be generally available -- 2.38.0 --=-=-= Content-Type: text/plain Invoking `package-vc-install' with a prefix argument will now check out the specific commit that bumps the version tag. At least for git, the slight problem here is that this means the head is in a detached state, not connected to any specific branch. I don't know if there is any elegant solution to this problem, or if it should even be "solved". --=-=-=--