emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r101243: Fix several Package Menu and


From: Chong Yidong
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r101243: Fix several Package Menu and Finder bugs.
Date: Mon, 30 Aug 2010 21:53:46 -0400
User-agent: Bazaar (2.0.3)

------------------------------------------------------------
revno: 101243
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Mon 2010-08-30 21:53:46 -0400
message:
  Fix several Package Menu and Finder bugs.
  
  * finder.el: Load finder-inf using `require'.
  (finder-list-matches): Sorting by status is now the default.
  (finder-compile-keywords): Simpify printing.
  
  * emacs-lisp/package.el (package--read-archive-file): Just use
  `read', to avoid copying an additional string.
  (package-menu-mode): Set header-line-format here.
  (package-menu-refresh, package-menu-revert): Signal an error if
  not in the Package Menu.
  (package-menu-package-list): New var.
  (package--generate-package-list): Operate on the current buffer;
  don't assume that it is *Packages*, since the user may rename it.
  Allow persistent package listings and sort keys using
  package-menu-package-list and package-menu-package-sort-key.
  (package-menu--version-predicate): Fix version calculation.
  (package-menu-sort-by-column): Don't select the window.
  (package--list-packages): Create the *Packages* buffer.  Set
  package-menu-package-list-key.
  (list-packages): Sorting by status is now the default.
  (package-buffer-info): Use match-string-no-properties.
  (define-package): Add a &rest argument for future proofing, but
  don't use it yet.
  (package-install-from-buffer, package-install-buffer-internal):
  Merged into a single function, package-install-from-buffer.
  (package-install-file): Caller changed.
  
  Also, fix headers for hfy-cmap.el and ps-print.el.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/cl-loaddefs.el
  lisp/emacs-lisp/package.el
  lisp/finder.el
  lisp/hfy-cmap.el
  lisp/ps-print.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-08-30 20:34:52 +0000
+++ b/lisp/ChangeLog    2010-08-31 01:53:46 +0000
@@ -1,3 +1,31 @@
+2010-08-31  Chong Yidong  <address@hidden>
+
+       * emacs-lisp/package.el (package--read-archive-file): Just use
+       `read', to avoid copying an additional string.
+       (package-menu-mode): Set header-line-format here.
+       (package-menu-refresh, package-menu-revert): Signal an error if
+       not in the Package Menu.
+       (package-menu-package-list): New var.
+       (package--generate-package-list): Operate on the current buffer;
+       don't assume that it is *Packages*, since the user may rename it.
+       Allow persistent package listings and sort keys using
+       package-menu-package-list and package-menu-package-sort-key.
+       (package-menu--version-predicate): Fix version calculation.
+       (package-menu-sort-by-column): Don't select the window.
+       (package--list-packages): Create the *Packages* buffer.  Set
+       package-menu-package-list-key.
+       (list-packages): Sorting by status is now the default.
+       (package-buffer-info): Use match-string-no-properties.
+       (define-package): Add a &rest argument for future proofing, but
+       don't use it yet.
+       (package-install-from-buffer, package-install-buffer-internal):
+       Merged into a single function, package-install-from-buffer.
+       (package-install-file): Caller changed.
+
+       * finder.el: Load finder-inf using `require'.
+       (finder-list-matches): Sorting by status is now the default.
+       (finder-compile-keywords): Simpify printing.
+
 2010-08-30  Stefan Monnier  <address@hidden>
 
        * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt.

=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el    2010-08-29 16:17:13 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el    2010-08-31 01:53:46 +0000
@@ -754,7 +754,7 @@
 ;;;;;;  find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
 ;;;;;;  substitute-if substitute delete-duplicates remove-duplicates
 ;;;;;;  delete-if-not delete-if delete* remove-if-not remove-if remove*
