changeset 110017:10e66ac64b61

Merge Finder and package-menu functionality. * lisp/finder.el: Require `package'. (finder-known-keywords): Tweak descriptions. Retire `oop' keyword. (finder-package-info): Var deleted. (finder-keywords-hash, finder--builtins-alist): New vars. (finder-compile-keywords): Compute package--builtins and finder-keywords-hash instead of finder-keywords-hash, respecting the "Package" header. (finder-unknown-keywords, finder-list-matches): Use finder-keywords-hash and package--list-packages. (finder-mode): Don't set font-lock-defaults. (finder-exit): We don't use "*Finder-package*" and "*Finder Category*" buffers anymore. * lisp/info.el (Info-finder-find-node): Search package-alist instead of finder-package-info. * lisp/emacs-lisp/package.el (package--builtins-base): Var deleted. (package--builtins): Set default value to nil. (package-initialize): Load precomputed value of package--builtins from finder-inf.el. (package-alist, package-compute-transaction) (package-download-transaction): Improve docstring. (package-read-all-archive-contents): Do not change package--builtins here. (list-packages): Make package-list-packages an alias for this. Sort by status by default. (package--list-packages): Add optional PACKAGES arg. (describe-package-1): Use font-lock-face property. For built-in packages, insert file commentary. (package--generate-package-list): Rename from package-list-packages-internal; all callers changed. Add optional PACKAGES arg. Add alphabetical sort fallbacks. (package-menu--version-predicate, package-menu--status-predicate) (package-menu--description-predicate) (package-menu--name-predicate): New functions.
author Chong Yidong <cyd@stupidchicken.com>
date Sun, 29 Aug 2010 18:15:09 -0400
parents a3e1f7134e6e
children aa172fa85851 c1792addf7ea 1b626601d32d
files lisp/ChangeLog lisp/emacs-lisp/package.el lisp/finder.el lisp/ibuffer.el lisp/info.el
diffstat 5 files changed, 433 insertions(+), 322 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Aug 29 16:10:43 2010 -0400
+++ b/lisp/ChangeLog	Sun Aug 29 18:15:09 2010 -0400
@@ -1,3 +1,41 @@
+2010-08-29  Chong Yidong  <cyd@stupidchicken.com>
+
+	* finder.el: Require `package'.
+	(finder-known-keywords): Tweak descriptions.  Retire `oop' keyword.
+	(finder-package-info): Var deleted.
+	(finder-keywords-hash, finder--builtins-alist): New vars.
+	(finder-compile-keywords): Compute package--builtins and
+	finder-keywords-hash instead of finder-keywords-hash, respecting
+	the "Package" header.
+	(finder-unknown-keywords, finder-list-matches): Use
+	finder-keywords-hash and package--list-packages.
+	(finder-mode): Don't set font-lock-defaults.
+	(finder-exit): We don't use "*Finder-package*" and "*Finder
+	Category*" buffers anymore.
+
+	* emacs-lisp/package.el (package--builtins-base): Var deleted.
+	(package--builtins): Set default value to nil.
+	(package-initialize): Load precomputed value of package--builtins
+	from finder-inf.el.
+	(package-alist, package-compute-transaction)
+	(package-download-transaction): Improve docstring.
+	(package-read-all-archive-contents): Do not change
+	package--builtins here.
+	(list-packages): Make package-list-packages an alias for this.
+	Sort by status by default.
+	(package--list-packages): Add optional PACKAGES arg.
+	(describe-package-1): Use font-lock-face property.  For built-in
+	packages, insert file commentary.
+	(package--generate-package-list): Rename from
+	package-list-packages-internal; all callers changed.  Add optional
+	PACKAGES arg.  Add alphabetical sort fallbacks.
+	(package-menu--version-predicate, package-menu--status-predicate)
+	(package-menu--description-predicate)
+	(package-menu--name-predicate): New functions.
+
+	* info.el (Info-finder-find-node): Search package-alist instead of
+	finder-package-info.
+
 2010-08-29  Chong Yidong  <cyd@stupidchicken.com>
 
 	* subr.el (version-regexp-alist): Don't use "a" and "b" for
--- a/lisp/emacs-lisp/package.el	Sun Aug 29 16:10:43 2010 -0400
+++ b/lisp/emacs-lisp/package.el	Sun Aug 29 18:15:09 2010 -0400
@@ -273,46 +273,35 @@
   :group 'package
   :version "24.1")
 
