aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2010-08-09 14:05:56 -0400
committerChong Yidong2010-08-09 14:05:56 -0400
commit148cef8e7a25f4d05d3b90c78fd8714f64048d24 (patch)
tree71d6a540d19517206a421becf0cec58ec1c58b22
parentb84fc05a591171240d8842490d068356933eb5c2 (diff)
downloademacs-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/ChangeLog17
-rw-r--r--lisp/emacs-lisp/package-x.el7
-rw-r--r--lisp/emacs-lisp/package.el89
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 @@
12010-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
12010-08-09 Kenichi Handa <handa@m17n.org> 182010-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.
345FUN 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.
363E.g., if given \"quux-23.0\", will return \"quux\"" 336E.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.
523Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." 494Each 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, \
727but version %s required" 693but 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)