Mercurial > emacs

changeset 110063:588307a027eb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from mainline.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Tue, 31 Aug 2010 04:17:54 +0000
parents 18cbc8672753 (current diff) 8be2f62f7851 (diff)
children 07b5be82cf7a
files lisp/gnus/gnus-move.el
diffstat 16 files changed, 331 insertions(+), 486 deletions(-) [+]
line wrap: on
line diff
--- a/doc/misc/ChangeLog	Tue Aug 31 00:03:58 2010 +0000
+++ b/doc/misc/ChangeLog	Tue Aug 31 04:17:54 2010 +0000
@@ -1,3 +1,10 @@
+2010-08-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus.texi (Summary Mail Commands): Note that only the addresses from
+	the first message are used for wide replies.
+	(Changing Servers): Remove documentation on gnus-change-server and
+	friends, since it's been removed.
+
 2010-08-29  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* gnus.texi (Drafts): Mention B DEL.
--- a/doc/misc/gnus.texi	Tue Aug 31 00:03:58 2010 +0000
+++ b/doc/misc/gnus.texi	Tue Aug 31 04:17:54 2010 +0000
@@ -1384,31 +1384,11 @@
 change @code{gnus-select-method}, your @file{.newsrc} file becomes
 worthless.
 
-Gnus provides a few functions to attempt to translate a @file{.newsrc}
-file from one server to another.  They all have one thing in
-common---they take a looong time to run.  You don't want to use these
-functions more than absolutely necessary.
-
-@kindex M-x gnus-change-server
-@findex gnus-change-server
-If you have access to both servers, Gnus can request the headers for all
-the articles you have read and compare @code{Message-ID}s and map the
-article numbers of the read articles and article marks.  The @kbd{M-x
-gnus-change-server} command will do this for all your native groups.  It
-will prompt for the method you want to move to.
-
-@kindex M-x gnus-group-move-group-to-server
-@findex gnus-group-move-group-to-server
-You can also move individual groups with the @kbd{M-x
-gnus-group-move-group-to-server} command.  This is useful if you want to
-move a (foreign) group from one server to another.
-
 @kindex M-x gnus-group-clear-data-on-native-groups
 @findex gnus-group-clear-data-on-native-groups
-If you don't have access to both the old and new server, all your marks
-and read ranges have become worthless.  You can use the @kbd{M-x
-gnus-group-clear-data-on-native-groups} command to clear out all data
-that you have on your native groups.  Use with caution.
+You can use the @kbd{M-x gnus-group-clear-data-on-native-groups}
+command to clear out all data that you have on your native groups.
+Use with caution.
 
 @kindex M-x gnus-group-clear-data
 @findex gnus-group-clear-data
@@ -6354,7 +6334,8 @@
 @findex gnus-summary-wide-reply-with-original
 Mail a wide reply to the current article and include the original
 message (@code{gnus-summary-wide-reply-with-original}).  This command uses
-the process/prefix convention.
+the process/prefix convention, but only uses the headers from the
+first article to determine the recipients.
 
 @item S v
 @kindex S v (Summary)
@@ -6418,8 +6399,6 @@
 If the prefix is 1, prompt for a group name to find the posting style.
 
 @item S i
-@itemx i
-@kindex i (Summary)
 @kindex S i (Summary)
 @findex gnus-summary-news-other-window
 Prepare a news (@code{gnus-summary-news-other-window}).  By default,
--- a/lisp/ChangeLog	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/ChangeLog	Tue Aug 31 04:17:54 2010 +0000
@@ -1,3 +1,31 @@
+2010-08-31  Chong Yidong  <cyd@stupidchicken.com>
+
+	* 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  <monnier@iro.umontreal.ca>
 
 	* progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt.
--- a/lisp/emacs-lisp/cl-loaddefs.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el	Tue Aug 31 04:17:54 2010 +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" "\
--- a/lisp/emacs-lisp/package.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/emacs-lisp/package.el	Tue Aug 31 04:17:54 2010 +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)
+(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.")
 
-(defun package--generate-package-list (&optional packages)
-  (package-initialize)			; FIXME: do this here?
-  (with-current-buffer (get-buffer-create "*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 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 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)
+    ;; 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 "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))))
+    (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))))))
+    (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
--- a/lisp/finder.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/finder.el	Tue Aug 31 04:17:54 2010 +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)
--- a/lisp/gnus/ChangeLog	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/ChangeLog	Tue Aug 31 04:17:54 2010 +0000
@@ -1,5 +1,23 @@
 2010-08-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+	* gnus-sum.el: As per discussion 3 years, 8 weeks, 3 days, 9 hours, 57