-(defconst package--builtins-base
-  ;; We use package-version split here to make sure to pick up the
-  ;; minor version.
-  `((emacs . [,(version-to-list emacs-version) nil
-	      "GNU Emacs"])
-    (package . [,(version-to-list package-el-version)
-		nil "Simple package system for GNU Emacs"]))
-  "Packages which are always built-in.")
+;; The value is precomputed in finder-inf.el, but don't load that
+;; until it's needed (i.e. when `package-intialize' is called).
+(defvar package--builtins nil
+  "Alist of built-in packages.
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
 
-(defvar package--builtins
-  (delq nil
-	(append
-	 package--builtins-base
-	 (if (>= emacs-major-version 22)
-	     ;; FIXME: emacs 22 includes tramp, rcirc, maybe
-	     ;; other things...
-	     '((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 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].")
+The vector DESC has the form [VERSION REQS DOCSTRING].
+  VERSION is a version list.
+  REQS is a list of packages (symbols) required by the package.
+  DOCSTRING is a brief description of the package.")
 (put 'package--builtins 'risky-local-variable t)
 
-(defvar package-alist package--builtins
+(defvar package-alist nil
   "Alist of all packages available for activation.
-This maps the package name to a vector [VERSION REQS DOCSTRING].
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
 
-The value is generated by `package-load-descriptor', usually
-called via `package-initialize'.  For user customizations of
-which packages to load/activate, see `package-load-list'.")
+The vector DESC has the form [VERSION REQS DOCSTRING].
+  VERSION is a version list.
+  REQS is a list of packages (symbols) required by the package.
+  DOCSTRING is a brief description of the package.
+
+This variable is set automatically by `package-load-descriptor',
+called via `package-initialize'.  To change which packages are
+loaded and/or activated, customize `package-load-list'.")
 (put 'package-archive-contents 'risky-local-variable t)
 
-(defvar package-activated-list
-  (mapcar #'car package-alist)
+(defvar package-activated-list nil
   "List of the names of currently activated packages.")
 (put 'package-activated-list 'risky-local-variable t)
 
@@ -673,7 +662,19 @@
 	 (version-list-<= min-version
 			  (package-desc-vers (cdr pkg-desc))))))
 
-(defun package-compute-transaction (result requirements)
+(defun package-compute-transaction (package-list requirements)
+  "Return a list of packages to be installed, including PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+
+REQUIREMENTS should be a list of additional requirements; each
+element in this list should have the form (PACKAGE VERSION),
+where PACKAGE is a package name and VERSION is the required
+version of that package (as a list).
+
+This function recursively computes the requirements of the
+packages in REQUIREMENTS, and returns a list of all the packages
+that must be installed.  Packages that are already installed are
+not included in this list."
   (dolist (elt requirements)
     (let* ((next-pkg (car elt))
 	   (next-version (cadr elt)))
@@ -704,13 +705,13 @@
 	     (symbol-name next-pkg) (package-version-join next-version)
 	     (package-version-join (package-desc-vers (cdr pkg-desc)))))
 	  ;; Only add to the transaction if we don't already have it.
-	  (unless (memq next-pkg result)
-	    (setq result (cons next-pkg result)))
-	  (setq result
-		(package-compute-transaction result
+	  (unless (memq next-pkg package-list)
+	    (setq package-list (cons next-pkg package-list)))
+	  (setq package-list
+		(package-compute-transaction package-list
 					     (package-desc-reqs
 					      (cdr pkg-desc))))))))
-  result)
+  package-list)
 
 (defun package-read-from-string (str)
   "Read a Lisp expression from STR.
@@ -744,22 +745,10 @@
 	    (cdr contents))))))
 
 (defun package-read-all-archive-contents ()
-  "Re-read `archive-contents' and `builtin-packages', if they exist.
-Set `package-archive-contents' and `package--builtins' if successful.
-Throw an error if the archive version is too new."
+  "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
   (dolist (archive package-archives)
-    (package-read-archive-contents (car archive)))
-  (let ((builtins (package--read-archive-file "builtin-packages")))
-    (if builtins
-	;; Version 1 of 'builtin-packages' is a list where the car is
-	;; a split emacs version and the cdr is an alist suitable for
-	;; package--builtins.
-	(let ((our-version (version-to-list emacs-version))
-	      (result package--builtins-base))
-	  (setq package--builtins
-		(dolist (elt builtins result)
-		  (if (version-list-<= (car elt) our-version)
-		      (setq result (append (cdr elt) result)))))))))
+    (package-read-archive-contents (car archive))))
 
 (defun package-read-archive-contents (archive)
   "Re-read `archive-contents' and `builtin-packages' for ARCHIVE.
@@ -787,9 +776,13 @@
               (version-list-< (aref existing-package 0) version))
       (add-to-list 'package-archive-contents entry))))
 
-(defun package-download-transaction (transaction)
-  "Download and install all the packages in the given transaction."
-  (dolist (elt transaction)
+(defun package-download-transaction (package-list)
+  "Download and install all the packages in PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+This function assumes that all package requirements in
+PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
+using `package-compute-transaction'."
+  (dolist (elt package-list)
     (let* ((desc (cdr (assq elt package-archive-contents)))
 	   ;; As an exception, if package is "held" in
 	   ;; `package-load-list', download the held version.
@@ -1028,6 +1021,9 @@
   "Load Emacs Lisp packages, and activate them.
 The variable `package-load-list' controls which packages to load."
   (interactive)
+  (require 'finder-inf nil t)
+  (setq package-alist package--builtins)
+  (setq package-activated-list (mapcar #'car package-alist))
   (setq package-obsolete-alist nil)
   (package-load-all-descriptors)
   (package-read-all-archive-contents)
@@ -1066,6 +1062,7 @@
 	(describe-package-1 package)))))
 
 (defun describe-package-1 (package)
+  (require 'lisp-mnt)
   (let ((package-name (symbol-name package))
 	(built-in (assq package package--builtins))
 	desc pkg-dir reqs version installable)
@@ -1088,9 +1085,10 @@
 	    installable t)
       (insert "an uninstalled package.\n\n"))
 
-    (insert "     " (propertize "Status" 'face 'bold) ": ")
+    (insert "     " (propertize "Status" 'font-lock-face 'bold) ": ")
     (cond (pkg-dir
-	   (insert (propertize "Installed" 'face 'font-lock-comment-face))
+	   (insert (propertize "Installed"
+			       'font-lock-face 'font-lock-comment-face))
 	   (insert " in `")
 	   ;; Todo: Add button for uninstalling.
 	   (help-insert-xref-button (file-name-as-directory pkg-dir)
@@ -1112,14 +1110,17 @@
 				 'package-symbol package
 				 'action 'package-install-button-action)))
 	  (built-in
-	   (insert (propertize "Built-in" 'face 'font-lock-builtin-face) "."))
+	   (insert (propertize "Built-in"
+			       'font-lock-face 'font-lock-builtin-face) "."))
 	  (t (insert "Deleted.")))
     (insert "\n")
