merge upstream

41 files changed, 2083 insertions, 1193 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d2d44793366..66336413e27 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,323 @@
+2011-06-22  Roland Winkler  <winkler@gnu.org>
+
+        * textmodes/bibtex.el (bibtex-entry-update): Use mapc.
+        (bibtex-clean-entry): First delete the old key so that a
+        customized algorithm for generating the new key does not get
+        confused by the old key.
+        (bibtex-url): Obey regexp of first step.
+        (bibtex-search-entries): Do not use add-to-list with local
+        list-var.
+
+2011-06-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * mail/smtpmail.el (smtpmail-try-auth-methods): If the user has
+        stored a user name, then query for the password first, instead of
+        waiting for SMTP to give an error message and the trying again.
+
+2011-06-22  Lawrence Mitchell  <wence@gmx.li>
+
+        * net/browse-url.el (browse-url-xdg-open): Use 0, rather than nil
+        BUFFER in call-process.
+
+2011-06-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * mail/smtpmail.el (smtpmail-via-smtp): Make sure we don't send
+        QUIT twice.
+        (smtpmail-try-auth-methods): Require user name and password from
+        auth-source.
+
+2011-06-22  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (display-buffer-default-specifiers)
+        (display-buffer-alist): Remove entries for pop-up-frame-alist.
+        Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
+        (split-window): Normalize SIDE argument (Bug#8916).
+
+        * frame.el (pop-up-frame-alist, pop-up-frame-function)
+        (special-display-frame-alist, special-display-popup-frame):
+        Remove duplicate declarations.  These are now in window.el.
+
+2011-06-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * mail/smtpmail.el (smtpmail-via-smtp): Set
+        :use-starttls-if-possible so that we always use STARTTLS if the
+        server supports it.  SMTP servers that support STARTTLS commonly
+        require it.
+
+        * net/network-stream.el (network-stream-open-starttls): Support
+        upgrading to STARTTLS always, even if we don't have built-in support.
+        (open-network-stream): Add the :always-query-capabilies keyword.
+
+        * mail/smtpmail.el: Rewritten to do opportunistic STARTTLS
+        upgrades with `open-network-stream', and rely solely on
+        auth-source for all credentials.  Big changes throughout the file,
+        but in particular:
+        (smtpmail-auth-credentials): Removed.
+        (smtpmail-starttls-credentials): Removed.
+        (smtpmail-via-smtp): Check for servers saying they want AUTH after
+        MAIL FROM, too.
+
+        * net/network-stream.el (network-stream-open-starttls): Provide
+        support for client certificates both for external and built-in
+        STARTTLS.
+        (auth-source): Require.
+        (open-network-stream): Document the :client-certificate keyword.
+        (network-stream-certificate): Change cert-cert to cert and
+        cert-key to key.
+
+2011-06-21  Michael Albinus  <michael.albinus@gmx.de>
+
+        * net/tramp-cache.el (top): Don't load the persistency file when
+        "emacs -Q" has been called.
+
+2011-06-21  Tim Harper  <timcharper@gmail.com>
+
+        * term/ns-win.el (ns-initialize-window-system): set
+        application-specific `ApplePressAndHoldEnabled' system
+        resource to NO as it is not yet supported by the NS port.
+
+2011-06-21  Juanma Barranquero  <lekktu@gmail.com>
+
+        * misc.el (list-dynamic-libraries--refresh): Compute header here...
+        (list-dynamic-libraries): ...not here.
+
+2011-06-21  Leo Liu  <sdl.web@gmail.com>
+
+        * subr.el (sha1): Implement sha1 using secure-hash.
+
+2011-06-21  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (display-buffer-alist): In default value do not
+        enforce searching a window on any but the selected frame.
+        Reported by Katsumi Yamaoka <yamaoka@jpl.org>.
+        (display-buffer-select-window): Remove function.
+        (display-buffer-in-window): When a window on another frame gets
+        reused, do not select it any more but just raise its frame if
+        necessary (Bug#8851) and (Bug#8856).
+        (display-buffer-normalize-options): Handle pop-up-frames related
+        options more faithfully.
+        (pop-to-buffer): Don't rely on `display-buffer' selecting the
+        window if it is on another frame.
+        (display-buffer-alist, display-buffer-default-specifiers): Don't
+        make new frame unsplittable by default.
+        (display-buffer-normalize-argument): Fix doc-string typo and use
+        'same-frame-other-window instead of 'other-window when associating
+        with display-buffer-macro-specifiers.
+
+2011-06-21  Vincent Belaïche  <vincent.b.1@hotmail.fr>
+
+        * play/5x5.el (5x5-solve-rotate-left, 5x5-solve-rotate-right):
+        New functions.
+        (5x5-mode-map, 5x5-mode-menu): Bind them.
+        (5x5-draw-grid): Tweak the solver's rendering.
+
+2011-06-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * progmodes/compile.el (compilation-error-regexp-alist-alist): Rename
+        `caml' to `python-tracebacks-and-caml'; allow leading tabs (bug#8585).
+
+2011-06-21  Drew Adams <drew.adams@oracle.com>
+
+        * menu-bar.el: Use function variable instead of switch-to-buffer.
+        (menu-bar-select-buffer-function): New variable.
+        (menu-bar-update-buffers): Use it (bug#8876).
+
+2011-06-21  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/bytecomp.el (add-to-list): Add handler to check the
+        variable's status.
+
+2011-06-20  Jan Djärv  <jan.h.d@swipnet.se>
+
+        * x-dnd.el (x-dnd-version-from-flags)
+        (x-dnd-more-than-3-from-flags): New functions that handle long-as-cons
+        and long as number (Bug#8899).
+        (x-dnd-handle-xdnd): Call functions above (Bug#8899).
+
+2011-06-20  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * minibuffer.el (completion-metadata): Add `metadata' to the alist.
+        (completion-try-completion, completion-all-completions): Compute the
+        metadata argument if it's missing; make it optional (bug#8795).
+
+        * wid-edit.el: Use lex-bind and move towards completion-at-point.
+        (widget-complete): Use new :completion-function property.
+        (widget-completions-at-point): New function.
+        (default): Use :completion-function instead of :complete.
+        (widget-default-completions): Rename from widget-default-complete;
+        Rewrite.
+        (widget-string-complete, widget-file-complete, widget-color-complete):
+        Remove functions.
+        (file, symbol, function, variable, coding-system, color):
+        * international/mule-cmds.el (default-input-method, charset)
+        (language-info-custom-alist):
+        * cus-edit.el (face): Use new property :completions.
+
+        * progmodes/pascal.el (pascal-completions-at-point): New function.
+        (pascal-mode): Use it.
+        (pascal-mode-map): Use completion-at-point.
+        (pascal-toggle-completions): Make obsolete.
+        (pascal-complete-word, pascal-show-completions):
+        * progmodes/octave-mod.el (octave-complete-symbol):
+        Redefine as obsolete alias.
+        * progmodes/octave-inf.el (inferior-octave-completion-at-point):
+        Signal absence of completion info for old Octave,
+        (inferior-octave-complete): Redefine as obsolete alias.
+        * progmodes/meta-mode.el: Use lexical-binding and completion-at-point.
+        (meta-completions-at-point): Rename from meta-complete-symbol and
+        adapt it for use on completion-at-point-functions.
+        (meta-common-mode): Use it.
+        (meta-looking-at-backward, meta-match-buffer): Remove.
+        (meta-complete-symbol): Redefine as obsolete alias.
+        (meta-common-mode-map): Use completion-at-point.
+        * progmodes/make-mode.el: Use lexical-binding and completion-at-point.
+        (makefile-mode-map): Use completion-at-point.
+        (makefile-completions-at-point): Rename from makefile-complete and
+        adapt it for use on completion-at-point-functions.
+        (makefile-mode): Use it.
+        (makefile-complete): Redefine as obsolete alias.
+
+2011-06-20  Deniz Dogan  <deniz@dogan.se>
+
+        * net/rcirc.el: Delete trailing whitespaces once and for all.
+
+2011-06-20  Daniel Colascione  <dan.colascione@gmail.com>
+
+        * emacs-lisp/syntax.el (syntax-ppss): Further improve docstring.
+
+2011-06-19  Chong Yidong  <cyd@stupidchicken.com>
+
+        * files.el (auto-mode-alist): Entry for m2-mode (Bug#8852).
+
+        * info.el (Info-apropos-toc-nodes): Minor doc fix (Bug#8833).
+
+2011-06-19  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (display-buffer-other-window-means-other-frame):
+        Call display-buffer-normalize-alist.
+        (display-buffer-normalize-specifiers-1): Rename to
+        display-buffer-normalize-argument.  New argument other-frame.
+        Rewrite.
+        (display-buffer-normalize-specifiers-2): Rename to
+        display-buffer-normalize-options.
+        (display-buffer-normalize-alist-1): New function.
+        (display-buffer-normalize-specifiers-3): Rename to
+        display-buffer-normalize-alist.
+        Call display-buffer-normalize-alist-1.
+        (display-buffer-normalize-options-inhibit): New variable.
+        (display-buffer-normalize-specifiers): Rewrite calling
+        display-buffer-normalize-alist,
+        display-buffer-normalize-argument, and
+        display-buffer-normalize-options.  Don't call the latter if
+        display-buffer-normalize-options-inhibit is non-nil.
+        (frame-auto-delete): New option.
+        (window-deletable-p): Use frame-auto-delete.
+        (window-list-no-nils, window-state-ignored-parameters)
+        (window-state-get-1, window-state-get, window-state-put-list)
+        (window-state-put-1, window-state-put-2, window-state-put):
+        New functions.
+        (display-buffer-normalize-options): Move special-display-p group
+        after pop-up-frame group (Bug#8851) and (Bug#8856).
+
+2011-06-18  Chong Yidong  <cyd@stupidchicken.com>
+
+        * emacs-lisp/rx.el (rx-constituents): Add support for numbered
+        groups (Bug#8776).
+        (rx-submatch-n): New function.
+        (rx): Document it.
+
+        * dired-x.el (dired-mark-unmarked-files): Fix interactive spec
+        (Bug#8768).
+
+        * replace.el (occur-mode-map): Set occur-edit-mode binding to "e".
+
+        * textmodes/fill.el (default-justification): Add :safe (Bug#8879).
+
+        * cus-face.el (custom-declare-face): Call custom-theme-recalc face
+        anytime existing face settings are present (Bug#8889).
+
+        * progmodes/delphi.el (delphi-mode-syntax-table): Use defvar.
+        (delphi-mode): Use define-derived-mode to inherit from prog-mode.
+        Remove unused argument.
+
+2011-06-18  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (display-buffer-default-specifiers):
+        Remove pop-up-frame.  Add pop-up-window-min-height,
+        pop-up-window-min-width, and another reuse-window specifier
+        (Bug#8882).  Reported by Dan Nicolaescu <dann@gnu.org>.
+        (display-buffer-normalize-specifiers-2):
+        Handle split-height-threshold and split-width-threshold also when
+        pop-up-windows is unset.  Add a reuse-window specifier for the
+        case popping up a new window fails.
+        (special-display-popup-frame): Remove double quoting.
+        (display-buffer-normalize-specifiers-1): Fix thinko.
+
+2011-06-17  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * shell.el (shell-completion-vars): Set pcomplete-termination-string
+        according to comint-completion-addsuffix.
+
+        * pcomplete.el: Convert to lexical binding and fix bug#8819.
+        (pcomplete-suffix-list): Mark as obsolete.
+        (pcomplete-completions-at-point): Capture pcomplete-norm-func and
+        pcomplete-seen in the closure.
+        (pcomplete-comint-setup): Setup completion-at-point as well.
+        (pcomplete--entries): New function.
+        (pcomplete--env-regexp): New var.
+        (pcomplete-entries): Rewrite to work with partial-completion and
+        without relying on pcomplete-suffix-list.
+        (pcomplete-pare-list): Remove, unused.
+
+2011-06-17  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (display-buffer-alist): Set pop-up-window-min-height
+        and pop-up-window-min-width in default value.  Reported by
+        Thierry Volpiatto <thierry.volpiatto@gmail.com>.  New specifier
+        other-window-means-other-frame.
+        (display-buffer-macro-specifiers): Comment out entry for
+        other-window specifier.
+        (display-buffer-other-window-means-other-frame): New function.
+        (display-buffer-normalize-specifiers-1): New arguments
+        buffer-name and label.  Treat other-window case specially.
+        (display-buffer-normalize-specifiers-2): Treat other-window case
+        specially.
+        (display-buffer-normalize-specifiers-3): New function.
+        (display-buffer-normalize-specifiers):
+        Call display-buffer-normalize-specifiers-3.
+
+2011-06-17  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (same-window-p): Fix two typos introduced when
+        adding with-no-warnings.
+        (display-buffer-normalize-specifiers-1): Don't check
+        pop-up-frames for 'unset initialization.
+        (display-buffer-normalize-specifiers-2): Major rewrite using
+        special-display-p and same-window-p (Bug#8851) and (Bug#8856).
+        (pop-up-frames, display-buffer-reuse-frames)
+        (display-buffer-mark-dedicated): Don't initialize to 'unset.
+        Suggested by David Engster <deng@randomsample.de>.
+        (even-window-heights): Initialize to 'unset.
+        (display-buffer-alist-set): Handle new 'unset initializations.
+        (display-buffer-macro-specifiers): Don't pop up a new frame in the
+        other window case.
+
+2011-06-16  Martin Rudalics  <rudalics@gmx.at>
+
+        * window.el (display-buffer-normalize-specifiers-1):
+        Respect current value of pop-up-frames for most reasonable values of
+        second argument of display-buffer (Bug#8865).
+        (switch-to-buffer-same-frame, switch-to-buffer-other-window)
+        (switch-to-buffer-other-window-same-frame)
+        (switch-to-buffer-other-frame): Fix doc-strings.  Reported by Drew
+        Adams (Bug#8875).
+        (display-buffer): Don't check noninteractive when calling
+        display-buffer-pop-up-frame.
+        (display-buffer-pop-up-frame): Never pop up a frame in
+        noninteractive mode (Bug#8857).
+        (enlarge-window, shrink-window): Don't report an error when the
+        window can't be resized as requested (Bug#8862).
+
 2011-06-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * pcmpl-rpm.el (pcomplete/rpm): Minor simplification.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index f14c055d7a8..7c96b526f41 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3830,9 +3830,8 @@ restoring it to the state of a face that has never been customized."
   :sample-face-get 'widget-face-sample-face-get
   :notify 'widget-face-notify
   :match (lambda (_widget value) (facep value))
-  :complete-function (lambda ()
-                       (interactive)
-                       (lisp-complete-symbol 'facep))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'facep 'strict)
   :prompt-match 'facep
   :prompt-history 'widget-face-prompt-value-history
   :validate (lambda (widget)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 90f21f32149..c23632ab885 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -34,30 +34,33 @@
 (defun custom-declare-face (face spec doc &rest args)
   "Like `defface', but FACE is evaluated as a normal argument."
   (unless (get face 'face-defface-spec)
-    (unless (facep face)
-      ;; If the user has already created the face, respect that.
-      (let ((value (or (get face 'saved-face) spec))
-            (have-window-system (memq initial-window-system '(x w32))))
-        ;; Create global face.
-        (make-empty-face face)
-        ;; Create frame-local faces
-        (dolist (frame (frame-list))
-          (face-spec-set-2 face frame value)
-          (when (memq (window-system frame) '(x w32 ns))
-            (setq have-window-system t)))
-        ;; When making a face after frames already exist
-        (if have-window-system
-            (make-face-x-resource-internal face))))
-    ;; Don't record SPEC until we see it causes no errors.
-    (put face 'face-defface-spec (purecopy spec))
-    (push (cons 'defface face) current-load-list)
-    (when (and doc (null (face-documentation face)))
-      (set-face-documentation face (purecopy doc)))
-    (custom-handle-all-keywords face args 'custom-face)
-    (run-hooks 'custom-define-hook)
-    ;; If the face has an existing theme setting, recalculate it.
-    (if (get face 'theme-face)
-        (custom-theme-recalc-face face)))
+    (let ((facep (facep face)))
+      (unless facep
+        ;; If the user has already created the face, respect that.
+        (let ((value (or (get face 'saved-face) spec))
+              (have-window-system (memq initial-window-system '(x w32))))
+          ;; Create global face.
+          (make-empty-face face)
+          ;; Create frame-local faces
+          (dolist (frame (frame-list))
+            (face-spec-set-2 face frame value)
+            (when (memq (window-system frame) '(x w32 ns))
+              (setq have-window-system t)))
+          ;; When making a face after frames already exist
+          (if have-window-system
+              (make-face-x-resource-internal face))))
+      ;; Don't record SPEC until we see it causes no errors.
+      (put face 'face-defface-spec (purecopy spec))
+      (push (cons 'defface face) current-load-list)
+      (when (and doc (null (face-documentation face)))
+        (set-face-documentation face (purecopy doc)))
+      (custom-handle-all-keywords face args 'custom-face)
+      (run-hooks 'custom-define-hook)
+      ;; If the face had existing settings, recalculate it.  For
+      ;; example, the user might load a theme with a face setting, and
+      ;; later load a library defining that face.
+      (if facep
+          (custom-theme-recalc-face face))))
   face)
 
 ;;; Face attributes.
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 548728cf28d..ca89d07ea7f 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -546,11 +546,14 @@ This functions works by temporarily binding `dired-marker-char' to
 ;; Returns t if any work was done, nil otherwise.
 (defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
   "Mark unmarked files matching REGEXP, displaying MSG.
-REGEXP is matched against the entire file name.
-Does not re-mark files which already have a mark.
+REGEXP is matched against the entire file name.  When called
+interactively, prompt for REGEXP.
 With prefix argument, unflag all those files.
 Optional fourth argument LOCALP is as in `dired-get-filename'."
-  (interactive "P")
+  (interactive
+   (list (dired-read-regexp
+          "Mark unmarked files matching regexp (default all): ")
+         nil current-prefix-arg nil))
   (let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
     (dired-mark-if
      (and
diff --git a/lisp/dired.el b/lisp/dired.el
index 48cdc2a2e26..43b2170d13a 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4089,7 +4089,7 @@ true then the type of the file linked to by FILE is printed instead.
 ;;;***
 
 ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump)
-;;;;;;  "dired-x" "dired-x.el" "94bd5ca0bd260e43402e3cd9f114970c")
+;;;;;;  "dired-x" "dired-x.el" "cdeb2935dc1d33819b12981ba5272073")
 ;;; Generated autoloads from dired-x.el
 
 (autoload 'dired-jump "dired-x" "\
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 1e7ee315942..127f93c6858 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4244,6 +4244,25 @@ binding slots have been popped."
 (defun byte-compile-form-make-variable-buffer-local (form)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
 
+(byte-defop-compiler-1 add-to-list byte-compile-add-to-list)
+(defun byte-compile-add-to-list (form)
+  ;; FIXME: This could be used for `set' as well, except that it's got
+  ;; its own opcode, so the final `byte-compile-normal-call' needs to
+  ;; be replaced with something else.
+  (pcase form
+    (`(,fun ',var . ,_)
+     (byte-compile-check-variable var 'assign)
+     (if (assq var byte-compile--lexical-environment)
+         (byte-compile-log-warning
+          (format "%s cannot use lexical var `%s'" fun var)
+          nil :error)
+       (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+                   (boundp var)
+                   (memq var byte-compile-bound-variables)
+                   (memq var byte-compile-free-references))
+         (byte-compile-warn "assignment to free variable `%S'" var)
+         (push var byte-compile-free-references)))))
+  (byte-compile-normal-call form))
 
 ;;; tags
 
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 7122de4789c..56efd142198 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -130,6 +130,8 @@
     (**                 . (rx-** 2 nil))   ; SRE
     (submatch           . (rx-submatch 1 nil)) ; SRE
     (group              . submatch)     ; sregex
+    (submatch-n         . (rx-submatch-n 2 nil))
+    (group-n            . submatch-n)
     (zero-or-more       . (rx-kleene 1 nil))
     (one-or-more        . (rx-kleene 1 nil))
     (zero-or-one        . (rx-kleene 1 nil))
@@ -690,6 +692,16 @@ FORM is either `(repeat N FORM1)' or `(repeat N M FORMS...)'."
             (mapconcat (lambda (re) (rx-form re ':)) (cdr form) nil))
           "\\)"))
 
+(defun rx-submatch-n (form)
+  "Parse and produce code from FORM, which is `(submatch-n N ...)'."
+  (let ((n (nth 1 form)))
+    (concat "\\(?" (number-to-string n) ":"
+            (if (= 3 (length form))
+                ;; Only one sub-form.
+                (rx-form (nth 2 form))
+              ;; Several sub-forms implicitly concatenated.
+              (mapconcat (lambda (re) (rx-form re ':)) (cddr form) nil))
+            "\\)")))
 
 (defun rx-backref (form)
   "Parse and produce code from FORM, which is `(backref N)'."
@@ -1072,6 +1084,11 @@ CHAR
      like `and', but makes the match accessible with `match-end',
      `match-beginning', and `match-string'.
 
+`(submatch-n N SEXP1 SEXP2 ...)'
+`(group-n N SEXP1 SEXP2 ...)'
+     like `group', but make it an explicitly-numbered group with
+     group number N.
+
 `(or SEXP1 SEXP2 ...)'
 `(| SEXP1 SEXP2 ...)'
      matches anything that matches SEXP1 or SEXP2, etc.  If all
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 7ba7b13af44..200b3a6389b 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -398,8 +398,9 @@ point (where the PPSS is equivalent to nil).")
 
 (defun syntax-ppss (&optional pos)
   "Parse-Partial-Sexp State at POS, defaulting to point.
-The returned value is the same as `parse-partial-sexp' except that
-values 2 and 6 values of the returned state cannot be relied upon.
+The returned value is the same as that of `parse-partial-sexp'
+run from point-min to POS except that values at positions 2 and 6
+in the returned list (counting from 0) cannot be relied upon.
 Point is at POS when this function returns."
   ;; Default values.
   (unless pos (setq pos (point)))
diff --git a/lisp/files.el b/lisp/files.el
index aafc6f92906..7b97b730111 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2333,6 +2333,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
      ("\\.ebrowse\\'" . ebrowse-tree-mode)
      ("#\\*mail\\*" . mail-mode)
      ("\\.g\\'" . antlr-mode)
+     ("\\.mod\\'" . m2-mode)
      ("\\.ses\\'" . ses-mode)
      ("\\.docbook\\'" . sgml-mode)
      ("\\.com\\'" . dcl-mode)
diff --git a/lisp/frame.el b/lisp/frame.el
index a95e91c8eeb..3ceec2657e7 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -95,96 +95,6 @@ appended when the minibuffer frame is created."
                        (sexp :tag "Value")))
   :group 'frames)
 
-(defcustom pop-up-frame-alist nil
-  "Alist of parameters for automatically generated new frames.
-You can set this in your init file; for example,
-
-  (setq pop-up-frame-alist '((width . 80) (height . 20)))
-
-If non-nil, the value you specify here is used by the default
-`pop-up-frame-function' for the creation of new frames.
-
-Since `pop-up-frame-function' is used by `display-buffer' for
-making new frames, any value specified here by default affects
-the automatic generation of new frames via `display-buffer' and
-all functions based on it.  The behavior of `make-frame' is not
-affected by this variable."
-  :type '(repeat (cons :format "%v"
-                       (symbol :tag "Parameter")
-                       (sexp :tag "Value")))
-  :group 'frames)
-
-(defcustom pop-up-frame-function
-  (lambda () (make-frame pop-up-frame-alist))
-  "Function used by `display-buffer' for creating a new frame.
-This function is called with no arguments and should return a new
-frame.  The default value calls `make-frame' with the argument
-`pop-up-frame-alist'."
-  :type 'function
-  :group 'frames)
-
-(defcustom special-display-frame-alist
-  '((height . 14) (width . 80) (unsplittable . t))
-  "Alist of parameters for special frames.
-Special frames are used for buffers whose names are listed in
-`special-display-buffer-names' and for buffers whose names match
-one of the regular expressions in `special-display-regexps'.
-
-This variable can be set in your init file, like this:
-
-  (setq special-display-frame-alist '((width . 80) (height . 20)))
-
-These supersede the values given in `default-frame-alist'."
-  :type '(repeat (cons :format "%v"
-                         (symbol :tag "Parameter")
-                         (sexp :tag "Value")))
-  :group 'frames)
-
-(defun special-display-popup-frame (buffer &optional args)
-  "Display BUFFER and return the window chosen.
-If BUFFER is already displayed in a visible or iconified frame,
-raise that frame.  Otherwise, display BUFFER in a new frame.
-
-Optional argument ARGS is a list specifying additional
-information.
-
-If ARGS is an alist, use it as a list of frame parameters.  If
-these parameters contain \(same-window . t), display BUFFER in
-the selected window.  If they contain \(same-frame . t), display
-BUFFER in a window of the selected frame.
-
-If ARGS is a list whose car is a symbol, use (car ARGS) as a
-function to do the work.  Pass it BUFFER as first argument,
-and (cdr ARGS) as second."
-  (if (and args (symbolp (car args)))
-      (apply (car args) buffer (cdr args))
-    (let ((window (get-buffer-window buffer 0)))
-      (or
-       ;; If we have a window already, make it visible.
-       (when window
-         (let ((frame (window-frame window)))
-           (make-frame-visible frame)
-           (raise-frame frame)
-           window))
-       ;; Reuse the current window if the user requested it.
-       (when (cdr (assq 'same-window args))
-         (condition-case nil
-             (progn (switch-to-buffer buffer) (selected-window))
-           (error nil)))
-       ;; Stay on the same frame if requested.
-       (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
-         (let* ((pop-up-windows t)
-                pop-up-frames
-                special-display-buffer-names special-display-regexps)
-           (display-buffer buffer)))
-       ;; If no window yet, make one in a new frame.
-       (let ((frame
-              (with-current-buffer buffer
-                (make-frame (append args special-display-frame-alist)))))
-         (set-window-buffer (frame-selected-window frame) buffer)
-         (set-window-dedicated-p (frame-selected-window frame) t)
-         (frame-selected-window frame))))))
-
 (defun handle-delete-frame (event)
   "Handle delete-frame events from the X server."
   (interactive "e")
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2bfaf32f958..5a6ad584438 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,38 @@
+2011-06-21  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * auth-source.el (auth-source-netrc-create): Don't print all tokens in
+        %S format, since that looks odd.
+        (auth-sources): Prefer the ~/.authinfo file over the ~/.authinfo.gpg
+        file, especially when saving.
+
+2011-06-21  Andrew Cohen  <cohen@andy.bu.edu>
+
+        * nnimap.el (nnimap-find-article-by-message-id): return nil when no
+        article found.
+
+2011-06-18  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * auth-source.el (auth-source-netrc-use-gpg-tokens): Replace
+        `auth-source-save-secrets' with a more sensitive alist that can be
+        configured per file.  Experimental, so defaults to 'never.
+        (auth-source-netrc-create): Use it.  Still experimental code.
+        (with-auth-source-epa-overrides): Use `find-file-hooks' if
+        `find-file-hook' is unbound (XEmacs fix).  Fix backquoting bug.
+
+2011-06-16  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * auth-source.el (auth-source-save-secrets): New variable to control if
+        secret tokens should be saved encrypted.
+        (auth-source-netrc-parse, auth-source-netrc-search): Pass the file name
+        to `auth-source-netrc-normalize'.
+        (with-auth-source-epa-overrides): Add convenience macro.  Don't depend
+        on the EPA variables being defined.
+        (auth-source-epa-make-gpg-token): Convert text to a "gpg:" token.
+        (auth-source-netrc-normalize): Convert "gpg:" tokens back to text in
+        the lexical-let closure.
+        (auth-source-netrc-create): Create "gpg:" tokens according to
+        `auth-source-save-secrets'.
+
 2011-06-10  Katsumi Yamaoka  <yamaoka@jpl.org>
 
         * gnus-group.el (gnus-group-update-group): Add new argument
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index e0bea324a25..6fe033fea79 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -154,6 +154,31 @@ let-binding."
           (const :tag "Never save" nil)
           (const :tag "Ask" ask)))
 
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+
+(defcustom auth-source-netrc-use-gpg-tokens 'never
+  "Set this to tell auth-source when to create GPG password
+tokens in netrc files.  It's either an alist or `never'."
+  :group 'auth-source
+  :version "23.2" ;; No Gnus
+  :type `(choice
+          (const :tag "Always use GPG password tokens" (t gpg))
+          (const :tag "Never use GPG password tokens" never)
+          (repeat :tag "Use a lookup list"
+                  (list
+                   (choice :tag "Matcher"
+                           (const :tag "Match anything" t)
+                           (const :tag "The EPA encrypted file extensions"
+                                  ,(if (boundp 'epa-file-auto-mode-alist-entry)
+                                       (car (symbol-value
+                                             'epa-file-auto-mode-alist-entry))
+                                     "\\.gpg\\'"))
+                           (regexp :tag "Regular expression"))
+                   (choice :tag "What to do"
+                           (const :tag "Save GPG-encrypted password tokens" gpg)
+                           (const :tag "Don't encrypt tokens" never))))))
+
 (defvar auth-source-magic "auth-source-magic ")
 
 (defcustom auth-source-do-cache t
@@ -183,7 +208,7 @@ If the value is a function, debug messages are logged by calling
           (function :tag "Function that takes arguments like `message'")
           (const :tag "Don't log anything" nil)))
 
-(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo" "~/.netrc")
+(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
   "List of authentication sources.
 
 The default will get login and password information from
@@ -237,9 +262,11 @@ can get pretty complex."
                                           ,@auth-source-protocols-customize))
                                         (list :tag "User" :inline t
                                               (const :format "" :value :user)
-                                              (choice :tag "Personality/Username"
+                                              (choice
+                                               :tag "Personality/Username"
                                                       (const :tag "Any" t)
-                                                      (string :tag "Name")))))))))
+                                                      (string
+                                                       :tag "Name")))))))))
 
 (defcustom auth-source-gpg-encrypt-to t
   "List of recipient keys that `authinfo.gpg' encrypted to.
@@ -686,7 +713,8 @@ Returns the deleted entries."
         when (string-match (concat "^" auth-source-magic)
                            (symbol-name sym))
         ;; remove that key
-        do (password-cache-remove (symbol-name sym))))
+        do (password-cache-remove (symbol-name sym)))
+  (setq auth-source-netrc-cache nil))
 
 (defun auth-source-remember (spec found)
   "Remember FOUND search results for SPEC."
@@ -898,7 +926,7 @@ Note that the MAX parameter is used so we can exit the parse early."
                         (null require)
                         ;; every element of require is in the normalized list
                         (let ((normalized (nth 0 (auth-source-netrc-normalize
-                                                 (list alist)))))
+                                                 (list alist) file))))
                           (loop for req in require
                                 always (plist-get normalized req)))))
               (decf max)
@@ -934,7 +962,56 @@ Note that the MAX parameter is used so we can exit the parse early."
 
           (nreverse result))))))
 
-(defun auth-source-netrc-normalize (alist)
+(defmacro with-auth-source-epa-overrides (&rest body)
+  `(let ((file-name-handler-alist
+          ',(if (boundp 'epa-file-handler)
+                (remove (symbol-value 'epa-file-handler)
+                        file-name-handler-alist)
+              file-name-handler-alist))
+         (,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)
+          ',(remove
+             'epa-file-find-file-hook
+             (if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)))
+         (auto-mode-alist
+          ',(if (boundp 'epa-file-auto-mode-alist-entry)
+                (remove (symbol-value 'epa-file-auto-mode-alist-entry)
+                        auto-mode-alist)
+              auto-mode-alist)))
+     ,@body))
+
+(defun auth-source-epa-make-gpg-token (secret file)
+  (require 'epa nil t)
+  (unless (featurep 'epa)
+    (error "EPA could not be loaded."))
+  (let* ((base (file-name-sans-extension file))
+         (passkey (format "gpg:-%s" base))
+         (stash (concat base ".gpg"))
+         ;; temporarily disable EPA
+         (stashfile
+          (with-auth-source-epa-overrides
+           (make-temp-file "gpg-token" nil
+                           stash)))
+         (epa-file-passphrase-alist
+          `((,stashfile
+             . ,(password-read
+                 (format
+                  "token pass for %s? "
+                  file)
+                 passkey)))))
+    (write-region secret nil stashfile)
+    ;; temporarily disable EPA
+    (unwind-protect
+        (with-auth-source-epa-overrides
+         (with-temp-buffer
+           (insert-file-contents stashfile)
+           (base64-encode-region (point-min) (point-max) t)
+           (concat "gpg:"
+                   (buffer-substring-no-properties
+                    (point-min)
+                    (point-max)))))
+      (delete-file stashfile))))
+
+(defun auth-source-netrc-normalize (alist filename)
   (mapcar (lambda (entry)
             (let (ret item)
               (while (setq item (pop entry))
@@ -950,15 +1027,65 @@ Note that the MAX parameter is used so we can exit the parse early."
 
                   ;; send back the secret in a function (lexical binding)
                   (when (equal k "secret")
-                    (setq v (lexical-let ((v v))
-                              (lambda () v))))
-
-                  (setq ret (plist-put ret
-                                       (intern (concat ":" k))
-                                       v))
-                  ))
-              ret))
-          alist))
+                    (setq v (lexical-let ((v v)
+                                          (filename filename)
+                                          (base (file-name-nondirectory
+                                                 filename))
+                                          (token-decoder nil)
+                                          (gpgdata nil)
+                                          (stash nil))
+                              (setq stash (concat base ".gpg"))
+                              (when (string-match "gpg:\\(.+\\)" v)
+                                (require 'epa nil t)
+                                (unless (featurep 'epa)
+                                  (error "EPA could not be loaded."))
+                                (setq gpgdata (base64-decode-string
+                                               (match-string 1 v)))
+                                ;; it's a GPG token
+                                (setq
+                                 token-decoder
+                                 (lambda (gpgdata)
+;;; FIXME: this relies on .gpg files being handled by EPA/EPG
+                                   (let* ((passkey (format "gpg:-%s" base))
+                                          ;; temporarily disable EPA
+                                          (stashfile
+                                           (with-auth-source-epa-overrides
+                                            (make-temp-file "gpg-token" nil
+                                                            stash)))
+                                          (epa-file-passphrase-alist
+                                           `((,stashfile
+                                              . ,(password-read
+                                                  (format
+                                                   "token pass for %s? "
+                                                   filename)
+                                                  passkey)))))
+                                     (unwind-protect
+                                         (progn
+                                           ;; temporarily disable EPA
+                                           (with-auth-source-epa-overrides
+                                            (write-region gpgdata
+                                                          nil
+                                                          stashfile))
+                                           (setq
+                                            v
+                                            (with-temp-buffer
+                                              (insert-file-contents stashfile)
+                                              (buffer-substring-no-properties
+                                               (point-min)
+                                               (point-max)))))
+                                       (delete-file stashfile)))
+                                   ;; clear out the decoder at end
+                                   (setq token-decoder nil
+                                         gpgdata nil))))
+                          (lambda ()
+                            (when token-decoder
+                              (funcall token-decoder gpgdata))
+                            v))))
+                (setq ret (plist-put ret
+                                     (intern (concat ":" k))
+                                     v))))
+            ret))
+  alist))
 
 ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
 ;;; (funcall secret)
@@ -982,7 +1109,8 @@ See `auth-source-search' for details on SPEC."
                    :file (oref backend source)
                    :host (or host t)
                    :user (or user t)
-                   :port (or port t)))))
+                   :port (or port t))
+                  (oref backend source))))
 
     ;; if we need to create an entry AND none were found to match
     (when (and create
@@ -1017,6 +1145,9 @@ See `auth-source-search' for details on SPEC."
          ;; we know (because of an assertion in auth-source-search) that the
          ;; :create parameter is either t or a list (which includes nil)
          (create-extra (if (eq t create) nil create))
+         (current-data (car (auth-source-search :max 1
+                                                :host host
+                                                :port port)))
          (required (append base-required create-extra))
          (file (oref backend source))
          (add "")
@@ -1051,7 +1182,9 @@ See `auth-source-search' for details on SPEC."
     (dolist (r required)
       (let* ((data (aget valist r))
              ;; take the first element if the data is a list
-             (data (auth-source-netrc-element-or-first data))
+             (data (or (auth-source-netrc-element-or-first data)
+                       (plist-get current-data
+                                  (intern (format ":%s" r) obarray))))
              ;; this is the default to be offered
              (given-default (aget auth-source-creation-defaults r))
              ;; the default supplementals are simple:
@@ -1098,7 +1231,36 @@ See `auth-source-search' for details on SPEC."
               (cond
                ((and (null data) (eq r 'secret))
                 ;; Special case prompt for passwords.
-                (read-passwd prompt))
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
+;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
+                (let* ((ep (format "Use GPG password tokens in %s?" file))
+                       (gpg-encrypt
+                        (cond
+                         ((eq auth-source-netrc-use-gpg-tokens 'never)
+                          'never)
+                         ((listp auth-source-netrc-use-gpg-tokens)
+                          (let ((check (copy-sequence
+                                        auth-source-netrc-use-gpg-tokens))
+                                item ret)
+                            (while check
+                              (setq item (pop check))
+                              (when (or (eq (car item) t)
+                                        (string-match (car item) file))
+                                (setq ret (cdr item))
+                                (setq check nil)))))
+                         (t 'never)))
+                        (plain (read-passwd prompt)))
+                  ;; ask if we don't know what to do (in which case
+                  ;; auth-source-netrc-use-gpg-tokens must be a list)
+                  (unless gpg-encrypt
+                    (setq gpg-encrypt (if (y-or-n-p ep) 'gpg 'never))
+                    ;; TODO: save the defcustom now? or ask?
+                    (setq auth-source-netrc-use-gpg-tokens
+                          (cons `(,file ,gpg-encrypt)
+                                auth-source-netrc-use-gpg-tokens)))
+                  (if (eq gpg-encrypt 'gpg)
+                      (auth-source-epa-make-gpg-token plain file)
+                    plain)))
                ((null data)
                 (when default
                   (setq prompt
@@ -1125,7 +1287,7 @@ See `auth-source-search' for details on SPEC."
           (let ((printer (lambda ()
                            ;; append the key (the symbol name of r)
                            ;; and the value in r
-                           (format "%s%s %S"
+                           (format "%s%s %s"
                                    ;; prepend a space
                                    (if (zerop (length add)) "" " ")
                                    ;; remap auth-source tokens to netrc
@@ -1135,8 +1297,9 @@ See `auth-source-search' for details on SPEC."
                                      (secret "password")
                                      (port   "port") ; redundant but clearer
                                      (t (symbol-name r)))
-                                   ;; the value will be printed in %S format
-                                   data))))
+                                   (if (string-match "[\" ]" data)
+                                       (format "%S" data)
+                                     data)))))
             (setq add (concat add (funcall printer)))))))
 
     (plist-put
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index dc8b38b8f9a..1bbd76f345e 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -929,7 +929,7 @@ textual parts.")
                  (car (setq result (nnimap-parse-response))))
         ;; Select the last instance of the message in the group.
         (and (setq article
-                   (car (last (assoc "SEARCH" (cdr result)))))
+                   (car (last (cdr (assoc "SEARCH" (cdr result))))))
              (string-to-number article))))))
 
 (defun nnimap-delete-article (articles)
diff --git a/lisp/info.el b/lisp/info.el
index 796fd7e2256..bca41c29d0f 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3230,7 +3230,7 @@ STRING is the search string given as an argument to `info-apropos',
 MATCHES is a list of index matches found by `Info-apropos-matches'.")
 
 (defun Info-apropos-toc-nodes (filename)
-  "Apropos-specific implementation of `Info-apropos-toc-nodes'."
+  "Apropos-specific implementation of `Info-toc-nodes'."
   (let ((nodes (mapcar 'car (reverse Info-apropos-nodes))))
     `(,filename
       ("Top" nil nil ,nodes)
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 5f4d3ea849e..b3f17bb3fcf 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1308,11 +1308,11 @@ This is the input method activated automatically by the command
 `toggle-input-method' (\\[toggle-input-method])."
   :link  '(custom-manual "(emacs)Input Methods")
   :group 'mule
-  :type '(choice (const nil) (string
-                              :completion-ignore-case t
-                              :complete-function widget-string-complete
-                              :completion-alist input-method-alist
-                              :prompt-history input-method-history))
+  :type '(choice (const nil)
+          (string
+           :completions (apply-partially
+                         #'completion-table-case-fold input-method-alist)
+           :prompt-history input-method-history))
   :set-after '(current-language-environment))
 
 (put 'input-method-function 'permanent-local t)
@@ -1875,10 +1875,10 @@ specifies the character set for the major languages of Western Europe."
 (define-widget 'charset 'symbol
   "An Emacs charset."
   :tag "Charset"
-  :complete-function (lambda ()
-                       (interactive)
-                       (lisp-complete-symbol 'charsetp))
-  :completion-ignore-case t
+  :completions (apply-partially #'completion-table-with-predicate
+                                (apply-partially #'completion-table-case-fold
+                                                 obarray)
+                                #'charsetp 'strict)
   :value 'ascii
   :validate (lambda (widget)
               (unless (charsetp (widget-value widget))
@@ -1912,9 +1912,9 @@ See `set-language-info-alist' for use in programs."
            (set-language-environment current-language-environment)))
   :type `(alist
           :key-type (string :tag "Language environment"
-                            :completion-ignore-case t
-                            :complete-function widget-string-complete
-                            :completion-alist language-info-alist)
+                            :completions
+                            (apply-partially #'completion-table-case-fold
+                                             language-info-alist))
           :value-type
           (alist :key-type symbol
                  :options ((documentation string)
@@ -1927,9 +1927,9 @@ See `set-language-info-alist' for use in programs."
                            (nonascii-translation charset)
                            (input-method
                             (string
-                             :completion-ignore-case t
-                             :complete-function widget-string-complete
-                             :completion-alist input-method-alist
+                             :completions
+                             (apply-partially #'completion-table-case-fold
+                                              input-method-alist)
                              :prompt-history input-method-history))
                            (features (repeat symbol))
                            (unibyte-display coding-system)))))
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index b4827cf10ba..901eb002dc1 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -565,7 +565,6 @@ of a mail alias.  The value is set up, buffer-local, when first needed.")
 
 (defun mail-abbrev-complete-alias ()
   "Perform completion on alias preceding point."
-  ;; Based on lisp.el:lisp-complete-symbol
   (interactive)
   (mail-abbrev-make-syntax-table)
   (let ((end (point))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index bc1ca77d24a..3c9ea9de573 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -34,16 +34,10 @@
 ;;
 ;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail'
 ;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use message/Gnus
-;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
+;;(setq smtpmail-smtp-server "YOUR SMTP HOST")
 ;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
 ;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME")
 ;;(setq smtpmail-debug-info t) ; only to debug problems
-;;(setq smtpmail-auth-credentials  ; or use ~/.authinfo
-;;      '(("YOUR SMTP HOST" 25 "username" "password")))
-;;(setq smtpmail-starttls-credentials
-;;      '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
-;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
-;; integer or a string, just as long as they match (eq).
 
 ;; To queue mail, set `smtpmail-queue-mail' to t and use
 ;; `smtpmail-send-queued-mail' to send.
@@ -58,17 +52,9 @@
 ;; Authentication by the AUTH mechanism.
 ;; See http://www.ietf.org/rfc/rfc2554.txt
 
-;; Modified by Simon Josefsson <simon@josefsson.org>, 2000-10-07, to support
-;; STARTTLS.  Requires external program
-;; ftp://ftp.opaopa.org/pub/elisp/starttls-*.tar.gz.
-;; See http://www.ietf.org/rfc/rfc2246.txt, http://www.ietf.org/rfc/rfc2487.txt
-
 ;;; Code:
 
 (require 'sendmail)
-(autoload 'starttls-any-program-available "starttls")
-(autoload 'starttls-open-stream "starttls")
-(autoload 'starttls-negotiate "starttls")
 (autoload 'mail-strip-quoted-names "mail-utils")
 (autoload 'message-make-date "message")
 (autoload 'message-make-message-id "message")
@@ -85,11 +71,9 @@
   :group 'mail)
 
 
-(defcustom smtpmail-default-smtp-server nil
+(defvar smtpmail-default-smtp-server nil
   "Specify default SMTP server.
-This only has effect if you specify it before loading the smtpmail library."
-  :type '(choice (const nil) string)
-  :group 'smtpmail)
+This only has effect if you specify it before loading the smtpmail library.")
 
 (defcustom smtpmail-smtp-server
   (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
@@ -110,6 +94,16 @@ don't define this value."
   :type '(choice (const nil) string)
   :group 'smtpmail)
 
+(defcustom smtpmail-stream-type nil
+  "Connection type SMTP connections.
+This may be either nil (plain connection) or `starttls' (use the
+starttls mechanism to turn on TLS security after opening the
+stream)."
+  :version "24.1"
+  :group 'smtpmail
+  :type '(choice (const :tag "Plain" nil)
+                 (const starttls)))
+
 (defcustom smtpmail-sendto-domain nil
   "Local domain name without a host name.
 This is appended (with an @-sign) to any specified recipients which do
@@ -117,11 +111,7 @@ not include an @-sign, so that each RCPT TO address is fully qualified.
 \(Some configurations of sendmail require this.)
 
 Don't bother to set this unless you have get an error like:
-        Sending failed; SMTP protocol error
-when sending mail, and the *trace of SMTP session to <somewhere>*
-buffer includes an exchange like:
-        RCPT TO: <someone>
-        501 <someone>: recipient address must contain a domain."
+        Sending failed; 501 <someone>: recipient address must contain a domain."
   :type '(choice (const nil) string)
   :group 'smtpmail)
 
@@ -157,39 +147,6 @@ and sent with `smtpmail-send-queued-mail'."
   :type 'directory
   :group 'smtpmail)
 
-(defcustom smtpmail-auth-credentials "~/.authinfo"
-  "Specify username and password for servers, directly or via .netrc file.
-This variable can either be a filename pointing to a file in netrc(5)
-format, or list of four-element lists that contain, in order,
-`servername' (a string), `port' (an integer), `user' (a string) and
-`password' (a string, or nil to query the user when needed).  If you
-need to enter a `realm' too, add it to the user string, so that it
-looks like `user@realm'."
-  :type '(choice file
-                 (repeat (list (string  :tag "Server")
-                               (integer :tag "Port")
-                               (string  :tag "Username")
-                               (choice (const :tag "Query when needed" nil)
-                                       (string  :tag "Password")))))
-  :version "22.1"
-  :group 'smtpmail)
-
-(defcustom smtpmail-starttls-credentials '(("" 25 "" ""))
-  "Specify STARTTLS keys and certificates for servers.
-This is a list of four-element list with `servername' (a string),
-`port' (an integer), `key' (a filename) and `certificate' (a
-filename).
-If you do not have a certificate/key pair, leave the `key' and
-`certificate' fields as `nil'.  A key/certificate pair is only
-needed if you want to use X.509 client authenticated
-connections."
-  :type '(repeat (list (string  :tag "Server")
-                       (integer :tag "Port")
-                       (file    :tag "Key")
-                       (file    :tag "Certificate")))
-  :version "21.1"
-  :group 'smtpmail)
-
 (defcustom smtpmail-warn-about-unknown-extensions nil
   "If set, print warnings about unknown SMTP extensions.
 This is mainly useful for development purposes, to learn about
@@ -230,6 +187,7 @@ The list is in preference order.")
         (tembuf (generate-new-buffer " smtpmail temp"))
         (case-fold-search nil)
         delimline
+        result
         (mailbuf (current-buffer))
         ;; Examine this variable now, so that
         ;; local binding in the mail buffer will take effect.
@@ -373,9 +331,10 @@ The list is in preference order.")
           ;; Send or queue
           (if (not smtpmail-queue-mail)
               (if (not (null smtpmail-recipient-address-list))
-                  (if (not (smtpmail-via-smtp
-                            smtpmail-recipient-address-list tembuf))
-                      (error "Sending failed; SMTP protocol error"))
+                  (when (setq result
+                              (smtpmail-via-smtp
+                               smtpmail-recipient-address-list tembuf))
+                    (error "Sending failed: %s" result))
                 (error "Sending failed; no recipients"))
             (let* ((file-data
                     (expand-file-name
@@ -432,7 +391,8 @@ The list is in preference order.")
     ;; mail, send it, etc...
     (let ((file-msg "")
           (qfile (expand-file-name smtpmail-queue-index-file
-                                   smtpmail-queue-dir)))
+                                   smtpmail-queue-dir))
+          result)
       (insert-file-contents qfile)
       (goto-char (point-min))
       (while (not (eobp))
@@ -448,17 +408,16 @@ The list is in preference order.")
                  (or (and mail-specify-envelope-from (mail-envelope-from))
                      user-mail-address)))
             (if (not (null smtpmail-recipient-address-list))
-                (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
-                                            (current-buffer)))
-                    (error "Sending failed; SMTP protocol error"))
+                (when (setq result (smtpmail-via-smtp
+                                    smtpmail-recipient-address-list
+                                    (current-buffer)))
+                  (error "Sending failed: %s" result))
               (error "Sending failed; no recipients"))))
         (delete-file file-msg)
         (delete-file (concat file-msg ".el"))
         (delete-region (point-at-bol) (point-at-bol 2)))
       (write-region (point-min) (point-max) qfile))))
 
-;; (defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
-
 (defun smtpmail-fqdn ()
   (if smtpmail-local-domain
       (concat (system-name) "." smtpmail-local-domain)
@@ -503,146 +462,149 @@ The list is in preference order.")
         (push el2 result)))
     (nreverse result)))
 
-(defvar starttls-extra-args)
-(defvar starttls-extra-arguments)
-
-(defun smtpmail-open-stream (process-buffer host port)
-  (let ((cred (smtpmail-find-credentials
-               smtpmail-starttls-credentials host port)))
-    (if (null (and cred (starttls-any-program-available)))
-        ;; The normal case.
-        (open-network-stream "SMTP" process-buffer host port)
-      (let* ((cred-key (smtpmail-cred-key cred))
-             (cred-cert (smtpmail-cred-cert cred))
-             (starttls-extra-args
-              (append
-               starttls-extra-args
-               (when (and (stringp cred-key) (stringp cred-cert)
-                          (file-regular-p
-                           (setq cred-key (expand-file-name cred-key)))
-                          (file-regular-p
-                           (setq cred-cert (expand-file-name cred-cert))))
-                 (list "--key-file" cred-key "--cert-file" cred-cert))))
-             (starttls-extra-arguments
-              (append
-               starttls-extra-arguments
-               (when (and (stringp cred-key) (stringp cred-cert)
-                          (file-regular-p
-                           (setq cred-key (expand-file-name cred-key)))
-                          (file-regular-p
-                           (setq cred-cert (expand-file-name cred-cert))))
-                 (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
-        (starttls-open-stream "SMTP" process-buffer host port)))))
-
 ;; `password-read' autoloads password-cache.
 (declare-function password-cache-add "password-cache" (key password))
 
-(defun smtpmail-try-auth-methods (process supported-extensions host port)
+(defun smtpmail-command-or-throw (process string &optional code)
+  (let (ret)
+    (smtpmail-send-command process string)
+    (unless (smtpmail-ok-p (setq ret (smtpmail-read-response process))
+                           code)
+      (throw 'done (format "%s in response to %s"
+                           (smtpmail-response-text ret)
+                           string)))
+    ret))
+
+(defun smtpmail-try-auth-methods (process supported-extensions host port
+                                          &optional ask-for-password)
+  (setq port
+        (if port
+            (format "%s" port)
+          "smtp"))
   (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
          (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
-         (auth-info (auth-source-search :max 1
-                                        :host host
-                                        :port (or port "smtp")))
-         (auth-user (plist-get (nth 0 auth-info) :user))
-         (auth-pass (plist-get (nth 0 auth-info) :secret))
-         (auth-pass (if (functionp auth-pass)
-                        (funcall auth-pass)
-                      auth-pass))
-         (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
-                   (list host port auth-user auth-pass)
-                 ;; else, if auth-source didn't return them...
-                 (if (stringp smtpmail-auth-credentials)
-                     (let* ((netrc (netrc-parse smtpmail-auth-credentials))
-                            (port-name (format "%s" (or port "smtp")))
-                            (hostentry (netrc-machine netrc host port-name
-                                                      port-name)))
-                       (when hostentry
-                         (list host port
-                               (netrc-get hostentry "login")
-                               (netrc-get hostentry "password"))))
-                   ;; else, try `smtpmail-find-credentials' since
-                   ;; `smtpmail-auth-credentials' is not a string
-                   (smtpmail-find-credentials
-                    smtpmail-auth-credentials host port))))
-         (prompt (when cred (format "SMTP password for %s:%s: "
-                                    (smtpmail-cred-server cred)
-                                    (smtpmail-cred-port cred))))
-         (passwd (when cred
-                   (or (smtpmail-cred-passwd cred)
-                       (password-read prompt prompt))))
+         (auth-source-creation-prompts
+          '((user  . "SMTP user at %h: ")
+            (secret . "SMTP password for %u@%h: ")))
+         (auth-info (car
+                     (auth-source-search
+                      :max 1
+                      :host host
+                      :port port
+                      :require (and ask-for-password
+                                    '(:user :secret))
+                      :create ask-for-password)))
+         (user (plist-get auth-info :user))
+         (password (plist-get auth-info :secret))
+         (save-function (and ask-for-password
+                             (plist-get auth-info :save-function)))
          ret)
-    (when (and cred mech)
-      (cond
-       ((eq mech 'cram-md5)
-        (smtpmail-send-command process (upcase (format "AUTH %s" mech)))
-        (if (or (null (car (setq ret (smtpmail-read-response process))))
-                (not (integerp (car ret)))
-                (>= (car ret) 400))
-            (throw 'done nil))
-        (when (eq (car ret) 334)
-          (let* ((challenge (substring (cadr ret) 4))
-                 (decoded (base64-decode-string challenge))
-                 (hash (rfc2104-hash 'md5 64 16 passwd decoded))
-                 (response (concat (smtpmail-cred-user cred) " " hash))
-                 ;; Osamu Yamane <yamane@green.ocn.ne.jp>:
-                 ;; SMTP auth fails because the SMTP server identifies
-                 ;; only the first part of the string (delimited by
-                 ;; new line characters) as a response from the
-                 ;; client, and the rest as distinct commands.
-
-                 ;; In my case, the response string is 80 characters
-                 ;; long.  Without the no-line-break option for
-                 ;; `base64-encode-string', only the first 76 characters
-                 ;; are taken as a response to the server, and the
-                 ;; authentication fails.
-                 (encoded (base64-encode-string response t)))
-            (smtpmail-send-command process (format "%s" encoded))
-            (if (or (null (car (setq ret (smtpmail-read-response process))))
-                    (not (integerp (car ret)))
-                    (>= (car ret) 400))
-                (throw 'done nil)))))
-       ((eq mech 'login)
-        (smtpmail-send-command process "AUTH LOGIN")
-        (if (or (null (car (setq ret (smtpmail-read-response process))))
-                (not (integerp (car ret)))
-                (>= (car ret) 400))
-            (throw 'done nil))
-        (smtpmail-send-command
-         process (base64-encode-string (smtpmail-cred-user cred) t))
-        (if (or (null (car (setq ret (smtpmail-read-response process))))
-                (not (integerp (car ret)))
-                (>= (car ret) 400))
-            (throw 'done nil))
-        (smtpmail-send-command process (base64-encode-string passwd t))
-        (if (or (null (car (setq ret (smtpmail-read-response process))))
-                (not (integerp (car ret)))
-                (>= (car ret) 400))
-            (throw 'done nil)))
-       ((eq mech 'plain)
-        ;; We used to send an empty initial request, and wait for an
-        ;; empty response, and then send the password, but this
-        ;; violate a SHOULD in RFC 2222 paragraph 5.1.  Note that this
-        ;; is not sent if the server did not advertise AUTH PLAIN in
-        ;; the EHLO response.  See RFC 2554 for more info.
-        (smtpmail-send-command process
-                               (concat "AUTH PLAIN "
-                                       (base64-encode-string
-                                        (concat "\0"
-                                                (smtpmail-cred-user cred)
-                                                "\0"
-                                                passwd) t)))
-        (if (or (null (car (setq ret (smtpmail-read-response process))))
-                (not (integerp (car ret)))
-                (not (equal (car ret) 235)))
-            (throw 'done nil)))
-
-       (t
-        (error "Mechanism %s not implemented" mech)))
-      ;; Remember the password.
-      (when (null (smtpmail-cred-passwd cred))
-        (password-cache-add prompt passwd)))))
-
-(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
+    (when (and user
+               (not password))
+      ;; The user has stored the user name, but not the password, so
+      ;; ask for the password, even if we're not forcing that through
+      ;; `ask-for-password'.
+      (setq auth-info
+            (car
+             (auth-source-search
+              :max 1
+              :host host
+              :port port
+              :require '(:user :secret)
+              :create t))
+            password (plist-get auth-info :secret)))
+    (when (functionp password)
+      (setq password (funcall password)))
+    (cond
+     ((or (not mech)
+          (not user)
+          (not password))
+      ;; No mechanism, or no credentials.
+      mech)
+     ((eq mech 'cram-md5)
+      (setq ret (smtpmail-command-or-throw process "AUTH CRAM-MD5"))
+      (when (eq (car ret) 334)
+        (let* ((challenge (substring (cadr ret) 4))
+               (decoded (base64-decode-string challenge))
+               (hash (rfc2104-hash 'md5 64 16 password decoded))
+               (response (concat user " " hash))
+               ;; Osamu Yamane <yamane@green.ocn.ne.jp>:
+               ;; SMTP auth fails because the SMTP server identifies
+               ;; only the first part of the string (delimited by
+               ;; new line characters) as a response from the
+               ;; client, and the rest as distinct commands.
+
+               ;; In my case, the response string is 80 characters
+               ;; long.  Without the no-line-break option for
+               ;; `base64-encode-string', only the first 76 characters
+               ;; are taken as a response to the server, and the
+               ;; authentication fails.
+               (encoded (base64-encode-string response t)))
+          (smtpmail-command-or-throw process encoded)
+          (when save-function
+            (funcall save-function)))))
+     ((eq mech 'login)
+      (smtpmail-command-or-throw process "AUTH LOGIN")
+      (smtpmail-command-or-throw
+       process (base64-encode-string user t))
+      (smtpmail-command-or-throw process (base64-encode-string password t))
+      (when save-function
+        (funcall save-function)))
+     ((eq mech 'plain)
+      ;; We used to send an empty initial request, and wait for an
+      ;; empty response, and then send the password, but this
+      ;; violate a SHOULD in RFC 2222 paragraph 5.1.  Note that this
+      ;; is not sent if the server did not advertise AUTH PLAIN in
+      ;; the EHLO response.  See RFC 2554 for more info.
+      (smtpmail-command-or-throw
+       process
+       (concat "AUTH PLAIN "
+               (base64-encode-string (concat "\0" user "\0" password) t))
+       235)
+      (when save-function
+        (funcall save-function)))
+     (t
+      (error "Mechanism %s not implemented" mech)))))
+
+(defun smtpmail-response-code (string)
+  (when string
+    (with-temp-buffer
+      (insert string)
+      (goto-char (point-min))
+      (and (re-search-forward "^\\([0-9]+\\) " nil t)
+           (string-to-number (match-string 1))))))
+
+(defun smtpmail-ok-p (response &optional code)
+  (and (car response)
+       (integerp (car response))
+       (< (car response) 400)
+       (or (null code)
+           (= code (car response)))))
+
+(defun smtpmail-response-text (response)
+  (mapconcat 'identity (cdr response) "\n"))
+
+(defun smtpmail-query-smtp-server ()
+  (let ((server (read-string "Outgoing SMTP mail server: "))
+        (ports '(587 "smtp"))
+        stream port)
+    (when (and smtpmail-smtp-server
+               (not (member smtpmail-smtp-server ports)))
+      (push smtpmail-smtp-server ports))
+    (while (and (not smtpmail-smtp-server)
+                (setq port (pop ports)))
+      (when (setq stream (ignore-errors
+                           (open-network-stream "smtp" nil server port)))
+        (customize-save-variable 'smtpmail-smtp-server server)
+        (customize-save-variable 'smtpmail-smtp-service port)
+        (delete-process stream)))
+    (unless smtpmail-smtp-server
+      (error "Couldn't contact an SMTP server"))))
+
+(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
+                                    &optional ask-for-password)
+  (unless smtpmail-smtp-server
+    (smtpmail-query-smtp-server))
   (let ((process nil)
         (host (or smtpmail-smtp-server
                   (error "`smtpmail-smtp-server' not defined")))
@@ -654,14 +616,16 @@ The list is in preference order.")
                                 (mail-envelope-from))
                            user-mail-address))
         response-code
-        greeting
         process-buffer
+        result
+        auth-mechanisms
         (supported-extensions '()))
     (unwind-protect
         (catch 'done
           ;; get or create the trace buffer
           (setq process-buffer
-                (get-buffer-create (format "*trace of SMTP session to %s*" host)))
+                (get-buffer-create
+                 (format "*trace of SMTP session to %s*" host)))
 
           ;; clear the trace buffer of old output
           (with-current-buffer process-buffer
@@ -669,105 +633,89 @@ The list is in preference order.")
             (erase-buffer))
 
           ;; open the connection to the server
-          (setq process (smtpmail-open-stream process-buffer host port))
-          (and (null process) (throw 'done nil))
+          (setq result
+                (open-network-stream
+                 "smtpmail" process-buffer host port
+                 :type smtpmail-stream-type
+                 :return-list t
+                 :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
+                 :end-of-command "^[0-9]+ .*\r\n"
+                 :success "^2.*\n"
+                 :always-query-capabilities t
+                 :starttls-function
+                 (lambda (capabilities)
+                   (and (string-match "-STARTTLS" capabilities)
+                        "STARTTLS\r\n"))
+                 :client-certificate t
+                 :use-starttls-if-possible t))
+
+          ;; If we couldn't access the server at all, we give up.
+          (unless (setq process (car result))
+            (throw 'done "Unable to contact server"))
 
           ;; set the send-filter
           (set-process-filter process 'smtpmail-process-filter)
 
+          (let* ((greeting (plist-get (cdr result) :greeting))
+                 (code (smtpmail-response-code greeting)))
+            (unless code
+              (throw 'done (format "No greeting: %s" greeting)))
+            (when (>= code 400)
+              (throw 'done (format "Connection not allowed: %s" greeting))))
+          
           (with-current-buffer process-buffer
             (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix)
             (make-local-variable 'smtpmail-read-point)
             (setq smtpmail-read-point (point-min))
 
-
-            (if (or (null (car (setq greeting (smtpmail-read-response process))))
-                    (not (integerp (car greeting)))
-                    (>= (car greeting) 400))
-                (throw 'done nil))
-
-            (let ((do-ehlo t)
-                  (do-starttls t))
-              (while do-ehlo
-                ;; EHLO
-                (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn)))
-
-                (if (or (null (car (setq response-code
-                                         (smtpmail-read-response process))))
-                        (not (integerp (car response-code)))
-                        (>= (car response-code) 400))
-                    (progn
-                      ;; HELO
-                      (smtpmail-send-command
-                       process (format "HELO %s" (smtpmail-fqdn)))
-
-                      (if (or (null (car (setq response-code
-                                               (smtpmail-read-response process))))
-                              (not (integerp (car response-code)))
-                              (>= (car response-code) 400))
-                          (throw 'done nil)))
-                  (dolist (line (cdr (cdr response-code)))
-                    (let ((name
-                           (with-case-table ascii-case-table
-                             (mapcar (lambda (s) (intern (downcase s)))
-                                     (split-string (substring line 4) "[ ]")))))
-                      (and (eq (length name) 1)
-                           (setq name (car name)))
-                      (and name
-                           (cond ((memq (if (consp name) (car name) name)
-                                        '(verb xvrb 8bitmime onex xone
-                                               expn size dsn etrn
-                                               enhancedstatuscodes
-                                               help xusr
-                                               auth=login auth starttls))
-                                  (setq supported-extensions
-                                        (cons name supported-extensions)))
-                                 (smtpmail-warn-about-unknown-extensions
-                                  (message "Unknown extension %s" name)))))))
-
-                (if (and do-starttls
-                         (smtpmail-find-credentials smtpmail-starttls-credentials host port)
-                         (member 'starttls supported-extensions)
-                         (numberp (process-id process)))
-                    (progn
-                      (smtpmail-send-command process (format "STARTTLS"))
-                      (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                              (not (integerp (car response-code)))
-                              (>= (car response-code) 400))
-                          (throw 'done nil))
-                      (starttls-negotiate process)
-                      (setq do-starttls nil))
-                  (setq do-ehlo nil))))
-
-            (smtpmail-try-auth-methods process supported-extensions host port)
-
-            (if (or (member 'onex supported-extensions)
-                    (member 'xone supported-extensions))
-                (progn
-                  (smtpmail-send-command process (format "ONEX"))
-                  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                          (not (integerp (car response-code)))
-                          (>= (car response-code) 400))
-                      (throw 'done nil))))
-
-            (if (and smtpmail-debug-verb
-                     (or (member 'verb supported-extensions)
-                         (member 'xvrb supported-extensions)))
-                (progn
-                  (smtpmail-send-command process (format "VERB"))
-                  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                          (not (integerp (car response-code)))
-                          (>= (car response-code) 400))
-                      (throw 'done nil))))
-
-            (if (member 'xusr supported-extensions)
-                (progn
-                  (smtpmail-send-command process (format "XUSR"))
-                  (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                          (not (integerp (car response-code)))
-                          (>= (car response-code) 400))
-                      (throw 'done nil))))
-
+            (let* ((capabilities (plist-get (cdr result) :capabilities))
+                   (code (smtpmail-response-code capabilities)))
+              (if (or (null code)
+                      (>= code 400))
+                  ;; The server didn't accept EHLO, so we fall back on HELO.
+                  (smtpmail-command-or-throw
+                   process (format "HELO %s" (smtpmail-fqdn)))
+                ;; EHLO was successful, so we parse the extensions.
+                (dolist (line (delete
+                               ""
+                               (split-string
+                                (plist-get (cdr result) :capabilities)
+                                "\r\n")))
+                  (let ((name
+                         (with-case-table ascii-case-table
+                           (mapcar (lambda (s) (intern (downcase s)))
+                                   (split-string (substring line 4) "[ ]")))))
+                    (when (= (length name) 1)
+                      (setq name (car name)))
+                    (when name
+                      (cond ((memq (if (consp name) (car name) name)
+                                   '(verb xvrb 8bitmime onex xone
+                                          expn size dsn etrn
+                                          enhancedstatuscodes
+                                          help xusr
+                                          auth=login auth starttls))
+                             (setq supported-extensions
+                                   (cons name supported-extensions)))
+                            (smtpmail-warn-about-unknown-extensions
+                             (message "Unknown extension %s" name))))))))
+
+            (setq auth-mechanisms
+                  (smtpmail-try-auth-methods
+                   process supported-extensions host port
+                   ask-for-password))
+
+            (when (or (member 'onex supported-extensions)
+                      (member 'xone supported-extensions))
+              (smtpmail-command-or-throw process (format "ONEX")))
+
+            (when (and smtpmail-debug-verb
+                       (or (member 'verb supported-extensions)
+                           (member 'xvrb supported-extensions)))
+              (smtpmail-command-or-throw process (format "VERB")))
+
+            (when (member 'xusr supported-extensions)
+              (smtpmail-command-or-throw process (format "XUSR")))
+            
             ;; MAIL FROM:<sender>
             (let ((size-part
                    (if (or (member 'size supported-extensions)
@@ -797,65 +745,73 @@ The list is in preference order.")
                            " BODY=8BITMIME"
                          "")
                      "")))
-              ;; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
-              (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
-                                                     envelope-from
-                                                     size-part
-                                                     body-part))
-
-              (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                      (not (integerp (car response-code)))
-                      (>= (car response-code) 400))
-                  (throw 'done nil)))
+              (smtpmail-send-command
+               process (format "MAIL FROM:<%s>%s%s"
+                               envelope-from size-part body-part))
+              (cond
+               ((smtpmail-ok-p (setq result (smtpmail-read-response process)))
+                ;; Success.
+                )
+               ((and auth-mechanisms
+                     (not ask-for-password)
+                     (= (car result) 530))
+                ;; We got a "530 auth required", so we close and try
+                ;; again, this time asking the user for a password.
+                (smtpmail-send-command process "QUIT")
+                (smtpmail-read-response process)
+                (delete-process process)
+                (setq process nil)
+                (throw 'done
+                       (smtpmail-via-smtp recipient smtpmail-text-buffer t)))
+               (t
+                ;; Return the error code.
+                (throw 'done
+                       (smtpmail-response-text result)))))
 
             ;; RCPT TO:<recipient>
             (let ((n 0))
               (while (not (null (nth n recipient)))
-                (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
-                (setq n (1+ n))
-
-                (setq response-code (smtpmail-read-response process))
-                (if (or (null (car response-code))
-                        (not (integerp (car response-code)))
-                        (>= (car response-code) 400))
-                    (throw 'done nil))))
-
-            ;; DATA
-            (smtpmail-send-command process "DATA")
-
-            (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                    (not (integerp (car response-code)))
-                    (>= (car response-code) 400))
-                (throw 'done nil))
-
-            ;; Mail contents
+                (smtpmail-send-command
+                 process (format "RCPT TO:<%s>"
+                                 (smtpmail-maybe-append-domain
+                                  (nth n recipient))))
+                (cond
+                 ((smtpmail-ok-p (setq result (smtpmail-read-response process)))
+                  ;; Success.
+                  nil)
+                 ((and auth-mechanisms
+                       (not ask-for-password)
+                       (= (car result) 550))
+                  ;; We got a "550 relay not permitted", and the server
+                  ;; accepts credentials, so we try again, but ask for a
+                  ;; password first.
+                  (smtpmail-send-command process "QUIT")
+                  (smtpmail-read-response process)
+                  (delete-process process)
+                  (setq process nil)
+                  (throw 'done
+                         (smtpmail-via-smtp recipient smtpmail-text-buffer t)))
+                 (t
+                  ;; Return the error code.
+                  (throw 'done
+                         (smtpmail-response-text result))))
+                (setq n (1+ n))))
+
+            ;; Send the contents.
+            (smtpmail-command-or-throw process "DATA")
             (smtpmail-send-data process smtpmail-text-buffer)
-
             ;; DATA end "."
-            (smtpmail-send-command process ".")
-
-            (if (or (null (car (setq response-code (smtpmail-read-response process))))
-                    (not (integerp (car response-code)))
-                    (>= (car response-code) 400))
-                (throw 'done nil))
-
-            ;; QUIT
-            ;; (smtpmail-send-command process "QUIT")
-            ;; (and (null (car (smtpmail-read-response process)))
-            ;;      (throw 'done nil))
-            t))
-      (if process
-          (with-current-buffer (process-buffer process)
-            (smtpmail-send-command process "QUIT")
-            (smtpmail-read-response process)
-
-            ;; (if (or (null (car (setq response-code (smtpmail-read-response process))))
-            ;;         (not (integerp (car response-code)))
-            ;;         (>= (car response-code) 400))
-            ;;     (throw 'done nil))
-            (delete-process process)
-            (unless smtpmail-debug-info
-              (kill-buffer process-buffer)))))))
+            (smtpmail-command-or-throw process ".")
+            ;; Return success.
+            nil))
+      (when (and process
+                 (buffer-live-p process-buffer))
+        (with-current-buffer (process-buffer process)
+          (smtpmail-send-command process "QUIT")
+          (smtpmail-read-response process)
+          (delete-process process)
+          (unless smtpmail-debug-info
+            (kill-buffer process-buffer)))))))
 
 
 (defun smtpmail-process-filter (process output)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 343a9c6dd0c..437bd523841 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1977,6 +1977,10 @@ Buffers menu is regenerated."
 ;; Used to cache the menu entries for commands in the Buffers menu
 (defvar menu-bar-buffers-menu-command-entries nil)
 
+(defvar menu-bar-select-buffer-function 'switch-to-buffer
+  "Function to select the buffer chosen from the `Buffers' menu-bar menu.
+It must accept a buffer as its only required argument.")
+
 (defun menu-bar-update-buffers (&optional force)
   ;; If user discards the Buffers item, play along.
   (and (lookup-key (current-global-map) [menu-bar buffer])
@@ -2022,7 +2026,7 @@ Buffers menu is regenerated."
                                         (cons nil nil))
                                   `(lambda ()
                                      (interactive)
-                                     (switch-to-buffer ,(cdr pair))))))
+                                     (funcall menu-bar-select-buffer-function ,(cdr pair))))))
                    (list buffers-vec))))
 
          ;; Make a Frames menu if we have more than one frame.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 03e8225f0c5..a7ffc8d061a 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -135,7 +135,8 @@ The metadata of a completion table should be constant between two boundaries."
   (let ((metadata (if (functionp table)
                       (funcall table string pred 'metadata))))
     (if (eq (car-safe metadata) 'metadata)
-        (cdr metadata))))
+        metadata
+      '(metadata))))
 
 (defun completion--field-metadata (field-start)
   (completion-metadata (buffer-substring-no-properties field-start (point))
@@ -513,7 +514,7 @@ an association list that can specify properties such as:
         (delete-dups (append (cdr over) (copy-sequence completion-styles)))
        completion-styles)))
 
-(defun completion-try-completion (string table pred point metadata)
+(defun completion-try-completion (string table pred point &optional metadata)
   "Try to complete STRING using completion table TABLE.
 Only the elements of table that satisfy predicate PRED are considered.
 POINT is the position of point within STRING.
@@ -524,9 +525,12 @@ a new position for point."
   (completion--some (lambda (style)
                       (funcall (nth 1 (assq style completion-styles-alist))
                                string table pred point))
-                    (completion--styles metadata)))
+                    (completion--styles (or metadata
+                                            (completion-metadata
+                                             (substring string 0 point)
+                                             table pred)))))
 
-(defun completion-all-completions (string table pred point metadata)
+(defun completion-all-completions (string table pred point &optional metadata)
   "List the possible completions of STRING in completion table TABLE.
 Only the elements of table that satisfy predicate PRED are considered.
 POINT is the position of point within STRING.
@@ -537,7 +541,10 @@ in the last `cdr'."
   (completion--some (lambda (style)
                       (funcall (nth 2 (assq style completion-styles-alist))
                                string table pred point))
-                    (completion--styles metadata)))
+                    (completion--styles (or metadata
+                                            (completion-metadata
+                                             (substring string 0 point)
+                                             table pred)))))
 
 (defun minibuffer--bitset (modified completions exact)
   (logior (if modified    4 0)
diff --git a/lisp/misc.el b/lisp/misc.el
index e50b5b38c75..8087c7f5259 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -151,6 +151,7 @@ Internal use only."
           (vector (list "Library" (1+ max-id-len) t)
                   (list "Loaded from" (1+ max-name-len) t)
                   (list "Candidate names" 0 t))))
+  (tabulated-list-init-header)
   (setq tabulated-list-entries nil)
   (dolist (lib dynamic-library-alist)
     (let* ((id (car lib))
@@ -178,7 +179,6 @@ The return value is always nil."
     (tabulated-list-mode)
     (setq tabulated-list-sort-key (cons "Library" nil))
     (add-hook 'tabulated-list-revert-hook 'list-dynamic-libraries--refresh nil t)
-    (tabulated-list-init-header)
     (setq list-dynamic-libraries--loaded-only-p loaded-only-p)
     (list-dynamic-libraries--refresh)
     (tabulated-list-print))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index c1ec3f0ed13..d9e6827d2df 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -958,7 +958,7 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
 ;;;###autoload
 (defun browse-url-xdg-open (url &optional new-window)
   (interactive (browse-url-interactive-arg "URL: "))
-  (call-process "nohup" nil nil nil "xdg-open" url))
+  (call-process "xdg-open" nil 0 nil url))
 
 ;;;###autoload
 (defun browse-url-netscape (url &optional new-window)
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index b17b9ae805c..161d7252d6e 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -44,6 +44,7 @@
 
 (require 'tls)
 (require 'starttls)
+(require 'auth-source)
 
 (declare-function gnutls-negotiate "gnutls" t t) ; defun*
 
@@ -110,10 +111,21 @@ values:
   STARTTLS if the server supports STARTTLS, and nil otherwise.
 
 :always-query-capabilies says whether to query the server for
-capabilities, even if we're doing a `plain' network connection.
+  capabilities, even if we're doing a `plain' network connection.
+
+:client-certificate should either be a list where the first
+  element is the certificate key file name, and the second
+  element is the certificate file name itself, or `t', which
+  means that `auth-source' will be queried for the key and the
+  certificate.  This parameter will only be used when doing TLS
+  or STARTTLS connections.
+
+If :use-starttls-if-possible is non-nil, do opportunistic
+STARTTLS upgrades even if Emacs doesn't have built-in TLS
+functionality.
 
 :nowait is a boolean that says the connection should be made
-asynchronously, if possible."
+  asynchronously, if possible."
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
   (let ((type (plist-get parameters :type))
@@ -152,6 +164,22 @@ asynchronously, if possible."
                   :type         (nth 3 result))
           (car result))))))
 
+(defun network-stream-certificate (host service parameters)
+  (let ((spec (plist-get :client-certificate parameters)))
+    (cond
+     ((listp spec)
+      ;; Either nil or a list with a key/certificate pair.
+      spec)
+     ((eq spec t)
+      (let* ((auth-info
+              (car (auth-source-search :max 1
+                                       :host host
+                                       :port service)))
+             (key (plist-get auth-info :key))
+             (cert (plist-get auth-info :cert)))
+        (and key cert
+             (list key cert)))))))
+
 ;;;###autoload
 (defalias 'open-protocol-stream 'open-network-stream)
 
@@ -184,7 +212,8 @@ asynchronously, if possible."
     ;; If we have built-in STARTTLS support, try to upgrade the
     ;; connection.
     (when (and (or (fboundp 'open-gnutls-stream)
-                   (and require-tls
+                   (and (or require-tls
+                            (plist-get parameters :use-starttls-if-possible))
                         (executable-find "gnutls-cli")))
                capabilities success-string starttls-function
                (setq starttls-command
@@ -201,14 +230,28 @@ asynchronously, if possible."
                     starttls-extra-arguments
                   ;; For opportunistic TLS upgrades, we don't really
                   ;; care about the identity of the peer.
-                  (cons "--insecure" starttls-extra-arguments))))
+                  (cons "--insecure" starttls-extra-arguments)))
+               (cert (network-stream-certificate host service parameters)))
+          ;; There are client certificates requested, so add them to
+          ;; the command line.
+          (when cert
+            (setq starttls-extra-arguments
+                  (nconc (list "--x509keyfile" (expand-file-name (nth 0 cert))
+                               "--x509certfile" (expand-file-name (nth 1 cert)))
+                         starttls-extra-arguments)))
           (setq stream (starttls-open-stream name buffer host service)))
         (network-stream-get-response stream start eoc))
+      ;; Requery capabilities for protocols that require it; i.e.,
+      ;; EHLO for SMTP.
+      (when (plist-get parameters :always-query-capabilities)
+        (network-stream-command stream capability-command eoc))
       (when (string-match success-string
                           (network-stream-command stream starttls-command eoc))
         ;; The server said it was OK to begin STARTTLS negotiations.
         (if (fboundp 'open-gnutls-stream)
-            (gnutls-negotiate :process stream :hostname host)
+            (let ((cert (network-stream-certificate host service parameters)))
+              (gnutls-negotiate :process stream :hostname host
+                                :keylist (and cert (list cert))))
           (unless (starttls-negotiate stream)
             (delete-process stream)))
         (if (memq (process-status stream) '(open run))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 70190867e89..f7f5f61fafe 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -987,7 +987,7 @@ This number is independent of the number of lines in the buffer.")
   (setq buffer-invisibility-spec '())
   (setq buffer-display-table (make-display-table))
   (set-display-table-slot buffer-display-table 4
-                          (let ((glyph (make-glyph-code 
+                          (let ((glyph (make-glyph-code
                                         ?. 'font-lock-keyword-face)))
                             (make-vector 3 glyph)))
 
@@ -1151,7 +1151,7 @@ Create the buffer if it doesn't exist."
                            (rcirc-generate-new-buffer-name process target))))
           (with-current-buffer new-buffer
             (rcirc-mode process target)
-            (rcirc-put-nick-channel process (rcirc-nick process) target 
+            (rcirc-put-nick-channel process (rcirc-nick process) target
                                     rcirc-current-line))
           new-buffer)))))
 
@@ -1238,7 +1238,7 @@ Create the buffer if it doesn't exist."
   (interactive)
   (let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
     (goto-char (point-max))
-    (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker 
+    (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker
                                                 (point)))
           (parent (buffer-name)))
       (delete-region rcirc-prompt-end-marker (point))
@@ -1477,7 +1477,7 @@ record activity."
                                (match-string 1 text)))
                            rcirc-ignore-list))
                ;; do not ignore if we sent the message
-               (not (string= sender (rcirc-nick process))))    
+               (not (string= sender (rcirc-nick process))))
     (let* ((buffer (rcirc-target-buffer process sender response target text))
            (inhibit-read-only t))
       (with-current-buffer buffer
@@ -1655,8 +1655,8 @@ log-files with absolute names (see `rcirc-log-filename-function')."
 (defun rcirc-view-log-file ()
   "View logfile corresponding to the current buffer."
   (interactive)
-  (find-file-other-window 
-   (expand-file-name (funcall rcirc-log-filename-function 
+  (find-file-other-window
+   (expand-file-name (funcall rcirc-log-filename-function
                               (rcirc-buffer-process) rcirc-target)
                      rcirc-log-directory)))
 
@@ -2446,7 +2446,7 @@ keywords when no KEYWORD is given."
                                  rcirc-fill-column)
                                 (t fill-column))
                           ;; make sure ... doesn't cause line wrapping
-                          3)))          
+                          3)))
       (fill-region (point) (point-max) nil t))))
 
 ;;; handlers
@@ -2813,7 +2813,7 @@ Passwords are stored in `rcirc-authinfo' (which see)."
             ;; quakenet authentication doesn't rely on the user's nickname.
             ;; the variable `nick' here represents the Q account name.
             (when (eq method 'quakenet)
-              (rcirc-send-privmsg 
+              (rcirc-send-privmsg
                process
                "Q@CServe.quakenet.org"
                (format "AUTH %s %s" nick (car args))))))))))
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index e3e6264b28f..9397025cb60 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -177,9 +177,9 @@ Remove also properties of all files in subdirectories."
   (tramp-message vec 8 "%s" directory)
     (maphash
      (lambda (key value)
-        (when (and (stringp (tramp-file-name-localname key))
-                   (string-match directory (tramp-file-name-localname key)))
-          (remhash key tramp-cache-data)))
+       (when (and (stringp (tramp-file-name-localname key))
+                  (string-match directory (tramp-file-name-localname key)))
+         (remhash key tramp-cache-data)))
      tramp-cache-data)))
 
 ;; Reverting or killing a buffer should also flush file properties.
@@ -200,12 +200,12 @@ Remove also properties of all files in subdirectories."
 (add-hook 'kill-buffer-hook 'tramp-flush-file-function)
 (add-hook 'tramp-cache-unload-hook
           (lambda ()
-             (remove-hook 'before-revert-hook
-                          'tramp-flush-file-function)
-             (remove-hook 'eshell-pre-command-hook
-                          'tramp-flush-file-function)
-             (remove-hook 'kill-buffer-hook
-                          'tramp-flush-file-function)))
+            (remove-hook 'before-revert-hook
+                         'tramp-flush-file-function)
+            (remove-hook 'eshell-pre-command-hook
+                         'tramp-flush-file-function)
+            (remove-hook 'kill-buffer-hook
+                         'tramp-flush-file-function)))
 
 ;;; -- Properties --
 
@@ -290,17 +290,17 @@ KEY identifies the connection, it is either a process or a vector."
     (let (result)
       (maphash
        (lambda (key value)
-          (let ((tmp (format
-                      "(%s %s)"
-                      (if (processp key)
-                          (prin1-to-string (prin1-to-string key))
-                        (prin1-to-string key))
-                      (if (hash-table-p value)
-                          (tramp-cache-print value)
-                        (if (bufferp value)
-                            (prin1-to-string (prin1-to-string value))
-                          (prin1-to-string value))))))
-            (setq result (if result (concat result " " tmp) tmp))))
+         (let ((tmp (format
+                     "(%s %s)"
+                     (if (processp key)
+                         (prin1-to-string (prin1-to-string key))
+                       (prin1-to-string key))
+                     (if (hash-table-p value)
+                         (tramp-cache-print value)
+                       (if (bufferp value)
+                           (prin1-to-string (prin1-to-string value))
+                         (prin1-to-string value))))))
+           (setq result (if result (concat result " " tmp) tmp))))
        table)
       result)))
 
@@ -310,8 +310,8 @@ KEY identifies the connection, it is either a process or a vector."
     (let (result)
       (maphash
        (lambda (key value)
-          (when (and (vectorp key) (null (aref key 3)))
-            (add-to-list 'result key)))
+         (when (and (vectorp key) (null (aref key 3)))
+           (add-to-list 'result key)))
        tramp-cache-data)
       result))
 
@@ -327,12 +327,12 @@ KEY identifies the connection, it is either a process or a vector."
         ;; Remove temporary data.
         (maphash
          (lambda (key value)
-            (if (and (vectorp key) (not (tramp-file-name-localname key)))
-                (progn
-                  (remhash "process-name" value)
-                  (remhash "process-buffer" value)
-                  (remhash "first-password-request" value))
-              (remhash key cache)))
+           (if (and (vectorp key) (not (tramp-file-name-localname key)))
+               (progn
+                 (remhash "process-name" value)
+                 (remhash "process-buffer" value)
+                 (remhash "first-password-request" value))
+             (remhash key cache)))
          cache)
         ;; Dump it.
         (with-temp-buffer
@@ -357,8 +357,8 @@ KEY identifies the connection, it is either a process or a vector."
   (add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
 (add-hook 'tramp-cache-unload-hook
           (lambda ()
-             (remove-hook 'kill-emacs-hook
-                          'tramp-dump-connection-properties)))
+            (remove-hook 'kill-emacs-hook
+                         'tramp-dump-connection-properties)))
 
 ;;;###tramp-autoload
 (defun tramp-parse-connection-properties (method)
@@ -368,18 +368,22 @@ for all methods.  Resulting data are derived from connection history."
   (let (res)
     (maphash
      (lambda (key value)
-        (if (and (vectorp key)
-                 (string-equal method (tramp-file-name-method key))
-                 (not (tramp-file-name-localname key)))
-            (push (list (tramp-file-name-user key)
-                        (tramp-file-name-host key))
-                  res)))
+       (if (and (vectorp key)
+                (string-equal method (tramp-file-name-method key))
+                (not (tramp-file-name-localname key)))
+           (push (list (tramp-file-name-user key)
+                       (tramp-file-name-host key))
+                 res)))
      tramp-cache-data)
     res))
 
 ;; Read persistent connection history.
 (when (and (stringp tramp-persistency-file-name)
-           (zerop (hash-table-count tramp-cache-data)))
+           (zerop (hash-table-count tramp-cache-data))
+           ;; When "emacs -Q" has been called, both variables are nil.
+           ;; We do not load the persistency file then, in order to
+           ;; have a clean test environment.
+           (or init-file-user site-run-file))
   (condition-case err
       (with-temp-buffer
         (insert-file-contents tramp-persistency-file-name)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 932436df8c9..46a82e3720d 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,4 +1,4 @@
-;;; pcomplete.el --- programmable completion
+;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
 
@@ -154,6 +154,7 @@ This mirrors the optional behavior of tcsh."
   "A list of characters which constitute a proper suffix."
   :type '(repeat character)
   :group 'pcomplete)
+(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
 
 (defcustom pcomplete-recexact nil
   "If non-nil, use shortest completion if characters cannot be added.
@@ -501,18 +502,16 @@ Same as `pcomplete' but using the standard completion UI."
                  ;; practice it should work just fine (fingers crossed).
                  (let ((prefixes (pcomplete--common-quoted-suffix
                                   pcomplete-stub buftext)))
-                   (apply-partially
-                    'pcomplete--table-subvert
-                    completions
-                    (cdr prefixes) (car prefixes))))
+                   (apply-partially #'pcomplete--table-subvert
+                                    completions
+                                    (cdr prefixes) (car prefixes))))
                 (t
-                 (lexical-let ((completions completions))
-                   (lambda (string pred action)
-                     (let ((res (complete-with-action
-                                 action completions string pred)))
-                       (if (stringp res)
-                           (pcomplete-quote-argument res)
-                         res)))))))
+                 (lambda (string pred action)
+                   (let ((res (complete-with-action
+                               action completions string pred)))
+                     (if (stringp res)
+                         (pcomplete-quote-argument res)
+                       res))))))
               (pred
                ;; Pare it down, if applicable.
                (when (and pcomplete-use-paring pcomplete-seen)
@@ -521,12 +520,13 @@ Same as `pcomplete' but using the standard completion UI."
                                  (funcall pcomplete-norm-func
                                           (directory-file-name f)))
                                pcomplete-seen))
-                 (lambda (f)
-                   (not (when pcomplete-seen
-                          (member
-                           (funcall pcomplete-norm-func
-                                    (directory-file-name f))
-                           pcomplete-seen)))))))
+                 ;; Capture the dynbound values for later use.
+                 (let ((norm-func pcomplete-norm-func)
+                       (seen pcomplete-seen))
+                   (lambda (f)
+                     (not (member
+                           (funcall norm-func (directory-file-name f))
+                           seen)))))))
           (when pcomplete-ignore-case
             (setq table
                   (apply-partially #'completion-table-case-fold table)))
@@ -780,6 +780,8 @@ dynamic-complete-functions are kept.  For comint mode itself,
 this is `comint-dynamic-complete-functions'."
   (set (make-local-variable 'pcomplete-parse-arguments-function)
        'pcomplete-parse-comint-arguments)
+  (add-hook 'completion-at-point-functions
+            'pcomplete-completions-at-point nil 'local)
   (set (make-local-variable completef-sym)
        (copy-sequence (symbol-value completef-sym)))
   (let* ((funs (symbol-value completef-sym))
@@ -887,15 +889,46 @@ Magic characters are those in `pcomplete-arg-quote-list'."
 
 (defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
   "Return either directories, or qualified entries."
-  ;; FIXME: pcomplete-entries doesn't return a list any more.
   (pcomplete-entries
    nil
-   (lexical-let ((re regexp)
-                 (pred predicate))
-     (lambda (f)
-       (or (file-directory-p f)
-           (and (if (not re) t (string-match re f))
-                (if (not pred) t (funcall pred f))))))))
+   (lambda (f)
+     (or (file-directory-p f)
+         (and (or (null regexp) (string-match regexp f))
+              (or (null predicate) (funcall predicate f)))))))
+
+(defun pcomplete--entries (&optional regexp predicate)
+  "Like `pcomplete-entries' but without env-var handling."
+  (let* ((ign-pred
+          (when (or pcomplete-file-ignore pcomplete-dir-ignore)
+            ;; Capture the dynbound value for later use.
+            (let ((file-ignore pcomplete-file-ignore)
+                  (dir-ignore pcomplete-dir-ignore))
+              (lambda (file)
+                (not
+                 (if (eq (aref file (1- (length file))) ?/)
+                     (and dir-ignore (string-match dir-ignore file))
+                   (and file-ignore (string-match file-ignore file))))))))
+         (reg-pred (if regexp (lambda (file) (string-match regexp file))))
+         (pred (cond
+                ((null (or ign-pred reg-pred))  predicate)
+                ((null (or ign-pred predicate)) reg-pred)
+                ((null (or reg-pred predicate)) ign-pred)
+                (t (lambda (f)
+                     (and (or (null reg-pred)  (funcall reg-pred f))
+                          (or (null ign-pred)  (funcall ign-pred f))
+                          (or (null predicate) (funcall predicate f))))))))
+    (lambda (s p a)
+      (if (and (eq a 'metadata) pcomplete-compare-entry-function)
+          `(metadata (cycle-sort-function
+                      . ,(lambda (comps)
+                           (sort comps pcomplete-compare-entry-function)))
+                     ,@(cdr (completion-file-name-table s p a)))
+        (let ((completion-ignored-extensions nil))
+          (completion-table-with-predicate
+           'completion-file-name-table pred 'strict s p a))))))
+
+(defconst pcomplete--env-regexp
+  "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")
 
 (defun pcomplete-entries (&optional regexp predicate)
   "Complete against a list of directory candidates.
@@ -905,65 +938,48 @@ If PREDICATE is non-nil, it will also be used to refine the match
 \(files for which the PREDICATE returns nil will be excluded).
 If no directory information can be extracted from the completed
 component, `default-directory' is used as the basis for completion."
-  (let* ((name (substitute-env-vars pcomplete-stub))
-         (completion-ignore-case pcomplete-ignore-case)
-         (default-directory (expand-file-name
-                             (or (file-name-directory name)
-                                 default-directory)))
-         above-cutoff)
-    (setq name (file-name-nondirectory name)
-          pcomplete-stub name)
-    (let ((completions
-           (file-name-all-completions name default-directory)))
-      (if regexp
-          (setq completions
-                (pcomplete-pare-list
-                 completions nil
-                 (function
-                  (lambda (file)
-                    (not (string-match regexp file)))))))
-      (if predicate
-          (setq completions
-                (pcomplete-pare-list
-                 completions nil
-                 (function
-                  (lambda (file)
-                    (not (funcall predicate file)))))))
-      (if (or pcomplete-file-ignore pcomplete-dir-ignore)
-          (setq completions
-                (pcomplete-pare-list
-                 completions nil
-                 (function
-                  (lambda (file)
-                    (if (eq (aref file (1- (length file)))
-                            ?/)
-                        (and pcomplete-dir-ignore
-                             (string-match pcomplete-dir-ignore file))
-                      (and pcomplete-file-ignore
-                           (string-match pcomplete-file-ignore file))))))))
-      (setq above-cutoff (and pcomplete-cycle-cutoff-length
-                             (> (length completions)
-                                pcomplete-cycle-cutoff-length)))
-      (sort completions
-            (function
-             (lambda (l r)
-               ;; for the purposes of comparison, remove the
-               ;; trailing slash from directory names.
-               ;; Otherwise, "foo.old/" will come before "foo/",
-               ;; since . is earlier in the ASCII alphabet than
-               ;; /
-               (let ((left (if (eq (aref l (1- (length l)))
-                                   ?/)
-                               (substring l 0 (1- (length l)))
-                             l))
-                     (right (if (eq (aref r (1- (length r)))
-                                    ?/)
-                                (substring r 0 (1- (length r)))
-                              r)))
-                 (if above-cutoff
-                     (string-lessp left right)
-                   (funcall pcomplete-compare-entry-function
-                            left right)))))))))
+  ;; FIXME: The old code did env-var expansion here, so we reproduce this
+  ;; behavior for now, but really env-var handling should be performed globally
+  ;; rather than here since it also applies to non-file arguments.
+  (let ((table (pcomplete--entries regexp predicate)))
+    (lambda (string pred action)
+      (let ((strings nil)
+            (orig-length (length string)))
+        ;; Perform env-var expansion.
+        (while (string-match pcomplete--env-regexp string)
+          (push (substring string 0 (match-beginning 1)) strings)
+          (push (getenv (match-string 2 string)) strings)
+          (setq string (substring string (match-end 1))))
+        (if (not (and strings
+                      (or (eq action t)
+                          (eq (car-safe action) 'boundaries))))
+            (let ((newstring
+                   (mapconcat 'identity (nreverse (cons string strings)) "")))
+              ;; FIXME: We could also try to return unexpanded envvars.
+              (complete-with-action action table newstring pred))
+          (let* ((envpos (apply #'+ (mapcar #' length strings)))
+                 (newstring
+                  (mapconcat 'identity (nreverse (cons string strings)) ""))
+                 (bounds (completion-boundaries newstring table pred
+                                                (or (cdr-safe action) ""))))
+            (if (>= (car bounds) envpos)
+                ;; The env-var is "out of bounds".
+                (if (eq action t)
+                    (complete-with-action action table newstring pred)
+                  (list* 'boundaries
+                         (+ (car bounds) (- orig-length (length newstring)))
+                         (cdr bounds)))
+              ;; The env-var is in the file bounds.
+              (if (eq action t)
+                  (let ((comps (complete-with-action
+                                action table newstring pred))
+                        (len (- envpos (car bounds))))
+                    ;; Strip the part of each completion that's actually
+                    ;; coming from the env-var.
+                    (mapcar (lambda (s) (substring s len)) comps))
+                (list* 'boundaries
+                       (+ envpos (- orig-length (length newstring)))
+                       (cdr bounds))))))))))
 
 (defsubst pcomplete-all-entries (&optional regexp predicate)
   "Like `pcomplete-entries', but doesn't ignore any entries."
@@ -1343,25 +1359,6 @@ If specific documentation can't be given, be generic."
 
 ;; general utilities
 
-(defun pcomplete-pare-list (l r &optional pred)
-  "Destructively remove from list L all elements matching any in list R.
-Test is done using `equal'.
-If PRED is non-nil, it is a function used for further removal.
-Returns the resultant list."
-  (while (and l (or (and r (member (car l) r))
-                    (and pred
-                         (funcall pred (car l)))))
-    (setq l (cdr l)))
-  (let ((m l))
-    (while m
-      (while (and (cdr m)
-                  (or (and r (member (cadr m) r))
-                      (and pred
-                           (funcall pred (cadr m)))))
-        (setcdr m (cddr m)))
-      (setq m (cdr m))))
-  l)
-
 (defun pcomplete-uniqify-list (l)
   "Sort and remove multiples in L."
   (setq l (sort l 'string-lessp))
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 5a8ff9d0f32..86e6b4abb6c 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -144,6 +144,8 @@
     (define-key map [(control c) (control x)] #'5x5-crack-xor-mutate)
     (define-key map "n"                       #'5x5-new-game)
     (define-key map "s"                       #'5x5-solve-suggest)
+    (define-key map "<"                       #'5x5-solve-rotate-left)
+    (define-key map ">"                       #'5x5-solve-rotate-right)
     (define-key map "q"                       #'5x5-quit-game)
     map)
   "Local keymap for the 5x5 game.")
@@ -174,6 +176,9 @@ GRID is the grid of positions to click.")
     ["Quit game"              5x5-quit-game t]
     "---"
     ["Use Calc solver"        5x5-solve-suggest         t]
+    ["Rotate left list of Calc solutions"        5x5-solve-rotate-left     t]
+    ["Rotate right list of Calc solutions"       5x5-solve-rotate-right    t]
+    "---"
     ["Crack randomly"         5x5-crack-randomly         t]
     ["Crack mutating current" 5x5-crack-mutating-current t]
     ["Crack mutating best"    5x5-crack-mutating-best    t]
@@ -207,18 +212,21 @@ squares you must fill the grid.
 
 5x5 keyboard bindings are:
 \\<5x5-mode-map>
-Flip                      \\[5x5-flip-current]
-Move up                   \\[5x5-up]
-Move down                 \\[5x5-down]
-Move left                 \\[5x5-left]
-Move right                \\[5x5-right]
-Start new game            \\[5x5-new-game]
-New game with random grid \\[5x5-randomize]
-Random cracker            \\[5x5-crack-randomly]
-Mutate current cracker    \\[5x5-crack-mutating-current]
-Mutate best cracker       \\[5x5-crack-mutating-best]
-Mutate xor cracker        \\[5x5-crack-xor-mutate]
-Quit current game         \\[5x5-quit-game]"
+Flip                        \\[5x5-flip-current]
+Move up                     \\[5x5-up]
+Move down                   \\[5x5-down]
+Move left                   \\[5x5-left]
+Move right                  \\[5x5-right]
+Start new game              \\[5x5-new-game]
+New game with random grid   \\[5x5-randomize]
+Random cracker              \\[5x5-crack-randomly]
+Mutate current cracker      \\[5x5-crack-mutating-current]
+Mutate best cracker         \\[5x5-crack-mutating-best]
+Mutate xor cracker          \\[5x5-crack-xor-mutate]
+Solve with Calc             \\[5x5-solve-suggest]
+Rotate left Calc Solutions  \\[5x5-solve-rotate-left]
+Rotate right Calc Solutions \\[5x5-solve-rotate-right]
+Quit current game           \\[5x5-quit-game]"
 
   (interactive "P")
   (setq 5x5-cracking nil)
@@ -331,9 +339,14 @@ Quit current game         \\[5x5-quit-game]"
                   (forward-char  (+ 1 (/ (1+ 5x5-x-scale) 2)))
                   (dotimes (x   5x5-grid-size)
                     (when (5x5-cell solution-grid y x)
+                      (if (= 0 (mod 5x5-x-scale 2))
+                          (progn
+                            (insert "()")
+                            (delete-region (point) (+ (point) 2))
+                            (backward-char 2))
                         (insert-char ?O 1)
                         (delete-char 1)
-                        (backward-char))
+                        (backward-char)))
                     (forward-char  (1+ 5x5-x-scale))))
                 (forward-line  5x5-y-scale))))
         (setq 5x5-solver-output nil)))
@@ -790,6 +803,64 @@ Argument N is ignored."
   (5x5-draw-grid (list 5x5-grid))
   (5x5-position-cursor))
 
+(defun 5x5-solve-rotate-left (&optional n)
+  "Rotate left by N the list of solutions in 5x5-solver-output.
+
+If N is not supplied rotate by 1, that is to say put the last
+element first in the list.
+
+The 5x5 game has in general several solutions.  For grid size=5,
+there are 4 possible solutions.  When function
+`5x5-solve-suggest' (press `\\[5x5-solve-suggest]') is called the
+solution that is presented is the one that needs least number of
+strokes --- other solutions can be viewed by rotating through the
+list. The list of solution is ordered by number of strokes, so
+rotating left just after calling `5x5-solve-suggest' will show
+the the solution with second least number of strokes, while
+rotating right will show the solution with greatest number of
+strokes."
+  (interactive "P")
+  (let ((len  (length 5x5-solver-output)))
+    (when (>= len 3)
+      (setq n (if (integerp n) n 1)
+            n (mod n (1- len)))
+      (unless (eq n 0)
+        (setq n  (- len n 1))
+        (let* ((p-tail (last 5x5-solver-output (1+ n)))
+               (tail (cdr p-tail))
+               (l-tail (last tail)))
+          ;;
+          ;;  For n = 2:
+          ;;
+          ;;  +--+--+   +--+--+   +--+--+   +--+--+   +--+--+
+          ;;  |M | ---->|S1| ---->|S2| ---->|S3| ---->|S4| ----> nil
+          ;;  +--+--+   +--+--+   +--+--+   +--+--+   +--+--+
+          ;;    ^                   ^         ^         ^
+          ;;    |                   |         |         |
+          ;;    + 5x5-solver-output |         |         + l-tail
+          ;;                        + p-tail  |
+          ;;                                  + tail
+          ;;
+          (setcdr l-tail (cdr 5x5-solver-output))
+          (setcdr 5x5-solver-output tail)
+          (unless (eq p-tail 5x5-solver-output)
+            (setcdr p-tail nil)))
+        (5x5-draw-grid (list 5x5-grid))
+        (5x5-position-cursor)))))
+
+(defun 5x5-solve-rotate-right (&optional n)
+  "Rotate right by N the list of solutions in 5x5-solver-output.
+If N is not supplied, rotate by 1.  Similar to function
+`5x5-solve-rotate-left' except that rotation is right instead of
+lest."
+  (interactive "P")
+  (setq n
+        (if (integerp n) (- n)
+          -1))
+  (5x5-solve-rotate-left n))
+
+
+
 ;; Keyboard response functions.
 
 (defun 5x5-flip-current ()
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index b8cac2fd331..1a23cd112af 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -155,8 +155,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
 \\([a-zA-Z]?:?[^:( \t\n]+\\)\
  \\([0-9]+\\)\\(?:[) \t]\\|:[^0-9\n]\\)" 2 3 nil (1))
 
-    (caml
-     "^ *File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
+    (python-tracebacks-and-caml
+     "^[ \t]*File \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1, lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
 \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:\\)?\\([ \n]Warning:\\)?\\)"
      2 (3 . 4) (5 . 6) (7))
 
diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el
index c809079381f..e8e2f8ffbf0 100644
--- a/lisp/progmodes/delphi.el
+++ b/lisp/progmodes/delphi.el
@@ -1959,12 +1959,12 @@ comment block.  If not in a // comment, just does a normal newline."
     kmap)
   "Keymap used in Delphi mode.")
 
-(defconst delphi-mode-syntax-table (make-syntax-table)
+(defvar delphi-mode-syntax-table nil
   "Delphi mode's syntax table.  It is just a standard syntax table.
 This is ok since we do our own keyword/comment/string face coloring.")
 
 ;;;###autoload
-(defun delphi-mode (&optional skip-initial-parsing)
+(define-derived-mode delphi-mode prog-mode "Delphi"
   "Major mode for editing Delphi code. \\<delphi-mode-map>
 \\[delphi-tab]\t- Indents the current line (or region, if Transient Mark mode
 \t  is enabled and the region is active) of Delphi code.
@@ -2007,14 +2007,6 @@ Coloring:
 
 Turning on Delphi mode calls the value of the variable `delphi-mode-hook'
 with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map delphi-mode-map)
-  (setq major-mode 'delphi-mode)        ;FIXME: Use define-derived-mode.
-  (setq mode-name "Delphi")
-
-  (setq local-abbrev-table delphi-mode-abbrev-table)
-  (set-syntax-table delphi-mode-syntax-table)
 
   ;; Buffer locals:
   (mapc #'(lambda (var)
@@ -2033,12 +2025,12 @@ with no args, if that value is non-nil."
   (add-hook 'after-change-functions 'delphi-after-change nil t)
 
   (widen)
-  (unless skip-initial-parsing
-    (delphi-save-excursion
-     (let ((delphi-verbose t))
-       (delphi-progress-start)
-       (delphi-parse-region (point-min) (point-max))
-       (delphi-progress-done))))
+
+  (delphi-save-excursion
+   (let ((delphi-verbose t))
+     (delphi-progress-start)
+     (delphi-parse-region (point-min) (point-max))
+     (delphi-progress-done)))
 
   (run-mode-hooks 'delphi-mode-hook))
 
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 22e5d2f7c5c..293ba49d4ae 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,4 +1,4 @@
-;;; make-mode.el --- makefile editing commands for Emacs
+;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1992, 1994, 1999-2011  Free Software Foundation, Inc.
 
@@ -602,7 +602,7 @@ The function must satisfy this calling convention:
     (define-key map "\C-c\C-m\C-p" 'makefile-makepp-mode)
     (define-key map "\M-p"     'makefile-previous-dependency)
     (define-key map "\M-n"     'makefile-next-dependency)
-    (define-key map "\e\t"     'makefile-complete)
+    (define-key map "\e\t"     'completion-at-point)
 
     ;; Make menus.
     (define-key map [menu-bar makefile-mode]
@@ -653,7 +653,7 @@ The function must satisfy this calling convention:
       '(menu-item "Find Targets and Macros" makefile-pickup-everything
                   :help "Notice names of all macros and targets in Makefile"))
     (define-key map [menu-bar makefile-mode complete]
-      '(menu-item "Complete Target or Macro" makefile-complete
+      '(menu-item "Complete Target or Macro" completion-at-point
                   :help "Perform completion on Makefile construct preceding point"))
     (define-key map [menu-bar makefile-mode backslash]
       '(menu-item "Backslash Region" makefile-backslash-region
@@ -852,6 +852,8 @@ Makefile mode can be configured by modifying the following variables:
    List of special targets. You will be offered to complete
    on one of those in the minibuffer whenever you enter a `.'.
    at the beginning of a line in Makefile mode."
+  (add-hook 'completion-at-point-functions
+            #'makefile-completions-at-point nil t)
   (add-hook 'write-file-functions
             'makefile-warn-suspicious-lines nil t)
   (add-hook 'write-file-functions
@@ -1147,11 +1149,7 @@ and adds all qualifying names to the list of known targets."
 
 ;;; Completion.
 
-(defun makefile-complete ()
-  "Perform completion on Makefile construct preceding point.
-Can complete variable and target names.
-The context determines which are considered."
-  (interactive)
+(defun makefile-completions-at-point ()
   (let* ((beg (save-excursion
                 (skip-chars-backward "^$(){}:#= \t\n")
                 (point)))
@@ -1168,22 +1166,26 @@ The context determines which are considered."
                ;; Preceding "$(" or "${" means macros only.
                ((and (memq pc '(?\{ ?\())
                      (progn
-                       (setq paren (if (eq paren ?\{) ?\} ?\)))
+                       (setq paren (if (eq pc ?\{) ?\} ?\)))
                        (backward-char)
                        (= (preceding-char) ?$)))
                 t)))))
-
-         (table (apply-partially 'completion-table-with-terminator
-                                   (cond
-                                    (do-macros (or paren ""))
-                                    ((save-excursion (goto-char beg) (bolp)) ":")
-                                    (t " "))
-                                   (append (if do-macros
-                                               '()
-                                             makefile-target-table)
-                                           makefile-macro-table))))
-    (completion-in-region beg (point) table)))
-
+         (suffix (cond
+                  (do-macros (if paren (string paren)))
+                  ((save-excursion (goto-char beg) (bolp)) ":")
+                  (t " "))))
+    (list beg (point)
+          (append (if do-macros '() makefile-target-table)
+                  makefile-macro-table)
+          :exit-function
+          (if suffix
+              (lambda (_s finished)
+                (when (memq finished '(sole finished))
+                  (if (looking-at (regexp-quote suffix))
+                      (goto-char (match-end 0))
+                    (insert suffix))))))))
+
+(define-obsolete-function-alias 'makefile-complete 'completion-at-point "24.1")
 
 
 ;; Backslashification.  Stolen from cc-mode.el.
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index b36104bf49b..ab640c0e270 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -1,4 +1,4 @@
-;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources
+;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*-
 
 ;; Copyright (C) 1997, 2001-2011  Free Software Foundation, Inc.
 
@@ -471,16 +471,13 @@ If the list was changed, sort the list and remove duplicates first."
   (string-lessp (car a) (car b)))
 
 
-(defun meta-complete-symbol ()
-  "Perform completion on Metafont or MetaPost symbol preceding point."
-  ;; FIXME: Use completion-at-point-functions.
-  (interactive "*")
+(defun meta-completions-at-point ()
   (let ((list meta-complete-list)
         entry)
     (while list
       (setq entry (car list)
             list (cdr list))
-      (if (meta-looking-at-backward (car entry) 200)
+      (if (looking-back (car entry) (max (point-min) (- (point) 200)))
           (setq list nil)))
     (if (numberp (nth 1 entry))
         (let* ((sub (nth 1 entry))
@@ -488,31 +485,19 @@ If the list was changed, sort the list and remove duplicates first."
                (begin (match-beginning sub))
                (end (match-end sub))
                (list (funcall (nth 2 entry))))
-          (completion-in-region
-           begin end
-           (if (zerop (length close)) list
-             (apply-partially 'completion-table-with-terminator
-                              close list))))
-      (funcall (nth 1 entry)))))
-
-
-(defun meta-looking-at-backward (regexp &optional limit)
-  ;; utility function used in `meta-complete-symbol'
-  (let ((pos (point)))
-    (save-excursion
-      (and (re-search-backward
-            regexp (if limit (max (point-min) (- (point) limit))) t)
-           (eq (match-end 0) pos)))))
-
-(defun meta-match-buffer (n)
-  ;; utility function used in `meta-complete-symbol'
-  (if (match-beginning n)
-      (let ((str (buffer-substring (match-beginning n) (match-end n))))
-        (set-text-properties 0 (length str) nil str)
-        (copy-sequence str))
-    ""))
-
-
+          (list
+           begin end list
+           :exit-function
+           (unless (zerop (length close))
+             (lambda (_s finished)
+               (when (memq finished '(sole finished))
+                 (if (looking-at (regexp-quote close))
+                     (goto-char (match-end 0))
+                   (insert close)))))))
+      (nth 1 entry))))
+
+(define-obsolete-function-alias 'meta-complete-symbol
+  'completion-at-point "24.1")
 
 ;;; Indentation.
 
@@ -906,7 +891,7 @@ The environment marked is the one that contains point or follows point."
     (define-key map "\C-c;"     'meta-comment-region)
     (define-key map "\C-c:"     'meta-uncomment-region)
     ;; Symbol Completion:
-    (define-key map "\M-\t"     'meta-complete-symbol)
+    (define-key map "\M-\t"     'completion-at-point)
     ;; Shell Commands:
     ;; (define-key map "\C-c\C-c"  'meta-command-file)
     ;; (define-key map "\C-c\C-k"  'meta-kill-job)
@@ -935,7 +920,7 @@ The environment marked is the one that contains point or follows point."
        ["Uncomment Region"              meta-uncomment-region
         :active (meta-mark-active)]
        "--"
-       ["Complete Symbol"               meta-complete-symbol t]
+       ["Complete Symbol"               completion-at-point t]
 ;      "--"
 ;      ["Command on Buffer"             meta-command-file t]
 ;      ["Kill Job"                      meta-kill-job t]
@@ -994,6 +979,7 @@ The environment marked is the one that contains point or follows point."
 
   (set (make-local-variable 'parse-sexp-ignore-comments) t)
 
+  (add-hook 'completion-at-point-functions #'meta-completions-at-point nil t)
   (set (make-local-variable 'comment-indent-function) #'meta-comment-indent)
   (set (make-local-variable 'indent-line-function) #'meta-indent-line)
   ;; No need to define a mode-specific 'indent-region-function.
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index 803a542563c..cb64b2436c6 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -267,8 +267,12 @@ startup file, `~/.emacs-octave'."
           (save-excursion
             (skip-syntax-backward "w_" (comint-line-beginning-position))
             (point))))
-    (cond (inferior-octave-complete-impossible nil)
-          ((eq start end) nil)
+    (cond ((eq start end) nil)
+          (inferior-octave-complete-impossible
+           (message (concat
+                     "Your Octave does not have `completion_matches'.  "
+                     "Please upgrade to version 2.X."))
+           nil)
           (t
            (list
             start end
@@ -279,19 +283,8 @@ startup file, `~/.emacs-octave'."
                (sort (delete-dups inferior-octave-output-list)
                      'string-lessp))))))))
 
-(defun inferior-octave-complete ()
-  "Perform completion on the Octave symbol preceding point.
-This is implemented using the Octave command `completion_matches' which
-is NOT available with versions of Octave prior to 2.0."
-  (interactive)
-  (if inferior-octave-complete-impossible
-      (error (concat
-              "Your Octave does not have `completion_matches'.  "
-              "Please upgrade to version 2.X."))
-    (let ((data (inferior-octave-completion-at-point)))
-      (if (null data)
-          (message "Cannot complete an empty string")
-        (apply #'completion-in-region data)))))
+(define-obsolete-function-alias 'inferior-octave-complete
+  'completion-at-point "24.1")
 
 (defun inferior-octave-dynamic-list-input-ring ()
   "List the buffer's input history in a help buffer."
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index 39d997e1d5e..183347cdeca 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -983,12 +983,8 @@ otherwise."
                         (setq end (point))))
     (list beg end octave-completion-alist)))
 
-(defun octave-complete-symbol ()
-  "Perform completion on Octave symbol preceding point.
-Compare that symbol against Octave's reserved words and builtin
-variables."
-  (interactive)
-  (apply 'completion-in-region (octave-completion-at-point-function)))
+(define-obsolete-function-alias 'octave-complete-symbol
+  'completion-at-point "24.1")
 
 ;;; Electric characters && friends
 
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index e28bb14bb9a..57ed13969b4 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -40,7 +40,6 @@
 ;;       pascal-tab-always-indent  t
 ;;       pascal-auto-endcomments   t
 ;;       pascal-auto-lineup        '(all)
-;;       pascal-toggle-completions nil
 ;;       pascal-type-keywords      '("array" "file" "packed" "char"
 ;;                                   "integer" "real" "string" "record")
 ;;       pascal-start-keywords     '("begin" "end" "function" "procedure"
@@ -79,8 +78,8 @@
     ;; These are user preferences, so not to set by default.
     ;;(define-key map "\r"       'electric-pascal-terminate-line)
     ;;(define-key map "\t"       'electric-pascal-tab)
-    (define-key map "\M-\t"    'pascal-complete-word)
-    (define-key map "\M-?"     'pascal-show-completions)
+    (define-key map "\M-\t"    'completion-at-point)
+    (define-key map "\M-?"     'completion-help-at-point)
     (define-key map "\177"     'backward-delete-char-untabify)
     (define-key map "\M-\C-h"  'pascal-mark-defun)
     (define-key map "\C-c\C-b" 'pascal-insert-block)
@@ -232,13 +231,13 @@ will do all lineups."
               (const :tag "Case statements" case))
   :group 'pascal)
 
-(defcustom pascal-toggle-completions nil
-  "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one.
-Repeated use of \\[pascal-complete-word] will show you all of them.
+(defvar pascal-toggle-completions nil
+  "*Non-nil meant \\<pascal-mode-map>\\[pascal-complete-word] would try all possible completions one by one.
+Repeated use of \\[pascal-complete-word] would show you all of them.
 Normally, when there is more than one possible completion,
-it displays a list of all possible completions."
-  :type 'boolean
-  :group 'pascal)
+it displays a list of all possible completions.")
+(make-obsolete-variable 'pascal-toggle-completions
+                        'completion-cycle-threshold "24.1")
 
 (defcustom pascal-type-keywords
   '("array" "file" "packed" "char" "integer" "real" "string" "record")
@@ -303,9 +302,9 @@ are handled in another way, and should not be added to this list."
   "Major mode for editing Pascal code. \\<pascal-mode-map>
 TAB indents for Pascal code.  Delete converts tabs to spaces as it moves back.
 
-\\[pascal-complete-word] completes the word around current point with respect \
+\\[completion-at-point] completes the word around current point with respect \
 to position in code
-\\[pascal-show-completions] shows all possible completions at this point.
+\\[completion-help-at-point] shows all possible completions at this point.
 
 Other useful functions are:
 
@@ -354,6 +353,7 @@ no args, if that value is non-nil."
   (set (make-local-variable 'comment-start) "{")
   (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *")
   (set (make-local-variable 'comment-end) "}")
+  (add-hook 'completion-at-point-functions 'pascal-completions-at-point nil t)
   ;; Font lock support
   (set (make-local-variable 'font-lock-defaults)
        '(pascal-font-lock-keywords nil t))
@@ -1287,54 +1287,17 @@ indent of the current line in parameterlist."
 (defvar pascal-last-word-shown nil)
 (defvar pascal-last-completions nil)
 
-(defun pascal-complete-word ()
-  "Complete word at current point.
-\(See also `pascal-toggle-completions', `pascal-type-keywords',
-`pascal-start-keywords' and `pascal-separator-keywords'.)"
-  (interactive)
+(defun pascal-completions-at-point ()
   (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
          (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point))))
+    (when (> e b)
+      (list b e #'pascal-completion))))
 
-    ;; Toggle-completions inserts whole labels
-    (if pascal-toggle-completions
-        (let* ((pascal-str (buffer-substring b e))
-               (allcomp (if (and pascal-toggle-completions
-                                 (string= pascal-last-word-shown pascal-str))
-                            pascal-last-completions
-                          (all-completions pascal-str 'pascal-completion))))
-          ;; Update entry number in list
-          (setq pascal-last-completions allcomp
-                pascal-last-word-numb
-                (if (>= pascal-last-word-numb (1- (length allcomp)))
-                    0
-                  (1+ pascal-last-word-numb)))
-          (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
-          ;; Display next match or same string if no match was found
-          (if allcomp
-              (progn
-                (goto-char e)
-                (insert-before-markers pascal-last-word-shown)
-                (delete-region b e))
-            (message "(No match)")))
-      ;; The other form of completion does not necessarily do that.
-      (completion-in-region b e 'pascal-completion))))
-
-(defun pascal-show-completions ()
-  "Show all possible completions at current point."
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-         (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-         (pascal-str (buffer-substring b e))
-         (allcomp (if (and pascal-toggle-completions
-                           (string= pascal-last-word-shown pascal-str))
-                      pascal-last-completions
-                    (all-completions pascal-str 'pascal-completion))))
-    ;; Show possible completions in a temporary buffer.
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list allcomp pascal-str))
-    ;; Wait for a keypress. Then delete *Completion*  window
-    (momentary-string-display "" (point))
-    (delete-window (get-buffer-window (get-buffer "*Completions*")))))
+(define-obsolete-function-alias 'pascal-complete-word
+  'completion-at-point "24.1")
+
+(define-obsolete-function-alias 'pascal-show-completions
+  'completion-help-at-point "24.1")
 
 
 (defun pascal-get-default-symbol ()
diff --git a/lisp/shell.el b/lisp/shell.el
index 8a282e94160..de811543ba0 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -398,6 +398,12 @@ to `dirtrack-mode'."
   (set (make-local-variable 'pcomplete-parse-arguments-function)
        ;; FIXME: This function should be moved to shell.el.
        #'pcomplete-parse-comint-arguments)
+  (set (make-local-variable 'pcomplete-termination-string)
+       (cond ((not comint-completion-addsuffix) "")
+             ((stringp comint-completion-addsuffix)
+              comint-completion-addsuffix)
+             ((not (consp comint-completion-addsuffix)) " ")
+             (t (cdr comint-completion-addsuffix))))
   ;; Don't use pcomplete's defaulting mechanism, rely on
   ;; shell-dynamic-complete-functions instead.
   (set (make-local-variable 'pcomplete-default-completion-function) #'ignore)
diff --git a/lisp/subr.el b/lisp/subr.el
index b328b7e17b7..4d2f3b1808c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2600,6 +2600,14 @@ Otherwise, return nil."
         (get-char-property (1- (field-end pos)) 'field)
       raw-field)))
 
+(defun sha1 (object &optional start end binary)
+  "Return the SHA1 (Secure Hash Algorithm) of an OBJECT.
+OBJECT is either a string or a buffer.  Optional arguments START and
+END are character positions specifying which portion of OBJECT for
+computing the hash.  If BINARY is non-nil, return a string in binary
+form."
+  (secure-hash 'sha1 object start end binary))
+
 
 ;;;; Support for yanking and text properties.
 
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 712929ecec0..fbf3e91d3d9 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -916,6 +916,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
   ;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
   (menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
 
+  ;; OS X Lion introduces PressAndHold, which is unsupported by this port. 
+  ;; See this thread for more details:
+  ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
+  (ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
+
   (setq ns-initialized t))
 
 (add-to-list 'handle-args-function-alist '(ns . x-handle-args))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 12094887f38..107a0728bae 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -3154,8 +3154,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE."
               (insert (bibtex-field-left-delimiter)))
             (goto-char end)))
         (skip-chars-backward " \t\n")
-        (dolist (field required) (bibtex-make-field field))
-        (dolist (field optional) (bibtex-make-optional-field field))))))
+        (mapc 'bibtex-make-field required)
+        (mapc 'bibtex-make-optional-field optional)))))
 
 (defun bibtex-parse-entry (&optional content)
   "Parse entry at point, return an alist.
@@ -4247,21 +4247,24 @@ At end of the cleaning process, the functions in
           ;; (bibtex-format-string)
           (t (bibtex-format-entry)))
     ;; set key
-    (when (or new-key (not key))
-      (setq key (bibtex-generate-autokey))
-      ;; Sometimes `bibtex-generate-autokey' returns an empty string
-      (if (or bibtex-autokey-edit-before-use (string= "" key))
-          (setq key (if (eq entry-type 'string)
-                        (bibtex-read-string-key key)
-                      (bibtex-read-key "Key to use: " key))))
-      (save-excursion
-        (re-search-forward (if (eq entry-type 'string)
-                               bibtex-string-maybe-empty-head
-                             bibtex-entry-maybe-empty-head))
-        (if (match-beginning bibtex-key-in-head)
-            (delete-region (match-beginning bibtex-key-in-head)
-                           (match-end bibtex-key-in-head)))
-        (insert key)))
+    (if (or new-key (not key))
+        (save-excursion
+          ;; First delete the old key so that a customized algorithm
+          ;; for generating the new key does not get confused by the
+          ;; old key.
+          (re-search-forward (if (eq entry-type 'string)
+                                 bibtex-string-maybe-empty-head
+                               bibtex-entry-maybe-empty-head))
+          (if (match-beginning bibtex-key-in-head)
+              (delete-region (match-beginning bibtex-key-in-head)
+                             (match-end bibtex-key-in-head)))
+          (setq key (bibtex-generate-autokey))
+          ;; Sometimes `bibtex-generate-autokey' returns an empty string
+          (if (or bibtex-autokey-edit-before-use (string= "" key))
+              (setq key (if (eq entry-type 'string)
+                            (bibtex-read-string-key key)
+                          (bibtex-read-key "Key to use: " key))))
+          (insert key)))
 
     (unless called-by-reformat
       (let* ((end (save-excursion
@@ -4718,7 +4721,7 @@ Return the URL or nil if none can be generated."
           (fields-alist (save-excursion (bibtex-parse-entry t)))
           ;; Always ignore case,
           (case-fold-search t)
-          text url scheme obj fmt fl-match step)
+          text url scheme obj fmt fl-match)
       ;; The return value of `bibtex-parse-entry' (i.e., FIELDS-ALIST)
       ;; is always used to generate the URL.  However, if the BibTeX
       ;; entry contains more than one URL, we have multiple matches
@@ -4773,11 +4776,8 @@ Return the URL or nil if none can be generated."
         (setq url (if (null scheme) (match-string 0 text)
                     (if (stringp (car scheme))
                         (setq fmt (pop scheme)))
-                    (dotimes (i (length scheme))
-                      (setq step (nth i scheme))
-                      ;; The first step shall use TEXT as obtained earlier.
-                      (unless (= i 0)
-                        (setq text (cdr (assoc-string (car step) fields-alist t))))
+                    (dolist (step scheme)
+                      (setq text (cdr (assoc-string (car step) fields-alist t)))
                       (if (string-match (nth 1 step) text)
                           (push (cond ((functionp (nth 2 step))
                                        (funcall (nth 2 step) text))
@@ -4857,24 +4857,24 @@ where FILE is the BibTeX file of ENTRY."
                            (save-excursion
                              (goto-char beg)
                              (and (looking-at bibtex-entry-head)
-                                  (setq key (bibtex-key-in-head)))))
-                      (add-to-list 'entries
-                                   (list key file
-                                         (buffer-substring-no-properties
-                                          beg end))))))
+                                  (setq key (bibtex-key-in-head))))
+                           (not (assoc key entries)))
+                      (push (list key file
+                                  (buffer-substring-no-properties beg end))
+                            entries))))
             ;; The following is slow.  But it works reliably even in more
             ;; complicated cases with BibTeX string constants and crossrefed
             ;; entries.  If you prefer speed over reliability, perform an
             ;; unrestricted search.
             (bibtex-map-entries
              (lambda (key beg end)
-               (if (cond (funp (funcall regexp beg end))
-                         ((and (setq text (bibtex-text-in-field field t))
-                               (string-match regexp text))))
-                   (add-to-list 'entries
-                                (list key file
-                                      (buffer-substring-no-properties
-                                       beg end))))))))))
+               (if (and (cond (funp (funcall regexp beg end))
+                              ((and (setq text (bibtex-text-in-field field t))
+                                    (string-match regexp text))))
+                        (not (assoc key entries)))
+                   (push (list key file
+                               (buffer-substring-no-properties beg end))
+                         entries))))))))
     (if display
         (if entries
             (bibtex-display-entries entries)
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 2b7e9a19baa..a85ed982ab0 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1054,6 +1054,7 @@ The `justification' text-property can locally override this variable."
                  (const full)
                  (const center)
                  (const none))
+  :safe 'symbolp
   :group 'fill)
 (make-variable-buffer-local 'default-justification)
 
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 7b7813db94b..b0d00242f2a 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,4 +1,4 @@
-;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
+;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
 ;;
 ;; Copyright (C) 1996-1997, 1999-2011  Free Software Foundation, Inc.
 ;;
@@ -1161,10 +1161,29 @@ the field."
   "Complete content of editable field from point.
 When not inside a field, signal an error."
   (interactive)
+  (let ((data (widget-completions-at-point)))
+    (cond
+     ((functionp data) (funcall data))
+     ((consp data)
+      (let ((completion-extra-properties (nth 3 data)))
+        (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
+                              (plist-get completion-extra-properties
+                                         :predicate))))
+     ((widget-field-find (point))
+      ;; This defaulting used to be performed in widget-default-complete, but
+      ;; it seems more appropriate here than in widget-default-completions.
+      (call-interactively 'widget-complete-field))
+     (t
+      (error "Not in an editable field")))))
+;; We may want to use widget completion in buffers where the major mode
+;; hasn't added widget-completions-at-point to completion-at-point-functions,
+;; so it's not really obsolete (yet).
+;; (make-obsolete 'widget-complete 'completion-at-point "24.1")
+
+(defun widget-completions-at-point ()
   (let ((field (widget-field-find (point))))
-    (if field
-        (widget-apply field :complete)
-      (error "Not in an editable field"))))
+    (when field
+      (widget-apply field :completions-function))))
 
 ;;; Setting up the buffer.
 
@@ -1435,7 +1454,7 @@ The value of the :type attribute should be an unconverted widget type."
   :value-to-external (lambda (_widget value) value)
   :button-prefix 'widget-button-prefix
   :button-suffix 'widget-button-suffix
-  :complete 'widget-default-complete
+  :completions-function #'widget-default-completions
   :create 'widget-default-create
   :indent nil
   :offset 0
@@ -1461,13 +1480,20 @@ The value of the :type attribute should be an unconverted widget type."
 
 (defvar widget--completing-widget)
 
-(defun widget-default-complete (widget)
-  "Call the value of the :complete-function property of WIDGET.
-If that does not exist, call the value of `widget-complete-field'.
-During this call, `widget--completing-widget' is bound to WIDGET."
-  (let ((widget--completing-widget widget))
-    (call-interactively (or (widget-get widget :complete-function)
-                            widget-complete-field))))
+(defun widget-default-completions (widget)
+  "Return completion data, like `completion-at-point-functions' would."
+  (let ((completions (widget-get widget :completions)))
+    (if completions
+        (list (widget-field-start widget)
+              (max (point) (widget-field-text-end widget))
+              completions)
+      (if (widget-get widget :complete)
+          (lambda () (widget-apply widget :complete))
+        (if (widget-get widget :complete-function)
+            (lambda ()
+              (let ((widget--completing-widget widget))
+                (call-interactively
+                 (widget-get widget :complete-function)))))))))
 
 (defun widget-default-create (widget)
   "Create WIDGET at point in the current buffer."
@@ -3018,20 +3044,6 @@ as the value."
   :complete-function 'ispell-complete-word
   :prompt-history 'widget-string-prompt-value-history)
 
-(defun widget-string-complete ()
-  "Complete contents of string field.
-Completions are taken from the :completion-alist property of the
-widget.  If that isn't a list, it's evalled and expected to yield a list."
-  (interactive)
-  (let* ((widget widget--completing-widget)
-         (completion-ignore-case (widget-get widget :completion-ignore-case))
-         (alist (widget-get widget :completion-alist))
-         (_ (unless (listp alist)
-              (setq alist (eval alist)))))
-    (completion-in-region (widget-field-start widget)
-                          (max (point) (widget-field-text-end widget))
-                          alist)))
-
 (define-widget 'regexp 'string
   "A regular expression."
   :match 'widget-regexp-match
@@ -3059,21 +3071,13 @@ widget.  If that isn't a list, it's evalled and expected to yield a list."
 (define-widget 'file 'string
   "A file widget.
 It reads a file name from an editable text field."
-  :complete-function 'widget-file-complete
+  :completions #'completion-file-name-table
   :prompt-value 'widget-file-prompt-value
   :format "%{%t%}: %v"
   ;; Doesn't work well with terminating newline.
   ;; :value-face 'widget-single-line-field
   :tag "File")
 
-(defun widget-file-complete ()
-  "Perform completion on file name preceding point."
-  (interactive)
-  (let ((widget widget--completing-widget))
-    (completion-in-region (widget-field-start widget)
-                          (max (point) (widget-field-text-end widget))
-                          'completion-file-name-table)))
-
 (defun widget-file-prompt-value (widget prompt value unbound)
   ;; Read file from minibuffer.
   (abbreviate-file-name
@@ -3113,7 +3117,7 @@ It reads a directory name from an editable text field."
   :tag "Symbol"
   :format "%{%t%}: %v"
   :match (lambda (_widget value) (symbolp value))
-  :complete-function 'lisp-complete-symbol
+  :completions obarray
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'symbolp
   :prompt-history 'widget-symbol-prompt-value-history
@@ -3141,9 +3145,8 @@ It reads a directory name from an editable text field."
 
 (define-widget 'function 'restricted-sexp
   "A Lisp function."
-  :complete-function (lambda ()
-                       (interactive)
-                       (lisp-complete-symbol 'fboundp))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'fboundp 'strict)
   :prompt-value 'widget-field-prompt-value
   :prompt-internal 'widget-symbol-prompt-internal
   :prompt-match 'fboundp
@@ -3165,9 +3168,8 @@ It reads a directory name from an editable text field."
   "A Lisp variable."
   :prompt-match 'boundp
   :prompt-history 'widget-variable-prompt-value-history
-  :complete-function (lambda ()
-                       (interactive)
-                       (lisp-complete-symbol 'boundp))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'boundp 'strict)
   :tag "Variable")
 
 (define-widget 'coding-system 'symbol
@@ -3178,9 +3180,8 @@ It reads a directory name from an editable text field."
   :prompt-history 'coding-system-value-history
   :prompt-value 'widget-coding-system-prompt-value
   :action 'widget-coding-system-action
-  :complete-function (lambda ()
-                       (interactive)
-                       (lisp-complete-symbol 'coding-system-p))
+  :completions (apply-partially #'completion-table-with-predicate
+                                obarray #'coding-system-p 'strict)
   :validate (lambda (widget)
               (unless (coding-system-p (widget-value widget))
                 (widget-put widget :error (format "Invalid coding system: %S"
@@ -3317,7 +3318,7 @@ It reads a directory name from an editable text field."
     (insert (widget-apply widget :value-get))
     (goto-char (point-min))
     (let (err)
-      (condition-case data
+      (condition-case data ;Note: We get a spurious byte-compile warning here.
           (progn
             ;; Avoid a confusing end-of-file error.
             (skip-syntax-forward "\\s-")
@@ -3685,7 +3686,7 @@ example:
   :size 10
   :tag "Color"
   :value "black"
-  :complete 'widget-color-complete
+  :completions (or facemenu-color-alist (defined-colors))
   :sample-face-get 'widget-color-sample-face-get
   :notify 'widget-color-notify
   :action 'widget-color-action)
@@ -3711,14 +3712,6 @@ example:
                (delete-window win)))
         (pop-to-buffer ,(current-buffer))))))
 
-(defun widget-color-complete (widget)
-  "Complete the color in WIDGET."
-  (require 'facemenu)                   ; for facemenu-color-alist
-  (completion-in-region (widget-field-start widget)
-                        (max (point) (widget-field-text-end widget))
-                        (or facemenu-color-alist
-                            (sort (defined-colors) 'string-lessp))))
-
 (defun widget-color-sample-face-get (widget)
   (let* ((value (condition-case nil
                     (widget-value widget)
diff --git a/lisp/window.el b/lisp/window.el
index 5493893d4c1..ac43fe7703c 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1165,13 +1165,20 @@ IGNORE, when non-nil means a window can be returned even if its
      (window-frame window))
     (or best best-2)))
 
-(defun get-window-with-predicate (predicate &optional minibuf
-                                            all-frames default)
+(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
   "Return a live window satisfying PREDICATE.
 More precisely, cycle through all windows calling the function
 PREDICATE on each one of them with the window as its sole
 argument.  Return the first window for which PREDICATE returns
-non-nil.  If no window satisfies PREDICATE, return DEFAULT.
+non-nil.  Windows are scanned starting with the window following
+the selcted window.  If no window satisfies PREDICATE, return
+DEFAULT.
+
+MINIBUF t means include the minibuffer window even if the
+minibuffer is not active.  MINIBUF nil or omitted means include
+the minibuffer window only if the minibuffer is active.  Any
+other value means do not include the minibuffer window even if
+the minibuffer is active.
 
 ALL-FRAMES nil or omitted means consider all windows on the selected
 frame, plus the minibuffer window if specified by the MINIBUF
@@ -1192,7 +1199,9 @@ values of ALL-FRAMES have special meanings:
 Anything else means consider all windows on the selected frame
 and no others."
   (catch 'found
-    (dolist (window (window-list-1 nil minibuf all-frames))
+    (dolist (window (window-list-1
+                     (next-window nil minibuf all-frames)
+                     minibuf all-frames))
       (when (funcall predicate window)
         (throw 'found window)))
     default))
@@ -1297,10 +1306,8 @@ selected frame and no others."
 (defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
   "Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
 BUFFER-OR-NAME may be a buffer or the name of an existing buffer
-and defaults to the current buffer.
-
-Any windows showing BUFFER-OR-NAME on the selected frame are listed
-first.
+and defaults to the current buffer.  Windows are scanned starting
+with the selected window.
 
 MINIBUF t means include the minibuffer window even if the
 minibuffer is not active.  MINIBUF nil or omitted means include
@@ -1328,7 +1335,7 @@ Anything else means consider all windows on the selected frame
 and no others."
   (let ((buffer (normalize-live-buffer buffer-or-name))
         windows)
-    (dolist (window (window-list-1 (frame-first-window) minibuf all-frames))
+    (dolist (window (window-list-1 (selected-window) minibuf all-frames))
       (when (eq (window-buffer window) buffer)
         (setq windows (cons window windows))))
     (nreverse windows)))
@@ -2044,7 +2051,18 @@ make selected window wider by DELTA columns.  If DELTA is
 negative, shrink selected window by -DELTA lines or columns.
 Return nil."
   (interactive "p")
-  (resize-window (selected-window) delta horizontal))
+  (cond
+   ((zerop delta))
+   ((window-size-fixed-p nil horizontal)
+    (error "Selected window has fixed size"))
+   ((window-resizable-p nil delta horizontal)
+    (resize-window nil delta horizontal))
+   (t
+    (resize-window
+     nil (if (> delta 0)
+             (window-max-delta nil horizontal)
+           (- (window-min-delta nil horizontal)))
+     horizontal))))
 
 (defun shrink-window (delta &optional horizontal)
   "Make selected window DELTA lines smaller.
@@ -2054,7 +2072,18 @@ make selected window narrower by DELTA columns.  If DELTA is
 negative, enlarge selected window by -DELTA lines or columns.
 Return nil."
   (interactive "p")
-  (resize-window (selected-window) (- delta) horizontal))
+  (cond
+   ((zerop delta))
+   ((window-size-fixed-p nil horizontal)
+    (error "Selected window has fixed size"))
+   ((window-resizable-p nil (- delta) horizontal)
+    (resize-window nil (- delta) horizontal))
+   (t
+    (resize-window
+     nil (if (> delta 0)
+             (- (window-min-delta nil horizontal))
+           (window-max-delta nil horizontal))
+     horizontal))))
 
 (defun maximize-window (&optional window)
   "Maximize WINDOW.
@@ -2222,6 +2251,28 @@ and no others."
         (next-window base-window (if nomini 'arg) all-frames))))
 
 ;;; Deleting windows.
+(defcustom frame-auto-delete 'automatic
+  "If non-nil, quitting a window can delete it's frame.
+If this variable is nil, functions that quit a window never
+delete the associated frame.  If this variable equals the symbol
+`automatic', a frame is deleted only if it the window is
+dedicated or was created by `display-buffer'.  If this variable
+is t, a frame can be always deleted, even if it was created by
+`make-frame-command'.  Other values should not be used.
+
+Note that a frame will be effectively deleted if and only if
+another frame still exists.
+
+Functions quitting a window and consequently affected by this
+variable are `switch-to-prev-buffer', `delete-windows-on',
+`replace-buffer-in-windows' and `quit-restore-window'."
+  :type '(choice
+          (const :tag "Never" nil)
+          (const :tag "Automatic" automatic)
+          (const :tag "Always" t))
+  :group 'windows
+  :group 'frames)
+
 (defun window-deletable-p (&optional window)
   "Return t if WINDOW can be safely deleted from its frame.
 Return `frame' if deleting WINDOW should delete its frame
@@ -2237,9 +2288,12 @@ instead."
         (quit-restore (window-parameter window 'quit-restore)))
     (cond
      ((frame-root-window-p window)
-      (when (and (or dedicated
-                     (and (eq (car-safe quit-restore) 'new-frame)
-                          (eq (nth 1 quit-restore) (window-buffer window))))
+      (when (and (or (eq frame-auto-delete t)
+                     (and (eq frame-auto-delete 'automatic)
+                          (or dedicated
+                              (and (eq (car-safe quit-restore) 'new-frame)
+                                   (eq (nth 1 quit-restore)
+                                       (window-buffer window))))))
                  (other-visible-frames-p frame))
         ;; WINDOW is the root window of its frame.  Return `frame' but
         ;; only if WINDOW is (1) either dedicated or quit-restore's car
@@ -2960,7 +3014,11 @@ new window are inherited from the window selected on WINDOW's
 frame.  The selected window is not changed by this function."
   (interactive "i")
   (setq window (normalize-any-window window))
-  (let* ((horizontal (not (memq side '(nil below above))))
+  (let* ((side (cond
+                ((not side) 'below)
+                ((memq side '(below above right left)) side)
+                (t 'right)))
+         (horizontal (not (memq side '(nil below above))))
          (frame (window-frame window))
          (parent (window-parent window))
          (function (window-parameter window 'split-window))
@@ -3454,15 +3512,320 @@ specific buffers."
     ;; (message "Done in %d rounds" round)
     ))
 
+;;; Window states, how to get them and how to put them in a window.
+(defsubst window-list-no-nils (&rest args)
+  "Like LIST but do not add nil elements of ARGS."
+  (delq nil (apply 'list args)))
+
+(defvar window-state-ignored-parameters '(quit-restore)
+  "List of window parameters ignored by `window-state-get'.")
+
+(defun window-state-get-1 (window &optional markers)
+  "Helper function for `window-state-get'."
+  (let* ((type
+          (cond
+           ((window-vchild window) 'vc)
+           ((window-hchild window) 'hc)
+           (t 'leaf)))
+         (buffer (window-buffer window))
+         (selected (eq window (selected-window)))
+         (head
+          (window-list-no-nils
+           type
+           (unless (window-next window) (cons 'last t))
+           (cons 'clone-number (window-clone-number window))
+           (cons 'total-height (window-total-size window))
+           (cons 'total-width (window-total-size window t))
+           (cons 'normal-height (window-normal-size window))
+           (cons 'normal-width (window-normal-size window t))
+           (cons 'splits (window-splits window))
+           (cons 'nest (window-nest window))
+           (let (list)
+             (dolist (parameter (window-parameters window))
+               (unless (memq (car parameter)
+                             window-state-ignored-parameters)
+                 (setq list (cons parameter list))))
+             (when list
+               (cons 'parameters list)))
+           (when buffer
+             ;; All buffer related things go in here - make the buffer
+             ;; current when retrieving `point' and `mark'.
+             (with-current-buffer (window-buffer window)
+               (let ((point (if selected (point) (window-point window)))
+                     (start (window-start window))
+                     (mark (mark)))
+                 (window-list-no-nils
+                  'buffer (buffer-name buffer)
+                  (cons 'selected selected)
+                  (when window-size-fixed (cons 'size-fixed window-size-fixed))
+                  (cons 'hscroll (window-hscroll window))
+                  (cons 'fringes (window-fringes window))
+                  (cons 'margins (window-margins window))
+                  (cons 'scroll-bars (window-scroll-bars window))
+                  (cons 'vscroll (window-vscroll window))
+                  (cons 'dedicated (window-dedicated-p window))
+                  (cons 'point (if markers (copy-marker point) point))
+                  (cons 'start (if markers (copy-marker start) start))
+                  (when mark
+                    (cons 'mark (if markers (copy-marker mark) mark)))))))))
+         (tail
+          (when (memq type '(vc hc))
+            (let (list)
+              (setq window (window-child window))
+              (while window
+                (setq list (cons (window-state-get-1 window markers) list))
+                (setq window (window-right window)))
+              (nreverse list)))))
+    (append head tail)))
+
+(defun window-state-get (&optional window markers)
+  "Return state of WINDOW as a Lisp object.
+WINDOW can be any window and defaults to the root window of the
+selected frame.
+
+Optional argument MARKERS non-nil means use markers for sampling
+positions like `window-point' or `window-start'.  MARKERS should
+be non-nil only if the value is used for putting the state back
+in the same session (note that markers slow down processing).
+
+The return value can be used as argument for `window-state-put'
+to put the state recorded here into an arbitrary window.  The
+value can be also stored on disk and read back in a new session."
+  (setq window
+        (if window
+            (if (window-any-p window)
+                window
+              (error "%s is not a live or internal window" window))
+          (frame-root-window)))
+  ;; The return value is a cons whose car specifies some constraints on
+  ;; the size of WINDOW.  The cdr lists the states of the subwindows of
+  ;; WINDOW.
+  (cons
+   ;; Frame related things would go into a function, say `frame-state',
+   ;; calling `window-state-get' to insert the frame's root window.
+   (window-list-no-nils
+    (cons 'min-height (window-min-size window))
+    (cons 'min-width (window-min-size window t))
+    (cons 'min-height-ignore (window-min-size window nil t))
+    (cons 'min-width-ignore (window-min-size window t t))
+    (cons 'min-height-safe (window-min-size window nil 'safe))
+    (cons 'min-width-safe (window-min-size window t 'safe))
+    ;; These are probably not needed.
+    (when (window-size-fixed-p window) (cons 'fixed-height t))
+    (when (window-size-fixed-p window t) (cons 'fixed-width t)))
+   (window-state-get-1 window markers)))
+
+(defvar window-state-put-list nil
+  "Helper variable for `window-state-put'.")
+
+(defun window-state-put-1 (state &optional window ignore totals)
+  "Helper function for `window-state-put'."
+  (let ((type (car state)))
+    (setq state (cdr state))
+    (cond
+     ((eq type 'leaf)
+      ;; For a leaf window just add unprocessed entries to
+      ;; `window-state-put-list'.
+      (setq window-state-put-list
+            (cons (cons window state) window-state-put-list)))
+     ((memq type '(vc hc))
+      (let* ((horizontal (eq type 'hc))
+             (total (window-total-size window horizontal))
+             (first t)
+             size new)
+        (dolist (item state)
+          ;; Find the next child window.  WINDOW always points to the
+          ;; real window that we want to fill with what we find here.
+          (when (memq (car item) '(leaf vc hc))
+            (if (assq 'last item)
+                ;; The last child window.  Below `window-state-put-1'
+                ;; will put into it whatever ITEM has in store.
+                (setq new nil)
+              ;; Not the last child window, prepare for splitting
+              ;; WINDOW.  SIZE is the new (and final) size of the old
+              ;; window.
+              (setq size
+                    (if totals
+                        ;; Use total size.
+                        (cdr (assq (if horizontal 'total-width 'total-height) item))
+                      ;; Use normalized size and round.
+                      (round (* total
+                                (cdr (assq
+                                      (if horizontal 'normal-width 'normal-height)
+                                      item))))))
+
+              ;; Use safe sizes, we try to resize later.
+              (setq size (max size (if horizontal
+                                       window-safe-min-height
+                                     window-safe-min-width)))
+
+              (if (window-sizable-p window (- size) horizontal 'safe)
+                  (let* ((window-nest (assq 'nest item)))
+                    ;; We must inherit the nesting, otherwise we might mess
+                    ;; up handling of atomic and side window.
+                    (setq new (split-window window size horizontal)))
+                ;; Give up if we can't resize window down to safe sizes.
+                (error "Cannot resize window %s" window))
+
+              (when first
+                (setq first nil)
+                ;; When creating the first child window add for parent
+                ;; unprocessed entries to `window-state-put-list'.
+                (setq window-state-put-list
+                      (cons (cons (window-parent window) state)
+                            window-state-put-list))))
+
+            ;; Now process the current window (either the one we've just
+            ;; split or the last child of its parent).
+            (window-state-put-1 item window ignore totals)
+            ;; Continue with the last window split off.
+            (setq window new))))))))
+
+(defun window-state-put-2 (ignore)
+  "Helper function for `window-state-put'."
+  (dolist (item window-state-put-list)
+    (let ((window (car item))
+          (clone-number (cdr (assq 'clone-number item)))
+          (splits (cdr (assq 'splits item)))
+          (nest (cdr (assq 'nest item)))
+          (parameters (cdr (assq 'parameters item)))
+          (state (cdr (assq 'buffer item))))
+      ;; Put in clone-number.
+      (when clone-number (set-window-clone-number window clone-number))
+      (when splits (set-window-splits window splits))
+      (when nest (set-window-nest window nest))
+      ;; Process parameters.
+      (when parameters
+        (dolist (parameter parameters)
+          (set-window-parameter window (car parameter) (cdr parameter))))
+      ;; Process buffer related state.
+      (when state
+        ;; We don't want to raise an error here so we create a buffer if
+        ;; there's none.
+        (set-window-buffer window (get-buffer-create (car state)))
+        (with-current-buffer (window-buffer window)
+          (set-window-hscroll window (cdr (assq 'hscroll state)))
+          (apply 'set-window-fringes
+                 (cons window (cdr (assq 'fringes state))))
+          (let ((margins (cdr (assq 'margins state))))
+            (set-window-margins window (car margins) (cdr margins)))
+          (let ((scroll-bars (cdr (assq 'scroll-bars state))))
+            (set-window-scroll-bars
+             window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars)))
+          (set-window-vscroll window (cdr (assq 'vscroll state)))
+          ;; Adjust vertically.
+          (if (memq window-size-fixed '(t height))
+              ;; A fixed height window, try to restore the original size.
+              (let ((delta (- (cdr (assq 'total-height item))
+                              (window-total-height window)))
+                    window-size-fixed)
+                (when (window-resizable-p window delta)
+                  (resize-window window delta)))
+            ;; Else check whether the window is not high enough.
+            (let* ((min-size (window-min-size window nil ignore))
+                   (delta (- min-size (window-total-size window))))
+              (when (and (> delta 0)
+                         (window-resizable-p window delta nil ignore))
+                (resize-window window delta nil ignore))))
+          ;; Adjust horizontally.
+          (if (memq window-size-fixed '(t width))
+              ;; A fixed width window, try to restore the original size.
+              (let ((delta (- (cdr (assq 'total-width item))
+                              (window-total-width window)))
+                    window-size-fixed)
+                (when (window-resizable-p window delta)
+                  (resize-window window delta)))
+            ;; Else check whether the window is not wide enough.
+            (let* ((min-size (window-min-size window t ignore))
+                   (delta (- min-size (window-total-size window t))))
+              (when (and (> delta 0)
+                         (window-resizable-p window delta t ignore))
+                (resize-window window delta t ignore))))
+          ;; Set dedicated status.
+          (set-window-dedicated-p window (cdr (assq 'dedicated state)))
+          ;; Install positions (maybe we should do this after all windows
+          ;; have been created and sized).
+          (ignore-errors
+            (set-window-start window (cdr (assq 'start state)))
+            (set-window-point window (cdr (assq 'point state)))
+            ;; I'm not sure whether we should set the mark here, but maybe
+            ;; it can be used.
+            (let ((mark (cdr (assq 'mark state))))
+              (when mark (set-mark mark))))
+          ;; Select window if it's the selected one.
+          (when (cdr (assq 'selected state))
+            (select-window window)))))))
+
+(defun window-state-put (state &optional window ignore)
+  "Put window state STATE into WINDOW.
+STATE should be the state of a window returned by an earlier
+invocation of `window-state-get'.  Optional argument WINDOW must
+specify a live window and defaults to the selected one.
+
+Optional argument IGNORE non-nil means ignore minimum window
+sizes and fixed size restrictions.  IGNORE equal `safe' means
+subwindows can get as small as `window-safe-min-height' and
+`window-safe-min-width'."
+  (setq window (normalize-live-window window))
+  (let* ((frame (window-frame window))
+         (head (car state))
+         ;; We check here (1) whether the total sizes of root window of
+         ;; STATE and that of WINDOW are equal so we can avoid
+         ;; calculating new sizes, and (2) if we do have to resize
+         ;; whether we can do so without violating size restrictions.
+         (totals
+          (and (= (window-total-size window)
+                  (cdr (assq 'total-height state)))
+               (= (window-total-size window t)
+                  (cdr (assq 'total-width state)))))
+         (min-height (cdr (assq 'min-height head)))
+         (min-width (cdr (assq 'min-width head)))
+         window-splits selected)
+    (if (and (not totals)
+             (or (> min-height (window-total-size window))
+                 (> min-width (window-total-size window t)))
+             (or (not ignore)
+                 (and (setq min-height
+                            (cdr (assq 'min-height-ignore head)))
+                      (setq min-width
+                            (cdr (assq 'min-width-ignore head)))
+                      (or (> min-height (window-total-size window))
+                          (> min-width (window-total-size window t)))
+                      (or (not (eq ignore 'safe))
+                          (and (setq min-height
+                                     (cdr (assq 'min-height-safe head)))
+                               (setq min-width
+                                     (cdr (assq 'min-width-safe head)))
+                               (or (> min-height
+                                      (window-total-size window))
+                                   (> min-width
+                                      (window-total-size window t))))))))
+        ;; The check above might not catch all errors due to rounding
+        ;; issues - so IGNORE equal 'safe might not always produce the
+        ;; minimum possible state.  But such configurations hardly make
+        ;; sense anyway.
+        (error "Window %s too small to accomodate state" window)
+      (setq state (cdr state))
+      (setq window-state-put-list nil)
+      ;; Work on the windows of a temporary buffer to make sure that
+      ;; splitting proceeds regardless of any buffer local values of
+      ;; `window-size-fixed'.  Release that buffer after the buffers of
+      ;; all live windows have been set by `window-state-put-2'.
+      (with-temp-buffer
+        (set-window-buffer window (current-buffer))
+        (window-state-put-1 state window nil totals)
+        (window-state-put-2 ignore))
+      (window-check frame))))
 
-
+;;; Displaying buffers.
 (defconst display-buffer-default-specifiers
   '((reuse-window nil same visible)
     (pop-up-window (largest . nil) (lru . nil))
-    (pop-up-frame)
-    (pop-up-frame-alist
-     (height . 24) (width . 80) (unsplittable . t))
+    (pop-up-window-min-height . 40)
+    (pop-up-window-min-width . 80)
+    (reuse-window other nil nil)
     (reuse-window nil other visible)
+    (reuse-window nil nil t)
     (reuse-window-even-sizes . t))
   "Buffer display default specifiers.
 The value specified here is used when no other specifiers have
@@ -3479,12 +3842,11 @@ buffer display specifiers.")
      (reuse-window nil same nil)
      (pop-up-window (largest . nil) (lru . nil))
      (reuse-window nil other nil))
-    (other-window
-     ;; Avoid selected window.
-     (reuse-window other same visible)
-     (pop-up-window (largest . nil) (lru . nil))
-     (pop-up-frame)
-     (reuse-window other other visible))
+    ;; (other-window
+    ;;  ;; Avoid selected window.
+    ;;  (reuse-window other same visible)
+    ;;  (pop-up-window (largest . nil) (lru . nil))
+    ;;  (reuse-window other other visible))
     (same-frame-other-window
      ;; Avoid other frames and selected window.
      (reuse-window other same nil)
@@ -3502,10 +3864,16 @@ buffer display specifiers.")
 
 (defcustom display-buffer-alist
   '((((regexp . ".*"))
-     reuse-window (reuse-window nil same visible)
+     ;; Reuse window showing same buffer on same frame.
+     reuse-window (reuse-window nil same nil)
+     ;; Pop up window.
      pop-up-window
+     ;; Split largest or lru window.
      (pop-up-window (largest . nil) (lru . nil))
-     reuse-window (reuse-window other other nil)
+     (pop-up-window-min-height . 40) ; split-height-threshold / 2
+     (pop-up-window-min-width . 80) ; split-width-threshold / 2
+     ;; Reuse any but selected window on same frame.
+     reuse-window (reuse-window other nil nil)
      (reuse-window-even-sizes . t)))
   "List associating buffer identifiers with display specifiers.
 The car of each element of this list is built from a set of cons
@@ -3766,6 +4134,14 @@ supported:
 
 - t to strongly dedicate the window to the buffer.
 
+A cons cell whose car is `other-window-means-other-frame' and
+whose cdr is non-nil means that you want calls of
+`display-buffer' with the second argument t or the symbol
+`other-window' to display the buffer in another frame.  This
+means, for example, that you prefer functions like
+`find-file-other-window' or `switch-to-buffer-other-window' to
+make a new frame instead of a new window on the selected frame.
+
 Usually, applications are free to override the specifiers of
 `display-buffer-alist' by passing their own specifiers as second
 argument of `display-buffer'.  For every `display-buffer-alist'
@@ -3997,9 +4373,7 @@ using the location specifiers `same-window' or `other-frame'."
         (list
          :tag "Pop-up frame"
          :value (pop-up-frame
-                 (pop-up-frame)
-                 (pop-up-frame-alist
-                  (height . 24) (width . 80) (unsplittable . t)))
+                 (pop-up-frame))
          :format "%t\n%v"
          :inline t
          (const :format "" pop-up-frame)
@@ -4210,6 +4584,15 @@ using the location specifiers `same-window' or `other-frame'."
         :format "%[No other window%] %v\n" :size 15
         (const :tag "Off" :format "%t" nil)
         (const :tag "Ignore" :format "%t" t)))
+      ;; Other window means other frame.
+      (cons
+       :format "%v"
+       (const :format "" other-window-means-other-frame)
+       (choice
+        :help-echo "Whether other window means same or other frame."
+        :format "%[Same or other frame%] %v\n" :size 15
+        (const :tag "Same frame" :format "%t" nil)
+        (const :tag "Other frame" :format "%t" t)))
       ;; Overriding.
       (cons
        :format "%v\n"
@@ -4340,22 +4723,6 @@ documentation of `display-buffer-alist' for a description."
      ((functionp set-width)
       (ignore-errors (funcall set-width window))))))
 
-;; We have to work around the deficiency that the command loop does not
-;; preserve the selected window when it is on a frame that hasn't been
-;; raised or given input focus.  So we have to (1) select the window
-;; used for displaying a buffer and (2) raise its frame if necessary,
-;; thus defeating one primary principle of `display-buffer' namely to
-;; _not_ select the window chosen for displaying the buffer :-(
-(defun display-buffer-select-window (window &optional norecord)
-  "Select WINDOW and raise its frame if necessary."
-  (let ((old-frame (selected-frame))
-        (new-frame (window-frame window)))
-    ;; Select WINDOW _before_ raising the frame to assure that the mouse
-    ;; cursor moves into the correct window.
-    (select-window window norecord)
-    (unless (eq old-frame new-frame)
-      (select-frame-set-input-focus new-frame))))
-
 (defun display-buffer-in-window (buffer window specifiers)
   "Display BUFFER in WINDOW and raise its frame if needed.
 WINDOW must be a live window and defaults to the selected one.
@@ -4376,8 +4743,16 @@ documentation of `display-buffer-alist' for a description."
       (set-window-dedicated-p window dedicated))
     (when no-other-window
       (set-window-parameter window 'no-other-window t))
-    (unless (eq old-frame new-frame)
-      (display-buffer-select-window window))
+    (unless (or (eq old-frame new-frame)
+                (not (frame-visible-p new-frame))
+                ;; Assume the selected frame is already visible enough.
+                (eq new-frame (selected-frame))
+                ;; Assume the frame from which we invoked the minibuffer
+                ;; is visible.
+                (and (minibuffer-window-active-p (selected-window))
+                     (eq new-frame
+                         (window-frame (minibuffer-selected-window)))))
+      (raise-frame new-frame))
     ;; Return window.
     window))
 
@@ -4705,7 +5080,8 @@ non-nil means to make a new frame on graphic displays only.
 
 SPECIFIERS must be a list of buffer display specifiers, see the
 documentation of `display-buffer-alist' for a description."
-  (unless (and graphic-only (not (display-graphic-p)))
+  (unless (or (and graphic-only (not (display-graphic-p)))
+              noninteractive)
     (let* ((selected-window (selected-window))
            (function (or (cdr (assq 'pop-up-frame-function specifiers))
                          'make-frame))
@@ -4906,16 +5282,49 @@ BUFFER-OR-NAME and return that buffer."
             buffer))
     (current-buffer)))
 
-(defun display-buffer-normalize-specifiers-1 (specifiers)
-  "Subroutine of `display-buffer-normalize-specifiers'.
-SPECIFIERS is the SPECIFIERS argument of `display-buffer'."
-  (let (normalized)
+(defun display-buffer-other-window-means-other-frame (buffer-or-name &optional label)
+  "Return non-nil if BUFFER shall be preferably displayed in another frame.
+BUFFER must be a live buffer or the name of a live buffer.
+
+Return nil if BUFFER shall be preferably displayed in another
+window on the selected frame.  Return non-nil if BUFFER shall be
+preferably displayed in a window on any but the selected frame.
+
+Optional argument LABEL is like the same argument of
+`display-buffer'.
+
+The calculation of the return value is exclusively based on the
+user preferences expressed in `display-buffer-alist'."
+  (let* ((buffer (normalize-live-buffer buffer-or-name))
+         (list (display-buffer-normalize-alist (buffer-name buffer) label))
+         (value (assq 'other-window-means-other-frame
+                      (or (car list) (cdr list)))))
+    (when value (cdr value))))
+
+(defun display-buffer-normalize-argument (buffer-name specifiers label other-frame)
+  "Normalize second argument of `display-buffer'.
+BUFFER-NAME is the name of the buffer that shall be displayed,
+SPECIFIERS is the second argument of `display-buffer'.  LABEL the
+same argument of `display-buffer'.  OTHER-FRAME non-nil means use
+other-frame for other-window."
+  (let (normalized entry)
     (cond
+     ((not specifiers)
+      nil)
      ((listp specifiers)
+      ;; If SPECIFIERS is a list, we assume it is a list of specifiers.
       (dolist (specifier specifiers)
         (cond
          ((consp specifier)
           (setq normalized (cons specifier normalized)))
+         ((eq specifier 'other-window)
+          ;; `other-window' must be treated separately.
+          (let ((entry (assq (if other-frame
+                                 'other-frame
+                               'same-frame-other-window)
+                             display-buffer-macro-specifiers)))
+            (dolist (item (cdr entry))
+              (setq normalized (cons item normalized)))))
          ((symbolp specifier)
           ;; Might be a macro specifier, try to expand it (the cdr is a
           ;; list and we have to reverse it later, so do it one at a
@@ -4924,34 +5333,37 @@ SPECIFIERS is the SPECIFIERS argument of `display-buffer'."
             (dolist (item (cdr entry))
               (setq normalized (cons item normalized)))))))
       ;; Reverse list.
-      (setq normalized (nreverse normalized)))
-     ;; The two cases below must come from the SPECIFIERS argument of
-     ;; `display-buffer'.
-     ((eq specifiers 't)
-      ;; Historically t means "other window".  Eventually we should get
-      ;; rid of this.
-      (setq normalized
-            (cdr (assq 'other-window display-buffer-macro-specifiers))
-            normalized))
-     ((symbolp specifiers)
-      ;; We allow scalar specifiers in calls of `display-buffer'.
-      (let ((entry (assq specifiers display-buffer-macro-specifiers)))
-        (when entry (setq normalized (cdr entry))))))
-
-    normalized))
-
-(defun display-buffer-normalize-specifiers-2 (&optional buffer-or-name)
+      (nreverse normalized))
+     ((setq entry (assq specifiers display-buffer-macro-specifiers))
+      ;; A macro specifier.
+      (cdr entry))
+     ((or other-frame (with-no-warnings pop-up-frames))
+      ;; Pop up another frame.
+      (cdr (assq 'other-frame display-buffer-macro-specifiers)))
+     (t
+      ;; In any other case pop up a new window.
+      (cdr (assq 'same-frame-other-window display-buffer-macro-specifiers))))))
+
+(defun display-buffer-normalize-options (buffer-or-name)
   "Subroutine of `display-buffer-normalize-specifiers'.
 BUFFER-OR-NAME is the buffer to display.  This routine provides a
 compatibility layer for the now obsolete Emacs 23 buffer display
 options."
-  (let* ((buffer (normalize-live-buffer buffer-or-name))
-         (buffer-name (buffer-name buffer))
-         specifiers)
-    ;; Disable warnings, there are too many obsolete options here.
-    (with-no-warnings
+  (with-no-warnings
+    (let* ((buffer (normalize-live-buffer buffer-or-name))
+           (buffer-name (buffer-name buffer))
+           (use-pop-up-frames
+            (or (and (eq pop-up-frames 'graphic-only)
+                     (display-graphic-p))
+                pop-up-frames))
+           specifiers)
+      ;; `even-window-heights', unless nil or unset.
+      (unless (memq even-window-heights '(nil unset))
+        (setq specifiers
+              (cons (cons 'reuse-window-even-sizes t) specifiers)))
+
       ;; `display-buffer-mark-dedicated'
-      (unless (memq display-buffer-mark-dedicated '(nil unset))
+      (when display-buffer-mark-dedicated
         (setq specifiers
               (cons (cons 'dedicate display-buffer-mark-dedicated)
                     specifiers)))
@@ -4968,25 +5380,31 @@ options."
             (min-width (if (numberp split-width-threshold)
                            (/ split-width-threshold 2)
                          1.0)))
-        (when pop-up-window
-          ;; `split-height-threshold'
+        ;; Create an entry only if a default value was changed.
+        (when (or pop-up-window
+                  (not (equal split-height-threshold 80))
+                  (not (equal split-width-threshold 160)))
+          ;; `reuse-window' (needed as fallback when popping up the new
+          ;; window fails).
           (setq specifiers
-                (cons (cons 'pop-up-window-min-height min-height)
+                (cons (list 'reuse-window 'other nil nil)
                       specifiers))
           ;; `split-width-threshold'
           (setq specifiers
                 (cons (cons 'pop-up-window-min-width min-width)
                       specifiers))
+          ;; `split-height-threshold'
+          (setq specifiers
+                (cons (cons 'pop-up-window-min-height min-height)
+                      specifiers))
           ;; `pop-up-window'
           (setq specifiers
                 (cons (list 'pop-up-window
                             (cons 'largest fun) (cons 'lru fun))
                       specifiers))))
 
-      ;; `pop-up-frame' group.  Anything is added here iff
-      ;; `pop-up-frames' is neither nil nor unset (we ignore the problem
-      ;; that callers usually don't care about graphic-only).
-      (unless (memq pop-up-frames '(nil unset))
+      ;; `pop-up-frame' group.
+      (when use-pop-up-frames
         ;; `pop-up-frame-function'.  If `pop-up-frame-function' uses the
         ;; now obsolete `pop-up-frame-alist' it will continue to do so.
         (setq specifiers
@@ -4994,165 +5412,90 @@ options."
                     specifiers))
         ;; `pop-up-frame'
         (setq specifiers
-              (cons (list 'pop-up-frame pop-up-frames) specifiers)))
-
-      ;; `special-display-regexps'
-      (dolist (entry special-display-regexps)
-        (cond
-         ((stringp entry)
-          ;; Plain string.
-          (when (string-match-p entry buffer-name)
-            (setq specifiers
-                  (cons
-                   (list 'fun-with-args special-display-function
-                         special-display-frame-alist)
-                   specifiers))))
-         ((consp entry)
-          (let ((name (car entry))
-                (rest (cdr entry)))
-            (cond
-             ((not (string-match-p name buffer-name)))
-             ((functionp (car rest))
-              ;; A function.
-              (setq specifiers
-                    (cons (list 'fun-with-args (car rest) (cadr rest))
-                          specifiers)))
-             ((listp rest)
-              ;; A list of parameters.
-              (cond
-               ((assq 'same-window rest)
-                (setq specifiers
-                      (cons (list 'reuse-window 'same) specifiers))
-                (setq specifiers
-                      (cons (list 'reuse-window-dedicated 'weak)
-                            specifiers)))
-               ((assq 'same-frame rest)
-                (setq specifiers
-                      (setq specifiers
-                            (cons (list 'same-frame) specifiers))))
-               (t
-                (setq specifiers
-                      (cons (list 'fun-with-args special-display-function
-                                  special-display-frame-alist)
-                            specifiers))))))))))
-
-      ;; `special-display-buffer-names'
-      (dolist (entry special-display-buffer-names)
-        (cond
-         ((stringp entry)
-          ;; Plain string.
-          (when (string-equal entry buffer-name)
-            (setq specifiers
-                  (cons
-                   (list 'fun-with-args special-display-function
-                         special-display-frame-alist)
-                   specifiers))))
-         ((consp entry)
-          (let ((name (car entry))
-                (rest (cdr entry)))
-            (cond
-             ((not (string-equal name buffer-name)))
-             ((functionp (car rest))
-              ;; A function.
-              (setq specifiers
-                    (cons (list 'fun-with-args (car rest) (cadr rest))
-                          specifiers)))
-             ((listp rest)
-              ;; A list of parameters.
-              (cond
-               ((assq 'same-window rest)
-                (setq specifiers
-                      (cons (list 'reuse-window 'same) specifiers))
-                (setq specifiers
-                      (cons (list 'reuse-window-dedicated 'weak)
-                            specifiers)))
-               ((assq 'same-frame rest)
-                (setq specifiers
-                      (setq specifiers
-                            (cons (list 'same-frame) specifiers))))
-               (t
-                (setq specifiers
-                      (cons (list 'fun-with-args special-display-function
-                                  special-display-frame-alist)
-                            specifiers))))))))))
-
-      ;; `same-window-regexps'
-      (dolist (entry same-window-regexps)
-        (cond
-         ((stringp entry)
-          (when (string-match-p entry buffer-name)
-            (setq specifiers
-                  (cons (list 'reuse-window 'same) specifiers))))
-         ((consp entry)
-          (when (string-match-p (car entry) buffer-name)
-            (setq specifiers
-                  (cons (list 'reuse-window 'same) specifiers))))))
+              (cons (list 'pop-up-frame t) specifiers)))
 
-      ;; `same-window-buffer-names'
-      (dolist (entry same-window-buffer-names)
-        (cond
-         ((stringp entry)
-          (when (string-equal entry buffer-name)
-            (setq specifiers
-                  (cons (list 'reuse-window 'same) specifiers))))
-         ((consp entry)
-          (when (string-equal (car entry) buffer-name)
-            (setq specifiers
-                  (cons (list 'reuse-window 'same) specifiers))))))
-
-      ;; `pop-up-windows' and `pop-up-frames' nil means means we
-      ;; are supposed to reuse any window (unless we find one showing
-      ;; the same buffer already).
-
-      ;; This clause is needed because Emacs 23 options can be used to
-      ;; suppress a certain behavior while `display-buffer-alist' can be
-      ;; only used to enforce some behavior.
-      (when (and (not pop-up-windows) (memq pop-up-frames '(nil unset)))
-        ;; `even-window-heights'
-        (when even-window-heights
-          (setq specifiers
-                (cons (cons 'reuse-window-even-sizes t) specifiers)))
+      ;; `pop-up-windows' and `use-pop-up-frames' both nil means means
+      ;; we are supposed to reuse any window on the same frame (unless
+      ;; we find one showing the same buffer already).
+      (unless (or pop-up-windows use-pop-up-frames)
         ;; `reuse-window' showing any buffer on same frame.
         (setq specifiers
               (cons (list 'reuse-window nil nil nil)
                     specifiers)))
 
-      ;; `display-buffer-reuse-frames' or `pop-up-frames' set means we
-      ;; are supposed to reuse a window showing the same buffer.
-      (unless (and (memq display-buffer-reuse-frames '(nil unset))
-                   (memq pop-up-frames '(nil unset)))
-        ;; `even-window-heights'
-        (when even-window-heights
+      ;; `special-display-p' group.
+      (when special-display-function
+        ;; `special-display-p' returns either t or a list of frame
+        ;; parameters to pass to `special-display-function'.
+        (let ((pars (special-display-p buffer-name)))
+          (when pars
+            (setq specifiers
+                  (cons (list 'fun-with-args special-display-function
+                              (when (listp pars) pars))
+                        specifiers)))))
+
+      ;; `pop-up-frames', `display-buffer-reuse-frames' means search for
+      ;; a window showing the buffer on some visible or iconfied frame.
+      ;; `last-nonminibuffer-frame' set and not the same frame means
+      ;; search that frame.
+      (let ((frames (or (and (or use-pop-up-frames
+                                 display-buffer-reuse-frames
+                                 (not (last-nonminibuffer-frame)))
+                             ;; All visible or iconfied frames.
+                             0)
+                        ;; Same frame.
+                        (last-nonminibuffer-frame))))
+        (when frames
           (setq specifiers
-                (cons (cons 'reuse-window-even-sizes t) specifiers)))
-        ;; `reuse-window' showing same buffer on visible frame.
+                (cons (list 'reuse-window 'other 'same frames)
+                      specifiers))))
+
+      ;; `same-window-p' group.
+      (when (same-window-p buffer-name)
+        ;; Try to reuse the same (selected) window.
         (setq specifiers
-              (cons (list 'reuse-window nil 'same 0)
+              (cons (list 'reuse-window 'same nil nil)
                     specifiers)))
 
-      specifiers)))
+      ;; Prepend "reuse window on same frame if showing the buffer
+      ;; already" specifier.  It will be overriden by the application
+      ;; supplied 'other-window specifier.
+      (setq specifiers (cons (list 'reuse-window nil 'same nil)
+                             specifiers))
 
-(defun display-buffer-normalize-specifiers (buffer-name specifiers label)
-  "Return normalized specifiers for a buffer matching BUFFER-NAME or LABEL.
-BUFFER-NAME must be a string specifying a valid buffer name.
-SPECIFIERS and LABEL are the homonymous arguments of
-`display-buffer'.
-
-The method for displaying the buffer specified by BUFFER-NAME or
-LABEL is established by appending the following four lists of
-specifiers:
-
-- The specifiers in `display-buffer-alist' whose buffer
-  identifier matches BUFFER-NAME or LABEL and whose 'override
-  component is set.
-
-- SPECIFIERS.
-
-- The specifiers in `display-buffer-alist' whose buffer
-  identifier matches BUFFER-NAME or LABEL and whose 'override
-  component is not set.
+      specifiers)))
 
-- `display-buffer-default-specifiers'."
+(defun display-buffer-normalize-alist-1 (specifiers label)
+  "Subroutine of `display-buffer-normalize-alist'.
+SPECIFIERS is a list of buffer display specfiers.  LABEL is the
+same argument of `display-buffer'."
+  (let (normalized entry)
+    (cond
+     ((not specifiers)
+      nil)
+     ((listp specifiers)
+      ;; If SPECIFIERS is a list, we assume it is a list of specifiers.
+      (dolist (specifier specifiers)
+        (cond
+         ((consp specifier)
+          (setq normalized (cons specifier normalized)))
+         ((symbolp specifier)
+          ;; Might be a macro specifier, try to expand it (the cdr is a
+          ;; list and we have to reverse it later, so do it one at a
+          ;; time).
+          (let ((entry (assq specifier display-buffer-macro-specifiers)))
+            (dolist (item (cdr entry))
+              (setq normalized (cons item normalized)))))))
+      ;; Reverse list.
+      (nreverse normalized))
+     ((setq entry (assq specifiers display-buffer-macro-specifiers))
+      ;; A macro specifier.
+      (cdr entry)))))
+
+(defun display-buffer-normalize-alist (buffer-name label)
+  "Normalize `display-buffer-alist'.
+BUFFER-NAME must be the name of the buffer that shall be displayed.
+LABEL the corresponding argument of `display-buffer'."
   (let (list-1 list-2)
     (dolist (entry display-buffer-alist)
       (when (and (listp entry)
@@ -5167,9 +5510,10 @@ specifiers:
                                         (string-match-p value buffer-name))
                                    (and (eq type 'label) (eq value label)))
                            (throw 'match t)))))))
-        (let* ((raw (cdr entry))
-               (normalized (display-buffer-normalize-specifiers-1 raw)))
-          (if (assq 'override raw)
+        (let* ((specifiers (cdr entry))
+               (normalized
+                (display-buffer-normalize-alist-1 specifiers label)))
+          (if (assq 'override specifiers)
               (setq list-1
                     (if list-1
                         (append list-1 normalized)
@@ -5179,15 +5523,46 @@ specifiers:
                       (append list-2 normalized)
                     normalized))))))
 
+    (cons list-1 list-2)))
+
+(defvar display-buffer-normalize-options-inhibit nil
+  "If non-nil, `display-buffer' doesn't process obsolete options.")
+
+(defun display-buffer-normalize-specifiers (buffer-name specifiers label)
+  "Return normalized specifiers for a buffer matching BUFFER-NAME or LABEL.
+BUFFER-NAME must be a string specifying a valid buffer name.
+SPECIFIERS and LABEL are the homonymous arguments of
+`display-buffer'.
+
+The method for displaying the buffer specified by BUFFER-NAME or
+LABEL is established by appending the following four lists of
+specifiers:
+
+- The specifiers in `display-buffer-alist' whose buffer
+  identifier matches BUFFER-NAME or LABEL and whose 'override
+  component is set.
+
+- SPECIFIERS.
+
+- The specifiers in `display-buffer-alist' whose buffer
+  identifier matches BUFFER-NAME or LABEL and whose 'override
+  component is not set.
+
+- `display-buffer-default-specifiers'."
+  (let* ((list (display-buffer-normalize-alist buffer-name label))
+         (other-frame (assq 'other-window-means-other-frame
+                            (or (car list) (cdr list)))))
     (append
      ;; Overriding user specifiers.
-     list-1
+     (car list)
      ;; Application specifiers.
-     (display-buffer-normalize-specifiers-1 specifiers)
+     (display-buffer-normalize-argument
+      buffer-name specifiers label other-frame)
      ;; Emacs 23 compatibility specifiers.
-     (display-buffer-normalize-specifiers-2 buffer-name)
+     (unless display-buffer-normalize-options-inhibit
+       (display-buffer-normalize-options buffer-name))
      ;; Non-overriding user specifiers.
-     list-2
+     (cdr list)
      ;; Default specifiers.
      display-buffer-default-specifiers)))
 
@@ -5301,8 +5676,8 @@ this list as arguments."
           ;; Try reusing a window not showing BUFFER on any visible or
           ;; iconified frame.
           (display-buffer-reuse-window buffer '(nil other 0))
-          ;; Try making a new frame (but not in batch mode).
-          (and (not noninteractive) (display-buffer-pop-up-frame buffer))
+          ;; Try making a new frame.
+          (display-buffer-pop-up-frame buffer)
           ;; Try using a weakly dedicated window.
           (display-buffer-reuse-window
            buffer '(nil nil t) '((reuse-window-dedicated . weak)))
@@ -5388,11 +5763,21 @@ documentations of `display-buffer' and `display-buffer-alist' for
 additional information."
   (interactive "BPop to buffer:\nP")
   (let ((buffer (normalize-buffer-to-display buffer-or-name))
-        window)
+        (old-window (selected-window))
+        (old-frame (selected-frame))
+        new-window new-frame)
     (set-buffer buffer)
-    (when (setq window (display-buffer buffer specifiers label))
-      (select-window window norecord)
-      buffer)))
+    (setq new-window (display-buffer buffer specifiers label))
+    (unless (eq new-window old-window)
+      ;; `display-buffer' has chosen another window, select it.
+      (select-window new-window norecord)
+      (setq new-frame (window-frame new-window))
+      (unless (eq new-frame old-frame)
+        ;; `display-buffer' has chosen another frame, make sure it gets
+        ;; input focus and is risen.
+        (select-frame-set-input-focus new-frame)))
+
+    buffer))
 
 (defsubst pop-to-buffer-same-window (&optional buffer-or-name norecord label)
   "Pop to buffer specified by BUFFER-OR-NAME in the selected window.
@@ -5513,8 +5898,8 @@ functions should call `pop-to-buffer-same-window' instead."
 (defun switch-to-buffer-same-frame (buffer-or-name &optional norecord)
   "Switch to buffer BUFFER-OR-NAME in a window on the selected frame.
 Another frame will be used only if there is no other choice.
-Optional arguments BUFFER-OR-NAME and NORECORD have the same
-meaning as for `switch-to-buffer'.
+Arguments BUFFER-OR-NAME and NORECORD have the same meaning as
+for `switch-to-buffer'.
 
 This function is intended for interactive use only.  Lisp
 functions should call `pop-to-buffer-same-frame' instead."
@@ -5527,8 +5912,8 @@ functions should call `pop-to-buffer-same-frame' instead."
   "Switch to buffer BUFFER-OR-NAME in another window.
 The selected window will be used only if there is no other
 choice.  Windows on the selected frame are preferred to windows
-on other frames.  Optional arguments BUFFER-OR-NAME and NORECORD
-have the same meaning as for `switch-to-buffer'.
+on other frames.  Arguments BUFFER-OR-NAME and NORECORD have the
+same meaning as for `switch-to-buffer'.
 
 This function is intended for interactive use only.  Lisp
 functions should call `pop-to-buffer-other-window' instead."
@@ -5540,8 +5925,8 @@ functions should call `pop-to-buffer-other-window' instead."
 (defun switch-to-buffer-other-window-same-frame (buffer-or-name &optional norecord)
   "Switch to buffer BUFFER-OR-NAME in another window on the selected frame.
 The selected window or another frame will be used only if there
-is no other choice.  Optional arguments BUFFER-OR-NAME and
-NORECORD have the same meaning as for `switch-to-buffer'.
+is no other choice.  Arguments BUFFER-OR-NAME and NORECORD have
+the same meaning as for `switch-to-buffer'.
 
 This function is intended for interactive use only.  Lisp
 functions should call `pop-to-buffer-other-window-same-frame'
@@ -5554,8 +5939,8 @@ instead."
 (defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
   "Switch to buffer BUFFER-OR-NAME on another frame.
 The same frame will be used only if there is no other choice.
-Optional arguments BUFFER-OR-NAME and NORECORD have the same
-meaning as for `switch-to-buffer'.
+Arguments BUFFER-OR-NAME and NORECORD have the same meaning
+as for `switch-to-buffer'.
 
 This function is intended for interactive use only.  Lisp
 functions should call `pop-to-buffer-other-frame' instead."
@@ -5607,8 +5992,8 @@ This function returns non-nil if `display-buffer' or
 `pop-to-buffer' would show a buffer named BUFFER-NAME in the
 selected rather than \(as usual\) some other window.  See
 `same-window-buffer-names' and `same-window-regexps'."
-  (let ((buffer-names (with-no-warnings special-display-buffer-names))
-        (regexps (with-no-warnings special-display-regexps)))
+  (let ((buffer-names (with-no-warnings same-window-buffer-names))
+        (regexps (with-no-warnings same-window-regexps)))
     (cond
      ((not (stringp buffer-name)))
      ;; The elements of `same-window-buffer-names' can be buffer
@@ -5674,7 +6059,7 @@ and (cdr ARGS) as second."
        ;; Reuse the current window if the user requested it.
        (when (cdr (assq 'same-window args))
          (display-buffer-reuse-window
-          buffer '(same nil nil) '((reuse-dedicated . 'weak))))
+          buffer '(same nil nil) '((reuse-dedicated . weak))))
        ;; Stay on the same frame if requested.
        (when (or (cdr (assq 'same-frame args))
                  (cdr (assq 'same-window args)))
@@ -5916,32 +6301,28 @@ frame.  The default value calls `make-frame' with the argument
  'pop-up-frame-function
  "use 2nd arg of `display-buffer' instead." "24.1")
 
-(defcustom pop-up-frames 'unset ; nil
+(defcustom pop-up-frames nil
   "Whether `display-buffer' should make a separate frame.
 If nil, never make a separate frame.
 If the value is `graphic-only', make a separate frame
 on graphic displays only.
-If this is the symbol unset, the option was not set and is
-ignored.
 Any other non-nil value means always make a separate frame."
   :type '(choice
-          (const :tag "Unset" unset)
           (const :tag "Never" nil)
           (const :tag "On graphic displays only" graphic-only)
           (const :tag "Always" t))
-  :version "24.1"
   :group 'windows
   :group 'frames)
 (make-obsolete-variable
  'pop-up-frames
  "use 2nd arg of `display-buffer' instead." "24.1")
 
-(defcustom display-buffer-reuse-frames 'unset ; nil
+(defcustom display-buffer-reuse-frames nil
   "Set and non-nil means `display-buffer' should reuse frames.
 If the buffer in question is already displayed in a frame, raise
 that frame."
   :type 'boolean
-  :version "24.1"
+  :version "21.1"
   :group 'windows
   :group 'frames)
 (make-obsolete-variable
@@ -6012,20 +6393,20 @@ is nil, `display-buffer' cannot split windows horizontally."
  'split-width-threshold
  "use 2nd arg of `display-buffer' instead." "24.1")
 
-(defcustom even-window-heights t
-  "If non-nil `display-buffer' will try to even window heights.
+(defcustom even-window-heights 'unset ; t
+  "If set and non-nil `display-buffer' will try to even window heights.
 Otherwise `display-buffer' will leave the window configuration
 alone.  Heights are evened only when `display-buffer' reuses a
 window that appears above or below the selected window."
   :type 'boolean
-  :version "23.1"
+  :version "24.1"
   :group 'windows)
 (make-obsolete-variable
  'even-window-heights
  "use 2nd arg of `display-buffer' instead." "24.1")
 
-(defvar display-buffer-mark-dedicated 'unset ; nil
-  "Set and non-nil means `display-buffer' marks the windows it creates as dedicated.
+(defvar display-buffer-mark-dedicated nil
+  "Non-nil means `display-buffer' marks the windows it creates as dedicated.
 The actual non-nil value of this variable will be copied to the
 `window-dedicated-p' flag.")
 (make-obsolete-variable
@@ -6202,7 +6583,7 @@ value of `display-buffer-alist'."
      nil
      (list
       'pop-up-frame
-      (unless (memq pop-up-frames '(nil unset))
+      (when pop-up-frames
         (list 'pop-up-frame pop-up-frames))
       (when pop-up-frame-function
         (cons 'pop-up-frame-function pop-up-frame-function))
@@ -6338,17 +6719,16 @@ value of `display-buffer-alist'."
      (list
       'reuse-window
       (list 'reuse-window nil 'same
-            (unless (and (memq display-buffer-reuse-frames '(nil unset))
-                         (memq pop-up-frames '(nil unset)))
+            (when (or display-buffer-reuse-frames pop-up-frames)
               ;; "0" (all visible and iconified frames) is hardcoded in
               ;; Emacs 23.
                 0))
-      (when even-window-heights
+      (unless (memq even-window-heights '(nil unset))
         (cons 'reuse-window-even-sizes t)))
      no-custom)
 
     ;; `display-buffer-mark-dedicated'
-    (unless (memq display-buffer-mark-dedicated '(nil unset))
+    (when display-buffer-mark-dedicated
       (display-buffer-alist-add
        nil
        (list
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 1c6af1f45f2..04b759a8116 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -433,6 +433,18 @@ otherwise return the frame coordinates."
 (declare-function x-get-selection-internal "xselect.c"
                   (selection-symbol target-type &optional time-stamp))
 
+(defun x-dnd-version-from-flags (flags)
+  "Return the version byte from the 32 bit FLAGS in an XDndEnter message"
+  (if (consp flags)   ;; Long as cons
+      (ash (car flags) -8)
+    (ash flags -24))) ;; Ordinary number
+
+(defun x-dnd-more-than-3-from-flags (flags)
+  "Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message"
+  (if (consp flags)
+      (logand (cdr flags) 1)
+    (logand flags 1)))
+      
 (defun x-dnd-handle-xdnd (event frame window message _format data)
   "Receive one XDND event (client message) and send the appropriate reply.
 EVENT is the client message.  FRAME is where the mouse is now.
@@ -440,9 +452,10 @@ WINDOW is the window within FRAME where the mouse is now.
 FORMAT is 32 (not used).  MESSAGE is the data part of an XClientMessageEvent."
   (cond ((equal "XdndEnter" message)
          (let* ((flags (aref data 1))
-                (version (and (consp flags) (ash (car flags) -8)))
-                (more-than-3 (and (consp flags) (cdr flags)))
+                (version (x-dnd-version-from-flags flags))
+                (more-than-3 (x-dnd-more-than-3-from-flags flags))
                 (dnd-source (aref data 0)))
+        (message "%s %s" version  more-than-3)
            (if version  ;; If flags is bad, version will be nil.
                (x-dnd-save-state
                 window nil nil