+	minutes, 56 seconds ago on the ding list, remove the `w' and `i'
+	bindings, as they aren't useful at all. `w' is moved to `W w'.
+
+	* gnus-move.el: Removed file, since it doesn't really work.
+
+	* gnus-html.el (gnus-article-html): Tell w3m that the input is
+	UTF-8. This seems to fix problems with some German web feeds.
+
+	* gnus.el (gnus-group-startup-message): Put the xpm version of the logo
+	at the top so that the proper colours are applied.
+
+	* gnus-art.el (gnus-article-view-part): Doc fix.
+
+	* gnus-html.el (gnus-html-put-image): Use gnus-create-image to be
+	XEmacs-compatible.
+	(gnus-html-put-image): Don't do images on non-graphic displays.
+
 	* nnslashdot.el: Removed this unused backend.
 
 	* gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100
--- a/lisp/gnus/gnus-art.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/gnus-art.el	Tue Aug 31 04:17:54 2010 +0000
@@ -5549,7 +5549,9 @@
     1))
 
 (defun gnus-article-view-part (&optional n)
-  "View MIME part N, which is the numerical prefix."
+  "View MIME part N, which is the numerical prefix.
+If the part is already shown, hide the part.  If N is nil, view
+all parts."
   (interactive "P")
   (with-current-buffer gnus-article-buffer
     (or (numberp n) (setq n (gnus-article-mime-match-handle-first
--- a/lisp/gnus/gnus-ems.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/gnus-ems.el	Tue Aug 31 04:17:54 2010 +0000
@@ -274,15 +274,13 @@
       (setq props (plist-put props :background (face-background face))))
     (apply 'create-image file type data-p props)))
 
-(defun gnus-put-image (glyph &optional string category point)
-  (let ((point (or point (point))))
-    (save-excursion
-      (goto-char point)
-      (insert-image glyph (or string " "))
-      (put-text-property point (point) 'gnus-image-category category)
-      (unless string
-	(put-text-property (1- (point)) (point)
-			   'gnus-image-text-deletable t)))
+(defun gnus-put-image (glyph &optional string category)
+  (let ((point (point)))
+    (insert-image glyph (or string " "))
+    (put-text-property point (point) 'gnus-image-category category)
+    (unless string
+      (put-text-property (1- (point)) (point)
+			 'gnus-image-text-deletable t))
     glyph))
 
 (defun gnus-remove-image (image &optional category)
--- a/lisp/gnus/gnus-html.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/gnus-html.el	Tue Aug 31 04:17:54 2010 +0000
@@ -28,6 +28,8 @@
 
 ;;; Code:
 
+(require 'mm-url)
+
 (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/")
   "Where Gnus will cache images it downloads from the web."
   :group 'gnus-art
@@ -59,8 +61,10 @@
 				 nil article-buffer nil
 				 "-halfdump"
 				 "-no-cookie"
+				 "-I" "UTF-8"
 				 "-O" "UTF-8"
 				 "-o" "ext_halfdump=1"
+				 "-o" "pre_conv=1"
 				 "-t" (format "%s" tab-width)
 				 "-cols" (format "%s" gnus-html-frame-width)
 				 "-o" "display_image=off"
@@ -162,21 +166,25 @@
 	(gnus-html-schedule-image-fetching buffer images)))))
 
 (defun gnus-html-put-image (file point)
-  (let ((image (ignore-errors
-		 (create-image file))))
-    (if (and image
-	     ;; Kludge to avoid displaying 30x30 gif images, which
-	     ;; seems to be a signal of a broken image.
-	     (not (and (eq (getf (cdr image) :type) 'gif)
-		       (= (car (image-size image t)) 30)
-		       (= (cdr (image-size image t)) 30))))
-	(progn
-	  (gnus-put-image image nil nil point)
-	  t)
-      (when (fboundp 'find-image)
-	(gnus-put-image (find-image '((:type xpm :file "lock-broken.xpm")))
-			nil nil point))
-      nil)))
+  (when (display-graphic-p)
+    (let ((image (ignore-errors
+		   (gnus-create-image file))))
+      (save-excursion
+	(goto-char point)
+	(if (and image
+		 ;; Kludge to avoid displaying 30x30 gif images, which
+		 ;; seems to be a signal of a broken image.
+		 (not (and (listp image)
+			   (eq (getf (cdr image) :type) 'gif)
+			   (= (car (image-size image t)) 30)
+			   (= (cdr (image-size image t)) 30))))
+	    (progn
+	      (gnus-put-image image)
+	      t)
+	  (when (fboundp 'find-image)
+	    (gnus-put-image (find-image
+			     '((:type xpm :file "lock-broken.xpm")))))
+	  nil)))))
 
 (defun gnus-html-prune-cache ()
   (let ((total-size 0)
--- a/lisp/gnus/gnus-move.el	Tue Aug 31 00:03:58 2010 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,181 +0,0 @@
-;;; gnus-move.el --- commands for moving Gnus from one server to another
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-start)
-(require 'gnus-int)
-(require 'gnus-range)
-
-;;;
-;;; Moving by comparing Message-ID's.
-;;;
-
-;;;###autoload
-(defun gnus-change-server (from-server to-server)
-  "Move from FROM-SERVER to TO-SERVER.
-Update the .newsrc.eld file to reflect the change of nntp server."
-  (interactive
-   (list gnus-select-method (gnus-read-method "Move to method: ")))
-
-  ;; First start Gnus.
-  (let ((gnus-activate-level 0)
-	(mail-sources nil))
-    (gnus))
-
-  (save-excursion
-    ;; Go through all groups and translate.
-    (let ((nntp-nov-gap nil))
-      (dolist (info gnus-newsrc-alist)
-	(when (gnus-group-native-p (gnus-info-group info))
-	  (gnus-move-group-to-server info from-server to-server))))))
-
-(defun gnus-move-group-to-server (info from-server to-server)
-  "Move group INFO from FROM-SERVER to TO-SERVER."
-  (let ((group (gnus-info-group info))
-	to-active hashtb type mark marks
-	to-article to-reads to-marks article
-	act-articles)
-    (gnus-message 7 "Translating %s..." group)
-    (when (gnus-request-group group nil to-server)
-      (setq to-active (gnus-parse-active)
-	    hashtb (gnus-make-hashtable 1024)
-	    act-articles (gnus-uncompress-range to-active))
-      ;; Fetch the headers from the `to-server'.
-      (when (and to-active
-		 act-articles
-		 (setq type (gnus-retrieve-headers
-			     act-articles
-			     group to-server)))
-	;; Convert HEAD headers.  I don't care.
-	(when (eq type 'headers)
-	  (nnvirtual-convert-headers))
-	;; Create a mapping from Message-ID to article number.
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(while (looking-at
-		"^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
-	  (gnus-sethash
-	   (buffer-substring (match-beginning 1) (match-end 1))
-	   (read (current-buffer))
-	   hashtb)
-	  (forward-line 1))
-	;; Then we read the headers from the `from-server'.
-	(when (and (gnus-request-group group nil from-server)
-		   (gnus-active group)
-		   (gnus-uncompress-range
-		    (gnus-active group))
-		   (setq type (gnus-retrieve-headers
-			       (gnus-uncompress-range
-				(gnus-active group))
-			       group from-server)))
-	  ;; Make it easier to map marks.
-	  (let ((mark-lists (gnus-info-marks info))
-		ms type m)
-	    (while mark-lists
-	      (setq type (caar mark-lists)
-		    ms (gnus-uncompress-range (cdr (pop mark-lists))))
-	      (while ms
-		(if (setq m (assq (car ms) marks))
-		    (setcdr m (cons type (cdr m)))
-		  (push (list (car ms) type) marks))
-		(pop ms))))
-	  ;; Convert.
-	  (when (eq type 'headers)
-	    (nnvirtual-convert-headers))
-	  ;; Go through the headers and map away.
-	  (set-buffer nntp-server-buffer)
-	  (goto-char (point-min))
-	  (while (looking-at
-		  "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
-	    (when (setq to-article
-			(gnus-gethash
-			 (buffer-substring (match-beginning 1) (match-end 1))
-			 hashtb))
-	      ;; Add this article to the list of read articles.
-	      (push to-article to-reads)
-	      ;; See if there are any marks and then add them.
-	      (when (setq mark (assq (read (current-buffer)) marks))
-		(setq marks (delq mark marks))
-		(setcar mark to-article)
-		(push mark to-marks))
-	      (forward-line 1)))
-	  ;; Now we know what the read articles are and what the
-	  ;; article marks are.  We transform the information
-	  ;; into the Gnus info format.
-	  (setq to-reads
-		(gnus-range-add
-		 (gnus-compress-sequence
-		  (and (setq to-reads (delq nil to-reads))
-		       (sort to-reads '<))
-		  t)
-		 (cons 1 (1- (car to-active)))))
-	  (gnus-info-set-read info to-reads)
-	  ;; Do the marks.  I'm sure y'all understand what's
-	  ;; going on down below, so I won't bother with any
-	  ;; further comments.  <duck>
-	  (let ((mlists gnus-article-mark-lists)
-		lists ms a)
-	    (while mlists
-	      (push (list (cdr (pop mlists))) lists))
-	    (while (setq ms (pop marks))
-	      (setq article (pop ms))
-	      (while ms
-		(setcdr (setq a (assq (pop ms) lists))
-			(cons article (cdr a)))))
-	    (setq a lists)
-	    (while a
-	      (setcdr (car a) (gnus-compress-sequence
-			       (and (cdar a) (sort (cdar a) '<))))
-	      (pop a))
-	    (gnus-info-set-marks info lists t)))))
-    (gnus-message 7 "Translating %s...done" group)))
-
-(defun gnus-group-move-group-to-server (info from-server to-server)
-  "Move the group on the current line from FROM-SERVER to TO-SERVER."
-  (interactive
-   (let ((info (gnus-get-info (gnus-group-group-name))))
-     (list info (gnus-find-method-for-group (gnus-info-group info))
-	   (gnus-read-method (format "Move group %s to method: "
-				     (gnus-info-group info))))))
-  (save-excursion
-    (gnus-move-group-to-server info from-server to-server)
-    ;; We have to update the group info to point use the right server.
-    (gnus-info-set-method info to-server t)
-    ;; We also have to change the name of the group and stuff.
-    (let* ((group (gnus-info-group info))
-	   (new-name (gnus-group-prefixed-name
-		      (gnus-group-real-name group) to-server)))
-      (gnus-info-set-group info new-name)
-      (gnus-sethash new-name (gnus-group-entry group) gnus-newsrc-hashtb)
-      (gnus-sethash group nil gnus-newsrc-hashtb))))
-
-(provide 'gnus-move)
-
-;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b
-;;; gnus-move.el ends here
--- a/lisp/gnus/gnus-sum.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/gnus-sum.el	Tue Aug 31 04:17:54 2010 +0000
@@ -1859,7 +1859,6 @@
   "=" gnus-summary-expand-window
   "\C-x\C-s" gnus-summary-reselect-current-group
   "\M-g" gnus-summary-rescan-group
-  "w" gnus-summary-stop-page-breaking
   "\C-c\C-r" gnus-summary-caesar-message
   "f" gnus-summary-followup
   "F" gnus-summary-followup-with-original
@@ -1881,7 +1880,6 @@
   [follow-link] mouse-face
   "m" gnus-summary-mail-other-window
   "a" gnus-summary-post-news
-  "i" gnus-summary-news-other-window
   "x" gnus-summary-limit-to-unread
   "s" gnus-summary-isearch-article
   "t" gnus-summary-toggle-header
--- a/lisp/gnus/gnus.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/gnus.el	Tue Aug 31 04:17:54 2010 +0000
@@ -1058,14 +1058,14 @@
 				    (symbol-value 'image-load-path))
 				   (t load-path)))
 	    (image (find-image
-		    `((:type svg :file "gnus.svg")
-		      (:type png :file "gnus.png")
-		      (:type xpm :file "gnus.xpm"
+		    `((:type xpm :file "gnus.xpm"
 			     :color-symbols
 			     (("thing" . ,(car gnus-logo-colors))
 			      ("shadow" . ,(cadr gnus-logo-colors))
 			      ("oort" . "#eeeeee")
 			      ("background" . ,(face-background 'default))))
+		      (:type svg :file "gnus.svg")
+		      (:type png :file "gnus.png")
 		      (:type pbm :file "gnus.pbm"
 			     ;; Account for the pbm's blackground.
 			     :background ,(face-foreground 'gnus-splash)
@@ -3026,8 +3026,6 @@
       gnus-dup-enter-articles)
      ("gnus-range" gnus-copy-sequence)
      ("gnus-eform" gnus-edit-form)
-     ("gnus-move" :interactive t
-      gnus-group-move-group-to-server gnus-change-server)
      ("gnus-logic" gnus-score-advanced)
      ("gnus-undo" gnus-undo-mode gnus-undo-register)
      ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
--- a/lisp/gnus/mml.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/gnus/mml.el	Tue Aug 31 04:17:54 2010 +0000
@@ -120,7 +120,7 @@
 			  ,dispositions))))
   :group 'message)
 
-(defcustom mml-insert-mime-headers-always nil
+(defcustom mml-insert-mime-headers-always t
   "If non-nil, always put Content-Type: text/plain at top of empty parts.
 It is necessary to work against a bug in certain clients."
   :version "22.1"
--- a/lisp/hfy-cmap.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/hfy-cmap.el	Tue Aug 31 04:17:54 2010 +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.
 
--- a/lisp/ps-print.el	Tue Aug 31 00:03:58 2010 +0000
+++ b/lisp/ps-print.el	Tue Aug 31 04:17:54 2010 +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>