diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 197 |
1 files changed, 115 insertions, 82 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 967720881f6..2962da5a917 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -234,7 +234,7 @@ of it available such that: This variable has three possible values: nil: no packages are hidden; - archive: only criteria (a) is used; + `archive': only criteria (a) is used; t: both criteria are used. This variable has no effect if `package-menu--hide-packages' is @@ -639,6 +639,28 @@ specifying the minimum acceptable version." (require 'finder-inf nil t) ; For `package--builtins'. (assq package package--builtins)))))) +(defun package--autoloads-file-name (pkg-desc) + "Return the absolute name of the autoloads file, sans extension. +PKG-DESC is a `package-desc' object." + (expand-file-name + (format "%s-autoloads" (package-desc-name pkg-desc)) + (package-desc-dir pkg-desc))) + +(defun package--activate-autoloads-and-load-path (pkg-desc) + "Load the autoloads file and add package dir to `load-path'. +PKG-DESC is a `package-desc' object." + (let* ((old-lp load-path) + (pkg-dir (package-desc-dir pkg-desc)) + (pkg-dir-dir (file-name-as-directory pkg-dir))) + (with-demoted-errors "Error loading autoloads: %s" + (load (package--autoloads-file-name pkg-desc) nil t)) + (when (and (eq old-lp load-path) + (not (or (member pkg-dir load-path) + (member pkg-dir-dir load-path)))) + ;; Old packages don't add themselves to the `load-path', so we have to + ;; do it ourselves. + (push pkg-dir load-path)))) + (defvar Info-directory-list) (declare-function info-initialize "info" ()) @@ -648,24 +670,14 @@ If RELOAD is non-nil, also `load' any files inside the package which correspond to previously loaded files (those returned by `package--list-loaded-files')." (let* ((name (package-desc-name pkg-desc)) - (pkg-dir (package-desc-dir pkg-desc)) - (pkg-dir-dir (file-name-as-directory pkg-dir))) + (pkg-dir (package-desc-dir pkg-desc))) (unless pkg-dir (error "Internal error: unable to find directory for `%s'" (package-desc-full-name pkg-desc))) - ;; Add to load path, add autoloads, and activate the package. - (let* ((old-lp load-path) - (autoloads-file (expand-file-name - (format "%s-autoloads" name) pkg-dir)) - (loaded-files-list (and reload (package--list-loaded-files pkg-dir)))) - (with-demoted-errors "Error in package-activate-1: %s" - (load autoloads-file nil t)) - (when (and (eq old-lp load-path) - (not (or (member pkg-dir load-path) - (member pkg-dir-dir load-path)))) - ;; Old packages don't add themselves to the `load-path', so we have to - ;; do it ourselves. - (push pkg-dir load-path)) + (let* ((loaded-files-list (when reload + (package--list-loaded-files pkg-dir)))) + ;; Add to load path, add autoloads, and activate the package. + (package--activate-autoloads-and-load-path pkg-desc) ;; Call `load' on all files in `pkg-dir' already present in ;; `load-history'. This is done so that macros in these files are updated ;; to their new definitions. If another package is being installed which @@ -674,7 +686,8 @@ correspond to previously loaded files (those returned by (with-demoted-errors "Error in package-activate-1: %s" (mapc (lambda (feature) (load feature nil t)) ;; Skip autoloads file since we already evaluated it above. - (remove (file-truename autoloads-file) loaded-files-list)))) + (remove (file-truename (package--autoloads-file-name pkg-desc)) + loaded-files-list)))) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. @@ -876,7 +889,8 @@ untar into a directory named DIR; otherwise, signal an error." " --- automatically extracted autoloads\n" ";;\n" ";;; Code:\n" - "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n" + ;; `load-path' should contain only directory names + "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n" " \n;; Local Variables:\n" ";; version-control: never\n" ";; no-byte-compile: t\n" @@ -919,8 +933,9 @@ untar into a directory named DIR; otherwise, signal an error." (defun package--compile (pkg-desc) "Byte-compile installed package PKG-DESC." (let ((warning-minimum-level :error) - (save-silently inhibit-message)) - (package-activate-1 pkg-desc) + (save-silently inhibit-message) + (load-path load-path)) + (package--activate-autoloads-and-load-path pkg-desc) (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) ;;;; Inferring package from current buffer @@ -1350,10 +1365,18 @@ If the archive version is too new, signal an error." (dolist (package contents) (package--add-to-archive-contents package archive))))) +(defvar package--old-archive-priorities nil + "Store currently used `package-archive-priorities'. +This is the value of `package-archive-priorities' last time +`package-read-all-archive-contents' was called. It can be used +by arbitrary functions to decide whether it is necessary to call +it again.") + (defun package-read-all-archive-contents () "Re-read `archive-contents', if it exists. If successful, set `package-archive-contents'." (setq package-archive-contents nil) + (setq package--old-archive-priorities package-archive-priorities) (dolist (archive package-archives) (package-read-archive-contents (car archive)))) @@ -1372,13 +1395,18 @@ If successful, set `package-archive-contents'." The variable `package-load-list' controls which packages to load. If optional arg NO-ACTIVATE is non-nil, don't activate packages. If `user-init-file' does not mention `(package-initialize)', add -it to the file." +it to the file. +If called as part of loading `user-init-file', set +`package-enable-at-startup' to nil, to prevent accidentally +loading packages twice." (interactive) (setq package-alist nil) (if (equal user-init-file load-file-name) ;; If `package-initialize' is being called as part of loading ;; the init file, it's obvious we don't need to ensure-init. - (setq package--init-file-ensured t) + (setq package--init-file-ensured t + ;; And likely we don't need to run it again after init. + package-enable-at-startup nil) (package--ensure-init-file)) (package-load-all-descriptors) (package-read-all-archive-contents) @@ -1592,11 +1620,12 @@ SEEN is used internally to detect infinite recursion." (unless problem (setq problem (if (stringp disabled) - (format "Package `%s' held at version %s, but version %s required" - next-pkg disabled - (package-version-join next-version)) - (format "Required package '%s' is disabled" - next-pkg))))) + (format-message + "Package `%s' held at version %s, but version %s required" + next-pkg disabled + (package-version-join next-version)) + (format-message "Required package `%s' is disabled" + next-pkg))))) (t (setq found pkg-desc))))) (unless found (cond @@ -1832,12 +1861,12 @@ add a call to it along with some explanatory comments." (save-restriction (widen) (goto-char (point-min)) - (search-forward "(package-initialize)" nil 'noerror)))) + (re-search-forward "(package-initialize\\_>" nil 'noerror)))) ;; Don't visit the file if we don't have to. (with-temp-buffer (insert-file-contents user-init-file) (goto-char (point-min)) - (search-forward "(package-initialize)" nil 'noerror))))) + (re-search-forward "(package-initialize\\_>" nil 'noerror))))) (unless contains-init (with-current-buffer (or buffer (let ((delay-mode-hooks t)) @@ -1867,7 +1896,7 @@ add a call to it along with some explanatory comments." ;;;###autoload (defun package-install (pkg &optional dont-select) "Install the package PKG. -PKG can be a package-desc or the package name of one the available packages +PKG can be a package-desc or a symbol naming one of the available packages in an archive in `package-archives'. Interactively, prompt for its name. If called interactively or if DONT-SELECT nil, add PKG to @@ -1898,15 +1927,15 @@ to install it but still mark it as selected." pkg))) (unless (or dont-select (package--user-selected-p name)) (package--save-selected-packages - (cons name package-selected-packages)))) - (if-let ((transaction - (if (package-desc-p pkg) - (unless (package-installed-p pkg) - (package-compute-transaction (list pkg) - (package-desc-reqs pkg))) - (package-compute-transaction () (list (list pkg)))))) - (package-download-transaction transaction) - (message "`%s' is already installed" (package-desc-full-name pkg)))) + (cons name package-selected-packages))) + (if-let ((transaction + (if (package-desc-p pkg) + (unless (package-installed-p pkg) + (package-compute-transaction (list pkg) + (package-desc-reqs pkg))) + (package-compute-transaction () (list (list pkg)))))) + (package-download-transaction transaction) + (message "`%s' is already installed" name)))) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. @@ -2096,7 +2125,8 @@ will be deleted." ;; do absolutely nothing. (when (or package-selected-packages (yes-or-no-p - "`package-selected-packages' is empty! Really remove ALL packages? ")) + (format-message + "`package-selected-packages' is empty! Really remove ALL packages? "))) (let ((removable (package--removable-packages))) (if removable (when (y-or-n-p @@ -2143,7 +2173,7 @@ will be deleted." (with-current-buffer standard-output (describe-package-1 package))))) -(defface package-help-section-name-face +(defface package-help-section-name '((t :inherit (bold font-lock-function-name-face))) "Face used on section names in package description buffers." :version "25.1") @@ -2154,7 +2184,7 @@ If more STRINGS are provided, insert them followed by a newline. Otherwise no newline is inserted." (declare (indent 1)) (insert (make-string (max 0 (- 11 (string-width name))) ?\s) - (propertize (concat name ": ") 'font-lock-face 'package-help-section-name-face)) + (propertize (concat name ": ") 'font-lock-face 'package-help-section-name)) (when strings (apply #'insert strings) (insert "\n"))) @@ -2204,7 +2234,7 @@ Otherwise no newline is inserted." "Installed" (capitalize status)) 'font-lock-face 'package-status-builtin-face)) - (insert (substitute-command-keys " in ‘")) + (insert (substitute-command-keys " in `")) (let ((dir (abbreviate-file-name (file-name-as-directory (if (file-in-directory-p pkg-dir package-user-dir) @@ -2214,10 +2244,10 @@ Otherwise no newline is inserted." (if (and (package-built-in-p name) (not (package-built-in-p name version))) (insert (substitute-command-keys - "’,\n shadowing a ") + "',\n shadowing a ") (propertize "built-in package" 'font-lock-face 'package-status-builtin-face)) - (insert (substitute-command-keys "’"))) + (insert (substitute-command-keys "'"))) (if signed (insert ".") (insert " (unsigned).")) @@ -2365,16 +2395,16 @@ Otherwise no newline is inserted." (defun package-install-button-action (button) (let ((pkg-desc (button-get button 'package-desc))) - (when (y-or-n-p (format "Install package `%s'? " - (package-desc-full-name pkg-desc))) + (when (y-or-n-p (format-message "Install package `%s'? " + (package-desc-full-name pkg-desc))) (package-install pkg-desc nil) (revert-buffer nil t) (goto-char (point-min))))) (defun package-delete-button-action (button) (let ((pkg-desc (button-get button 'package-desc))) - (when (y-or-n-p (format "Delete package `%s'? " - (package-desc-full-name pkg-desc))) + (when (y-or-n-p (format-message "Delete package `%s'? " + (package-desc-full-name pkg-desc))) (package-delete pkg-desc) (revert-buffer nil t) (goto-char (point-min))))) @@ -2654,6 +2684,8 @@ KEYWORDS should be nil or a list of keywords." (push pkg info-list))))) ;; Available and disabled packages: + (unless (equal package--old-archive-priorities package-archive-priorities) + (package-read-all-archive-contents)) (dolist (elt package-archive-contents) (let ((name (car elt))) ;; To be displayed it must be in PACKAGES; @@ -2758,68 +2790,68 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." ;;; Package menu faces -(defface package-name-face +(defface package-name '((t :inherit link)) "Face used on package names in the package menu." :version "25.1") -(defface package-description-face +(defface package-description '((t :inherit default)) "Face used on package description summaries in the package menu." :version "25.1") -(defface package-status-built-in-face +(defface package-status-built-in '((t :inherit font-lock-builtin-face)) "Face used on the status and version of built-in packages." :version "25.1") -(defface package-status-external-face +(defface package-status-external '((t :inherit package-status-builtin-face)) "Face used on the status and version of external packages." :version "25.1") -(defface package-status-available-face +(defface package-status-available '((t :inherit default)) "Face used on the status and version of available packages." :version "25.1") -(defface package-status-new-face - '((t :inherit (bold package-status-available-face))) +(defface package-status-new + '((t :inherit (bold package-status-available))) "Face used on the status and version of new packages." :version "25.1") -(defface package-status-held-face +(defface package-status-held '((t :inherit font-lock-constant-face)) "Face used on the status and version of held packages." :version "25.1") -(defface package-status-disabled-face +(defface package-status-disabled '((t :inherit font-lock-warning-face)) "Face used on the status and version of disabled packages." :version "25.1") -(defface package-status-installed-face +(defface package-status-installed '((t :inherit font-lock-comment-face)) "Face used on the status and version of installed packages." :version "25.1") -(defface package-status-dependency-face - '((t :inherit package-status-installed-face)) +(defface package-status-dependency + '((t :inherit package-status-installed)) "Face used on the status and version of dependency packages." :version "25.1") -(defface package-status-unsigned-face +(defface package-status-unsigned '((t :inherit font-lock-warning-face)) "Face used on the status and version of unsigned packages." :version "25.1") -(defface package-status-incompat-face +(defface package-status-incompat '((t :inherit font-lock-comment-face)) "Face used on the status and version of incompat packages." :version "25.1") -(defface package-status-avail-obso-face - '((t :inherit package-status-incompat-face)) +(defface package-status-avail-obso + '((t :inherit package-status-incompat)) "Face used on the status and version of avail-obso packages." :version "25.1") @@ -2831,22 +2863,22 @@ PKG is a package-desc object. Return (PKG-DESC [NAME VERSION STATUS DOC])." (let* ((status (package-desc-status pkg)) (face (pcase status - (`"built-in" 'package-status-built-in-face) - (`"external" 'package-status-external-face) - (`"available" 'package-status-available-face) - (`"avail-obso" 'package-status-avail-obso-face) - (`"new" 'package-status-new-face) - (`"held" 'package-status-held-face) - (`"disabled" 'package-status-disabled-face) - (`"installed" 'package-status-installed-face) - (`"dependency" 'package-status-dependency-face) - (`"unsigned" 'package-status-unsigned-face) - (`"incompat" 'package-status-incompat-face) + (`"built-in" 'package-status-built-in) + (`"external" 'package-status-external) + (`"available" 'package-status-available) + (`"avail-obso" 'package-status-avail-obso) + (`"new" 'package-status-new) + (`"held" 'package-status-held) + (`"disabled" 'package-status-disabled) + (`"installed" 'package-status-installed) + (`"dependency" 'package-status-dependency) + (`"unsigned" 'package-status-unsigned) + (`"incompat" 'package-status-incompat) (_ 'font-lock-warning-face)))) ; obsolete. (list pkg `[(,(symbol-name (package-desc-name pkg)) - face package-name-face - font-lock-face package-name-face + face package-name + font-lock-face package-name follow-link t package-desc ,pkg action package-menu-describe-package) @@ -2858,7 +2890,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (list (propertize (or (package-desc-archive pkg) "") 'font-lock-face face))) ,(propertize (package-desc-summary pkg) - 'font-lock-face 'package-description-face)]))) + 'font-lock-face 'package-description)]))) (defvar package-menu--old-archive-contents nil "`package-archive-contents' before the latest refresh.") @@ -3077,8 +3109,8 @@ prompt (see `package-menu--prompt-transaction-p')." (length packages) (mapconcat #'package-desc-full-name packages ", "))) ;; Exactly 1 - (t (format "package `%s'" - (package-desc-full-name (car packages)))))) + (t (format-message "package `%s'" + (package-desc-full-name (car packages)))))) (defun package-menu--prompt-transaction-p (delete install upgrade) "Prompt the user about DELETE, INSTALL, and UPGRADE. @@ -3194,7 +3226,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (if-let ((removable (package--removable-packages))) (message "Package menu: Operation finished. %d packages %s" (length removable) - "are no longer needed, type `M-x package-autoremove' to remove them") + (substitute-command-keys + "are no longer needed, type `\\[package-autoremove]' to remove them")) (message (replace-regexp-in-string "__" "ed" message-template) "finished")))))))) |