changeset 109602:a86a4e812897

Package listing tweaks. * emacs-lisp/package.el (package--list-packages): Fix column alignment. (package--builtins): Tweak descriptions. (package-print-package): Upcase descriptions if necessary. Show all built-in packages in font-lock-builtin-face. (package-list-packages-internal): Omit "emacs" package. Show status of built-in packages as "built-in".
author Chong Yidong <cyd@stupidchicken.com>
date Sat, 31 Jul 2010 20:38:19 -0400
parents 0a12f74cc5d8
children d660473e004d
files lisp/ChangeLog lisp/emacs-lisp/package.el
diffstat 2 files changed, 39 insertions(+), 28 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Aug 01 02:14:14 2010 +0200
+++ b/lisp/ChangeLog	Sat Jul 31 20:38:19 2010 -0400
@@ -1,3 +1,13 @@
+2010-08-01  Chong Yidong  <cyd@stupidchicken.com>
+
+	* emacs-lisp/package.el (package--list-packages): Fix column
+	alignment.
+	(package--builtins): Tweak descriptions.
+	(package-print-package): Upcase descriptions if necessary.  Show
+	all built-in packages in font-lock-builtin-face.
+	(package-list-packages-internal): Omit "emacs" package.  Show
+	status of built-in packages as "built-in".
+
 2010-07-31  Chong Yidong  <cyd@stupidchicken.com>
 
 	* mouse.el (mouse-save-then-kill): Doc fix.  Deactivate mark
--- a/lisp/emacs-lisp/package.el	Sun Aug 01 02:14:14 2010 +0200
+++ b/lisp/emacs-lisp/package.el	Sat Jul 31 20:38:19 2010 -0400
@@ -292,15 +292,15 @@
 	 (if (>= emacs-major-version 22)
 	     ;; FIXME: emacs 22 includes tramp, rcirc, maybe
 	     ;; other things...
-	     '((erc . [(5 2) nil "An Emacs Internet Relay Chat client"])
+	     '((erc . [(5 2) nil "Internet Relay Chat client"])
 	       ;; The external URL is version 1.15, so make sure the
 	       ;; built-in one looks newer.
 	       (url . [(1 16) nil "URL handling libary"])))
 	 (if (>= emacs-major-version 23)
 	     '(;; Strangely, nxml-version is missing in Emacs 23.
 	       ;; We pick the merge date as the version.
-	       (nxml . [(20071123) nil "Major mode for editing XML documents."])
-	       (bubbles . [(0 5) nil "Puzzle game for Emacs."])))))
+	       (nxml . [(20071123) nil "Major mode for XML documents"])
+	       (bubbles . [(0 5) nil "A puzzle game"])))))
   "Alist of all built-in packages.
 Maps the package name to a vector [VERSION REQS DOCSTRING].")
 (put 'package--builtins 'risky-local-variable t)
@@ -358,16 +358,6 @@
       ;; Both null.
       (funcall fun 0 0))))
 
-(defun package--test-version-compare ()
-  "Test suite for `package-version-compare'."
-  (unless (and (package-version-compare '(0) '(0) '=)
-	       (not (package-version-compare '(1) '(0) '=))
-	       (package-version-compare '(1 0 1) '(1) '>=)
-	       (package-version-compare '(1 0 1) '(1) '>)
-	       (not (package-version-compare '(0 9 1) '(1 0 2) '>=)))
-    (error "Failed"))
-  t)
-
 (defun package-strip-version (dirname)
   "Strip the version from a combined package name and version.
 E.g., if given \"quux-23.0\", will return \"quux\""
@@ -1422,7 +1412,7 @@
 
 (defun package-print-package (package version key desc)
   (let ((face
-	 (cond ((eq package 'emacs) 'font-lock-builtin-face)
+	 (cond ((string= key "built-in") 'font-lock-builtin-face)
 	       ((string= key "available") 'default)
 	       ((string= key "held") 'font-lock-constant-face)
 	       ((string= key "disabled") 'font-lock-warning-face)
@@ -1444,7 +1434,9 @@
     ;; FIXME: this 'when' is bogus...
     (when desc
       (indent-to 43 1)
-      (insert (propertize desc 'font-lock-face face)))
+      (let ((opoint (point)))
+	(insert (propertize desc 'font-lock-face face))
+	(upcase-region opoint (min (point) (1+ opoint)))))
     (insert "\n")))
 
 (defun package-list-maybe-add (package version status description result)
@@ -1462,22 +1454,31 @@
     (setq buffer-read-only nil)
     (erase-buffer)
     (let ((info-list)
-	  name desc hold)
+	  name desc hold
+	  builtin)
       ;; List installed packages
       (dolist (elt package-alist)
+	;; Ignore the Emacs package.
 	(setq name (car elt)
 	      desc (cdr elt)
 	      hold (assq name package-load-list))
-	(setq info-list
-	      (package-list-maybe-add name (package-desc-vers desc)
-				      ;; FIXME: it turns out to be
-				      ;; tricky to see if this package
-				      ;; is presently activated.
-				      (if (stringp (cadr hold))
-					  "held"
-					"installed")
-				      (package-desc-doc desc)
-				      info-list)))
+	(unless (eq name 'emacs)
+	  (setq info-list
+		(package-list-maybe-add
+		 name (package-desc-vers desc)
+		 ;; FIXME: it turns out to be tricky to see if this
+		 ;; package is presently activated.
+		 (cond ((stringp (cadr hold))
+			"held")
+		       ((and (setq builtin (assq name package--builtins))
+			     (package-version-compare
+			      (package-desc-vers (cdr builtin))
+			      (package-desc-vers desc)
+			      '=))
+			"built-in")
+		       (t "installed"))
+		 (package-desc-doc desc)
+		 info-list))))
       ;; List available packages
       (dolist (elt package-archive-contents)
 	(setq name (car elt)
@@ -1574,8 +1575,8 @@
 	   '((0 . "")
 	     (2 . "Package")
 	     (20 . "Version")
-	     (30 . "Status")
-	     (41 . "Description"))
+	     (32 . "Status")
+	     (43 . "Description"))
 	   ""))
 
     ;; It's okay to use pop-to-buffer here.  The package menu buffer