diff options
Diffstat (limited to 'lisp/emacs-lisp/package-vc.el')
| -rw-r--r-- | lisp/emacs-lisp/package-vc.el | 341 |
1 files changed, 229 insertions, 112 deletions
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index c6625bf0ff8..b3e3f450f1d 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -62,6 +62,18 @@ (defconst package-vc--elpa-packages-version 1 "Version number of the package specification format understood by package-vc.") +(defconst package-vc--backend-type + `(choice :convert-widget + ,(lambda (widget) + (let (opts) + (dolist (be vc-handled-backends) + (when (or (vc-find-backend-function be 'clone) + (alist-get 'clone (get be 'vc-functions))) + (push (widget-convert (list 'const be)) opts))) + (widget-put widget :args opts)) + widget)) + "The type of VC backends that support cloning package VCS repositories.") + (defcustom package-vc-heuristic-alist `((,(rx bos "http" (? "s") "://" (or (: (? "www.") "github.com" @@ -94,24 +106,34 @@ (+ (or alnum "-" "." "_")) (? "/"))) eos) . Bzr)) - "Heuristic mapping URL regular expressions to VC backends." + "Alist mapping repository URLs to VC backends. +`package-vc-install' consults this alist to determine the VC +backend from the repository URL when you call it without +specifying a backend. Each element of the alist has the form +\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of +the first association for which the URL of the repository matches +the URL-REGEXP of the association. If no match is found, +`package-vc-install' uses `package-vc-default-backend' instead." :type `(alist :key-type (regexp :tag "Regular expression matching URLs") - :value-type (choice :tag "VC Backend" - ,@(mapcar (lambda (b) `(const ,b)) - vc-handled-backends))) + :value-type ,package-vc--backend-type) :version "29.1") (defcustom package-vc-default-backend 'Git - "Default VC backend used when cloning a package repository. -If no repository type was specified or could be guessed by -`package-vc-heuristic-alist', this is the default VC backend -used as fallback. The value must be a member of -`vc-handled-backends' and the named backend must implement -the `clone' function." - :type `(choice ,@(mapcar (lambda (b) (list 'const b)) - vc-handled-backends)) + "Default VC backend to use for cloning package repositories. +`package-vc-install' uses this backend when you specify neither +the backend nor a repository URL that's recognized via +`package-vc-heuristic-alist'. + +The value must be a member of `vc-handled-backends' that supports +the `clone' VC function." + :type package-vc--backend-type :version "29.1") +(defcustom package-vc-register-as-project t + "Non-nil means that packages should be registered as projects." + :type 'boolean + :version "30.1") + (defvar package-vc-selected-packages) ; pacify byte-compiler ;;;###autoload @@ -135,20 +157,21 @@ the `clone' function." (package-desc-create :name name :kind 'vc)) spec))))))) -(defcustom package-vc-selected-packages '() - "List of packages that must be installed. -Each member of the list is of the form (NAME . SPEC), where NAME -is a symbol designating the package and SPEC is one of: + +(defcustom package-vc-selected-packages nil + "List of packages to install from their VCS repositories. +Each element is of the form (NAME . SPEC), where NAME is a symbol +designating the package and SPEC is one of: - nil, if any package version can be installed; - a version string, if that specific revision is to be installed; -- a property list, describing a package specification. For more - details, please consult the subsection \"Specifying Package - Sources\" in the Info node `(emacs)Fetching Package Sources'. +- a property list, describing a package specification. For possible + values, see the subsection \"Specifying Package Sources\" in the + Info node `(emacs)Fetching Package Sources'. -This user option will be automatically updated to store package -specifications for packages that are not specified in any -archive." +The command `package-vc-install' updates the value of this user +option to store package specifications for packages that are not +specified in any archive." :type '(alist :tag "List of packages you want to be installed" :key-type (symbol :tag "Package") :value-type @@ -339,6 +362,47 @@ asynchronously." "\n") nil pkg-file nil 'silent)))) +(defcustom package-vc-allow-build-commands nil + "Whether to run extra build commands when installing VC packages. + +Some packages specify \"make\" targets or other shell commands +that should run prior to building the package, by including the +:make or :shell-command keywords in their specification. By +default, Emacs ignores these keywords when installing and +upgrading VC packages, but if the value is a list of package +names (symbols), the build commands will be run for those +packages. If the value is t, always respect :make and +:shell-command keywords. + +It may be necessary to run :make and :shell-command arguments in +order to initialize a package or build its documentation, but +please be careful when changing this option, as installing and +updating a package can run potentially harmful code. + +This applies to package specifications that come from your +configured package archives, as well as from entries in +`package-vc-selected-packages' and specifications that you give +to `package-vc-install' directly." + :type '(choice (const :tag "Run for all packages" t) + (repeat :tag "Run only for selected packages" (symbol :tag "Package name")) + (const :tag "Never run" nil)) + :version "30.1") + +(defun package-vc--make (pkg-spec pkg-desc) + "Process :make and :shell-command in PKG-SPEC. +PKG-DESC is the package descriptor for the package that is being +prepared." + (let ((target (plist-get pkg-spec :make)) + (cmd (plist-get pkg-spec :shell-command)) + (buf (format " *package-vc make %s*" (package-desc-name pkg-desc)))) + (when (or cmd target) + (with-current-buffer (get-buffer-create buf) + (erase-buffer) + (when (and cmd (/= 0 (call-process shell-file-name nil t nil shell-command-switch cmd))) + (warn "Failed to run %s, see buffer %S" cmd (buffer-name))) + (when (and target (/= 0 (apply #'call-process "make" nil t nil (if (consp target) target (list target))))) + (warn "Failed to make %s, see buffer %S" target (buffer-name))))))) + (declare-function org-export-to-file "ox" (backend file)) (defun package-vc--build-documentation (pkg-desc file) @@ -349,42 +413,48 @@ otherwise it's assumed to be an Info file." (default-directory (package-desc-dir pkg-desc)) (docs-directory (file-name-directory (expand-file-name file))) (output (expand-file-name (format "%s.info" pkg-name))) + (log-buffer (get-buffer-create (format " *package-vc doc: %s*" pkg-name))) clean-up) - (when (string-match-p "\\.org\\'" file) - (require 'ox) - (require 'ox-texinfo) - (with-temp-buffer - (insert-file-contents file) - (setq file (make-temp-file "ox-texinfo-")) - (let ((default-directory docs-directory)) - (org-export-to-file 'texinfo file)) - (setq clean-up t))) - (with-current-buffer (get-buffer-create " *package-vc doc*") - (erase-buffer) - (cond - ((/= 0 (call-process "makeinfo" nil t nil - "-I" docs-directory - "--no-split" file - "-o" output)) - (message "Failed to build manual %s, see buffer %S" - file (buffer-name))) - ((/= 0 (call-process "install-info" nil t nil - output (expand-file-name "dir"))) - (message "Failed to install manual %s, see buffer %S" - output (buffer-name))) - ((kill-buffer)))) + (with-current-buffer log-buffer + (erase-buffer)) + (condition-case err + (progn + (when (string-match-p "\\.org\\'" file) + (require 'ox) + (require 'ox-texinfo) + (with-temp-buffer + (insert-file-contents file) + (setq file (make-temp-file "ox-texinfo-")) + (let ((default-directory docs-directory)) + (org-export-to-file 'texinfo file)) + (setq clean-up t))) + (cond + ((/= 0 (call-process "makeinfo" nil log-buffer nil + "-I" docs-directory + "--no-split" file + "-o" output)) + (message "Failed to build manual %s, see buffer %S" + file (buffer-name))) + ((/= 0 (call-process "install-info" nil log-buffer nil + output (expand-file-name "dir"))) + (message "Failed to install manual %s, see buffer %S" + output (buffer-name))) + ((kill-buffer log-buffer)))) + (error (with-current-buffer log-buffer + (insert (error-message-string err))) + (message "Failed to export org manual for %s, see buffer %S" pkg-name log-buffer))) (when clean-up (delete-file file)))) -(defun package-vc-install-dependencies (requirements) - "Install missing dependencies, and return missing ones. -The return value will be nil if everything was found, or a list -of (NAME VERSION) pairs of all packages that couldn't be found. +(defun package-vc-install-dependencies (deps) + "Install missing dependencies according to DEPS. -REQUIREMENTS should be a list of additional requirements; each -element in this list should have the form (PACKAGE VERSION-LIST), -where PACKAGE is a package name and VERSION-LIST is the required -version of that package." +DEPS is a list of elements (PACKAGE VERSION-LIST), where +PACKAGE is a package name and VERSION-LIST is the required +version of that package. + +Return a list of dependencies that couldn't be met (or nil, when +this function successfully installs all given dependencies)." (let ((to-install '()) (missing '())) (cl-labels ((search (pkg) "Attempt to find all dependencies for PKG." @@ -418,7 +488,7 @@ version of that package." (let ((desc-a (package-desc-name a)) (desc-b (package-desc-name b))) (depends-on-p desc-a desc-b)))) - (mapc #'search requirements) + (mapc #'search deps) (cl-callf sort to-install #'version-order) (cl-callf seq-uniq to-install #'duplicate-p) (cl-callf sort to-install #'dependent-order)) @@ -431,26 +501,35 @@ This includes downloading missing dependencies, generating autoloads, generating a package description file (used to identify a package as a VC package later on), building documentation and marking the package as installed." - (let (missing) - ;; Remove any previous instance of PKG-DESC from `package-alist' - (let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) - (when pkgs - (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs))))) + (let ((pkg-spec (package-vc--desc->spec pkg-desc)) + missing) ;; In case the package was installed directly from source, the ;; dependency list wasn't know beforehand, and they might have ;; to be installed explicitly. - (let ((deps '())) + (let ((ignored-files + (if (plist-get pkg-spec :ignored-files) + (mapconcat + (lambda (ignore) + (wildcard-to-regexp + (if (string-match-p "\\`/" ignore) + (concat pkg-dir ignore) + (concat "*/" ignore)))) + (plist-get pkg-spec :ignored-files) + "\\|") + regexp-unmatchable)) + (deps '())) (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) - (with-temp-buffer - (insert-file-contents file) - (when-let* ((require-lines (lm-header-multiline "package-requires"))) - (thread-last - (mapconcat #'identity require-lines " ") - package-read-from-string - package--prepare-dependencies - (nconc deps) - (setq deps))))) + (unless (string-match-p ignored-files file) + (with-temp-buffer + (insert-file-contents file) + (when-let* ((require-lines (lm-header-multiline "package-requires"))) + (thread-last + (mapconcat #'identity require-lines " ") + package-read-from-string + lm--prepare-package-dependencies + (nconc deps) + (setq deps)))))) (dolist (dep deps) (cl-callf version-to-list (cadr dep))) (setf missing (package-vc-install-dependencies (delete-dups deps))) @@ -459,8 +538,7 @@ documentation and marking the package as installed." missing))) (let ((default-directory (file-name-as-directory pkg-dir)) - (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)) - (pkg-spec (package-vc--desc->spec pkg-desc))) + (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) ;; Generate autoloads (let* ((name (package-desc-name pkg-desc)) (auto-name (format "%s-autoloads.el" name)) @@ -483,11 +561,22 @@ documentation and marking the package as installed." ;; Generate package file (package-vc--generate-description-file pkg-desc pkg-file) + ;; Process :make and :shell-command arguments before building documentation + (when (or (eq package-vc-allow-build-commands t) + (memq (package-desc-name pkg-desc) + package-vc-allow-build-commands)) + (package-vc--make pkg-spec pkg-desc)) + ;; Detect a manual (when (executable-find "install-info") (dolist (doc-file (ensure-list (plist-get pkg-spec :doc))) (package-vc--build-documentation pkg-desc doc-file)))) + ;; Remove any previous instance of PKG-DESC from `package-alist' + (let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) + (when pkgs + (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs))))) + ;; Update package-alist. (let ((new-desc (package-load-descriptor pkg-dir))) ;; Activation has to be done before compilation, so that if we're @@ -538,6 +627,8 @@ and return nil if it cannot reasonably guess." (and url (alist-get url package-vc-heuristic-alist nil nil #'string-match-p))) +(declare-function project-remember-projects-under "project" (dir &optional recursive)) + (defun package-vc--clone (pkg-desc pkg-spec dir rev) "Clone the package PKG-DESC whose spec is PKG-SPEC into the directory DIR. REV specifies a specific revision to checkout. This overrides the `:branch' @@ -559,6 +650,11 @@ attribute in PKG-SPEC." (or (and (not (eq rev :last-release)) rev) branch)) (error "Failed to clone %s from %s" name url)))) + (when package-vc-register-as-project + (let ((default-directory dir)) + (require 'project) + (project-remember-projects-under dir))) + ;; Check out the latest release if requested (when (eq rev :last-release) (if-let ((release-rev (package-vc--release-rev pkg-desc))) @@ -666,7 +762,10 @@ installed package." ;;;###autoload (defun package-vc-upgrade-all () - "Attempt to upgrade all installed VC packages." + "Upgrade all installed VC packages. + +This may fail if the local VCS state of one of the packages +conflicts with its remote repository state." (interactive) (dolist (package package-alist) (dolist (pkg-desc (cdr package)) @@ -676,7 +775,10 @@ installed package." ;;;###autoload (defun package-vc-upgrade (pkg-desc) - "Attempt to upgrade the package PKG-DESC." + "Upgrade the package described by PKG-DESC from package's VC repository. + +This may fail if the local VCS state of the package conflicts +with the remote repository state." (interactive (list (package-vc--read-package-desc "Upgrade VC package: " t))) ;; HACK: To run `package-vc--unpack-1' after checking out the new ;; revision, we insert a hook into `vc-post-command-functions', and @@ -739,34 +841,45 @@ If no such revision can be found, return nil." ;;;###autoload (defun package-vc-install (package &optional rev backend name) - "Fetch a PACKAGE and set it up for using with Emacs. - -If PACKAGE is a string containing an URL, download the package -from the repository at that URL; the function will try to guess -the name of the package from the URL. This can be overridden by -passing the optional argument NAME. If PACKAGE is a cons-cell, -it should have the form (NAME . SPEC), where NAME is a symbol -indicating the package name and SPEC is a plist as described in -`package-vc-selected-packages'. Otherwise PACKAGE should be a -symbol whose name is the package name, and the URL for the -package will be taken from the package's metadata. + "Fetch a package described by PACKAGE and set it up for use with Emacs. + +PACKAGE specifies which package to install, where to find its +source repository and how to build it. + +If PACKAGE is a symbol, install the package with that name +according to metadata that package archives provide for it. This +is the simplest way to call this function, but it only works if +the package you want to install is listed in a package archive +you have configured. + +If PACKAGE is a string, it specifies the URL of the package +repository. In this case, optional argument BACKEND specifies +the VC backend to use for cloning the repository; if it's nil, +this function tries to infer which backend to use according to +the value of `package-vc-heuristic-alist' and if that fails it +uses `package-vc-default-backend'. Optional argument NAME +specifies the package name in this case; if it's nil, this +package uses `file-name-base' on the URL to obtain the package +name, otherwise NAME is the package name as a symbol. + +PACKAGE can also be a cons cell (PNAME . SPEC) where PNAME is the +package name as a symbol, and SPEC is a plist that specifies how +to fetch and build the package. For possible values, see the +subsection \"Specifying Package Sources\" in the Info +node `(emacs)Fetching Package Sources'. By default, this function installs the last revision of the package available from its repository. If REV is a string, it -describes the revision to install, as interpreted by the VC -backend. The special value `:last-release' (interactively, the -prefix argument), will use the commit of the latest release, if -it exists. The last release is the latest revision which changed -the \"Version:\" header of the package's main Lisp file. - -Optional argument BACKEND specifies the VC backend to use for cloning -the package's repository; this is only possible if NAME-OR-URL is a URL, -a string. If BACKEND is omitted or nil, the function -uses `package-vc-heuristic-alist' to guess the backend. -Note that by default, a VC package will be prioritized over a -regular package, but it will not remove a VC package. - -\(fn PACKAGE &optional REV BACKEND)" +describes the revision to install, as interpreted by the relevant +VC backend. The special value `:last-release' (interactively, +the prefix argument), says to use the commit of the latest +release, if it exists. The last release is the latest revision +which changed the \"Version:\" header of the package's main Lisp +file. + +If you use this function to install a package that you also have +installed from a package archive, the version this function +installs takes precedence." (interactive (progn ;; Initialize the package system to get the list of package @@ -829,7 +942,6 @@ for the last released version of the package." (lambda (dir) (or (not (file-exists-p dir)) (directory-empty-p dir)))) (and current-prefix-arg :last-release)))) - (setf directory (expand-file-name directory)) (package-vc--archives-initialize) (let ((pkg-spec (or (package-vc--desc->spec pkg-desc) (and-let* ((extras (package-desc-extras pkg-desc)) @@ -842,18 +954,19 @@ for the last released version of the package." (find-file directory))) ;;;###autoload -(defun package-vc-install-from-checkout (dir name) - "Set up the package NAME in DIR by linking it into the ELPA directory. +(defun package-vc-install-from-checkout (dir &optional name) + "Install the package NAME from its source directory DIR. +NAME defaults to the base name of DIR. Interactively, prompt the user for DIR, which should be a directory under version control, typically one created by `package-vc-checkout'. If invoked interactively with a prefix argument, prompt the user -for the NAME of the package to set up. Otherwise infer the package -name from the base name of DIR." - (interactive (let ((dir (read-directory-name "Directory: "))) - (list dir - (if current-prefix-arg - (read-string "Package name: ") - (file-name-base (directory-file-name dir)))))) +for the NAME of the package to set up." + (interactive (let* ((dir (read-directory-name "Directory: ")) + (base (file-name-base (directory-file-name dir)))) + (list dir (and current-prefix-arg + (read-string + (format-prompt "Package name" base) + nil nil base))))) (unless (vc-responsible-backend dir) (user-error "Directory %S is not under version control" dir)) (package-vc--archives-initialize) @@ -885,13 +998,17 @@ prompt for the name of the package to rebuild." ;;;###autoload (defun package-vc-prepare-patch (pkg-desc subject revisions) - "Send patch for REVISIONS to maintainer of the package PKG using SUBJECT. -The function uses `vc-prepare-patch', passing SUBJECT and -REVISIONS directly. PKG-DESC must be a package description. + "Email patches for REVISIONS to maintainer of package PKG-DESC using SUBJECT. + +PKG-DESC is a package descriptor and SUBJECT is the subject of +the message. + Interactively, prompt for PKG-DESC, SUBJECT, and REVISIONS. When invoked with a numerical prefix argument, use the last N revisions. When invoked interactively in a Log View buffer with -marked revisions, use those." +marked revisions, use those. + +See also `vc-prepare-patch'." (interactive (list (package-vc--read-package-desc "Package to prepare a patch for: " t) (and (not vc-prepare-patches-separately) |