diff options
| author | Philip Kaludercic | 2022-11-06 10:24:56 +0100 |
|---|---|---|
| committer | Philip Kaludercic | 2022-11-17 20:37:28 +0100 |
| commit | 3ff8310cc303a54e52d92dea3f778c7f3422746d (patch) | |
| tree | 797c17e5089d0760a1ec6585f18323e1448bb61e | |
| parent | aadf07f5b80467a3ca5485bc0eae7fbcb3fa0e48 (diff) | |
| download | emacs-3ff8310cc303a54e52d92dea3f778c7f3422746d.tar.gz emacs-3ff8310cc303a54e52d92dea3f778c7f3422746d.zip | |
Mark 'package-vc-update' as interactive
* lisp/emacs-lisp/package-vc.el (package-vc--sourced-packages-list):
Remove function in favour of 'package-vc--read-package-name'.
(package-vc--read-package-name):
Extract out common functionality.
(package-vc--read-package-desc): Add auxiliary function based on
'package-vc--read-package-name'.
(package-vc-update): Add interactive spec using
'package-vc--read-package-desc'.
(package-vc-install): Use 'package-vc--read-package-desc'.
(package-vc-checkout): Use 'package-vc--read-package-desc'.
(package-vc--read-pkg): Remove in favour of 'package-vc--read-package-desc'.
(package-vc-refresh): Use 'package-vc--read-package-desc'.
(package-vc-prepare-patch): Use 'package-vc--read-package-desc'.
| -rw-r--r-- | lisp/emacs-lisp/package-vc.el | 83 |
1 files changed, 42 insertions, 41 deletions
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index e7b871e171f..d6d3f7645e7 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el | |||
| @@ -506,21 +506,39 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC." | |||
| 506 | 506 | ||
| 507 | (package-vc--unpack-1 pkg-desc pkg-dir))) | 507 | (package-vc--unpack-1 pkg-desc pkg-dir))) |
| 508 | 508 | ||
| 509 | (defun package-vc--sourced-packages-list () | 509 | (defun package-vc--read-package-name (prompt &optional allow-url installed) |
| 510 | "Generate a list of packages with VC data." | 510 | "Query the user for a source package and return a name with PROMPT. |
| 511 | (seq-filter | 511 | If the optional argument ALLOW-URL is non-nil, the user is also |
| 512 | (lambda (pkg) | 512 | allowed to specify a non-package name. If the optional argument |
| 513 | (or (package-vc--desc->spec (cadr pkg)) | 513 | INSTALLED is non-nil, the selection will be filtered down to |
| 514 | ;; If we have no explicit VC data, we can try a kind of | 514 | source packages that have already been installed." |
| 515 | ;; heuristic and use the URL header, that might already be | 515 | (package-vc--archives-initialize) |
| 516 | ;; pointing towards a repository, and use that as a backup | 516 | (completing-read prompt (if installed package-alist package-archive-contents) |
| 517 | (and-let* ((extras (package-desc-extras (cadr pkg))) | 517 | (if installed |
| 518 | (url (alist-get :url extras)) | 518 | (lambda (pkg) (package-vc-p (cadr pkg))) |
| 519 | ((package-vc--guess-backend url)))))) | 519 | (lambda (pkg) |
| 520 | package-archive-contents)) | 520 | (or (package-vc--desc->spec (cadr pkg)) |
| 521 | ;; If we have no explicit VC data, we can try a kind of | ||
| 522 | ;; heuristic and use the URL header, that might already be | ||
| 523 | ;; pointing towards a repository, and use that as a backup | ||
| 524 | (and-let* ((extras (package-desc-extras (cadr pkg))) | ||
| 525 | (url (alist-get :url extras)) | ||
| 526 | ((package-vc--guess-backend url))))))) | ||
| 527 | nil (not allow-url))) | ||
| 528 | |||
| 529 | (defun package-vc--read-package-desc (prompt &optional installed) | ||
| 530 | "Query the user for a source package and return a description with PROMPT. | ||
| 531 | If the optional argument INSTALLED is non-nil, the selection will | ||
| 532 | be filtered down to source packages that have already been | ||
| 533 | installed, and the package description will be that of an | ||
| 534 | installed package." | ||
| 535 | (cadr (assoc (package-vc--read-package-name prompt nil installed) | ||
| 536 | (if installed package-alist package-archive-contents) | ||
| 537 | #'string=))) | ||
| 521 | 538 | ||
| 522 | (defun package-vc-update (pkg-desc) | 539 | (defun package-vc-update (pkg-desc) |
| 523 | "Attempt to update the package PKG-DESC." | 540 | "Attempt to update the package PKG-DESC." |
| 541 | (interactive (list (package-vc--read-package-desc "Update source package:"))) | ||
| 524 | ;; HACK: To run `package-vc--unpack-1' after checking out the new | 542 | ;; HACK: To run `package-vc--unpack-1' after checking out the new |
| 525 | ;; revision, we insert a hook into `vc-post-command-functions', and | 543 | ;; revision, we insert a hook into `vc-post-command-functions', and |
| 526 | ;; remove it right after it ran. To avoid running the hook multiple | 544 | ;; remove it right after it ran. To avoid running the hook multiple |
| @@ -605,11 +623,10 @@ uses `package-vc--guess-backend' to guess the backend." | |||
| 605 | ;; Initialize the package system to get the list of package | 623 | ;; Initialize the package system to get the list of package |
| 606 | ;; symbols for completion. | 624 | ;; symbols for completion. |
| 607 | (package-vc--archives-initialize) | 625 | (package-vc--archives-initialize) |
| 608 | (let* ((packages (package-vc--sourced-packages-list)) | 626 | (let* ((name-or-url (package-vc--read-package-name |
| 609 | (input (completing-read | 627 | "Fetch and install package: " t)) |
| 610 | "Fetch package source (name or URL): " packages)) | 628 | (name (file-name-base name-or-url))) |
| 611 | (name (file-name-base input))) | 629 | (list name-or-url (intern (string-remove-prefix "emacs-" name)) |
| 612 | (list input (intern (string-remove-prefix "emacs-" name)) | ||
| 613 | (and current-prefix-arg :last-release))))) | 630 | (and current-prefix-arg :last-release))))) |
| 614 | (package-vc--archives-initialize) | 631 | (package-vc--archives-initialize) |
| 615 | (cond | 632 | (cond |
| @@ -647,18 +664,12 @@ package's repository. If REV has the special value | |||
| 647 | `:last-release' (interactively, the prefix argument), that stands | 664 | `:last-release' (interactively, the prefix argument), that stands |
| 648 | for the last released version of the package." | 665 | for the last released version of the package." |
| 649 | (interactive | 666 | (interactive |
| 650 | (progn | 667 | (let* ((name (package-vc--read-package-name "Fetch package source: "))) |
| 651 | ;; Initialize the package system to get the list of package | 668 | (list (cadr (assoc name package-archive-contents #'string=)) |
| 652 | ;; symbols for completion. | 669 | (read-file-name "Clone into new or empty directory: " nil nil t nil |
| 653 | (package-vc--archives-initialize) | 670 | (lambda (dir) (or (not (file-exists-p dir)) |
| 654 | (let* ((packages (package-vc--sourced-packages-list)) | 671 | (directory-empty-p dir)))) |
| 655 | (input (completing-read | 672 | (and current-prefix-arg :last-release)))) |
| 656 | "Fetch package source (name or URL): " packages))) | ||
| 657 | (list (cadr (assoc input package-archive-contents #'string=)) | ||
| 658 | (read-file-name "Clone into new or empty directory: " nil nil t nil | ||
| 659 | (lambda (dir) (or (not (file-exists-p dir)) | ||
| 660 | (directory-empty-p dir)))) | ||
| 661 | (and current-prefix-arg :last-release))))) | ||
| 662 | (package-vc--archives-initialize) | 673 | (package-vc--archives-initialize) |
| 663 | (let ((pkg-spec (or (package-vc--desc->spec pkg-desc) | 674 | (let ((pkg-spec (or (package-vc--desc->spec pkg-desc) |
| 664 | (and-let* ((extras (package-desc-extras pkg-desc)) | 675 | (and-let* ((extras (package-desc-extras pkg-desc)) |
| @@ -697,19 +708,9 @@ name from the base name of DIR." | |||
| 697 | (defun package-vc-refresh (pkg-desc) | 708 | (defun package-vc-refresh (pkg-desc) |
| 698 | "Refresh the installation for package given by PKG-DESC. | 709 | "Refresh the installation for package given by PKG-DESC. |
| 699 | Interactively, prompt for the name of the package to refresh." | 710 | Interactively, prompt for the name of the package to refresh." |
| 700 | (interactive (list (package-vc--read-pkg "Refresh package: "))) | 711 | (interactive (list (package-vc--read-package-desc "Refresh package: " t))) |
| 701 | (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc))) | 712 | (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc))) |
| 702 | 713 | ||
| 703 | (defun package-vc--read-pkg (prompt) | ||
| 704 | "Query for a source package description with PROMPT." | ||
| 705 | (cadr (assoc (completing-read | ||
| 706 | prompt | ||
| 707 | package-alist | ||
| 708 | (lambda (pkg) (package-vc-p (cadr pkg))) | ||
| 709 | t) | ||
| 710 | package-alist | ||
| 711 | #'string=))) | ||
| 712 | |||
| 713 | ;;;###autoload | 714 | ;;;###autoload |
| 714 | (defun package-vc-prepare-patch (pkg subject revisions) | 715 | (defun package-vc-prepare-patch (pkg subject revisions) |
| 715 | "Send patch for REVISIONS to maintainer of the package PKG using SUBJECT. | 716 | "Send patch for REVISIONS to maintainer of the package PKG using SUBJECT. |
| @@ -719,7 +720,7 @@ Interactively, prompt for PKG, SUBJECT, and REVISIONS. However, | |||
| 719 | if the current buffer has marked commit log entries, REVISIONS | 720 | if the current buffer has marked commit log entries, REVISIONS |
| 720 | are the tags of the marked entries, see `log-view-get-marked'." | 721 | are the tags of the marked entries, see `log-view-get-marked'." |
| 721 | (interactive | 722 | (interactive |
| 722 | (list (package-vc--read-pkg "Package to prepare a patch for: ") | 723 | (list (package-vc--read-package-desc "Package to prepare a patch for: " t) |
| 723 | (and (not vc-prepare-patches-separately) | 724 | (and (not vc-prepare-patches-separately) |
| 724 | (read-string "Subject: " "[PATCH] " nil nil t)) | 725 | (read-string "Subject: " "[PATCH] " nil nil t)) |
| 725 | (or (log-view-get-marked) | 726 | (or (log-view-get-marked) |