-;;;;;;  replace fill reduce) "cl-seq" "cl-seq.el" 
"8f4ba525c894365101b9a53905db94ba")
+;;;;;;  replace fill reduce) "cl-seq" "cl-seq.el" 
"7b7531276ddf8457abecdd487d3cf0b7")
 ;;; Generated autoloads from cl-seq.el
 
 (autoload 'reduce "cl-seq" "\

=== modified file 'lisp/emacs-lisp/package.el'
--- a/lisp/emacs-lisp/package.el        2010-08-29 22:15:09 +0000
+++ b/lisp/emacs-lisp/package.el        2010-08-31 01:53:46 +0000
@@ -471,17 +471,18 @@
                                            pkg-vec)))
                  package-obsolete-alist)))))
 
-;; (define-package "emacs" "21.4.1" "GNU Emacs core package.")
-;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0")))
 (defun define-package (name-str version-string
-                               &optional docstring requirements)
+                               &optional docstring requirements
+                               &rest extra-properties)
   "Define a new package.
 NAME is the name of the package, a string.
 VERSION-STRING is the version of the package, a dotted sequence
 of integers.
 DOCSTRING is the optional description.
 REQUIREMENTS is a list of requirements on other packages.
-Each requirement is of the form (OTHER-PACKAGE \"VERSION\")."
+Each requirement is of the form (OTHER-PACKAGE \"VERSION\").
+
+EXTRA-PROPERTIES is currently unused."
   (let* ((name (intern name-str))
         (pkg-desc (assq name package-alist))
         (new-version (version-to-list version-string))
@@ -717,13 +718,13 @@
   "Read a Lisp expression from STR.
 Signal an error if the entire string was not used."
   (let* ((read-data (read-from-string str))
-          (more-left
-             (condition-case nil
-                       ;; The call to `ignore' suppresses a compiler warning.
-                       (progn (ignore (read-from-string
-                                       (substring str (cdr read-data))))
-                                   t)
-                   (end-of-file nil))))
+        (more-left
+         (condition-case nil
+             ;; The call to `ignore' suppresses a compiler warning.
+             (progn (ignore (read-from-string
+                             (substring str (cdr read-data))))
+                    t)
+           (end-of-file nil))))
     (if more-left
         (error "Can't read whole string")
       (car read-data))))
@@ -733,16 +734,14 @@
 Will return the data from the file, or nil if the file does not exist.
 Will throw an error if the archive version is too new."
   (let ((filename (expand-file-name file package-user-dir)))
-    (if (file-exists-p filename)
-       (with-temp-buffer
-         (insert-file-contents-literally filename)
-         (let ((contents (package-read-from-string
-                          (buffer-substring-no-properties (point-min)
-                                                          (point-max)))))
-           (if (> (car contents) package-archive-version)
-               (error "Package archive version %d is greater than %d - upgrade 
package.el"
-                      (car contents) package-archive-version))
-           (cdr contents))))))
+    (when (file-exists-p filename)
+      (with-temp-buffer
+       (insert-file-contents-literally filename)
+       (let ((contents (read (current-buffer))))
+         (if (> (car contents) package-archive-version)
+             (error "Package archive version %d is higher than %d"
+                    (car contents) package-archive-version))
+         (cdr contents))))))
 
 (defun package-read-all-archive-contents ()
   "Re-read `archive-contents', if it exists.
@@ -751,18 +750,17 @@
     (package-read-archive-contents (car archive))))
 
 (defun package-read-archive-contents (archive)
-  "Re-read `archive-contents' and `builtin-packages' for ARCHIVE.
-If successful, set `package-archive-contents' and `package--builtins'.
+  "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
 If the archive version is too new, signal an error."
-  (let ((archive-contents (package--read-archive-file
-                           (concat "archives/" archive
-                                   "/archive-contents"))))
-    (if archive-contents
-        ;; Version 1 of 'archive-contents' is identical to our
-        ;; internal representation.
-        ;; TODO: merge archive lists
-        (dolist (package archive-contents)
-          (package--add-to-archive-contents package archive)))))
+  ;; Version 1 of 'archive-contents' is identical to our internal
+  ;; representation.
+  (let* ((dir (concat "archives/" archive))
+        (contents-file (concat dir "/archive-contents"))
+        contents)
+    (when (setq contents (package--read-archive-file contents-file))
+      (dolist (package contents)
+       (package--add-to-archive-contents package archive)))))
 
 (defun package--add-to-archive-contents (package archive)
   "Add the PACKAGE from the given ARCHIVE if necessary.
@@ -833,61 +831,60 @@
            v-str))))
 
 (defun package-buffer-info ()
-  "Return a vector of information about the package in the current buffer.
-The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
-FILENAME is the file name, a string.  It does not have the \".el\" extension.
+  "Return a vector describing the package in the current buffer.
+The vector has the form
+
+   [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
+
+FILENAME is the file name, a string, sans the \".el\" extension.
 REQUIRES is a requires list, or nil.
-DESCRIPTION is the package description (a string).
+DESCRIPTION is the package description, a string.
 VERSION is the version, a string.
 COMMENTARY is the commentary section, a string, or nil if none.
-Throws an exception if the buffer does not contain a conforming package.
-If there is a package, narrows the buffer to the file's boundaries.
-May narrow buffer or move point even on failure."
+
+If the buffer does not contain a conforming package, signal an
+error.  If there is a package, narrow the buffer to the file's
+boundaries."
   (goto-char (point-min))
-  (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
-      (let ((file-name (match-string 1))
-           (desc (match-string 2))
-           (start (progn (beginning-of-line) (point))))
-       (if (search-forward (concat ";;; " file-name ".el ends here"))
-           (progn
-             ;; Try to include a trailing newline.
-             (forward-line)
-             (narrow-to-region start (point))
-             (require 'lisp-mnt)
-             ;; Use some headers we've invented to drive the process.
-             (let* ((requires-str (lm-header "package-requires"))
-                    (requires (if requires-str
-                                  (package-read-from-string requires-str)))
-                    ;; Prefer Package-Version, because if it is
-                    ;; defined the package author probably wants us
-                    ;; to use it.  Otherwise try Version.
-                    (pkg-version
-                     (or (package-strip-rcs-id (lm-header "package-version"))
-                         (package-strip-rcs-id (lm-header "version"))))
-                    (commentary (lm-commentary)))
-               (unless pkg-version
-                 (error
-                  "Package does not define a usable \"Version\" or 
\"Package-Version\" header"))
-               ;; Turn string version numbers into list form.
-               (setq requires
-                     (mapcar
-                      (lambda (elt)
-                        (list (car elt)
-                              (version-to-list (car (cdr elt)))))
-                      requires))
-               (set-text-properties 0 (length file-name) nil file-name)
-               (set-text-properties 0 (length pkg-version) nil pkg-version)
-               (set-text-properties 0 (length desc) nil desc)
-               (vector file-name requires desc pkg-version commentary)))
-         (error "Package missing a terminating comment")))
-    (error "No starting comment for package")))
+  (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
+    (error "Packages lacks a file header"))
+  (let ((file-name (match-string-no-properties 1))
+       (desc      (match-string-no-properties 2))
+       (start     (line-beginning-position)))
+    (unless (search-forward (concat ";;; " file-name ".el ends here"))
+      (error "Package lacks a terminating comment"))
+    ;; Try to include a trailing newline.
+    (forward-line)
+    (narrow-to-region start (point))
+    (require 'lisp-mnt)
+    ;; Use some headers we've invented to drive the process.
+    (let* ((requires-str (lm-header "package-requires"))
+          (requires (if requires-str
+                        (package-read-from-string requires-str)))
+          ;; Prefer Package-Version; if defined, the package author
+          ;; probably wants us to use it.  Otherwise try Version.
+          (pkg-version
+           (or (package-strip-rcs-id (lm-header "package-version"))
+               (package-strip-rcs-id (lm-header "version"))))
+          (commentary (lm-commentary)))
+      (unless pkg-version
+       (error
+        "Package lacks a \"Version\" or \"Package-Version\" header"))
+      ;; Turn string version numbers into list form.
+      (setq requires
+           (mapcar
+            (lambda (elt)
+              (list (car elt)
+                    (version-to-list (car (cdr elt)))))
+            requires))
+      (vector file-name requires desc pkg-version commentary))))
 
 (defun package-tar-file-info (file)
   "Find package information for a tar file.
 FILE is the name of the tar file to examine.
 The return result is a vector like `package-buffer-info'."
   (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file)
-    (error "`%s' doesn't have a package-ish name" file))
+    (error "Invalid package name `%s'" file))
   (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 
file)))
         (pkg-version (match-string-no-properties 2 file))
         ;; Extract the package descriptor.
