diff options
| author | Chong Yidong | 2010-08-09 14:05:56 -0400 |
|---|---|---|
| committer | Chong Yidong | 2010-08-09 14:05:56 -0400 |
| commit | 148cef8e7a25f4d05d3b90c78fd8714f64048d24 (patch) | |
| tree | 71d6a540d19517206a421becf0cec58ec1c58b22 | |
| parent | b84fc05a591171240d8842490d068356933eb5c2 (diff) | |
| download | emacs-148cef8e7a25f4d05d3b90c78fd8714f64048d24.tar.gz emacs-148cef8e7a25f4d05d3b90c78fd8714f64048d24.zip | |
Use version-list-* functions in package.el.
* emacs-lisp/package-x.el (package-upload-buffer-internal): Use
version-to-list.
(package-upload-buffer-internal): Use version-list-<=.
* emacs-lisp/package.el (package-version-split)
(package--version-first-nonzero, package-version-compare):
Functions removed.
(package-directory-list, package-load-all-descriptors)
(package--built-in, package-activate, define-package)
(package-installed-p, package-compute-transaction)
(package-read-all-archive-contents)
(package--add-to-archive-contents, package-buffer-info)
(package-tar-file-info, package-list-packages-internal): Use
version-to-list and version-list-*.
| -rw-r--r-- | lisp/ChangeLog | 17 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package-x.el | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 89 |
3 files changed, 46 insertions, 67 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c242b6feb78..e302160bd1f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,20 @@ | |||
| 1 | 2010-08-09 Chong Yidong <cyd@stupidchicken.com> | ||
| 2 | |||
| 3 | * emacs-lisp/package.el (package-version-split) | ||
| 4 | (package--version-first-nonzero, package-version-compare): | ||
| 5 | Functions removed. | ||
| 6 | (package-directory-list, package-load-all-descriptors) | ||
| 7 | (package--built-in, package-activate, define-package) | ||
| 8 | (package-installed-p, package-compute-transaction) | ||
| 9 | (package-read-all-archive-contents) | ||
| 10 | (package--add-to-archive-contents, package-buffer-info) | ||
| 11 | (package-tar-file-info, package-list-packages-internal): Use | ||
| 12 | version-to-list and version-list-*. | ||
| 13 | |||
| 14 | * emacs-lisp/package-x.el (package-upload-buffer-internal): Use | ||
| 15 | version-to-list. | ||
| 16 | (package-upload-buffer-internal): Use version-list-<=. | ||
| 17 | |||
| 1 | 2010-08-09 Kenichi Handa <handa@m17n.org> | 18 | 2010-08-09 Kenichi Handa <handa@m17n.org> |
| 2 | 19 | ||
| 3 | * language/hebrew.el: Exclude U+05BD (Hebrew MAQAF) from the | 20 | * language/hebrew.el: Exclude U+05BD (Hebrew MAQAF) from the |
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 2a5d84f339b..b93950049e0 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el | |||
| @@ -129,7 +129,7 @@ If nil, the \"gnu\" archive is used." | |||
| 129 | (aref pkg-info 2))) | 129 | (aref pkg-info 2))) |
| 130 | (pkg-version (aref pkg-info 3)) | 130 | (pkg-version (aref pkg-info 3)) |
| 131 | (commentary (aref pkg-info 4)) | 131 | (commentary (aref pkg-info 4)) |
| 132 | (split-version (package-version-split pkg-version)) | 132 | (split-version (version-to-list pkg-version)) |
| 133 | (pkg-buffer (current-buffer)) | 133 | (pkg-buffer (current-buffer)) |
| 134 | 134 | ||
| 135 | ;; Download latest archive-contents. | 135 | ;; Download latest archive-contents. |
| @@ -150,9 +150,8 @@ If nil, the \"gnu\" archive is used." | |||
| 150 | (error "Unrecognized archive version %d" (car contents))) | 150 | (error "Unrecognized archive version %d" (car contents))) |
| 151 | (let ((elt (assq pkg-name (cdr contents)))) | 151 | (let ((elt (assq pkg-name (cdr contents)))) |
| 152 | (if elt | 152 | (if elt |
| 153 | (if (package-version-compare split-version | 153 | (if (version-list-<= split-version |
| 154 | (package-desc-vers (cdr elt)) | 154 | (package-desc-vers (cdr elt))) |
| 155 | '<=) | ||
| 156 | (error "New package has smaller version: %s" pkg-version) | 155 | (error "New package has smaller version: %s" pkg-version) |
| 157 | (setcdr elt new-desc)) | 156 | (setcdr elt new-desc)) |
| 158 | (setq contents (cons (car contents) | 157 | (setq contents (cons (car contents) |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bcb8349c187..2e8c7dc7d4f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -272,16 +272,12 @@ contrast, `package-user-dir' contains packages for personal use." | |||
| 272 | :group 'package | 272 | :group 'package |
| 273 | :version "24.1") | 273 | :version "24.1") |
| 274 | 274 | ||
| 275 | (defun package-version-split (string) | ||
| 276 | "Split a package string into a version list." | ||
| 277 | (mapcar 'string-to-int (split-string string "[.]"))) | ||
| 278 | |||
| 279 | (defconst package--builtins-base | 275 | (defconst package--builtins-base |
| 280 | ;; We use package-version split here to make sure to pick up the | 276 | ;; We use package-version split here to make sure to pick up the |
| 281 | ;; minor version. | 277 | ;; minor version. |
| 282 | `((emacs . [,(package-version-split emacs-version) nil | 278 | `((emacs . [,(version-to-list emacs-version) nil |
| 283 | "GNU Emacs"]) | 279 | "GNU Emacs"]) |
| 284 | (package . [,(package-version-split package-el-version) | 280 | (package . [,(version-to-list package-el-version) |
| 285 | nil "Simple package system for GNU Emacs"])) | 281 | nil "Simple package system for GNU Emacs"])) |
| 286 | "Packages which are always built-in.") | 282 | "Packages which are always built-in.") |
| 287 | 283 | ||
| @@ -335,29 +331,6 @@ The second subexpression is the version string.") | |||
| 335 | "Turn a list of version numbers into a version string." | 331 | "Turn a list of version numbers into a version string." |
| 336 | (mapconcat 'int-to-string l ".")) | 332 | (mapconcat 'int-to-string l ".")) |
| 337 | 333 | ||
| 338 | (defun package--version-first-nonzero (l) | ||
| 339 | (while (and l (= (car l) 0)) | ||
| 340 | (setq l (cdr l))) | ||
| 341 | (if l (car l) 0)) | ||
| 342 | |||
| 343 | (defun package-version-compare (v1 v2 fun) | ||
| 344 | "Compare two version lists according to FUN. | ||
| 345 | FUN can be <, <=, =, >, >=, or /=." | ||
| 346 | (while (and v1 v2 (= (car v1) (car v2))) | ||
| 347 | (setq v1 (cdr v1) | ||
| 348 | v2 (cdr v2))) | ||
| 349 | (if v1 | ||
| 350 | (if v2 | ||
| 351 | ;; Both not null; we know the cars are not =. | ||
| 352 | (funcall fun (car v1) (car v2)) | ||
| 353 | ;; V1 not null, V2 null. | ||
| 354 | (funcall fun (package--version-first-nonzero v1) 0)) | ||
| 355 | (if v2 | ||
| 356 | ;; V1 null, V2 not null. | ||
| 357 | (funcall fun 0 (package--version-first-nonzero v2)) | ||
| 358 | ;; Both null. | ||
| 359 | (funcall fun 0 0)))) | ||
| 360 | |||
| 361 | (defun package-strip-version (dirname) | 334 | (defun package-strip-version (dirname) |
| 362 | "Strip the version from a combined package name and version. | 335 | "Strip the version from a combined package name and version. |
| 363 | E.g., if given \"quux-23.0\", will return \"quux\"" | 336 | E.g., if given \"quux-23.0\", will return \"quux\"" |
| @@ -401,9 +374,8 @@ updates `package-alist' and `package-obsolete-alist'." | |||
| 401 | ((eq force t) | 374 | ((eq force t) |
| 402 | t) | 375 | t) |
| 403 | ((stringp force) ; held | 376 | ((stringp force) ; held |
| 404 | (package-version-compare (package-version-split version) | 377 | (version-list-= (version-to-list version) |
| 405 | (package-version-split force) | 378 | (version-to-list force))) |
| 406 | '=)) | ||
| 407 | (t | 379 | (t |
| 408 | (error "Invalid element in `package-load-list'"))) | 380 | (error "Invalid element in `package-load-list'"))) |
| 409 | (package-load-descriptor dir subdir)))))))) | 381 | (package-load-descriptor dir subdir)))))))) |
| @@ -460,8 +432,7 @@ updates `package-alist' and `package-obsolete-alist'." | |||
| 460 | (defun package--built-in (package version) | 432 | (defun package--built-in (package version) |
| 461 | "Return true if the package is built-in to Emacs." | 433 | "Return true if the package is built-in to Emacs." |
| 462 | (let ((elt (assq package package--builtins))) | 434 | (let ((elt (assq package package--builtins))) |
| 463 | (and elt | 435 | (and elt (version-list-= (package-desc-vers (cdr elt)) version)))) |
| 464 | (package-version-compare (package-desc-vers (cdr elt)) version '=)))) | ||
| 465 | 436 | ||
| 466 | ;; FIXME: return a reason instead? | 437 | ;; FIXME: return a reason instead? |
| 467 | (defun package-activate (package version) | 438 | (defun package-activate (package version) |
| @@ -479,7 +450,7 @@ Return nil if the package could not be activated." | |||
| 479 | (req-list (package-desc-reqs (cdr pkg-desc))) | 450 | (req-list (package-desc-reqs (cdr pkg-desc))) |
| 480 | ;; If the package was never activated, do it now. | 451 | ;; If the package was never activated, do it now. |
| 481 | (keep-going (or (not (memq package package-activated-list)) | 452 | (keep-going (or (not (memq package package-activated-list)) |
| 482 | (package-version-compare this-version version '>)))) | 453 | (version-list-< version this-version)))) |
| 483 | (while (and req-list keep-going) | 454 | (while (and req-list keep-going) |
| 484 | (let* ((req (car req-list)) | 455 | (let* ((req (car req-list)) |
| 485 | (req-name (car req)) | 456 | (req-name (car req)) |
| @@ -493,7 +464,7 @@ Return nil if the package could not be activated." | |||
| 493 | ;; can also get here if the requested package was already | 464 | ;; can also get here if the requested package was already |
| 494 | ;; activated. Return non-nil in the latter case. | 465 | ;; activated. Return non-nil in the latter case. |
| 495 | (and (memq package package-activated-list) | 466 | (and (memq package package-activated-list) |
| 496 | (package-version-compare this-version version '>=)))))) | 467 | (version-list-<= version this-version)))))) |
| 497 | 468 | ||
| 498 | (defun package-mark-obsolete (package pkg-vec) | 469 | (defun package-mark-obsolete (package pkg-vec) |
| 499 | "Put package on the obsolete list, if not already there." | 470 | "Put package on the obsolete list, if not already there." |
| @@ -523,21 +494,20 @@ REQUIREMENTS is a list of requirements on other packages. | |||
| 523 | Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." | 494 | Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." |
| 524 | (let* ((name (intern name-str)) | 495 | (let* ((name (intern name-str)) |
| 525 | (pkg-desc (assq name package-alist)) | 496 | (pkg-desc (assq name package-alist)) |
| 526 | (new-version (package-version-split version-string)) | 497 | (new-version (version-to-list version-string)) |
| 527 | (new-pkg-desc | 498 | (new-pkg-desc |
| 528 | (cons name | 499 | (cons name |
| 529 | (vector new-version | 500 | (vector new-version |
| 530 | (mapcar | 501 | (mapcar |
| 531 | (lambda (elt) | 502 | (lambda (elt) |
| 532 | (list (car elt) | 503 | (list (car elt) |
| 533 | (package-version-split (car (cdr elt))))) | 504 | (version-to-list (car (cdr elt))))) |
| 534 | requirements) | 505 | requirements) |
| 535 | docstring)))) | 506 | docstring)))) |
| 536 | ;; Only redefine a package if the redefinition is newer. | 507 | ;; Only redefine a package if the redefinition is newer. |
| 537 | (if (or (not pkg-desc) | 508 | (if (or (not pkg-desc) |
| 538 | (package-version-compare new-version | 509 | (version-list-< (package-desc-vers (cdr pkg-desc)) |
| 539 | (package-desc-vers (cdr pkg-desc)) | 510 | new-version)) |
| 540 | '>)) | ||
| 541 | (progn | 511 | (progn |
| 542 | (when pkg-desc | 512 | (when pkg-desc |
| 543 | ;; Remove old package and declare it obsolete. | 513 | ;; Remove old package and declare it obsolete. |
| @@ -548,9 +518,8 @@ Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." | |||
| 548 | ;; You can have two packages with the same version, for instance | 518 | ;; You can have two packages with the same version, for instance |
| 549 | ;; one in the system package directory and one in your private | 519 | ;; one in the system package directory and one in your private |
| 550 | ;; directory. We just let the first one win. | 520 | ;; directory. We just let the first one win. |
| 551 | (unless (package-version-compare new-version | 521 | (unless (version-list-= new-version |
| 552 | (package-desc-vers (cdr pkg-desc)) | 522 | (package-desc-vers (cdr pkg-desc))) |
| 553 | '=) | ||
| 554 | ;; The package is born obsolete. | 523 | ;; The package is born obsolete. |
| 555 | (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) | 524 | (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc)))))) |
| 556 | 525 | ||
| @@ -700,9 +669,8 @@ It will move point to somewhere in the headers." | |||
| 700 | (defun package-installed-p (package &optional min-version) | 669 | (defun package-installed-p (package &optional min-version) |
| 701 | (let ((pkg-desc (assq package package-alist))) | 670 | (let ((pkg-desc (assq package package-alist))) |
| 702 | (and pkg-desc | 671 | (and pkg-desc |
| 703 | (package-version-compare min-version | 672 | (version-list-<= min-version |
| 704 | (package-desc-vers (cdr pkg-desc)) | 673 | (package-desc-vers (cdr pkg-desc)))))) |
| 705 | '<=)))) | ||
| 706 | 674 | ||
| 707 | (defun package-compute-transaction (result requirements) | 675 | (defun package-compute-transaction (result requirements) |
| 708 | (dolist (elt requirements) | 676 | (dolist (elt requirements) |
| @@ -720,9 +688,7 @@ It will move point to somewhere in the headers." | |||
| 720 | (symbol-name next-pkg))) | 688 | (symbol-name next-pkg))) |
| 721 | ((null (stringp hold)) | 689 | ((null (stringp hold)) |
| 722 | (error "Invalid element in `package-load-list'")) | 690 | (error "Invalid element in `package-load-list'")) |
| 723 | ((package-version-compare next-version | 691 | ((version-list-< (version-to-list hold) next-version) |
| 724 | (package-version-split hold) | ||
| 725 | '>) | ||
| 726 | (error "Package '%s' held at version %s, \ | 692 | (error "Package '%s' held at version %s, \ |
| 727 | but version %s required" | 693 | but version %s required" |
| 728 | (symbol-name next-pkg) hold | 694 | (symbol-name next-pkg) hold |
| @@ -730,9 +696,8 @@ but version %s required" | |||
| 730 | (unless pkg-desc | 696 | (unless pkg-desc |
| 731 | (error "Package '%s' is not available for installation" | 697 | (error "Package '%s' is not available for installation" |
| 732 | (symbol-name next-pkg))) | 698 | (symbol-name next-pkg))) |
| 733 | (unless (package-version-compare (package-desc-vers (cdr pkg-desc)) | 699 | (unless (version-list-<= next-version |
| 734 | next-version | 700 | (package-desc-vers (cdr pkg-desc))) |
| 735 | '>=) | ||
| 736 | (error | 701 | (error |
| 737 | "Need package '%s' with version %s, but only %s is available" | 702 | "Need package '%s' with version %s, but only %s is available" |
| 738 | (symbol-name next-pkg) (package-version-join next-version) | 703 | (symbol-name next-pkg) (package-version-join next-version) |
| @@ -788,11 +753,11 @@ Throw an error if the archive version is too new." | |||
| 788 | ;; Version 1 of 'builtin-packages' is a list where the car is | 753 | ;; Version 1 of 'builtin-packages' is a list where the car is |
| 789 | ;; a split emacs version and the cdr is an alist suitable for | 754 | ;; a split emacs version and the cdr is an alist suitable for |
| 790 | ;; package--builtins. | 755 | ;; package--builtins. |
| 791 | (let ((our-version (package-version-split emacs-version)) | 756 | (let ((our-version (version-to-list emacs-version)) |
| 792 | (result package--builtins-base)) | 757 | (result package--builtins-base)) |
| 793 | (setq package--builtins | 758 | (setq package--builtins |
| 794 | (dolist (elt builtins result) | 759 | (dolist (elt builtins result) |
| 795 | (if (package-version-compare our-version (car elt) '>=) | 760 | (if (version-list-<= (car elt) our-version) |
| 796 | (setq result (append (cdr elt) result))))))))) | 761 | (setq result (append (cdr elt) result))))))))) |
| 797 | 762 | ||
| 798 | (defun package-read-archive-contents (archive) | 763 | (defun package-read-archive-contents (archive) |
| @@ -818,8 +783,7 @@ Also, add the originating archive to the end of the package vector." | |||
| 818 | (vconcat (cdr package) (vector archive)))) | 783 | (vconcat (cdr package) (vector archive)))) |
| 819 | (existing-package (cdr (assq name package-archive-contents)))) | 784 | (existing-package (cdr (assq name package-archive-contents)))) |
| 820 | (when (or (not existing-package) | 785 | (when (or (not existing-package) |
| 821 | (package-version-compare version | 786 | (version-list-< (aref existing-package 0) version)) |
| 822 | (aref existing-package 0) '>)) | ||
| 823 | (add-to-list 'package-archive-contents entry)))) | 787 | (add-to-list 'package-archive-contents entry)))) |
| 824 | 788 | ||
| 825 | (defun package-download-transaction (transaction) | 789 | (defun package-download-transaction (transaction) |
| @@ -915,7 +879,7 @@ May narrow buffer or move point even on failure." | |||
| 915 | (mapcar | 879 | (mapcar |
| 916 | (lambda (elt) | 880 | (lambda (elt) |
| 917 | (list (car elt) | 881 | (list (car elt) |
| 918 | (package-version-split (car (cdr elt))))) | 882 | (version-to-list (car (cdr elt))))) |
| 919 | requires)) | 883 | requires)) |
| 920 | (set-text-properties 0 (length file-name) nil file-name) | 884 | (set-text-properties 0 (length file-name) nil file-name) |
| 921 | (set-text-properties 0 (length pkg-version) nil pkg-version) | 885 | (set-text-properties 0 (length pkg-version) nil pkg-version) |
| @@ -964,7 +928,7 @@ The return result is a vector like `package-buffer-info'." | |||
| 964 | (mapcar | 928 | (mapcar |
| 965 | (lambda (elt) | 929 | (lambda (elt) |
| 966 | (list (car elt) | 930 | (list (car elt) |
| 967 | (package-version-split (car (cdr elt))))) | 931 | (version-to-list (car (cdr elt))))) |
| 968 | requires)) | 932 | requires)) |
| 969 | (vector pkg-name requires docstring version-string readme)))) | 933 | (vector pkg-name requires docstring version-string readme)))) |
| 970 | 934 | ||
| @@ -1471,10 +1435,9 @@ Emacs." | |||
| 1471 | (cond ((stringp (cadr hold)) | 1435 | (cond ((stringp (cadr hold)) |
| 1472 | "held") | 1436 | "held") |
| 1473 | ((and (setq builtin (assq name package--builtins)) | 1437 | ((and (setq builtin (assq name package--builtins)) |
| 1474 | (package-version-compare | 1438 | (version-list-= |
| 1475 | (package-desc-vers (cdr builtin)) | 1439 | (package-desc-vers (cdr builtin)) |
| 1476 | (package-desc-vers desc) | 1440 | (package-desc-vers desc))) |
| 1477 | '=)) | ||
| 1478 | "built-in") | 1441 | "built-in") |
| 1479 | (t "installed")) | 1442 | (t "installed")) |
| 1480 | (package-desc-doc desc) | 1443 | (package-desc-doc desc) |
| @@ -1486,7 +1449,7 @@ Emacs." | |||
| 1486 | hold (assq name package-load-list)) | 1449 | hold (assq name package-load-list)) |
| 1487 | (unless (and hold (stringp (cadr hold)) | 1450 | (unless (and hold (stringp (cadr hold)) |
| 1488 | (package-installed-p | 1451 | (package-installed-p |
| 1489 | name (package-version-split (cadr hold)))) | 1452 | name (version-to-list (cadr hold)))) |
| 1490 | (setq info-list | 1453 | (setq info-list |
| 1491 | (package-list-maybe-add name | 1454 | (package-list-maybe-add name |
| 1492 | (package-desc-vers desc) | 1455 | (package-desc-vers desc) |