Merge from trunk and from gnulib stdio.

21 files changed, 352 insertions, 116 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5164207a5ce..b12445b466f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,73 @@
+2011-03-20  Jay Belanger  <jay.p.belanger@gmail.com>
+
+        * calc/calc-menu.el (calc-units-menu): Add entries for logarithmic
+        units and musical notes.
+
+2011-03-20  Leo  <sdl.web@gmail.com>
+
+        * ido.el (ido-read-internal): Use completing-read-default.
+        (ido-completing-read): Fix compatibility with completing-read.
+
+2011-03-20  Christian Ohler  <ohler@gnu.org>
+
+        * emacs-lisp/ert.el (ert-run-tests-batch): Remove unused variable.
+        (ert-delete-all-tests): Use `called-interactively-p' rather than
+        `interactive-p'.
+        (ert--make-xrefs-region): Respect END.
+
+2011-03-19  Chong Yidong  <cyd@stupidchicken.com>
+
+        * dired-aux.el (dired-create-directory): Signal an error if the
+        directory already exists (Bug#8246).
+
+        * facemenu.el (list-colors-display): Call list-faces-display
+        inside with-help-window.
+        (list-colors-print): Use display property to align the final
+        column, instead of checking window-width.
+
+2011-03-19  Eli Zaretskii  <eliz@gnu.org>
+
+        * emerge.el (emerge-metachars): Separate value for ms-dos and
+        windows-nt systems.
+        (emerge-protect-metachars): Quote correctly for ms-dos and
+        windows-nt systems.
+
+2011-03-19  Ralph Schleicher  <rs@ralph-schleicher.de>
+
+        * info.el (info-initialize): Replace all uses of `:' with
+        path-separator for compatibility with non-Unix systems.
+        Cache quoting of path-separator.  (Bug#8258)
+
+2011-03-19  Juanma Barranquero  <lekktu@gmail.com>
+
+        * avoid.el (mouse-avoidance-mode, mouse-avoidance-nudge-dist)
+        (mouse-avoidance-threshold, mouse-avoidance-banish-destination)
+        (mouse-avoidance-mode): Fix typos in docstrings.
+
+2011-03-19  Chong Yidong  <cyd@stupidchicken.com>
+
+        * startup.el (package-subdirectory-regexp): Move from package.el.
+        Omit \\` and \\', and let callers add them.
+
+        * emacs-lisp/package.el (package-strip-version)
+        (package-load-all-descriptors): Add \\` and \\' to
+        package-subdirectory-regexp before using it.
+        (package-untar-buffer): New arg DIR; ensure that file untars only
+        into this expected directory.  Remove superfluous delete-region.
+        (package-unpack): Caller changed.
+        (package-tar-file-info): Use package-subdirectory-regexp.
+
+2011-03-18  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * vc/diff-mode.el (diff-mode-map): Shadow problematic bindings from
+        diff-mode-shared-map (bug#8284).
+        (diff-mode-shared-map): Re-introduce some bindings that were problematic.
+
+2011-03-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * calendar/time-date.el (format-seconds): Use assoc instead of
+        assoc-string, since assoc-string doesn't exist in XEmacs.
+
 2011-03-17  Juanma Barranquero  <lekktu@gmail.com>
 
         * custom.el (custom-known-themes): Reflow docstring.
diff --git a/lisp/avoid.el b/lisp/avoid.el
index c864d48e9ce..038927105ec 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -76,7 +76,7 @@
 
 ;;;###autoload
 (defcustom mouse-avoidance-mode nil
-  "Activate mouse avoidance mode.
+  "Activate Mouse Avoidance mode.
 See function `mouse-avoidance-mode' for possible values.
 Setting this variable directly does not take effect;
 use either \\[customize] or the function `mouse-avoidance-mode'."
@@ -85,8 +85,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'."
          (mouse-avoidance-mode (or value 'none)))
   :initialize 'custom-initialize-default
   :type '(choice (const :tag "none" nil) (const banish) (const jump)
-                 (const animate) (const exile) (const proteus)
-                 )
+                 (const animate) (const exile) (const proteus))
   :group 'avoid
   :require 'avoid
   :version "20.3")
@@ -94,7 +93,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'."
 
 (defcustom mouse-avoidance-nudge-dist 15
   "Average distance that mouse will be moved when approached by cursor.
-Only applies in Mouse-Avoidance mode `jump' and its derivatives.
+Only applies in Mouse Avoidance mode `jump' and its derivatives.
 For best results make this larger than `mouse-avoidance-threshold'."
   :type 'integer
   :group 'avoid)
@@ -112,7 +111,7 @@ For best results make this larger than `mouse-avoidance-threshold'."
 (defcustom mouse-avoidance-threshold 5
   "Mouse-pointer's flight distance.
 If the cursor gets closer than this, the mouse pointer will move away.
-Only applies in mouse-avoidance-modes `animate' and `jump'."
+Only applies in Mouse Avoidance modes `animate' and `jump'."
   :type 'integer
   :group 'avoid)
 
@@ -183,7 +182,7 @@ Acceptable distance is defined by `mouse-avoidance-threshold'."
                 mouse-avoidance-threshold))))))
 
 (defun mouse-avoidance-banish-destination ()
-  "The position to which Mouse-Avoidance mode `banish' moves the mouse.
+  "The position to which Mouse Avoidance mode `banish' moves the mouse.
 You can redefine this if you want the mouse banished to a different corner."
   (let* ((pos (window-edges)))
     (cons (- (nth 2 pos) 2)
@@ -333,7 +332,7 @@ redefine this function to suit your own tastes."
 
 ;;;###autoload
 (defun mouse-avoidance-mode (&optional mode)
-  "Set cursor avoidance mode to MODE.
+  "Set Mouse Avoidance mode to MODE.
 MODE should be one of the symbols `banish', `exile', `jump', `animate',
 `cat-and-mouse', `proteus', or `none'.
 
@@ -353,7 +352,7 @@ Effects of the different modes:
 
 Whenever the mouse is moved, the frame is also raised.
 
-\(see `mouse-avoidance-threshold' for definition of \"too close\",
+\(See `mouse-avoidance-threshold' for definition of \"too close\",
 and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
 definition of \"random distance\".)"
   (interactive
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index aaddf3e486e..d8099b0aadc 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -960,6 +960,111 @@
            (require 'calc-units)
            (call-interactively 'calc-view-units-table))
          :keys "u V"]
+        (list "Logarithmic Units"
+              ["Convert (1:) to dB (power)"
+               (progn
+                 (require 'calc-units)
+                 (call-interactively 'calc-db))
+               :keys "l d"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (2:) to dB (power) with reference level (1:)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-option-flag t))
+                   (call-interactively 'calc-db)))
+               :keys "O l d"
+               :active (>= (calc-stack-size) 2)]
+              ["Convert (1:) to Np (power)"
+               (progn
+                 (require 'calc-units)
+                 (call-interactively 'calc-np))
+               :keys "l n"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (2:) to Np (power) with reference level (1:)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-option-flag t))
+                   (call-interactively 'calc-np)))
+               :keys "O l n"
+               :active (>= (calc-stack-size) 2)]
+              ["Convert (1:) to power quantity"
+               (progn
+                 (require 'calc-units)
+                 (call-interactively 'calc-lu-quant))
+               :keys "l q"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (2:) to power quantity with reference level (1:)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-option-flag t))
+                   (call-interactively 'calc-lu-quant)))
+               :keys "O l q"
+               :active (>= (calc-stack-size) 2)]
+              "----"
+              ["Convert (1:) to dB (field)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-hyperbolic-flag t))
+                   (call-interactively 'calc-db)))
+               :keys "H l d"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (2:) to dB (field) with reference level (1:)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-option-flag t)
+                       (calc-hyperbolic-flag t))
+                   (call-interactively 'calc-db)))
+               :keys "O H l d"
+               :active (>= (calc-stack-size) 2)]
+              ["Convert (1:) to Np (field)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-hyperbolic-flag t))
+                   (call-interactively 'calc-np)))
+               :keys "H l n"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (2:) to Np (field) with reference level (1:)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-option-flag t)
+                       (calc-hyperbolic-flag t))
+                   (call-interactively 'calc-np)))
+               :keys "O H l d"
+               :active (>= (calc-stack-size) 2)]
+              ["Convert (1:) to field quantity"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-hyperbolic-flag t))
+                   (call-interactively 'calc-lu-quant)))
+               :keys "H l q"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (2:) to field quantity with reference level (1:)"
+               (progn
+                 (require 'calc-units)
+                 (let ((calc-option-flag t)
+                       (calc-hyperbolic-flag))
+                   (call-interactively 'calc-lu-quant)))
+               :keys "O H l q"
+               :active (>= (calc-stack-size) 2)])
+        (list "Musical Notes"
+              ["Convert (1:) to scientific pitch notation"
+               (progn
+                 (require 'calc-units)
+                 (call-interactively 'calc-spn))
+               :keys "l s"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (1:) to midi number"
+               (progn
+                 (require 'calc-units)
+                 (call-interactively 'calc-midi))
+               :keys "l m"
+               :active (>= (calc-stack-size) 1)]
+              ["Convert (1:) to frequency"
+               (progn
+                 (require 'calc-units)
+                 (call-interactively 'calc-freq))
+               :keys "l f"
+               :active (>= (calc-stack-size) 1)])
         "----"
         ["Help on Units"
          (calc-info-goto-node "Units")])
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index a1bfad3a5f5..62203600612 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -308,13 +308,9 @@ This function does not work for SECONDS greater than `most-positive-fixnum'."
       (setq start (match-end 0)
             spec (match-string 1 string))
       (unless (string-equal spec "%")
-        ;; `assoc-string' is not available in XEmacs.  So when compiling
-        ;; Gnus (`time-date.el' is part of Gnus) with XEmacs, we get
-        ;; a warning here.  But `format-seconds' is not used anywhere in
-        ;; Gnus so it's not a real problem. --rsteib
-        (or (setq match (assoc-string spec units t))
+        (or (setq match (assoc (downcase spec) units))
             (error "Bad format specifier: `%s'" spec))
-        (if (assoc-string spec usedunits t)
+        (if (assoc (downcase spec) usedunits)
             (error "Multiple instances of specifier: `%s'" spec))
         (if (string-equal (car match) "z")
             (setq zeroflag t)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index c533c81be0e..9ab1fcb0e2b 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1638,11 +1638,14 @@ Optional arg HOW-TO determiness how to treat the target.
 
 ;;;###autoload
 (defun dired-create-directory (directory)
-  "Create a directory called DIRECTORY."
+  "Create a directory called DIRECTORY.
+If DIRECTORY already exists, signal an error."
   (interactive
    (list (read-file-name "Create directory: " (dired-current-directory))))
   (let* ((expanded (directory-file-name (expand-file-name directory)))
          (try expanded) new)
+    (if (file-exists-p expanded)
+        (error "Cannot create directory %s: file exists" expanded))
     ;; Find the topmost nonexistent parent dir (variable `new')
     (while (and try (not (file-exists-p try)) (not (equal new try)))
       (setq new try
diff --git a/lisp/dired.el b/lisp/dired.el
index c4374503a6f..22470ea61e6 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3627,7 +3627,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
 ;;;;;;  dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
 ;;;;;;  dired-clean-directory dired-do-print dired-do-touch dired-do-chown
 ;;;;;;  dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
-;;;;;;  dired-diff) "dired-aux" "dired-aux.el" "154cdfbf451aedec60c5012b625ff329")
+;;;;;;  dired-diff) "dired-aux" "dired-aux.el" "2d805d6766bd7970cd446413b4ed4ce0")
 ;;; Generated autoloads from dired-aux.el
 
 (autoload 'dired-diff "dired-aux" "\
@@ -3858,6 +3858,7 @@ Not documented
 
 (autoload 'dired-create-directory "dired-aux" "\
 Create a directory called DIRECTORY.
+If DIRECTORY already exists, signal an error.
 
 \(fn DIRECTORY)" t nil)
 
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 5bd8fd01b1e..b2e20843856 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1482,9 +1482,8 @@ Returns the stats object."
                  (let ((print-escape-newlines t)
                        (print-level 5)
                        (print-length 10))
-                   (let ((begin (point)))
-                     (ert--pp-with-indentation-and-newline
-                      (ert-test-result-with-condition-condition result))))
+                   (ert--pp-with-indentation-and-newline
+                    (ert-test-result-with-condition-condition result)))
                  (goto-char (1- (point-max)))
                  (assert (looking-at "\n"))
                  (delete-char 1)
@@ -1603,7 +1602,7 @@ Nothing more than an interactive interface to `ert-make-test-unbound'."
 (defun ert-delete-all-tests ()
   "Make all symbols in `obarray' name no test."
   (interactive)
-  (when (interactive-p)
+  (when (called-interactively-p 'any)
     (unless (y-or-n-p "Delete all tests? ")
       (error "Aborted")))
   ;; We can't use `ert-select-tests' here since that gives us only
@@ -1793,7 +1792,7 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'."
 BEGIN and END specify a region in the current buffer."
   (save-excursion
     (save-restriction
-      (narrow-to-region begin (point))
+      (narrow-to-region begin end)
       ;; Inhibit optimization in `debugger-make-xrefs' that would
       ;; sometimes insert unrelated backtrace info into our buffer.
       (let ((debugger-previous-backtrace nil))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 399e0fb2e24..5dc2938fe08 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -319,12 +319,6 @@ Like `package-alist', but maps package name to a second alist.
 The inner alist is keyed by version.")
 (put 'package-obsolete-alist 'risky-local-variable t)
 
-(defconst package-subdirectory-regexp
-  "\\`\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)\\'"
-  "Regular expression matching the name of a package subdirectory.
-The first subexpression is the package name.
-The second subexpression is the version string.")
-
 (defun package-version-join (vlist)
   "Return the version string corresponding to the list VLIST.
 This is, approximately, the inverse of `version-to-list'.
@@ -357,7 +351,7 @@ This is, approximately, the inverse of `version-to-list'.
 (defun package-strip-version (dirname)
   "Strip the version from a combined package name and version.
 E.g., if given \"quux-23.0\", will return \"quux\""
-  (if (string-match package-subdirectory-regexp dirname)
+  (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname)
       (match-string 1 dirname)))
 
 (defun package-load-descriptor (dir package)
@@ -382,12 +376,13 @@ In each valid package subdirectory, this function loads the
 description file containing a call to `define-package', which
 updates `package-alist' and `package-obsolete-alist'."
   (let ((all (memq 'all package-load-list))
+        (regexp (concat "\\`" package-subdirectory-regexp "\\'"))
         name version force)
     (dolist (dir (cons package-user-dir package-directory-list))
       (when (file-directory-p dir)
         (dolist (subdir (directory-files dir))
           (when (and (file-directory-p (expand-file-name subdir dir))
-                     (string-match package-subdirectory-regexp subdir))
+                     (string-match regexp subdir))
             (setq name    (intern (match-string 1 subdir))
                   version (match-string 2 subdir)
                   force   (assq name package-load-list))
@@ -579,30 +574,29 @@ EXTRA-PROPERTIES is currently unused."
       (package-autoload-ensure-default-file generated-autoload-file))
     (update-directory-autoloads pkg-dir)))
 
-(defun package-untar-buffer ()
+(defvar tar-parse-info)
+(declare-function tar-untar-buffer "tar-mode" ())
+
+(defun package-untar-buffer (dir)
   "Untar the current buffer.
-This uses `tar-untar-buffer' if it is available.
-Otherwise it uses an external `tar' program.
-`default-directory' should be set by the caller."
+This uses `tar-untar-buffer' from Tar mode.  All files should
+untar into a directory named DIR; otherwise, signal an error."
   (require 'tar-mode)
-  (if (fboundp 'tar-untar-buffer)
-      (progn
-        ;; tar-mode messes with narrowing, so we just let it have the
-        ;; whole buffer to play with.
-        (delete-region (point-min) (point))
-        (tar-mode)
-        (tar-untar-buffer))
-    ;; FIXME: check the result.
-    (call-process-region (point) (point-max) "tar" nil '(nil nil) nil
-                         "xf" "-")))
+  (tar-mode)
+  ;; Make sure everything extracts into DIR.
+  (let ((regexp (concat "\\`" (regexp-quote dir) "/")))
+    (dolist (tar-data tar-parse-info)
+      (unless (string-match regexp (aref tar-data 2))
+        (error "Package does not untar cleanly into directory %s/" dir))))
+  (tar-untar-buffer))
 
 (defun package-unpack (name version)
-  (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version)
-                                   package-user-dir)))
+  (let* ((dirname (concat (symbol-name name) "-" version))
+         (pkg-dir (expand-file-name dirname package-user-dir)))
     (make-directory package-user-dir t)
     ;; FIXME: should we delete PKG-DIR if it exists?
     (let* ((default-directory (file-name-as-directory package-user-dir)))
-      (package-untar-buffer)
+      (package-untar-buffer dirname)
       (package-generate-autoloads (symbol-name name) pkg-dir)
       (let ((load-path (cons pkg-dir load-path)))
         (byte-recompile-directory pkg-dir 0 t)))))
@@ -942,7 +936,8 @@ FILE is the name of the tar file to examine.
 The return result is a vector like `package-buffer-info'."
   (let ((default-directory (file-name-directory file))
         (file (file-name-nondirectory file)))
-    (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file)
+    (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'")
+                          file)
       (error "Invalid package name `%s'" file))
     (let* ((pkg-name (match-string-no-properties 1 file))
            (pkg-version (match-string-no-properties 2 file))
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 97862afb678..fffe09a84a5 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -567,18 +567,12 @@ You can change the color sort order by customizing `list-colors-sort'."
   (with-help-window buffer-name
     (with-current-buffer standard-output
       (erase-buffer)
+      (list-colors-print list callback)
+      (set-buffer-modified-p nil)
       (setq truncate-lines t)))
-  (let ((buf (get-buffer buffer-name))
-        (inhibit-read-only t))
-    ;; Display buffer before generating content, to allow
-    ;; `list-colors-print' to get the right window-width.
-    (with-selected-window (or (get-buffer-window buf t) (selected-window))
-      (with-current-buffer buf
-        (list-colors-print list callback)
-        (set-buffer-modified-p nil)))
-    (when callback
-      (pop-to-buffer buf)
-      (message "Click on a color to select it."))))
+  (when callback
+    (pop-to-buffer buffer-name)
+    (message "Click on a color to select it.")))
 
 (defun list-colors-print (list &optional callback)
   (let ((callback-fn
@@ -595,30 +589,19 @@ You can change the color sort order by customizing `list-colors-sort'."
       (let* ((opoint (point))
              (color-values (color-values (car color)))
              (light-p (>= (apply 'max color-values)
-                          (* (car (color-values "white")) .5)))
-             (max-len (max (- (window-width) 33) 20)))
+                          (* (car (color-values "white")) .5))))
         (insert (car color))
         (indent-to 22)
         (put-text-property opoint (point) 'face `(:background ,(car color)))
         (put-text-property
          (prog1 (point)
            (insert " ")
-           (if (cdr color)
-               ;; Insert as many color names as possible, fitting max-len.
-               (let ((names (list (car color)))
-                     (others (cdr color))
-                     (len (length (car color)))
-                     newlen)
-                 (while (and others
-                             (< (setq newlen (+ len 2 (length (car others))))
-                                max-len))
-                   (setq len newlen)
-                   (push (pop others) names))
-                 (insert (mapconcat 'identity (nreverse names) ", ")))
-             (insert (car color))))
+           ;; Insert all color names.
+           (insert (mapconcat 'identity color ",")))
          (point)
          'face (list :foreground (car color)))
-        (indent-to (max (- (window-width) 8) 44))
+        (insert (propertize " " 'display '(space :align-to (- right 9))))
+        (insert " ")
         (insert (propertize
                  (apply 'format "#%02x%02x%02x"
                         (mapcar (lambda (c) (lsh c -8))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index b22ed7397af..7eca03bd93b 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,33 @@
+2011-03-18  Julien Danjou  <julien@danjou.info>
+
+        * gnus-util.el (gnus-buffer-live-p): Simplify gnus-buffer-live-p.
+        (gnus-buffer-live-p): Check that buffer is not nil.
+
+2011-03-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * gnus-art.el: Require mouse, which the build bot seems to say is
+        needed.
+
+        * gravatar.el (gravatar-retrieve-synchronously): Use `url-retrieve' on
+        XEmacs, since it doesn't have url-retrieve-synchronously.
+
+2011-03-17  Antoine Levitt  <antoine.levitt@gmail.com>
+
+        * gnus-group.el (gnus-group-list-ticked): New function.
+        (gnus-group-make-menu-bar): Provide a menu entry for it.
+        (gnus-group-list-map): Provide a binding for it.
+
+2011-03-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * shr.el (shr-visit-file): New command.
+
+        * nnimap.el (nnimap-fetch-inbox): Rewrite slightly last patch.
+
+2011-03-17  Bjørn Mork  <bjorn@mork.no>
+
+        * nnimap.el (nnimap-fetch-inbox): Don't download bodies on ver4-capable
+        servers.
+
 2011-03-16  Julien Danjou  <julien@danjou.info>
 
         * mm-uu.el (mm-uu-dissect-text-parts): Only dissect handle that are
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b994a2839bc..7c7e0531926 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -44,6 +44,7 @@
 (require 'wid-edit)
 (require 'mm-uu)
 (require 'message)
+(require 'mouse)
 
 (autoload 'gnus-msg-mail "gnus-msg" nil t)
 (autoload 'gnus-button-mailto "gnus-msg")
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index e928811b558..c265538e19c 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -697,7 +697,8 @@ simple manner.")
   "M" gnus-group-list-all-matching
   "l" gnus-group-list-level
   "c" gnus-group-list-cached
-  "?" gnus-group-list-dormant)
+  "?" gnus-group-list-dormant
+  "!" gnus-group-list-ticked)
 
 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
   "k"  gnus-group-list-limit
@@ -849,7 +850,8 @@ simple manner.")
         ["List all groups matching..." gnus-group-list-all-matching t]
         ["List active file" gnus-group-list-active t]
         ["List groups with cached" gnus-group-list-cached t]
-        ["List groups with dormant" gnus-group-list-dormant t])
+        ["List groups with dormant" gnus-group-list-dormant t]
+        ["List groups with ticked" gnus-group-list-ticked t])
        ("Sort"
         ["Default sort" gnus-group-sort-groups t]
         ["Sort by method" gnus-group-sort-groups-by-method t]
@@ -4536,6 +4538,28 @@ This command may read the active file."
   (goto-char (point-min))
   (gnus-group-position-point))
 
+(defun gnus-group-list-ticked (level &optional lowest)
+  "List all groups with ticked articles.
+If the prefix LEVEL is non-nil, it should be a number that says which
+level to cut off listing groups.
+If LOWEST, don't list groups with level lower than LOWEST.
+
+This command may read the active file."
+  (interactive "P")
+  (when level
+    (setq level (prefix-numeric-value level)))
+  (when (or (not level) (>= level gnus-level-zombie))
+    (gnus-cache-open))
+  (funcall gnus-group-prepare-function
+           (or level gnus-level-subscribed)
+           #'(lambda (info)
+               (let ((marks (gnus-info-marks info)))
+                 (assq 'tick marks)))
+           lowest
+           'ignore)
+  (goto-char (point-min))
+  (gnus-group-position-point))
+
 (defun gnus-group-listed-groups ()
   "Return a list of listed groups."
   (let (point groups)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 42dbd5948cf..3f66b45aaab 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -672,11 +672,9 @@ If N, return the Nth ancestor instead."
         (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references)
           (match-string 1 references))))))
 
-(defun gnus-buffer-live-p (buffer)
+(defsubst gnus-buffer-live-p (buffer)
   "Say whether BUFFER is alive or not."
-  (and buffer
-       (get-buffer buffer)
-       (buffer-name (get-buffer buffer))))
+  (and buffer (buffer-live-p (get-buffer buffer))))
 
 (defun gnus-horizontal-recenter ()
   "Recenter the current buffer horizontally."
diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el
index 0c97080d847..4b0c9a16283 100644
--- a/lisp/gnus/gravatar.el
+++ b/lisp/gnus/gravatar.el
@@ -129,8 +129,10 @@ You can provide a list of argument to pass to CB in CBARGS."
   "Retrieve MAIL-ADDRESS gravatar and returns it."
   (let ((url (gravatar-build-url mail-address)))
     (if (gravatar-cache-expired url)
-        (with-current-buffer (url-retrieve-synchronously url)
-          (when gravatar-automatic-caching
+        (with-current-buffer (if (featurep 'xemacs)
+                                 (url-retrieve url)
+                               (url-retrieve-synchronously url))
+          (when gravatar-automatic-caching
             (url-store-in-cache (current-buffer)))
           (let ((data (gravatar-data->image)))
             (kill-buffer (current-buffer))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index e0804f81e2e..bcbe7b678d5 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1762,11 +1762,15 @@ textual parts.")
     (format "(UID %s%s)"
             (format
              (if (nnimap-ver4-p)
-                 "BODY.PEEK[HEADER] BODY.PEEK"
+                 "BODY.PEEK"
                "RFC822.PEEK"))
-            (if nnimap-split-download-body-default
-                "[]"
-              "[1]")))
+            (cond
+             (nnimap-split-download-body-default
+              "[]")
+             ((nnimap-ver4-p)
+              "[HEADER]")
+             (t
+              "[1]"))))
    t))
 
 (defun nnimap-split-incoming-mail ()
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index c9c5bd5ff1c..113137a0046 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -113,6 +113,15 @@ cid: URL as the argument.")
 
 ;; Public functions and commands.
 
+(defun shr-visit-file (file)
+  (interactive "fHTML file name: ")
+  (pop-to-buffer "*html*")
+  (erase-buffer)
+  (shr-insert-document
+   (with-temp-buffer
+     (insert-file-contents file)
+     (libxml-parse-html-region (point-min) (point-max)))))
+
 ;;;###autoload
 (defun shr-insert-document (dom)
   (setq shr-content-cache nil)
diff --git a/lisp/ido.el b/lisp/ido.el
index 2e67e367a8f..2a5c7cf2f0e 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1983,7 +1983,7 @@ If INITIAL is non-nil, it specifies the initial input string."
         (setq ido-exit nil)
         (setq ido-final-text
               (catch 'ido
-                (completing-read
+                (completing-read-default
                  (ido-make-prompt item prompt)
                  '(("dummy" . 1)) nil nil ; table predicate require-match
                  (prog1 ido-text-init (setq ido-text-init nil)) ;initial-contents
@@ -4740,13 +4740,13 @@ See `read-directory-name' for additional parameters."
           (concat ido-current-directory filename)))))
 
 ;;;###autoload
-(defun ido-completing-read (prompt choices &optional predicate require-match initial-input hist def)
+(defun ido-completing-read (prompt choices &optional predicate require-match initial-input hist def inherit-input-method)
   "Ido replacement for the built-in `completing-read'.
 Read a string in the minibuffer with ido-style completion.
 PROMPT is a string to prompt with; normally it ends in a colon and a space.
 CHOICES is a list of strings which are the possible completions.
-PREDICATE is currently ignored; it is included to be compatible
- with `completing-read'.
+PREDICATE and INHERIT-INPUT-METHOD is currently ignored; it is included
+ to be compatible with `completing-read'.
 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
  the input is (or completes to) an element of CHOICES or is null.
  If the input is null, `ido-completing-read' returns DEF, or an empty
diff --git a/lisp/info.el b/lisp/info.el
index bc2062e72b2..fb753659737 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -594,15 +594,15 @@ in `Info-file-supports-index-cookies-list'."
 (defun info-initialize ()
   "Initialize `Info-directory-list', if that hasn't been done yet."
   (unless Info-directory-list
-    (let ((path (getenv "INFOPATH")))
+    (let ((path (getenv "INFOPATH"))
+          (sep (regexp-quote path-separator)))
       (setq Info-directory-list
             (prune-directory-list
              (if path
-                 (if (string-match ":\\'" path)
-                     (append (split-string (substring path 0 -1)
-                                           (regexp-quote path-separator))
+                 (if (string-match-p (concat sep "\\'") path)
+                     (append (split-string (substring path 0 -1) sep)
                              (Info-default-dirs))
-                   (split-string path (regexp-quote path-separator)))
+                   (split-string path sep))
                (Info-default-dirs)))))))
 
 ;;;###autoload
diff --git a/lisp/startup.el b/lisp/startup.el
index 65b1a013c21..e8e85a41c77 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -392,6 +392,15 @@ Warning Warning!!!  Pure space overflow    !!!Warning Warning
   :type 'directory
   :initialize 'custom-initialize-delay)
 
+(defconst package-subdirectory-regexp
+  "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)"
+  "Regular expression matching the name of a package subdirectory.
+The first subexpression is the package name.
+The second subexpression is the version string.
+
+The regexp should not contain a starting \"\\`\" or a trailing
+ \"\\'\"; those are added automatically by callers.")
+
 (defun normal-top-level-add-subdirs-to-load-path ()
   "Add all subdirectories of current directory to `load-path'.
 More precisely, this uses only the subdirectories whose names
@@ -1194,9 +1203,9 @@ the `--debug-init' option to view a complete error backtrace."
              (when (file-directory-p dir)
                (dolist (subdir (directory-files dir))
                  (when (and (file-directory-p (expand-file-name subdir dir))
-                            ;; package-subdirectory-regexp from package.el
-                            (string-match "\\`\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)\\'"
-                                          subdir))
+                            (string-match
+                             (concat "\\`" package-subdirectory-regexp "\\'")
+                             subdir))
                    (throw 'package-dir-found t)))))))
        (package-initialize))
 
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 9ccb37f3a55..72f415a9b94 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -122,8 +122,7 @@ when editing big diffs)."
     ("\C-m" . diff-goto-source)
     ([mouse-2] . diff-goto-source)
     ;; From XEmacs' diff-mode.
-    ;; Standard M-w is useful, so don't change M-W.
-    ;;("W" . widen)
+    ("W" . widen)
     ;;("." . diff-goto-source)          ;display-buffer
     ;;("f" . diff-goto-source)          ;find-file
     ("o" . diff-goto-source)            ;other-window
@@ -135,17 +134,21 @@ when editing big diffs)."
     ;; Not useful if you have to metafy them.
     ;;(" " . scroll-up)
     ;;("\177" . scroll-down)
-    ;; Standard M-a is useful, so don't change M-A.
-    ;;("A" . diff-ediff-patch)
-    ;; Standard M-r is useful, so don't change M-r or M-R.
-    ;;("r" . diff-restrict-view)
-    ;;("R" . diff-reverse-direction)
-    )
+    ("A" . diff-ediff-patch)
+    ("r" . diff-restrict-view)
+    ("R" . diff-reverse-direction))
   "Basic keymap for `diff-mode', bound to various prefix keys."
   :inherit special-mode-map)
 
 (easy-mmode-defmap diff-mode-map
-  `(("\e" . ,diff-mode-shared-map)
+  `(("\e" . ,(let ((map (make-sparse-keymap)))
+               ;; We want to inherit most bindings from diff-mode-shared-map,
+               ;; but not all since they may hide useful M-<foo> global
+               ;; bindings when editing.
+               (set-keymap-parent map diff-mode-shared-map)
+               (dolist (key '("A" "r" "R" "g" "q" "W"))
+                 (define-key map key nil))
+               map))
     ;; From compilation-minor-mode.
     ("\C-c\C-c" . diff-goto-source)
     ;; By analogy with the global C-x 4 a binding.
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index 601b6b1e597..5435a840ac9 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -3176,21 +3176,26 @@ See also `auto-save-file-name-p'."
 
 ;; Metacharacters that have to be protected from the shell when executing
 ;; a diff/diff3 command.
-(defcustom emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
-  "Characters that must be quoted with \\ when used in a shell command line.
+(defcustom emerge-metachars
+  (if (memq system-type '(ms-dos windows-nt))
+      "[ \t\"<>|?*^&=]"
+    "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]")
+  "Characters that must be quoted when used in a shell command line.
 More precisely, a [...] regexp to match any one such character."
   :type 'regexp
   :group 'emerge)
 
 ;; Quote metacharacters (using \) when executing a diff/diff3 command.
 (defun emerge-protect-metachars (s)
-  (let ((limit 0))
-    (while (string-match emerge-metachars s limit)
-      (setq s (concat (substring s 0 (match-beginning 0))
-                      "\\"
-                      (substring s (match-beginning 0))))
-      (setq limit (1+ (match-end 0)))))
-  s)
+  (if (memq system-type '(ms-dos windows-nt))
+      (shell-quote-argument s)
+    (let ((limit 0))
+      (while (string-match emerge-metachars s limit)
+        (setq s (concat (substring s 0 (match-beginning 0))
+                        "\\"
+                        (substring s (match-beginning 0))))
+        (setq limit (1+ (match-end 0)))))
+    s))
 
 (provide 'emerge)