@@ -898,20 +895,19 @@
                                    pkg-name "-pkg.el")))
         (pkg-def-parsed (package-read-from-string pkg-def-contents)))
     (unless (eq (car pkg-def-parsed) 'define-package)
-      (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name))
-    (let ((name-str (nth 1 pkg-def-parsed))
+      (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
+    (let ((name-str       (nth 1 pkg-def-parsed))
          (version-string (nth 2 pkg-def-parsed))
-         (docstring (nth 3 pkg-def-parsed))
-         (requires (nth 4 pkg-def-parsed))
-
+         (docstring      (nth 3 pkg-def-parsed))
+         (requires       (nth 4 pkg-def-parsed))
          (readme (shell-command-to-string
                   ;; Requires GNU tar.
                   (concat "tar -xOf " file " "
                           pkg-name "-" pkg-version "/README"))))
       (unless (equal pkg-version version-string)
-       (error "Inconsistent versions!"))
+       (error "Package has inconsistent versions"))
       (unless (equal pkg-name name-str)
-       (error "Inconsistent names!"))
+       (error "Package has inconsistent names"))
       ;; Kind of a hack.
       (if (string-match ": Not found in archive" readme)
          (setq readme nil))
@@ -919,18 +915,27 @@
       (if (eq (car requires) 'quote)
          (setq requires (car (cdr requires))))
       (setq requires
-           (mapcar
-            (lambda (elt)
-              (list (car elt)
-                    (version-to-list (car (cdr elt)))))
-            requires))
+           (mapcar (lambda (elt)
+                     (list (car elt)
+                           (version-to-list (cadr elt))))
+                   requires))
       (vector pkg-name requires docstring version-string readme))))
 