-    (when version
-      (insert "    " (propertize "Version" 'face 'bold) ": " version "\n"))
+    (and version
+	 (> (length version) 0)
+	 (insert "    "
+		 (propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
     (setq reqs (package-desc-reqs desc))
     (when reqs
-      (insert "   " (propertize "Requires" 'face 'bold) ": ")
+      (insert "   " (propertize "Requires" 'font-lock-face 'bold) ": ")
       (let ((first t)
 	    name vers text)
 	(dolist (req reqs)
@@ -1134,38 +1135,46 @@
 		(t (insert ", ")))
 	  (help-insert-xref-button text 'help-package name))
 	(insert "\n")))
-    (insert "    " (propertize "Summary" 'face 'bold)
+    (insert "    " (propertize "Summary" 'font-lock-face 'bold)
 	    ": " (package-desc-doc desc) "\n\n")
 
-    ;; Insert the package commentary.
-    ;; FIXME: We should try to be smarter about when to download.
-    (let ((readme (expand-file-name (concat package-name "-readme.txt")
-				    package-user-dir)))
-      ;; Try downloading the commentary.  If that fails, try an
-      ;; existing readme file in `package-user-dir'.
-      (cond ((let ((buffer
-		    (condition-case nil
-			(url-retrieve-synchronously
-			 (concat (package-archive-url package)
-				 package-name "-readme.txt"))
-		      (error nil)))
-		   response)
-	       (when buffer
-		 (with-current-buffer buffer
-		   (setq response (url-http-parse-response))
-		   (if (or (< response 200) (>= response 300))
-		       (setq response nil)
-		     (setq buffer-file-name
-			   (expand-file-name readme package-user-dir))
-		     (delete-region (point-min) (1+ url-http-end-of-headers))
-		     (save-buffer)))
-		 (when response
-		   (insert-buffer-substring buffer)
-		   (kill-buffer buffer)
-		   t))))
-	    ((file-readable-p readme)
-	     (insert-file-contents readme)
-	     (goto-char (point-max)))))))
+    (if (assq package package--builtins)
+	;; For built-in packages, insert the commentary.
+	(let ((fn (locate-file (concat package-name ".el") load-path
+			       load-file-rep-suffixes))
+	      (opoint (point)))
+	  (insert (or (lm-commentary fn) ""))
+	  (save-excursion
+	    (goto-char opoint)
+	    (when (re-search-forward "^;;; Commentary:\n" nil t)
+	      (replace-match ""))
+	    (while (re-search-forward "^\\(;+ ?\\)" nil t)
+	      (replace-match ""))))
+      (let ((readme (expand-file-name (concat package-name "-readme.txt")
+				      package-user-dir)))
+	;; For elpa packages, try downloading the commentary.  If that
+	;; fails, try an existing readme file in `package-user-dir'.
+	(cond ((let ((buffer (ignore-errors
+			       (url-retrieve-synchronously
+				(concat (package-archive-url package)
+					package-name "-readme.txt"))))
+		     response)
+		 (when buffer
+		   (with-current-buffer buffer
+		     (setq response (url-http-parse-response))
+		     (if (or (< response 200) (>= response 300))
+			 (setq response nil)
+		       (setq buffer-file-name
+			     (expand-file-name readme package-user-dir))
+		       (delete-region (point-min) (1+ url-http-end-of-headers))
+		       (save-buffer)))
+		   (when response
+		     (insert-buffer-substring buffer)
+		     (kill-buffer buffer)
+		     t))))
+	      ((file-readable-p readme)
+	       (insert-file-contents readme)
+	       (goto-char (point-max))))))))
 
 (defun package-install-button-action (button)
   (let ((package (button-get button 'package-symbol)))
@@ -1195,6 +1204,8 @@
     (define-key map "x" 'package-menu-execute)
     (define-key map "h" 'package-menu-quick-help)
     (define-key map "?" 'package-menu-describe-package)
+    (define-key map [follow-link] 'mouse-face)
+    (define-key map [mouse-2] 'mouse-select-window)
     (define-key map [menu-bar package-menu] (cons "Package" menu-map))
     (define-key menu-map [mq]
       '(menu-item "Quit" quit-window
@@ -1246,6 +1257,7 @@
 (defvar package-menu-sort-button-map
   (let ((map (make-sparse-keymap)))
     (define-key map [header-line mouse-1] 'package-menu-sort-by-column)
+    (define-key map [header-line mouse-2] 'package-menu-sort-by-column)
     (define-key map [follow-link] 'mouse-face)
     map)
   "Local keymap for package menu sort buttons.")
@@ -1276,12 +1288,12 @@
 available for download."
   (interactive)
   (package-refresh-contents)
-  (package-list-packages-internal))
+  (package--generate-package-list))
 
 (defun package-menu-revert ()
   "Update the list of packages."
   (interactive)
-  (package-list-packages-internal))
+  (package--generate-package-list))
 
 (defun package-menu-describe-package ()
   "Describe the package in the current line."
@@ -1429,7 +1441,7 @@
 ;; This decides how we should sort; nil means by package name.
 (defvar package-menu-sort-key nil)
 
-(defun package-list-packages-internal ()
+(defun package--generate-package-list (&optional packages)
   (package-initialize)			; FIXME: do this here?
   (with-current-buffer (get-buffer-create "*Packages*")
     (setq buffer-read-only nil)
@@ -1439,34 +1451,35 @@
 	  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))
-	(unless (memq name '(emacs package))
+	(setq name (car elt))
+	(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
+		   (or (null packages)
+		       (memq name packages)))
+	  (setq desc (cdr elt)
+		hold (cadr (assq name package-load-list))
+		builtin (cdr (assq name package--builtins)))
 	  (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))
+		 (cond ((stringp hold) "held")
+		       ((and builtin
 			     (version-list-=
-			      (package-desc-vers (cdr builtin))
+			      (package-desc-vers builtin)
 			      (package-desc-vers desc)))
 			"built-in")
 		       (t "installed"))
 		 (package-desc-doc desc)
 		 info-list))))
-      ;; List available packages
+
+      ;; List available and disabled packages
       (dolist (elt package-archive-contents)
 	(setq name (car elt)
 	      desc (cdr elt)
 	      hold (assq name package-load-list))
-	(unless (and hold (stringp (cadr hold))
-		     (package-installed-p
-		      name (version-to-list (cadr hold))))
+	(when (or (null packages)
+		  (memq name packages))
 	  (setq info-list
 		(package-list-maybe-add name
 					(package-desc-vers desc)
@@ -1488,47 +1501,80 @@
 						    info-list)))
 		    (cdr elt)))
 	    package-obsolete-alist)
-      (let ((selector (cond
-		       ((string= package-menu-sort-key "Version")
-			;; FIXME this doesn't work.
-			#'(lambda (e) (cdr (car e))))
-		       ((string= package-menu-sort-key "Status")
-			#'(lambda (e) (car (cdr e))))
-		       ((string= package-menu-sort-key "Description")
-			#'(lambda (e) (car (cdr (cdr e)))))
-		       (t ; "Package" is default.
-			#'(lambda (e) (symbol-name (car (car e))))))))
-	(setq info-list
-	      (sort info-list
-		    (lambda (left right)
-		      (let ((vleft (funcall selector left))
-			    (vright (funcall selector right)))
-			(string< vleft vright))))))
-      (mapc (lambda (elt)
-	      (package-print-package (car (car elt))
-				     (cdr (car elt))
-				     (car (cdr elt))
-				     (car (cdr (cdr elt)))))
-	    info-list))
+
+      (setq info-list
+	    (sort info-list
+		  (cond ((string= package-menu-sort-key "Version")
+			 'package-menu--version-predicate)
+			((string= package-menu-sort-key "Status")
+			 'package-menu--status-predicate)
+			((string= package-menu-sort-key "Description")
+			 'package-menu--description-predicate)
+			(t ; Sort by package name by default
+			 'package-menu--name-predicate))))
+
+      (dolist (elt info-list)
+	(package-print-package (car (car elt))
+			       (cdr (car elt))
+			       (car (cdr elt))
+			       (car (cdr (cdr elt))))))
     (goto-char (point-min))
+    (set-buffer-modified-p nil)
     (current-buffer)))
 
+(defun package-menu--version-predicate (left right)
+  (let ((vleft  (cdr (car left)))
+	(vright (cdr (car right))))
+    (if (version-list-= vleft right)
+	(package-menu--name-predicate left right)
+      (version-list-< left right))))
+
+(defun package-menu--status-predicate (left right)
+  (let ((sleft  (cadr left))
+	(sright (cadr right)))
+    (cond ((string= sleft sright)
+	   (package-menu--name-predicate left right))
+	  ((string= sleft  "available") t)
+	  ((string= sright "available") nil)
+	  ((string= sleft  "installed") t)
+	  ((string= sright "installed") nil)
+	  ((string= sleft  "held") t)
+	  ((string= sright "held") nil)
+	  ((string= sleft  "built-in") t)
+	  ((string= sright "built-in") nil)
+	  ((string= sleft  "obsolete") t)
+	  ((string= sright  "obsolete") nil)
+	  (t (string< sleft sright)))))
+
+(defun package-menu--description-predicate (left right)
+  (let ((sleft  (car (cddr left)))
+	(sright (car (cddr right))))
+    (if (string= sleft sright)
+	(package-menu--name-predicate left right)
+      (string< sleft sright))))
+
+(defun package-menu--name-predicate (left right)
+  (string< (symbol-name (caar left))
+	   (symbol-name (caar right))))
+
 (defun package-menu-sort-by-column (&optional e)
   "Sort the package menu by the last column clicked on."
-  (interactive (list last-input-event))
+  (interactive "e")
   (if e (mouse-select-window e))
   (let* ((pos (event-start e))
-	 (obj (posn-object pos))
-	 (col (if obj
-		  (get-text-property (cdr obj) 'column-name (car obj))
-		(get-text-property (posn-point pos) 'column-name))))
-    (setq package-menu-sort-key col))
-  (package-list-packages-internal))
+  	 (obj (posn-object pos))
+  	 (col (if obj
+  		  (get-text-property (cdr obj) 'column-name (car obj))
+  		(get-text-property (posn-point pos) 'column-name)))
+  	 (inhibit-read-only t))
+    (setq package-menu-sort-key col)
+    (package--generate-package-list)))
 
-(defun package--list-packages ()
-  "Display a list of packages.
-Helper function that does all the work for the user-facing functions."
-  (with-current-buffer (package-list-packages-internal)
+(defun package--list-packages (&optional packages)
+  "Display the properties of PACKAGES.
+PACKAGES should be a list of package names (symbols).
+If PACKAGES is nil, display all packages in `package-alist'."
+  (with-current-buffer (package--generate-package-list packages)
     (package-menu-mode)
     ;; Set up the header line.
     (setq header-line-format
@@ -1560,22 +1606,22 @@
 	   ""))
 
     ;; It's okay to use pop-to-buffer here.  The package menu buffer
-    ;; has keybindings, and the user just typed 'M-x
-    ;; package-list-packages', suggesting that they might want to use
-    ;; them.
+    ;; has keybindings, and the user just typed `M-x list-packages',
+    ;; suggesting that they might want to use them.
     (pop-to-buffer (current-buffer))))
 
 ;;;###autoload
-(defun package-list-packages ()
+(defun list-packages ()
   "Display a list of packages.
 Fetches the updated list of packages before displaying.
 The list is displayed in a buffer named `*Packages*'."
   (interactive)
   (package-refresh-contents)
+  (setq package-menu-sort-key "Status")
   (package--list-packages))
 
 ;;;###autoload
-(defalias 'list-packages 'package-list-packages)
+(defalias 'package-list-packages 'list-packages)
 
 (defun package-list-packages-no-fetch ()
   "Display a list of packages.
--- a/lisp/finder.el	Sun Aug 29 16:10:43 2010 -0400
+++ b/lisp/finder.el	Sun Aug 29 18:15:09 2010 -0400
@@ -30,6 +30,7 @@
 
 ;;; Code:
 
+(require 'package)
 (require 'lisp-mnt)
 (require 'find-func)			;for find-library(-suffixes)
 ;; Use `load' rather than `require' so that it doesn't get loaded
@@ -39,46 +40,42 @@
 ;; These are supposed to correspond to top-level customization groups,
 ;; says rms.
 (defvar finder-known-keywords
-  '(
-    (abbrev	. "abbreviation handling, typing shortcuts, macros")
-    ;; Too specific:
-    (bib	. "code related to the `bib' bibliography processor")
-    (c		. "support for the C language and related languages")
-    (calendar	. "calendar and time management support")
-    (comm	. "communications, networking, remote access to files")
+  '((abbrev	. "abbreviation handling, typing shortcuts, and macros")
+    (bib	. "bibliography processors")
+    (c		. "C and related programming languages")
+    (calendar	. "calendar and time management tools")
+    (comm	. "communications, networking, and remote file access")
     (convenience . "convenience features for faster editing")
-    (data	. "support for editing files of data")
-    (docs	. "support for Emacs documentation")
+    (data	. "editing data (non-text) files")
+    (docs	. "Emacs documentation facilities")
     (emulations	. "emulations of other editors")
     (extensions	. "Emacs Lisp language extensions")
-    (faces	. "support for multiple fonts")
-    (files      . "support for editing and manipulating files")
-    (frames     . "support for Emacs frames and window systems")
+    (faces	. "fonts and colors for text")
+    (files      . "file editing and manipulation")
+    (frames     . "Emacs frames and window systems")
     (games	. "games, jokes and amusements")
-    (hardware	. "support for interfacing with exotic hardware")
-    (help	. "support for on-line help systems")
-    (hypermedia . "support for links between text or other media types")
-    (i18n	. "internationalization and alternate character-set support")
+    (hardware	. "interfacing with system hardware")
+    (help	. "on-line help systems")
+    (hypermedia . "links between text or other media types")
+    (i18n	. "internationalization and character-set support")
     (internal	. "code for Emacs internals, build process, defaults")
     (languages	. "specialized modes for editing programming languages")
     (lisp	. "Lisp support, including Emacs Lisp")
     (local	. "code local to your site")
-    (maint	. "maintenance aids for the Emacs development group")
-    (mail	. "modes for electronic-mail handling")
-    (matching	. "various sorts of searching and matching")
+    (maint	. "Emacs development tools and aids")
+    (mail	. "email reading and posting")
+    (matching	. "searching, matching, and sorting")
     (mouse	. "mouse support")
-    (multimedia . "images and sound support")
-    (news	. "support for netnews reading and posting")
-    (oop        . "support for object-oriented programming")
-    (outlines   . "support for hierarchical outlining")
-    (processes	. "process, subshell, compilation, and job control support")
-    (terminals	. "support for terminal types")
-    (tex	. "supporting code for the TeX formatter")
+    (multimedia . "images and sound")
+    (news	. "USENET news reading and posting")
+    (outlines   . "hierarchical outlining and note taking")
+    (processes	. "processes, subshells, and compilation")
+    (terminals	. "text terminals (ttys)")
+    (tex	. "the TeX document formatter")
     (tools	. "programming tools")
-    (unix	. "front-ends/assistants for, or emulators of, UNIX-like features")
+    (unix	. "UNIX feature interfaces and emulators")
     (vc		. "version control")
-    (wp		. "word processing")
-    ))
+    (wp		. "word processing")))
 
 (defvar finder-mode-map
   (let ((map (make-sparse-keymap))
@@ -125,8 +122,9 @@
 
 ;;; Code for regenerating the keyword list.
 
-(defvar finder-package-info nil
-  "Assoc list mapping file names to description & keyword lists.")
+(defvar finder-keywords-hash nil
+  "Hash table mapping keywords to lists of package names.
+Keywords and package names both should be symbols.")
 
 (defvar generated-finder-keywords-file "finder-inf.el"
   "The function `finder-compile-keywords' writes keywords into this file.")
@@ -142,10 +140,91 @@
 
 (autoload 'autoload-rubric "autoload")
 
+(defvar finder--builtins-alist
+  '(("calc" . calc)
+    ("ede"  . ede)
+    ("erc"  . erc)
+    ("eshell" . eshell)
+    ("gnus" . gnus)
+    ("international" . emacs)
+    ("language" . emacs)
+    ("mh-e" . mh-e)
+    ("semantic" . semantic)
+    ("analyze" . semantic)
+    ("bovine" . semantic)
+    ("decorate" . semantic)
+    ("symref" . semantic)
+    ("wisent" . semantic)
+    ("nxml" . nxml)
+    ("org"  . org)
+    ("srecode" . srecode)
+    ("term" . emacs)
+    ("url"  . url))
+  "Alist of built-in package directories.
+Each element should have the form (DIR . PACKAGE), where DIR is a
+directory name and PACKAGE is the name of a package (a symbol).
+When generating `package--builtins', Emacs assumes any file in
+DIR is part of the package PACKAGE.")
+
 (defun finder-compile-keywords (&rest dirs)
-  "Regenerate the keywords association list into `generated-finder-keywords-file'.
-Optional arguments DIRS are a list of Emacs Lisp directories to compile from;
-no arguments compiles from `load-path'."
+  "Regenerate list of built-in Emacs packages.
+This recomputes `package--builtins' and `finder-keywords-hash',
+and prints them into the file `generated-finder-keywords-file'.
+
+Optional DIRS is a list of Emacs Lisp directories to compile
+from; the default is `load-path'."
+  ;; Allow compressed files also.
+  (setq package--builtins nil)
+  (setq finder-keywords-hash (make-hash-table :test 'eq))
+  (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
+	package-override files base-name processed
+	summary keywords package version entry desc)
+    (dolist (d (or dirs load-path))
+      (when (file-exists-p (directory-file-name d))
+	(message "Directory %s" d)
+	(setq package-override
+	      (intern-soft
+	       (cdr-safe
+		(assoc (file-name-nondirectory (directory-file-name d))
+		       finder--builtins-alist))))
+	(setq files (directory-files d nil el-file-regexp))
+	(dolist (f files)
+	  (unless (or (string-match finder-no-scan-regexp f)
+		      (null (setq base-name
+				  (and (string-match el-file-regexp f)
+				       (intern (match-string 1 f)))))
+		      (memq base-name processed))
+	    (push base-name processed)
+	    (with-temp-buffer
+	      (insert-file-contents (expand-file-name f d))
+	      (setq summary  (lm-synopsis)
+		    keywords (mapcar 'intern (lm-keywords-list))
+		    package  (or package-override
+				 (intern-soft (lm-header "package"))
+				 base-name)
+		    version  (lm-header "version")))
+	    (when summary
+	      (setq version (ignore-errors (version-to-list version)))
+	      (setq entry (assq package package--builtins))
+	      (cond ((null entry)
+		     (push (cons package (vector version nil summary))
+			   package--builtins))
+		    ((eq base-name package)
+		     (setq desc (cdr entry))
+		     (aset desc 0 version)
+		     (aset desc 2 summary)))
+	      (dolist (kw keywords)
+		(puthash kw
+			 (cons package
+			       (delq package
+				     (gethash kw finder-keywords-hash)))
+			 finder-keywords-hash))))))))
+
+  (setq package--builtins
+	(sort package--builtins
+	      (lambda (a b) (string< (symbol-name (car a))
+				     (symbol-name (car b))))))
+
   (save-excursion
     (find-file generated-finder-keywords-file)
     (setq buffer-undo-list t)
@@ -153,40 +232,23 @@
     (insert (autoload-rubric generated-finder-keywords-file
                              "keyword-to-package mapping" t))
     (search-backward "")
-    (insert "(setq finder-package-info '(\n")
-    (let (processed summary keywords)
-      (mapc
-       (lambda (d)
-	 (when (file-exists-p (directory-file-name d))
-	   (message "Directory %s" d)
-	   (mapc
-	    (lambda (f)
-              ;; FIXME should this not be using (expand-file-name f d)?
-	      (unless (or (member f processed)
-                          (string-match finder-no-scan-regexp f))
-                (setq processed (cons f processed))
-                (with-temp-buffer
-                  (insert-file-contents (expand-file-name f d))
-                  (setq summary (lm-synopsis)
-                        keywords (lm-keywords-list)))
-                (insert
-                 (format "    (\"%s\"\n        "
-                         (if (string-match "\\.\\(gz\\|Z\\)$" f)
-                             (file-name-sans-extension f)
-                           f)))
-                (prin1 summary (current-buffer))
-                (insert "\n        ")
-                (prin1 (mapcar 'intern keywords) (current-buffer))
-                (insert ")\n")))
-	    (directory-files d nil
-                             ;; Allow compressed files also.  FIXME:
-                             ;; generalize this, especially for
-                             ;; MS-DOG-type filenames.
-                             "^[^=].*\\.el\\(\\.\\(gz\\|Z\\)\\)?$"
-                             ))))
-       (or dirs load-path)))
-    (insert "    ))\n")
-    (eval-buffer)         ; so we get the new keyword list immediately
+    (insert "(setq package--builtins '(\n")
+    (dolist (package package--builtins)
+      (insert "  (")
+      (prin1 (car package) (current-buffer))
+      (insert " .\n    [")
+      (let ((desc (cdr package)))
+	(prin1 (aref desc 0) (current-buffer))
+	(insert " ")
+	(prin1 (aref desc 1) (current-buffer))
+	(insert " ")
+	(prin1 (aref desc 2) (current-buffer)))
+      (insert "])\n"))
+    (insert "    ))\n\n")
+    ;; Insert hash table.
+    (insert "(setq finder-keywords-hash\n      ")
+    (prin1 finder-keywords-hash (current-buffer))
+    (insert ")\n")
     (basic-save-buffer)))
 
 (defun finder-compile-keywords-make-dist ()
@@ -226,26 +288,14 @@
 
 (defun finder-unknown-keywords ()
   "Return an alist of unknown keywords and number of their occurences.
-Unknown are keywords that are present in `finder-package-info'
-but absent in `finder-known-keywords'."
-  (let ((unknown-keywords-hash (make-hash-table)))
-    ;; Prepare a hash where key is a keyword
-    ;; and value is the number of keyword occurences.
-    (mapc (lambda (package)
-	    (mapc (lambda (keyword)
-		    (unless (assq keyword finder-known-keywords)
-		      (puthash keyword
-			       (1+ (gethash keyword unknown-keywords-hash 0))
-			       unknown-keywords-hash)))
-		  (nth 2 package)))
-	  finder-package-info)
-    ;; Make an alist from the hash and sort by the keyword name.
-    (sort (let (unknown-keywords-list)
-	    (maphash (lambda (key value)
-		       (push (cons key value) unknown-keywords-list))
-		     unknown-keywords-hash)
-	    unknown-keywords-list)
-	  (lambda (a b) (string< (car a) (car b))))))
+Unknown keywords are those present in `finder-keywords-hash' but
+not `finder-known-keywords'."
+  (let (alist)
+    (maphash (lambda (kw packages)
+	       (unless (assq kw finder-known-keywords)
+		 (push (cons kw (length packages)) alist)))
+	     finder-keywords-hash)
+    (sort alist (lambda (a b) (string< (car a) (car b))))))
 
 ;;;###autoload
 (defun finder-list-keywords ()
@@ -255,46 +305,28 @@
       (pop-to-buffer "*Finder*")
     (pop-to-buffer (get-buffer-create "*Finder*"))
     (finder-mode)
-    (setq buffer-read-only nil
-          buffer-undo-list t)
-    (erase-buffer)
-    (mapc
-     (lambda (assoc)
-       (let ((keyword (car assoc)))
-	 (insert (symbol-name keyword))
-	 (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
-	 (finder-mouse-face-on-line)))
-     finder-known-keywords)
-    (goto-char (point-min))
-    (setq finder-headmark (point)
-          buffer-read-only t)
-    (set-buffer-modified-p nil)
-    (balance-windows)
-    (finder-summary)))
+    (let ((inhibit-read-only t))
+      (erase-buffer)
+      (dolist (assoc finder-known-keywords)
+	(let ((keyword (car assoc)))
+	  (insert (propertize (symbol-name keyword)
+			      'font-lock-face 'font-lock-constant-face))
+	  (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
+	  (finder-mouse-face-on-line)))
+      (goto-char (point-min))
+      (setq finder-headmark (point)
+	    buffer-read-only t)
+      (set-buffer-modified-p nil)
+      (balance-windows)
+      (finder-summary))))
 
 (defun finder-list-matches (key)
-  (pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*")))
-  (finder-mode)
-  (setq buffer-read-only nil
-         buffer-undo-list t)
-  (erase-buffer)
-  (let ((id (intern key)))
-    (insert
-     "The following packages match the keyword `" key "':\n\n")
-    (setq finder-headmark (point))
-    (mapc
-     (lambda (x)
-       (when (memq id (cadr (cdr x)))
-         (insert (car x))
-         (finder-insert-at-column 16 (concat (cadr x) "\n"))
-         (finder-mouse-face-on-line)))
-     finder-package-info)
-    (goto-char (point-min))
-    (forward-line)
-    (setq buffer-read-only t)
-    (set-buffer-modified-p nil)
-    (shrink-window-if-larger-than-buffer)
-    (finder-summary)))
+  (let* ((id (intern key))
+	 (packages (gethash id finder-keywords-hash)))
+    (unless packages
+      (error "No packages matching key `%s'" key))
+    (setq package-menu-sort-key nil)
+    (package--list-packages packages)))
 
 (define-button-type 'finder-xref 'action #'finder-goto-xref)
 
@@ -381,8 +413,8 @@
 \\[finder-select]	more help for the item on the current line
 \\[finder-exit]	exit Finder mode and kill the Finder buffer."
   :syntax-table finder-mode-syntax-table
-  (setq font-lock-defaults '(finder-font-lock-keywords nil nil
-                             (("+-*/.<>=!?$%_&~^:@" . "w")) nil))
+  (setq buffer-read-only t
+	buffer-undo-list t)
   (set (make-local-variable 'finder-headmark) nil))
 
 (defun finder-summary ()
@@ -399,8 +431,8 @@
 Delete the window and kill all Finder-related buffers."
   (interactive)
   (ignore-errors (delete-window))
-  (dolist (buff '("*Finder*" "*Finder-package*" "*Finder Category*"))
-    (and (get-buffer buff) (kill-buffer buff))))
+  (let ((buf "*Finder*"))
+    (and (get-buffer buf) (kill-buffer buf))))
 
 
 (provide 'finder)
--- a/lisp/ibuffer.el	Sun Aug 29 16:10:43 2010 -0400
+++ b/lisp/ibuffer.el	Sun Aug 29 18:15:09 2010 -0400
@@ -2641,7 +2641,7 @@
 ;;;;;;  ibuffer-backward-filter-group ibuffer-forward-filter-group
 ;;;;;;  ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
 ;;;;;;  ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
-;;;;;;  ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "e1272bfdc7c3b6e926b2a68155217303")
+;;;;;;  ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "fa9822b5ef905f06d8a03dc9ce3a2894")
 ;;; Generated autoloads from ibuf-ext.el
 
 (autoload 'ibuffer-auto-mode "ibuf-ext" "\
--- a/lisp/info.el	Sun Aug 29 16:10:43 2010 -0400
+++ b/lisp/info.el	Sun Aug 29 18:15:09 2010 -0400
@@ -3372,7 +3372,6 @@
   filename)
 
 (defvar finder-known-keywords)
-(defvar finder-package-info)
 (declare-function find-library-name "find-func" (library))
 (declare-function finder-unknown-keywords "finder" ())
 (declare-function lm-commentary "lisp-mnt" (&optional file))
@@ -3388,15 +3387,14 @@
     (insert "Finder Keywords\n")
     (insert "***************\n\n")
     (insert "* Menu:\n\n")
-    (mapc
-     (lambda (assoc)
-       (let ((keyword (car assoc)))
-	 (insert (format "* %-14s %s.\n"
-			 (concat (symbol-name keyword) "::")
-			 (cdr assoc)))))
-     (append '((all . "All package info")
-	       (unknown . "unknown keywords"))
-	   finder-known-keywords)))
+    (dolist (assoc (append '((all . "All package info")
+			     (unknown . "unknown keywords"))
+			   finder-known-keywords))
+      (let ((keyword (car assoc)))
+	(insert (format "* %s %s.\n"
+			(concat (symbol-name keyword) ": "
+				"kw:" (symbol-name keyword) ".")
+			(cdr assoc))))))
    ((equal nodename "unknown")
     ;; Display unknown keywords
     (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n"
@@ -3416,17 +3414,36 @@
 		    Info-finder-file nodename))
     (insert "Finder Package Info\n")
     (insert "*******************\n\n")
-    (mapc (lambda (package)
-	    (insert (format "%s - %s\n"
-			    (format "*Note %s::" (nth 0 package))
-			    (nth 1 package)))
-	    (insert "Keywords: "
-		    (mapconcat (lambda (keyword)
-				 (format "*Note %s::" (symbol-name keyword)))
-			       (nth 2 package) ", ")
-		    "\n\n"))
-	  finder-package-info))
-   ((string-match-p "\\.el\\'" nodename)
+    (dolist (package package-alist)
+      (insert (format "%s - %s\n"
+		      (format "*Note %s::" (nth 0 package))
+		      (nth 1 package)))))
+   ((string-match "\\`kw:" nodename)
+    (setq nodename (substring nodename (match-end 0)))
+    ;; Display packages that match the keyword
+    ;; or the list of keywords separated by comma.
+    (insert (format "\n\^_\nFile: %s,  Node: kw:%s,  Up: Top\n\n"
+		    Info-finder-file nodename))
+    (insert "Finder Packages\n")
+    (insert "***************\n\n")
+    (insert
+     "The following packages match the keyword `" nodename "':\n\n")
+    (insert "* Menu:\n\n")
+    (let ((keywords
+	   (mapcar 'intern (if (string-match-p "," nodename)
+			       (split-string nodename ",[ \t\n]*" t)
+			     (list nodename))))
+	  hits desc)
+      (dolist (kw keywords)
+	(push (copy-tree (gethash kw finder-keywords-hash)) hits))
+      (setq hits (delete-dups (apply 'append hits)))
+      (dolist (package hits)
+	(setq desc (cdr-safe (assq package package-alist)))
+	(when (vectorp desc)
+	  (insert (format "* %-16s %s.\n"
+			  (concat (symbol-name package) "::")
+			  (aref desc 2)))))))
+   (t
     ;; Display commentary section
     (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n"
 		    Info-finder-file nodename))
@@ -3447,29 +3464,7 @@
 	   (goto-char (point-min))
 	   (while (re-search-forward "^;+ ?" nil t)
 	     (replace-match "" nil nil))
-	   (buffer-string))))))
-   (t
-    ;; Display packages that match the keyword
-    ;; or the list of keywords separated by comma.
-    (insert (format "\n\^_\nFile: %s,  Node: %s,  Up: Top\n\n"
-		    Info-finder-file nodename))
-    (insert "Finder Packages\n")
-    (insert "***************\n\n")
-    (insert
-     "The following packages match the keyword `" nodename "':\n\n")
-    (insert "* Menu:\n\n")
-    (let ((keywords
-	   (mapcar 'intern (if (string-match-p "," nodename)
-			       (split-string nodename ",[ \t\n]*" t)
-			     (list nodename)))))
-      (mapc
-       (lambda (package)
-	 (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package)))
-				   keywords))
-	   (insert (format "* %-16s %s.\n"
-			   (concat (nth 0 package) "::")
-			   (nth 1 package)))))
-       finder-package-info)))))
+	   (buffer-string))))))))
 
 ;;;###autoload
 (defun info-finder (&optional keywords)