diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 60 |
1 files changed, 55 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 67cd44d6758..c3a2061aae2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -161,6 +161,7 @@ | |||
| 161 | 161 | ||
| 162 | ;;; Code: | 162 | ;;; Code: |
| 163 | 163 | ||
| 164 | (eval-when-compile (require 'subr-x)) | ||
| 164 | (eval-when-compile (require 'cl-lib)) | 165 | (eval-when-compile (require 'cl-lib)) |
| 165 | (eval-when-compile (require 'epg)) ;For setf accessors. | 166 | (eval-when-compile (require 'epg)) ;For setf accessors. |
| 166 | 167 | ||
| @@ -1510,6 +1511,11 @@ with PKG-DESC entry removed." | |||
| 1510 | (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) | 1511 | (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) |
| 1511 | (car p)))))) | 1512 | (car p)))))) |
| 1512 | 1513 | ||
| 1514 | (defun package--newest-p (pkg) | ||
| 1515 | "Return t if PKG is the newest package with its name." | ||
| 1516 | (equal (cadr (assq (package-desc-name pkg) package-alist)) | ||
| 1517 | pkg)) | ||
| 1518 | |||
| 1513 | (defun package-delete (pkg-desc &optional force nosave) | 1519 | (defun package-delete (pkg-desc &optional force nosave) |
| 1514 | "Delete package PKG-DESC. | 1520 | "Delete package PKG-DESC. |
| 1515 | 1521 | ||
| @@ -1527,7 +1533,10 @@ If NOSAVE is non-nil, the package is not removed from | |||
| 1527 | ;; don't want it marked as selected, so we remove it from | 1533 | ;; don't want it marked as selected, so we remove it from |
| 1528 | ;; `package-selected-packages' even if it can't be deleted. | 1534 | ;; `package-selected-packages' even if it can't be deleted. |
| 1529 | (when (and (null nosave) | 1535 | (when (and (null nosave) |
| 1530 | (package--user-selected-p name)) | 1536 | (package--user-selected-p name) |
| 1537 | ;; Don't delesect if this is an older version of an | ||
| 1538 | ;; upgraded package. | ||
| 1539 | (package--newest-p pkg-desc)) | ||
| 1531 | (customize-save-variable | 1540 | (customize-save-variable |
| 1532 | 'package-selected-packages (remove name package-selected-packages))) | 1541 | 'package-selected-packages (remove name package-selected-packages))) |
| 1533 | (cond ((not (string-prefix-p (file-name-as-directory | 1542 | (cond ((not (string-prefix-p (file-name-as-directory |
| @@ -2262,7 +2271,7 @@ If optional arg BUTTON is non-nil, describe its associated package." | |||
| 2262 | (defun package-menu-mark-install (&optional _num) | 2271 | (defun package-menu-mark-install (&optional _num) |
| 2263 | "Mark a package for installation and move to the next line." | 2272 | "Mark a package for installation and move to the next line." |
| 2264 | (interactive "p") | 2273 | (interactive "p") |
| 2265 | (if (member (package-menu-get-status) '("available" "new")) | 2274 | (if (member (package-menu-get-status) '("available" "new" "dependency")) |
| 2266 | (tabulated-list-put-tag "I" t) | 2275 | (tabulated-list-put-tag "I" t) |
| 2267 | (forward-line))) | 2276 | (forward-line))) |
| 2268 | 2277 | ||
| @@ -2351,6 +2360,40 @@ call will upgrade the package." | |||
| 2351 | (length upgrades) | 2360 | (length upgrades) |
| 2352 | (if (= (length upgrades) 1) "" "s"))))) | 2361 | (if (= (length upgrades) 1) "" "s"))))) |
| 2353 | 2362 | ||
| 2363 | (defun package--sort-deps-in-alist (package only) | ||
| 2364 | "Return a list of dependencies for PACKAGE sorted by dependency. | ||
| 2365 | PACKAGE is included as the first element of the returned list. | ||
| 2366 | ONLY is an alist associating package names to package objects. | ||
| 2367 | Only these packages will be in the return value an their cdrs are | ||
| 2368 | destructively set to nil in ONLY." | ||
| 2369 | (let ((out)) | ||
| 2370 | (dolist (dep (package-desc-reqs package)) | ||
| 2371 | (when-let ((cell (assq (car dep) only)) | ||
| 2372 | (dep-package (cdr-safe cell))) | ||
| 2373 | (setcdr cell nil) | ||
| 2374 | (setq out (append (package--sort-deps-in-alist dep-package only) | ||
| 2375 | out)))) | ||
| 2376 | (cons package out))) | ||
| 2377 | |||
| 2378 | (defun package--sort-by-dependence (package-list) | ||
| 2379 | "Return PACKAGE-LIST sorted by dependence. | ||
| 2380 | That is, any element of the returned list is guaranteed to not | ||
| 2381 | directly depend on any elements that come before it. | ||
| 2382 | |||
| 2383 | PACKAGE-LIST is a list of package-desc objects. | ||
| 2384 | Indirect dependencies are guaranteed to be returned in order only | ||
| 2385 | if all the in-between dependencies are also in PACKAGE-LIST." | ||
| 2386 | (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list)) | ||
| 2387 | out-list) | ||
| 2388 | (dolist (cell alist out-list) | ||
| 2389 | ;; `package--sort-deps-in-alist' destructively changes alist, so | ||
| 2390 | ;; some cells might already be empty. We check this here. | ||
| 2391 | (when-let ((pkg-desc (cdr cell))) | ||
| 2392 | (setcdr cell nil) | ||
| 2393 | (setq out-list | ||
| 2394 | (append (package--sort-deps-in-alist pkg-desc alist) | ||
| 2395 | out-list)))))) | ||
| 2396 | |||
| 2354 | (defun package-menu-execute (&optional noquery) | 2397 | (defun package-menu-execute (&optional noquery) |
| 2355 | "Perform marked Package Menu actions. | 2398 | "Perform marked Package Menu actions. |
| 2356 | Packages marked for installation are downloaded and installed; | 2399 | Packages marked for installation are downloaded and installed; |
| @@ -2384,7 +2427,13 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." | |||
| 2384 | (mapconcat #'package-desc-full-name | 2427 | (mapconcat #'package-desc-full-name |
| 2385 | install-list ", "))))) | 2428 | install-list ", "))))) |
| 2386 | (mapc (lambda (p) | 2429 | (mapc (lambda (p) |
| 2387 | (package-install p (null (package-installed-p p)))) | 2430 | ;; Mark as selected if it's the exact version of a |
| 2431 | ;; package that's already installed, or if it's not | ||
| 2432 | ;; installed at all. Don't mark if it's a new | ||
| 2433 | ;; version of an installed package. | ||
| 2434 | (package-install p (or (package-installed-p p) | ||
| 2435 | (not (package-installed-p | ||
| 2436 | (package-desc-name p)))))) | ||
| 2388 | install-list))) | 2437 | install-list))) |
| 2389 | ;; Delete packages, prompting if necessary. | 2438 | ;; Delete packages, prompting if necessary. |
| 2390 | (when delete-list | 2439 | (when delete-list |
| @@ -2398,7 +2447,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." | |||
| 2398 | (length delete-list) | 2447 | (length delete-list) |
| 2399 | (mapconcat #'package-desc-full-name | 2448 | (mapconcat #'package-desc-full-name |
| 2400 | delete-list ", "))))) | 2449 | delete-list ", "))))) |
| 2401 | (dolist (elt delete-list) | 2450 | (dolist (elt (package--sort-by-dependence delete-list)) |
| 2402 | (condition-case-unless-debug err | 2451 | (condition-case-unless-debug err |
| 2403 | (package-delete elt) | 2452 | (package-delete elt) |
| 2404 | (error (message (cadr err))))) | 2453 | (error (message (cadr err))))) |
| @@ -2412,7 +2461,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." | |||
| 2412 | (format "These %d packages are no longer needed, delete them (%s)? " | 2461 | (format "These %d packages are no longer needed, delete them (%s)? " |
| 2413 | (length removable) | 2462 | (length removable) |
| 2414 | (mapconcat #'symbol-name removable ", ")))) | 2463 | (mapconcat #'symbol-name removable ", ")))) |
| 2415 | (mapc (lambda (p) (package-delete (cadr (assq p package-alist)))) | 2464 | ;; We know these are removable, so we can use force instead of sorting them. |
| 2465 | (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) 'force 'nosave)) | ||
| 2416 | removable)))) | 2466 | removable)))) |
| 2417 | (package-menu--generate t t)))) | 2467 | (package-menu--generate t t)))) |
| 2418 | 2468 | ||