-(defun package-install-buffer-internal (pkg-info type)
+;;;###autoload
+(defun package-install-from-buffer (pkg-info type)
+  "Install a package from the current buffer.
+When called interactively, the current buffer is assumed to be a
+single .el file that follows the packaging guidelines; see info
+node `(elisp)Packaging'.
+
+When called from Lisp, PKG-INFO is a vector describing the
+information, of the type returned by `package-buffer-info'; and
+TYPE is the package type (either `single' or `tar')."
+  (interactive (list (package-buffer-info) 'single))
   (save-excursion
     (save-restriction
       (let* ((file-name (aref pkg-info 0))
-            (requires (aref pkg-info 1))
+            (requires  (aref pkg-info 1))
             (desc (if (string= (aref pkg-info 2) "")
                       "No description available."
                     (aref pkg-info 2)))
@@ -950,15 +955,6 @@
        (package-initialize)))))
 
 ;;;###autoload
-(defun package-install-from-buffer ()
-  "Install a package from the current buffer.
-The package is assumed to be a single .el file which
-follows the elisp comment guidelines; see
-info node `(elisp)Library Headers'."
-  (interactive)
-  (package-install-buffer-internal (package-buffer-info) 'single))
-
-;;;###autoload
 (defun package-install-file (file)
   "Install a package from a file.
 The file can either be a tar file or an Emacs Lisp file."
@@ -966,9 +962,10 @@
   (with-temp-buffer
     (insert-file-contents-literally file)
     (cond
-     ((string-match "\\.el$" file) (package-install-from-buffer))
+     ((string-match "\\.el$" file)
+      (package-install-from-buffer (package-buffer-info) 'single))
      ((string-match "\\.tar$" file)
-      (package-install-buffer-internal (package-tar-file-info file) 'tar))
+      (package-install-from-buffer (package-tar-file-info file) 'tar))
      (t (error "Unrecognized extension `%s'" (file-name-extension file))))))
 
 (defun package-delete (name version)
@@ -1012,7 +1009,7 @@
   (dolist (archive package-archives)
     (condition-case nil
        (package--download-one-archive archive "archive-contents")
-      (error (message "Failed to download archive `%s'."
+      (error (message "Failed to download `%s' archive."
                      (car archive)))))
   (package-read-all-archive-contents))
 
@@ -1275,10 +1272,32 @@
   (setq mode-name "Package Menu")
   (setq truncate-lines t)
   (setq buffer-read-only t)
-  ;; Support Emacs 21.
-  (if (fboundp 'run-mode-hooks)
-      (run-mode-hooks 'package-menu-mode-hook)
-    (run-hooks 'package-menu-mode-hook)))
+  (setq header-line-format
+       (mapconcat
+        (lambda (pair)
+          (let ((column (car pair))
+                (name (cdr pair)))
+            (concat
+             ;; Insert a space that aligns the button properly.
+             (propertize " " 'display (list 'space :align-to column)
+                         'face 'fixed-pitch)
+             ;; Set up the column button.
+             (propertize name
+                         'column-name name
+                         'help-echo "mouse-1: sort by column"
+                         'mouse-face 'highlight
+                         'keymap package-menu-sort-button-map))))
+        ;; We take a trick from buff-menu and have a dummy leading
+        ;; space to align the header line with the beginning of the
+        ;; text.  This doesn't really work properly on Emacs 21, but
+        ;; it is close enough.
+        '((0 . "")
+          (2 . "Package")
+          (20 . "Version")
+          (32 . "Status")
+          (43 . "Description"))
+        ""))
+  (run-mode-hooks 'package-menu-mode-hook))
 
 (defun package-menu-refresh ()
   "Download the ELPA archive.
@@ -1287,12 +1306,16 @@
 package menu.  This lets you see what new packages are
 available for download."
   (interactive)
+  (unless (eq major-mode 'package-menu-mode)
+    (error "The current buffer is not a Package Menu"))
   (package-refresh-contents)
   (package--generate-package-list))
 
 (defun package-menu-revert ()
   "Update the list of packages."
   (interactive)
+  (unless (eq major-mode 'package-menu-mode)
+    (error "The current buffer is not a Package Menu"))
   (package--generate-package-list))
 
 (defun package-menu-describe-package ()
@@ -1438,96 +1461,99 @@
                       result)))
   result)
 
-;; This decides how we should sort; nil means by package name.
-(defvar package-menu-sort-key nil)
-
-(defun package--generate-package-list (&optional packages)
-  (package-initialize)                 ; FIXME: do this here?
-  (with-current-buffer (get-buffer-create "*Packages*")
+(defvar package-menu-package-list nil
+  "List of packages to display in the Package Menu buffer.
+A value of nil means to display all packages.")
+
+(defvar package-menu-sort-key nil
+  "Sort key for the current Package Menu buffer.")
+
+(defun package--generate-package-list ()
+  "Populate the current Package Menu buffer."
+  (package-initialize)
+  (let ((inhibit-read-only t)
+       info-list name desc hold builtin)
     (setq buffer-read-only nil)
     (erase-buffer)
-    (let ((info-list)
-         name desc hold
-         builtin)
-      ;; List installed packages
-      (dolist (elt package-alist)
-       (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 hold) "held")
-                      ((and builtin
-                            (version-list-=
-                             (package-desc-vers builtin)
-                             (package-desc-vers desc)))
-                       "built-in")
-                      (t "installed"))
-                (package-desc-doc desc)
-                info-list))))
-
-      ;; List available and disabled packages
-      (dolist (elt package-archive-contents)
-       (setq name (car elt)
-             desc (cdr elt)
-             hold (assq name package-load-list))
-       (when (or (null packages)
-                 (memq name packages))
-         (setq info-list
-               (package-list-maybe-add name
-                                       (package-desc-vers desc)
-                                       (if (and hold (null (cadr hold)))
-                                           "disabled"
-                                         "available")
-                                       (package-desc-doc (cdr elt))
-                                       info-list))))
-      ;; List obsolete packages
-      (mapc (lambda (elt)
-             (mapc (lambda (inner-elt)
-                     (setq info-list
-                           (package-list-maybe-add (car elt)
-                                                   (package-desc-vers
-                                                    (cdr inner-elt))
-                                                   "obsolete"
-                                                   (package-desc-doc
-                                                    (cdr inner-elt))
-                                                   info-list)))
-                   (cdr elt)))
-           package-obsolete-alist)
-
-      (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))))))
+    ;; List installed packages
+    (dolist (elt package-alist)
+      (setq name (car elt))
+      (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
+                (or (null package-menu-package-list)
+                    (memq name package-menu-package-list)))
+       (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 hold) "held")
+                    ((and builtin
+                          (version-list-=
+                           (package-desc-vers builtin)
+                           (package-desc-vers desc)))
+                     "built-in")
+                    (t "installed"))
+              (package-desc-doc desc)
+              info-list))))
+
+    ;; List available and disabled packages
+    (dolist (elt package-archive-contents)
+      (setq name (car elt)
+           desc (cdr elt)
+           hold (assq name package-load-list))
+      (when (or (null package-menu-package-list)
+               (memq name package-menu-package-list))
+       (setq info-list
+             (package-list-maybe-add name
+                                     (package-desc-vers desc)
+                                     (if (and hold (null (cadr hold)))
+                                         "disabled"
+                                       "available")
+                                     (package-desc-doc (cdr elt))
+                                     info-list))))
+    ;; List obsolete packages
+    (mapc (lambda (elt)
+           (mapc (lambda (inner-elt)
+                   (setq info-list
+                         (package-list-maybe-add (car elt)
+                                                 (package-desc-vers
+                                                  (cdr inner-elt))
+                                                 "obsolete"
+                                                 (package-desc-doc
+                                                  (cdr inner-elt))
+                                                 info-list)))
+                 (cdr elt)))
+         package-obsolete-alist)
+
+    (setq info-list
+         (sort info-list
+               (cond ((string= package-menu-sort-key "Package")
+                      'package-menu--name-predicate)
+                     ((string= package-menu-sort-key "Version")
+                      'package-menu--version-predicate)
+                     ((string= package-menu-sort-key "Description")
+                      'package-menu--description-predicate)
+                     (t ; By default, sort by package status
+                      'package-menu--status-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)
+  (let ((vleft  (or (cdr (car left))  '(0)))
+       (vright (or (cdr (car right)) '(0))))
+    (if (version-list-= vleft vright)
        (package-menu--name-predicate left right)
-      (version-list-< left right))))
+      (version-list-< vleft vright))))
 
 (defun package-menu--status-predicate (left right)
   (let ((sleft  (cadr left))
@@ -1558,53 +1584,28 @@
           (symbol-name (caar right))))
 
 (defun package-menu-sort-by-column (&optional e)
-  "Sort the package menu by the last column clicked on."
+  "Sort the package menu by the column of the mouse click E."
   (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)))
-        (inhibit-read-only t))
-    (setq package-menu-sort-key col)
-    (package--generate-package-list)))
+        (obj (posn-object pos))
+        (col (if obj
+                 (get-text-property (cdr obj) 'column-name (car obj))
+               (get-text-property (posn-point pos) 'column-name)))
+        (buf (window-buffer (posn-window (event-start e)))))
+    (with-current-buffer buf
+      (when (eq major-mode 'package-menu-mode)
+       (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)
+  "Generate and pop to the *Packages* buffer.
+Optional PACKAGES is a list of names of packages (symbols) to
+list; the default is to display everything in `package-alist'."
+  (with-current-buffer (get-buffer-create "*Packages*")
     (package-menu-mode)
-    ;; Set up the header line.
-    (setq header-line-format
-         (mapconcat
-          (lambda (pair)
-            (let ((column (car pair))
-                  (name (cdr pair)))
-              (concat
-               ;; Insert a space that aligns the button properly.
-               (propertize " " 'display (list 'space :align-to column)
-                           'face 'fixed-pitch)
-               ;; Set up the column button.
-               (if (string= name "Version")
-                   name
-                 (propertize name
-                             'column-name name
-                             'help-echo "mouse-1: sort by column"
-                             'mouse-face 'highlight
-                             'keymap package-menu-sort-button-map)))))
-          ;; We take a trick from buff-menu and have a dummy leading
-          ;; space to align the header line with the beginning of the
-          ;; text.  This doesn't really work properly on Emacs 21,
-          ;; but it is close enough.
-          '((0 . "")
-            (2 . "Package")
-            (20 . "Version")
-            (32 . "Status")
-            (43 . "Description"))
-          ""))
-
+    (set (make-local-variable 'package-menu-package-list) packages)
+    (set (make-local-variable 'package-menu-sort-key) nil)
+    (package--generate-package-list)
     ;; It's okay to use pop-to-buffer here.  The package menu buffer
     ;; has keybindings, and the user just typed `M-x list-packages',
     ;; suggesting that they might want to use them.
@@ -1617,7 +1618,6 @@
 The list is displayed in a buffer named `*Packages*'."
   (interactive)
   (package-refresh-contents)
-  (setq package-menu-sort-key "Status")
   (package--list-packages))
 
 ;;;###autoload

=== modified file 'lisp/finder.el'
--- a/lisp/finder.el    2010-08-29 22:15:09 +0000
+++ b/lisp/finder.el    2010-08-31 01:53:46 +0000
@@ -32,10 +32,8 @@
 
 (require 'package)
 (require 'lisp-mnt)
-(require 'find-func)                   ;for find-library(-suffixes)
-;; Use `load' rather than `require' so that it doesn't get loaded
-;; during byte-compilation (at which point it might be missing).
-(load "finder-inf" t t)
+(require 'find-func) ;for find-library(-suffixes)
+(require 'finder-inf nil t)
 
 ;; These are supposed to correspond to top-level customization groups,
 ;; says rms.
@@ -234,17 +232,10 @@
     (search-backward "")
     (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 "  ")
+      (prin1 package (current-buffer))
+      (insert "\n"))
+    (insert "))\n\n")
     ;; Insert hash table.
     (insert "(setq finder-keywords-hash\n      ")
     (prin1 finder-keywords-hash (current-buffer))
@@ -325,7 +316,6 @@
         (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)

=== modified file 'lisp/hfy-cmap.el'
--- a/lisp/hfy-cmap.el  2010-04-24 02:36:43 +0000
+++ b/lisp/hfy-cmap.el  2010-08-31 01:53:46 +0000
@@ -13,6 +13,7 @@
 ;; Description: fallback code for colour name -> rgb mapping
 ;; URL: http://rtfm.etla.org/emacs/htmlfontify/
 ;; Last-Updated: Sat 2003-02-15 03:49:32 +0000
+;; Package: htmlfontify
 
 ;; This file is part of GNU Emacs.
 

=== modified file 'lisp/ps-print.el'
--- a/lisp/ps-print.el  2010-08-29 16:17:13 +0000
+++ b/lisp/ps-print.el  2010-08-31 01:53:46 +0000
@@ -13,7 +13,6 @@
 ;; Keywords: wp, print, PostScript
 ;; Version: 7.3.5
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-;; Package: ps-print
 
 (defconst ps-print-version "7.3.5"
   "ps-print.el, v 7.3.5 <2009/12/23 vinicius>


reply via email to

[Prev in Thread] Current Thread [Next in Thread]