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.

5 files changed, 435 insertions, 324 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d4ba7de1635..63aeae241c4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,43 @@
 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
         "alpha" and "beta".
         (version-to-list): Handle versions like "10.3d".
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 7042566724c..214830b8b54 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -273,46 +273,35 @@ contrast, `package-user-dir' contains packages for personal use."
   :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.")
-
-(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 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.
+
+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 @@ It will move point to somewhere in the headers."
          (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 @@ but version %s required"
              (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 @@ Will throw an error if the archive version is too new."
             (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 @@ Also, add the originating archive to the end of the package vector."
               (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 @@ download."
   "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 @@ The variable `package-load-list' controls which packages to load."
         (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 @@ The variable `package-load-list' controls which packages to load."
             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 @@ The variable `package-load-list' controls which packages to load."
                                  '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 @@ The variable `package-load-list' controls which packages to load."
                 (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 @@ The variable `package-load-list' controls which packages to load."
     (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 @@ The variable `package-load-list' controls which packages to load."
 (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 @@ package menu.  This lets you see what new packages are
 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 @@ Emacs."
 ;; 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 @@ Emacs."
           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 @@ Emacs."
                                                     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))
-
-(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)
+         (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 (&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 @@ Helper function that does all the work for the user-facing functions."
            ""))
 
     ;; 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.
diff --git a/lisp/finder.el b/lisp/finder.el
index b7eccf3ac70..0e16b9aa44a 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -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 @@ cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
 
 (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 @@ no arguments compiles from `load-path'."
     (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 @@ no arguments compiles from `load-path'."
 
 (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 @@ but absent in `finder-known-keywords'."
       (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 @@ FILE should be in a form suitable for passing to `locate-library'."
 \\[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 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
 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)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 44e59a5c8bd..c2492818b45 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2641,7 +2641,7 @@ will be inserted before the group at point."
 ;;;;;;  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" "\
diff --git a/lisp/info.el b/lisp/info.el
index 65b9492e351..4fa9503b14e 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3372,7 +3372,6 @@ Build a menu of the possible matches."
   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 @@ Build a menu of the possible matches."
     (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 @@ Build a menu of the possible matches."
                     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 @@ Build a menu of the possible matches."
            (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)