merge from upstream

21 files changed, 933 insertions, 565 deletions

diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 9b24ac7a1f4..742bcf726eb 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -951,7 +951,7 @@ group.  The string matched by the first group is highlighted with
       (3 antlr-keyword-face)
       (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
              antlr-keyword-face
-           type-face)))
+           font-lock-type-face)))
      (,(lambda (limit)
          (antlr-re-search-forward
           "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e389007065a..18010407eda 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -5449,49 +5449,47 @@ comment at the start of cc-engine.el for more info."
       (forward-char)
 
       (unless (looking-at c-<-op-cont-regexp)
-                (while (and
+        (while (and
                 (progn
-                      (c-forward-syntactic-ws)
-                 (let ((orig-record-found-types c-record-found-types))
-                   (when (or (and c-record-type-identifiers all-types)
-                             (c-major-mode-is 'java-mode))
-                     ;; All encountered identifiers are types, so set the
-                     ;; promote flag and parse the type.
-                     (progn
-                       (c-forward-syntactic-ws)
-                       (if (looking-at "\\?")
-                           (forward-char)
-                         (when (looking-at c-identifier-start)
-                           (let ((c-promote-possible-types t)
-                                 (c-record-found-types t))
-                             (c-forward-type))))
+                  (c-forward-syntactic-ws)
+                  (let ((orig-record-found-types c-record-found-types))
+                    (when (or (and c-record-type-identifiers all-types)
+                              (c-major-mode-is 'java-mode))
+                      ;; All encountered identifiers are types, so set the
+                      ;; promote flag and parse the type.
+                      (progn
+                        (c-forward-syntactic-ws)
+                        (if (looking-at "\\?")
+                            (forward-char)
+                          (when (looking-at c-identifier-start)
+                            (let ((c-promote-possible-types t)
+                                  (c-record-found-types t))
+                              (c-forward-type))))
 
-                     (c-forward-syntactic-ws)
+                        (c-forward-syntactic-ws)
 
-                     (when (or (looking-at "extends")
-                               (looking-at "super"))
-                       (forward-word)
-                       (c-forward-syntactic-ws)
-                       (let ((c-promote-possible-types t)
-                            (c-record-found-types t))
-                         (c-forward-type)
-                         (c-forward-syntactic-ws))))))
-
-                      (setq pos (point))
-
-                      (or
-                       ;; Note: These regexps exploit the match order in \| so
-                       ;; that "<>" is matched by "<" rather than "[^>:-]>".
-                       (c-syntactic-re-search-forward
-                        ;; Stop on ',', '|', '&', '+' and '-' to catch
-                        ;; common binary operators that could be between
-                        ;; two comparison expressions "a<b" and "c>d".
-                        "[<;{},|+&-]\\|[>)]"
-                        nil t t)
-                       t))
+                        (when (or (looking-at "extends")
+                                  (looking-at "super"))
+                          (forward-word)
+                          (c-forward-syntactic-ws)
+                          (let ((c-promote-possible-types t)
+                                (c-record-found-types t))
+                            (c-forward-type)
+                            (c-forward-syntactic-ws))))))
 
-                    (cond
-                     ((eq (char-before) ?>)
+                  (setq pos (point))
+
+                  ;; Note: These regexps exploit the match order in \| so
+                  ;; that "<>" is matched by "<" rather than "[^>:-]>".
+                  (c-syntactic-re-search-forward
+                   ;; Stop on ',', '|', '&', '+' and '-' to catch
+                   ;; common binary operators that could be between
+                   ;; two comparison expressions "a<b" and "c>d".
+                   "[<;{},|+&-]\\|[>)]"
+                   nil t t))
+
+                (cond
+                 ((eq (char-before) ?>)
                   ;; Either an operator starting with '>' or the end of
                   ;; the angle bracket arglist.
 
@@ -5532,14 +5530,14 @@ comment at the start of cc-engine.el for more info."
                               (when (or (setq keyword-match
                                               (looking-at c-opt-<>-sexp-key))
                                         (not (looking-at c-keywords-regexp)))
-                                    (setq id-start (point))))
-
-                                (setq subres
-                                      (let ((c-promote-possible-types t)
-                                            (c-record-found-types t))
-                                        (c-forward-<>-arglist-recur
-                                         (and keyword-match
-                                              (c-keyword-member
+                                (setq id-start (point))))
+
+                            (setq subres
+                                  (let ((c-promote-possible-types t)
+                                        (c-record-found-types t))
+                                    (c-forward-<>-arglist-recur
+                                     (and keyword-match
+                                          (c-keyword-member
                                            (c-keyword-sym (match-string 1))
                                            'c-<>-type-kwds)))))
                             )))
@@ -5560,16 +5558,16 @@ comment at the start of cc-engine.el for more info."
                                    (c-forward-syntactic-ws)
                                    (looking-at c-opt-identifier-concat-key)))
                             (c-record-ref-id (cons id-start id-end))
-                              (c-record-type-id (cons id-start id-end))))))
-                      t)
-
-                ((and (not c-restricted-<>-arglists)
-                      (or (and (eq (char-before) ?&)
-                               (not (eq (char-after) ?&)))
-                          (eq (char-before) ?,)))
-                      ;; Just another argument.  Record the position.  The
-                      ;; type check stuff that made us stop at it is at
-                      ;; the top of the loop.
+                          (c-record-type-id (cons id-start id-end))))))
+                  t)
+
+                 ((and (not c-restricted-<>-arglists)
+                       (or (and (eq (char-before) ?&)
+                                (not (eq (char-after) ?&)))
+                           (eq (char-before) ?,)))
+                  ;; Just another argument.      Record the position.  The
+                  ;; type check stuff that made us stop at it is at
+                  ;; the top of the loop.
                   (setq arg-start-pos (cons (point) arg-start-pos)))
 
                  (t
@@ -5648,17 +5646,23 @@ comment at the start of cc-engine.el for more info."
 
 (defun c-forward-name ()
   ;; Move forward over a complete name if at the beginning of one,
-  ;; stopping at the next following token.  If the point is not at
-  ;; something that are recognized as name then it stays put.  A name
-  ;; could be something as simple as "foo" in C or something as
+  ;; stopping at the next following token.  A keyword, as such,
+  ;; doesn't count as a name.  If the point is not at something that
+  ;; is recognized as a name then it stays put.
+  ;;
+  ;; A name could be something as simple as "foo" in C or something as
   ;; complex as "X<Y<class A<int>::B, BIT_MAX >> b>, ::operator<> ::
   ;; Z<(a>b)> :: operator const X<&foo>::T Q::G<unsigned short
   ;; int>::*volatile const" in C++ (this function is actually little
   ;; more than a `looking-at' call in all modes except those that,
-  ;; like C++, have `c-recognize-<>-arglists' set).  Return nil if no
-  ;; name is found, 'template if it's an identifier ending with an
-  ;; angle bracket arglist, 'operator of it's an operator identifier,
-  ;; or t if it's some other kind of name.
+  ;; like C++, have `c-recognize-<>-arglists' set).
+  ;;
+  ;; Return
+  ;; o - nil if no name is found;
+  ;; o - 'template if it's an identifier ending with an angle bracket
+  ;;   arglist;
+  ;; o - 'operator of it's an operator identifier;
+  ;; o - t if it's some other kind of name.
   ;;
   ;; This function records identifier ranges on
   ;; `c-record-type-identifiers' and `c-record-ref-identifiers' if
@@ -5810,16 +5814,28 @@ comment at the start of cc-engine.el for more info."
     (goto-char pos)
     res))
 
-(defun c-forward-type ()
+(defun c-forward-type (&optional brace-block-too)
   ;; Move forward over a type spec if at the beginning of one,
-  ;; stopping at the next following token.  Return t if it's a known
-  ;; type that can't be a name or other expression, 'known if it's an
-  ;; otherwise known type (according to `*-font-lock-extra-types'),
-  ;; 'prefix if it's a known prefix of a type, 'found if it's a type
-  ;; that matches one in `c-found-types', 'maybe if it's an identfier
-  ;; that might be a type, or nil if it can't be a type (the point
-  ;; isn't moved then).  The point is assumed to be at the beginning
-  ;; of a token.
+  ;; stopping at the next following token.  The keyword "typedef"
+  ;; isn't part of a type spec here.
+  ;;
+  ;; BRACE-BLOCK-TOO, when non-nil, means move over the brace block in
+  ;; constructs like "struct foo {...} bar ;" or "struct {...} bar;".
+  ;; The current (2009-03-10) intention is to convert all uses of
+  ;; `c-forward-type' to call with this parameter set, then to
+  ;; eliminate it.
+  ;;
+  ;; Return
+  ;;   o - t if it's a known type that can't be a name or other
+  ;;     expression;
+  ;;   o - 'known if it's an otherwise known type (according to
+  ;;     `*-font-lock-extra-types');
+  ;;   o - 'prefix if it's a known prefix of a type;
+  ;;   o - 'found if it's a type that matches one in `c-found-types';
+  ;;   o - 'maybe if it's an identfier that might be a type; or
+  ;;   o -  nil if it can't be a type (the point isn't moved then).
+  ;;
+  ;; The point is assumed to be at the beginning of a token.
   ;;
   ;; Note that this function doesn't skip past the brace definition
   ;; that might be considered part of the type, e.g.
@@ -5838,32 +5854,39 @@ comment at the start of cc-engine.el for more info."
 
     ;; Skip leading type modifiers.  If any are found we know it's a
     ;; prefix of a type.
-    (when c-opt-type-modifier-key
+    (when c-opt-type-modifier-key ; e.g. "const" "volatile", but NOT "typedef"
       (while (looking-at c-opt-type-modifier-key)
         (goto-char (match-end 1))
         (c-forward-syntactic-ws)
         (setq res 'prefix)))
 
     (cond
-     ((looking-at c-type-prefix-key)
-      ;; Looking at a keyword that prefixes a type identifier,
-      ;; e.g. "class".
+     ((looking-at c-type-prefix-key) ; e.g. "struct", "class", but NOT
+                                     ; "typedef".
       (goto-char (match-end 1))
       (c-forward-syntactic-ws)
       (setq pos (point))
-      (if (memq (setq name-res (c-forward-name)) '(t template))
-          (progn
-            (when (eq name-res t)
-              ;; In many languages the name can be used without the
-              ;; prefix, so we add it to `c-found-types'.
-              (c-add-type pos (point))
-              (when (and c-record-type-identifiers
-                         c-last-identifier-range)
-                (c-record-type-id c-last-identifier-range)))
-            (setq res t))
-        ;; Invalid syntax.
-        (goto-char start)
-        (setq res nil)))
+
+      (setq name-res (c-forward-name))
+      (setq res (not (null name-res)))
+      (when (eq name-res t)
+        ;; In many languages the name can be used without the
+        ;; prefix, so we add it to `c-found-types'.
+        (c-add-type pos (point))
+        (when (and c-record-type-identifiers
+                   c-last-identifier-range)
+          (c-record-type-id c-last-identifier-range)))
+      (when (and brace-block-too
+                 (memq res '(t nil))
+                 (eq (char-after) ?\{)
+                 (save-excursion
+                   (c-safe
+                     (progn (c-forward-sexp)
+                            (c-forward-syntactic-ws)
+                            (setq pos (point))))))
+        (goto-char pos)
+        (setq res t))
+      (unless res (goto-char start)))   ; invalid syntax
 
      ((progn
         (setq pos nil)
@@ -5953,14 +5976,13 @@ comment at the start of cc-engine.el for more info."
              (setq res nil)))))
 
     (when res
-      ;; Skip trailing type modifiers.  If any are found we know it's
+      ;; Skip trailing type modifiers.  If any are found we know it's
       ;; a type.
       (when c-opt-type-modifier-key
-        (while (looking-at c-opt-type-modifier-key)
+        (while (looking-at c-opt-type-modifier-key) ; e.g. "const", "volatile"
           (goto-char (match-end 1))
           (c-forward-syntactic-ws)
           (setq res t)))
-
       ;; Step over any type suffix operator.  Do not let the existence
       ;; of these alter the classification of the found type, since
       ;; these operators typically are allowed in normal expressions
@@ -5970,7 +5992,7 @@ comment at the start of cc-engine.el for more info."
           (goto-char (match-end 1))
           (c-forward-syntactic-ws)))
 
-      (when c-opt-type-concat-key
+      (when c-opt-type-concat-key       ; Only/mainly for pike.
         ;; Look for a trailing operator that concatenates the type
         ;; with a following one, and if so step past that one through
         ;; a recursive call.  Note that we don't record concatenated
@@ -6121,11 +6143,15 @@ comment at the start of cc-engine.el for more info."
   ;;      car ^                                     ^ point
   ;;     Foo::Foo (int b) : Base (b) {}
   ;; car ^                ^ point
-  ;;
-  ;;   The cdr of the return value is non-nil iff a `c-typedef-decl-kwds'
-  ;;   specifier (e.g. class, struct, enum, typedef) is found in the
-  ;;   declaration, i.e. the declared identifier(s) are types.
-  ;;
+  ;; 
+  ;;   The cdr of the return value is non-nil when a
+  ;;   `c-typedef-decl-kwds' specifier is found in the declaration.
+  ;;   Specifically it is a dotted pair (A . B) where B is t when a
+  ;;   `c-typedef-kwds' ("typedef") is present, and A is t when some
+  ;;   other `c-typedef-decl-kwds' (e.g. class, struct, enum)
+  ;;   specifier is present.  I.e., (some of) the declared
+  ;;   identifier(s) are types.
+  ;; 
   ;; If a cast is parsed:
   ;;
   ;;   The point is left at the first token after the closing paren of
@@ -6183,9 +6209,11 @@ comment at the start of cc-engine.el for more info."
         ;; If `backup-at-type' is nil then the other variables have
         ;; undefined values.
         backup-at-type backup-type-start backup-id-start
-        ;; Set if we've found a specifier that makes the defined
-        ;; identifier(s) types.
+        ;; Set if we've found a specifier (apart from "typedef") that makes
+        ;; the defined identifier(s) types.
         at-type-decl
+        ;; Set if we've a "typedef" keyword.
+        at-typedef
         ;; Set if we've found a specifier that can start a declaration
         ;; where there's no type.
         maybe-typeless
@@ -6225,12 +6253,14 @@ comment at the start of cc-engine.el for more info."
 
           ;; Look for a specifier keyword clause.
           (when (looking-at c-prefix-spec-kwds-re)
+            (if (looking-at c-typedef-key)
+                (setq at-typedef t))
             (setq kwd-sym (c-keyword-sym (match-string 1)))
             (save-excursion
               (c-forward-keyword-clause 1)
               (setq kwd-clause-end (point))))
 
-          (when (setq found-type (c-forward-type))
+          (when (setq found-type (c-forward-type t)) ; brace-block-too
             ;; Found a known or possible type or a prefix of a known type.
 
             (when at-type
@@ -6295,6 +6325,8 @@ comment at the start of cc-engine.el for more info."
                           (setq backup-maybe-typeless t)))
 
                     (when (c-keyword-member kwd-sym 'c-typedef-decl-kwds)
+                      ;; This test only happens after we've scanned a type.
+                      ;; So, with valid syntax, kwd-sym can't be 'typedef.
                       (setq at-type-decl t))
                     (when (c-keyword-member kwd-sym 'c-typeless-decl-kwds)
                       (setq maybe-typeless t))
@@ -6894,7 +6926,9 @@ comment at the start of cc-engine.el for more info."
             (goto-char type-start)
             (c-forward-type))))
 
-      (cons id-start at-type-decl))
+      (cons id-start
+            (and (or at-type-decl at-typedef)
+                 (cons at-type-decl at-typedef))))
 
      (t
       ;; False alarm.  Restore the recorded ranges.
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 72703b9a5e4..a99876a6bfc 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -289,7 +289,7 @@
     ;; bit of the overhead compared to a real matcher.  The main reason
     ;; is however to pass the real search limit to the anchored
     ;; matcher(s), since most (if not all) font-lock implementations
-    ;; arbitrarily limits anchored matchers to the same line, and also
+    ;; arbitrarily limit anchored matchers to the same line, and also
     ;; to insulate against various other irritating differences between
     ;; the different (X)Emacs font-lock packages.
     ;;
@@ -310,7 +310,7 @@
     ;; covered by the font-lock context.)
 
     ;; Note: Replace `byte-compile' with `eval' to debug the generated
-    ;; lambda easier.
+    ;; lambda more easily.
     (byte-compile
      `(lambda (limit)
         (let (;; The font-lock package in Emacs is known to clobber
@@ -721,16 +721,26 @@ casts and declarations are fontified.  Used on level 2 and higher."
 
   ;; Clear the list of found types if we start from the start of the
   ;; buffer, to make it easier to get rid of misspelled types and
-  ;; variables that has gotten recognized as types in malformed code.
+  ;; variables that have gotten recognized as types in malformed code.
   (when (bobp)
     (c-clear-found-types))
 
-  ;; Clear the c-type char properties in the region to recalculate
-  ;; them properly. This is necessary e.g. to handle constructs that
-  ;; might been required as declarations temporarily during editing.
-  ;; The interesting properties are anyway those put on the closest
-  ;; token before the region.
-  (c-clear-char-properties (point) limit 'c-type)
+  ;; Clear the c-type char properties which mark the region, to recalculate
+  ;; them properly.  The most interesting properties are those put on the
+  ;; closest token before the region.
+  (save-excursion
+    (let ((pos (point)))
+      (c-backward-syntactic-ws)
+      (c-clear-char-properties
+       (if (and (not (bobp))
+                (memq (c-get-char-property (1- (point)) 'c-type)
+                      '(c-decl-arg-start
+                        c-decl-end
+                        c-decl-id-start
+                        c-decl-type-start)))
+           (1- (point))
+         pos)
+       limit 'c-type)))
 
   ;; Update `c-state-cache' to the beginning of the region.  This will
   ;; make `c-beginning-of-syntax' go faster when it's used later on,
@@ -739,6 +749,8 @@ casts and declarations are fontified.  Used on level 2 and higher."
 
   ;; Check if the fontified region starts inside a declarator list so
   ;; that `c-font-lock-declarators' should be called at the start.
+  ;; The declared identifiers are font-locked correctly as types, if
+  ;; that is what they are.
   (let ((prop (save-excursion
                 (c-backward-syntactic-ws)
                 (unless (bobp)
@@ -831,12 +843,19 @@ casts and declarations are fontified.  Used on level 2 and higher."
   nil)
 
 (defun c-font-lock-declarators (limit list types)
-  ;; Assuming the point is at the start of a declarator in a
-  ;; declaration, fontify it.  If LIST is non-nil, fontify also all
-  ;; following declarators in a comma separated list (e.g.  "foo" and
-  ;; "bar" in "int foo = 17, bar;").  Stop at LIMIT.  If TYPES is
-  ;; non-nil, fontify all identifiers as types.  Nil is always
-  ;; returned.
+  ;; Assuming the point is at the start of a declarator in a declaration,
+  ;; fontify the identifier it declares.  (If TYPES is set, it does this via
+  ;; the macro `c-fontify-types-and-refs'.)
+  ;;
+  ;; If LIST is non-nil, also fontify the ids in any following declarators in
+  ;; a comma separated list (e.g.  "foo" and "*bar" in "int foo = 17, *bar;");
+  ;; additionally, mark the commas with c-type property 'c-decl-id-start or
+  ;; 'c-decl-type-start (according to TYPES).  Stop at LIMIT.
+  ;;
+  ;; If TYPES is non-nil, fontify all identifiers as types.
+  ;;
+  ;; Nil is always returned.  The function leaves point at the delimiter after
+  ;; the last declarator it processes.
   ;;
   ;; This function might do hidden buffer changes.
 
@@ -848,18 +867,31 @@ casts and declarations are fontified.  Used on level 2 and higher."
        c-last-identifier-range
        (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)))
 
-    (while (and
+    ;; The following `while' fontifies a single declarator id each time round.
+    ;; It loops only when LIST is non-nil.
+    (while
+        ;; Inside the following "condition form", we move forward over the
+        ;; declarator's identifier up as far as any opening bracket (for array
+        ;; size) or paren (for parameters of function-type) or brace (for
+        ;; array/struct initialisation) or "=" or terminating delimiter
+        ;; (e.g. "," or ";" or "}").
+        (and
             pos
             (< (point) limit)
 
+            ;; The following form moves forward over the declarator's
+            ;; identifier (and what precedes it), returning t.  If there
+            ;; wasn't one, it returns nil, terminating the `while'.
             (let (got-identifier)
               (setq paren-depth 0)
-              ;; Skip over type decl prefix operators.  (Note similar
-              ;; code in `c-forward-decl-or-cast-1'.)
+              ;; Skip over type decl prefix operators, one for each iteration
+              ;; of the while.  These are, e.g. "*" in "int *foo" or "(" and
+              ;; "*" in "int (*foo) (void)" (Note similar code in
+              ;; `c-forward-decl-or-cast-1'.)
               (while (and (looking-at c-type-decl-prefix-key)
                           (if (and (c-major-mode-is 'c++-mode)
-                                   (match-beginning 2))
-                              ;; If the second submatch matches in C++ then
+                                   (match-beginning 3))
+                              ;; If the third submatch matches in C++ then
                               ;; we're looking at an identifier that's a
                               ;; prefix only if it specifies a member pointer.
                               (progn
@@ -882,7 +914,7 @@ casts and declarations are fontified.  Used on level 2 and higher."
                   (goto-char (match-end 1)))
                 (c-forward-syntactic-ws))
 
-              ;; If we didn't pass the identifier above already, do it now.
+              ;; If we haven't passed the identifier already, do it now.
               (unless got-identifier
                 (setq id-start (point))
                 (c-forward-name))
@@ -890,12 +922,14 @@ casts and declarations are fontified.  Used on level 2 and higher."
 
               (/= id-end pos))
 
-            ;; Skip out of the parens surrounding the identifier.
+            ;; Skip out of the parens surrounding the identifier.  If closing
+            ;; parens are missing, this form returns nil.
             (or (= paren-depth 0)
                 (c-safe (goto-char (scan-lists (point) 1 paren-depth))))
 
             (<= (point) limit)
 
+            ;; Skip over any trailing bit, such as "__attribute__".
             (progn
               (when (looking-at c-decl-hangon-key)
                 (c-forward-keyword-clause 1))
@@ -936,7 +970,7 @@ casts and declarations are fontified.  Used on level 2 and higher."
                                 id-face)))
 
       (goto-char next-pos)
-      (setq pos nil)
+      (setq pos nil)          ; So as to terminate the enclosing `while' form.
       (when list
         ;; Jump past any initializer or function prototype to see if
         ;; there's a ',' to continue at.
@@ -944,11 +978,11 @@ casts and declarations are fontified.  Used on level 2 and higher."
         (cond ((eq id-face 'font-lock-function-name-face)
                ;; Skip a parenthesized initializer (C++) or a function
                ;; prototype.
-               (if (c-safe (c-forward-sexp 1) t)
+               (if (c-safe (c-forward-sexp 1) t) ; over the parameter list.
                    (c-forward-syntactic-ws limit)
-                 (goto-char limit)))
+                 (goto-char limit)))    ; unbalanced parens
 
-              (got-init
+              (got-init ; "=" sign OR opening "(", "[", or "{"
                ;; Skip an initializer expression.  If we're at a '='
                ;; then accept a brace list directly after it to cope
                ;; with array initializers.  Otherwise stop at braces
@@ -956,7 +990,7 @@ casts and declarations are fontified.  Used on level 2 and higher."
                (and (if (and (eq got-init ?=)
                              (= (c-forward-token-2 1 nil limit) 0)
                              (looking-at "{"))
-                        (c-safe (c-forward-sexp) t)
+                        (c-safe (c-forward-sexp) t) ; over { .... }
                       t)
                     ;; FIXME: Should look for c-decl-end markers here;
                     ;; we might go far into the following declarations
@@ -971,7 +1005,7 @@ casts and declarations are fontified.  Used on level 2 and higher."
           (c-put-char-property (point) 'c-type separator-prop)
           (forward-char)
           (c-forward-syntactic-ws limit)
-          (setq pos (point))))))
+          (setq pos (point))))))     ; acts to make the `while' form continue.
   nil)
 
 (defconst c-font-lock-maybe-decl-faces
@@ -984,27 +1018,29 @@ casts and declarations are fontified.  Used on level 2 and higher."
         font-lock-keyword-face))
 
 (defun c-font-lock-declarations (limit)
+  ;; Fontify all the declarations, casts and labels from the point to LIMIT.
+  ;; Assumes that strings and comments have been fontified already.
+  ;;
   ;; This function will be called from font-lock for a region bounded by POINT
   ;; and LIMIT, as though it were to identify a keyword for
   ;; font-lock-keyword-face.  It always returns NIL to inhibit this and
   ;; prevent a repeat invocation.  See elisp/lispref page "Search-based
   ;; Fontification".
   ;;
-  ;; Fontify all the declarations, casts and labels from the point to LIMIT.
-  ;; Assumes that strings and comments have been fontified already.
-  ;;
   ;; This function might do hidden buffer changes.
 
   ;;(message "c-font-lock-declarations search from %s to %s" (point) limit)
 
   (save-restriction
-    (let (;; The position where `c-find-decl-spots' stopped.
+    (let (;; The position where `c-find-decl-spots' last stopped.
           start-pos
-          ;; 'decl if we're in an arglist containing declarations (but
-          ;; if `c-recognize-paren-inits' is set it might also be an
-          ;; initializer arglist), '<> if the arglist is of angle
-          ;; bracket type, 'arglist if it's some other arglist, or nil
-          ;; if not in an arglist at all.
+          ;; o - 'decl if we're in an arglist containing declarations
+          ;;   (but if `c-recognize-paren-inits' is set it might also be
+          ;;   an initializer arglist);
+          ;; o - '<> if the arglist is of angle bracket type;
+          ;; o - 'arglist if it's some other arglist;
+          ;; o - nil, if not in an arglist at all.  This includes the
+          ;;   parenthesised condition which follows "if", "while", etc.
           context
           ;; The position of the next token after the closing paren of
           ;; the last detected cast.
@@ -1082,57 +1118,106 @@ casts and declarations are fontified.  Used on level 2 and higher."
               ;; can't start a declaration.
               t
 
-            ;; Set `context'.  Look for "<" for the sake of C++-style template
-            ;; arglists.
-            (if (memq (char-before match-pos) '(?\( ?, ?\[ ?<))
-
-                ;; Find out the type of the arglist.
-                (if (<= match-pos (point-min))
-                    (setq context 'arglist)
-                  (let ((type (c-get-char-property (1- match-pos) 'c-type)))
-                    (cond ((eq type 'c-decl-arg-start)
-                           ;; Got a cached hit in a declaration arglist.
-                           (setq context 'decl))
-                          ((or (eq type 'c-<>-arg-sep)
-                               (eq (char-before match-pos) ?<))
-                           ;; Inside an angle bracket arglist.
-                           (setq context '<>))
-                          (type
-                           ;; Got a cached hit in some other type of arglist.
-                           (setq context 'arglist))
-                          ((if inside-macro
-                               (< match-pos max-type-decl-end-before-token)
-                             (< match-pos max-type-decl-end))
-                           ;; The point is within the range of a previously
-                           ;; encountered type decl expression, so the arglist
-                           ;; is probably one that contains declarations.
-                           ;; However, if `c-recognize-paren-inits' is set it
-                           ;; might also be an initializer arglist.
-                           (setq context 'decl)
-                           ;; The result of this check is cached with a char
-                           ;; property on the match token, so that we can look
-                           ;; it up again when refontifying single lines in a
-                           ;; multiline declaration.
-                           (c-put-char-property (1- match-pos)
-                                                'c-type 'c-decl-arg-start))
-                          (t
-                           (setq context 'arglist)))))
-
-              (setq context nil))
-
-            ;; If we're in a normal arglist context we don't want to
-            ;; recognize commas in nested angle bracket arglists since
-            ;; those commas could be part of our own arglist.
-            (setq c-restricted-<>-arglists (and c-recognize-<>-arglists
-                                                (eq context 'arglist))
-
-                  ;; Now analyze the construct.
-                  decl-or-cast (c-forward-decl-or-cast-1
+            ;; Set `context' and `c-restricted-<>-arglists'.  Look for
+            ;; "<" for the sake of C++-style template arglists.
+            ;; Ignore "(" when it's part of a control flow construct
+            ;; (e.g. "for (").
+            (let ((type (and (> match-pos (point-min))
+                             (c-get-char-property (1- match-pos) 'c-type))))
+              (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?<)))
+                     (setq context nil
+                           c-restricted-<>-arglists nil))
+                    ;; A control flow expression
+                    ((and (eq (char-before match-pos) ?\()
+                          (save-excursion
+                            (goto-char match-pos)
+                            (backward-char)
+                            (c-backward-token-2)
+                            (looking-at c-block-stmt-2-key)))
+                     (setq context nil
+                           c-restricted-<>-arglists t))
+                    ;; Near BOB.
+                    ((<= match-pos (point-min))
+                     (setq context 'arglist
+                           c-restricted-<>-arglists t))
+                    ;; Got a cached hit in a declaration arglist.
+                    ((eq type 'c-decl-arg-start)
+                     (setq context 'decl
+                           c-restricted-<>-arglists nil))
+                    ;; Inside an angle bracket arglist.
+                    ((or (eq type 'c-<>-arg-sep)
+                         (eq (char-before match-pos) ?<))
+                     (setq context '<>
+                           c-restricted-<>-arglists nil))
+                    ;; Got a cached hit in some other type of arglist.
+                    (type
+                     (setq context 'arglist
+                           c-restricted-<>-arglists t))
+                    ((if inside-macro
+                         (< match-pos max-type-decl-end-before-token)
+                       (< match-pos max-type-decl-end))
+                     ;; The point is within the range of a previously
+                     ;; encountered type decl expression, so the arglist
+                     ;; is probably one that contains declarations.
+                     ;; However, if `c-recognize-paren-inits' is set it
+                     ;; might also be an initializer arglist.
+                     (setq context 'decl
+                           c-restricted-<>-arglists nil)
+                     ;; The result of this check is cached with a char
+                     ;; property on the match token, so that we can look
+                     ;; it up again when refontifying single lines in a
+                     ;; multiline declaration.
+                     (c-put-char-property (1- match-pos)
+                                          'c-type 'c-decl-arg-start))
+                    (t (setq context 'arglist
+                             c-restricted-<>-arglists t))))
+
+            ;; Check we haven't missed a preceding "typedef".
+            (when (not (looking-at c-typedef-key))
+              (c-backward-syntactic-ws)
+              (c-backward-token-2)
+              (or (looking-at c-typedef-key)
+                  (goto-char start-pos)))
+
+            ;; Now analyze the construct.
+            (setq decl-or-cast (c-forward-decl-or-cast-1
                                 match-pos context last-cast-end))
 
             (if (not decl-or-cast)
-                ;; False alarm.  Return t to go on to the next check.
-                t
+                ;; Are we at a declarator?
+                ;; Try to go back to the declaration to check this.
+                (let (paren-state bod-res lim encl-pos is-typedef)
+                  (goto-char start-pos)
+                  (save-excursion
+                    (setq lim (and (c-syntactic-skip-backward "^;" nil t)
+                                   (point))))
+                  (save-excursion
+                    (setq bod-res (car (c-beginning-of-decl-1 lim)))
+                    (if (and (eq bod-res 'same)
+                             (progn
+                               (c-backward-syntactic-ws)
+                               (eq (char-before) ?\})))
+                        (c-beginning-of-decl-1 lim))
+                    ;; We're now putatively at the declaration.
+                    (setq paren-state (c-parse-state))
+                    ;; At top level or inside a "{"?
+                    (if (or (not (setq encl-pos
+                                       (c-most-enclosing-brace paren-state)))
+                            (eq (char-after encl-pos) ?\{))
+                        (progn
+                          (when (looking-at c-typedef-key) ; "typedef"
+                            (setq is-typedef t)
+                            (goto-char (match-end 0))
+                            (c-forward-syntactic-ws))
+                          ;; At a real declaration?
+                          (if (memq (c-forward-type t) '(t known found))
+                              (progn
+                                (c-font-lock-declarators limit t is-typedef)
+                                nil)
+                      ;; False alarm.  Return t to go on to the next check.
+                            (goto-char start-pos)
+                            t))
+                      t)))
 
               (if (eq decl-or-cast 'cast)
                   ;; Save the position after the previous cast so we can feed
@@ -1296,7 +1381,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
   "Complex font lock matchers for types and declarations.  Used on level
 3 and higher."
 
-  ;; Note: This code in this form dumps a number of funtions into the
+  ;; Note: This code in this form dumps a number of functions into the
   ;; resulting constant, `c-matchers-3'.  At run time, font lock will call
   ;; each of them as a "FUNCTION" (see Elisp page "Search-based
   ;; Fontification").  The font lock region is delimited by POINT and the
@@ -1348,7 +1433,7 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
            `(,(concat "\\<\\(" re "\\)\\>")
              1 'font-lock-type-face)))
 
-      ;; Fontify types preceded by `c-type-prefix-kwds'.
+      ;; Fontify types preceded by `c-type-prefix-kwds' (e.g. "struct").
       ,@(when (c-lang-const c-type-prefix-kwds)
           `((,(byte-compile
                `(lambda (limit)
@@ -1396,23 +1481,25 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
       ;; override it if it turns out to be an new declaration, but
       ;; it will be wrong if it's an expression (see the test
       ;; decls-8.cc).
-      ,@(when (c-lang-const c-opt-block-decls-with-vars-key)
-          `((,(c-make-font-lock-search-function
-               (concat "}"
-                       (c-lang-const c-single-line-syntactic-ws)
-                       "\\("            ; 1 + c-single-line-syntactic-ws-depth
-                       (c-lang-const c-type-decl-prefix-key)
-                       "\\|"
-                       (c-lang-const c-symbol-key)
-                       "\\)")
-               `((c-font-lock-declarators limit t nil)
-                 (progn
-                   (c-put-char-property (match-beginning 0) 'c-type
-                                        'c-decl-id-start)
-                   (goto-char (match-beginning
-                               ,(1+ (c-lang-const
-                                     c-single-line-syntactic-ws-depth)))))
-                 (goto-char (match-end 0)))))))
+;;       ,@(when (c-lang-const c-opt-block-decls-with-vars-key)
+;;        `((,(c-make-font-lock-search-function
+;;             (concat "}"
+;;                     (c-lang-const c-single-line-syntactic-ws)
+;;                     "\\("            ; 1 + c-single-line-syntactic-ws-depth
+;;                     (c-lang-const c-type-decl-prefix-key)
+;;                     "\\|"
+;;                     (c-lang-const c-symbol-key)
+;;                     "\\)")
+;;             `((c-font-lock-declarators limit t nil) ; That `nil' says use `font-lock-variable-name-face';
+;;                                      ; `t' would mean `font-lock-function-name-face'.
+;;               (progn
+;;                 (c-put-char-property (match-beginning 0) 'c-type
+;;                                      'c-decl-id-start)
+;; ;                                    'c-decl-type-start)
+;;                 (goto-char (match-beginning
+;;                             ,(1+ (c-lang-const
+;;                                   c-single-line-syntactic-ws-depth)))))
+;;               (goto-char (match-end 0)))))))
 
       ;; Fontify the type in C++ "new" expressions.
       ,@(when (c-major-mode-is 'c++-mode)
@@ -1660,6 +1747,10 @@ need for `c-font-lock-extra-types'.")
 ;;; C++.
 
 (defun c-font-lock-c++-new (limit)
+  ;; FIXME!!!  Put in a comment about the context of this function's
+  ;; invocation.  I think it's called as an ANCHORED-MATCHER within an
+  ;; ANCHORED-HIGHLIGHTER.  (2007/2/10).
+  ;;
   ;; Assuming point is after a "new" word, check that it isn't inside
   ;; a string or comment, and if so try to fontify the type in the
   ;; allocation expression.  Nil is always returned.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 5cd5c0b95ca..ba056133651 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1565,6 +1565,17 @@ be a subset of `c-primitive-type-kwds'."
             ;; In CORBA PSDL:
             "strong"))
 
+(c-lang-defconst c-typedef-kwds
+  "Prefix keyword\(s\) like \"typedef\" which make a type declaration out
+of a variable declaration."
+  t        '("typedef")
+  (awk idl java) nil)
+
+(c-lang-defconst c-typedef-key
+  ;; Adorned regexp matching `c-typedef-kwds'.
+  t (c-make-keywords-re t (c-lang-const c-typedef-kwds)))
+(c-lang-defvar c-typedef-key (c-lang-const c-typedef-key))
+
 (c-lang-defconst c-type-prefix-kwds
   "Keywords where the following name - if any - is a type name, and
 where the keyword together with the symbol works as a type in
@@ -1731,6 +1742,10 @@ will be handled."
   ;; types in IDL since they only can occur in "raises" specs.
   idl  (delete "exception" (append (c-lang-const c-typedef-decl-kwds) nil)))
 
+(c-lang-defconst c-typedef-decl-key
+  t  (c-make-keywords-re t (c-lang-const c-typedef-decl-kwds)))
+(c-lang-defvar c-typedef-decl-key (c-lang-const c-typedef-decl-key))
+
 (c-lang-defconst c-typeless-decl-kwds
   "Keywords introducing declarations where the \(first) identifier
 \(declarator) follows directly after the keyword, without any type.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 6a76a657829..505a5663ebc 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -100,7 +100,6 @@
 (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
 (cc-bytecomp-defun set-keymap-parents)  ; XEmacs
 (cc-bytecomp-defun run-mode-hooks)      ; Emacs 21.1
-(cc-bytecomp-obsolete-fun make-local-hook) ; Marked obsolete in Emacs 21.1.
 
 ;; We set these variables during mode init, yet we don't require
 ;; font-lock.
@@ -600,9 +599,10 @@ that requires a literal mode spec at compile time."
 
   ;; Install the functions that ensure that various internal caches
   ;; don't become invalid due to buffer changes.
-  (make-local-hook 'before-change-functions)
+  (when (featurep 'xemacs)
+    (make-local-hook 'before-change-functions)
+    (make-local-hook 'after-change-functions))
   (add-hook 'before-change-functions 'c-before-change nil t)
-  (make-local-hook 'after-change-functions)
   (add-hook 'after-change-functions 'c-after-change nil t)
   (set (make-local-variable 'font-lock-extend-after-change-region-function)
         'c-extend-after-change-region)) ; Currently (2009-05) used by all
@@ -1113,8 +1113,8 @@ This does not load the font-lock package.  Use after
           c-beginning-of-syntax
           (font-lock-mark-block-function
            . c-mark-function)))
-
-  (make-local-hook 'font-lock-mode-hook)
+  (if (featurep 'xemacs)
+      (make-local-hook 'font-lock-mode-hook))
   (add-hook 'font-lock-mode-hook 'c-after-font-lock-init nil t))
 
 (defun c-extend-after-change-region (beg end old-len)
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 48120563b29..15d44f6538a 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -50,7 +50,6 @@
 
 ;; Silence the compiler.
 (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
-(cc-bytecomp-obsolete-fun make-local-hook) ; Marked obsolete in Emacs 21.1.
 
 
 (defvar c-style-alist
@@ -649,7 +648,7 @@ any reason to call this function directly."
     (mapc func varsyms)
     ;; Hooks must be handled specially
     (if this-buf-only-p
-        (make-local-hook 'c-special-indent-hook)
+        (if (featurep 'xemacs) (make-local-hook 'c-special-indent-hook))
       (with-no-warnings (make-variable-buffer-local 'c-special-indent-hook))
       (setq c-style-variables-are-local-p t))
     ))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 7f0732ecffc..a335f3dd427 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2425,9 +2425,6 @@ The file-structure looks like this:
        (or compilation-auto-jump-to-first-error
            (eq compilation-scroll-output 'first-error))))
 
-;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.gcov\\'") 'compilation-mode))
-
 (provide 'compile)
 
 ;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d89e41b38fb..46002929791 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1,8 +1,8 @@
 ;;; cperl-mode.el --- Perl code editing commands for Emacs
 
 ;; Copyright (C) 1985, 1986, 1987, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
-;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;;     Free Software Foundation, Inc.
+;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010  Free Software Foundation, Inc.
 
 ;; Author: Ilya Zakharevich
 ;;      Bob Olson
@@ -1802,13 +1802,12 @@ or as help on variables `cperl-tips', `cperl-problems',
   (set 'vc-rcs-header cperl-vc-rcs-header)
   (make-local-variable 'vc-sccs-header)
   (set 'vc-sccs-header cperl-vc-sccs-header)
-  ;; This one is obsolete...
-  (make-local-variable 'vc-header-alist)
-  (with-no-warnings
-   (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
-                             `((SCCS ,(car cperl-vc-sccs-header))
-                               (RCS ,(car cperl-vc-rcs-header)))))
-   )
+  (when (featurep 'xemacs)
+    ;; This one is obsolete...
+    (make-local-variable 'vc-header-alist)
+    (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
+                              `((SCCS ,(car cperl-vc-sccs-header))
+                                (RCS ,(car cperl-vc-rcs-header))))))
   (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
          (make-local-variable 'compilation-error-regexp-alist-alist)
          (set 'compilation-error-regexp-alist-alist
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 2018a71574e..042cc8c33f6 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -68,12 +68,14 @@ Use the `etags' program to make a tags table file."
   :type '(repeat file))
 
 ;;;###autoload
-(defcustom tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".tgz"))
+(defcustom tags-compression-info-list
+  (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz"))
   "*List of extensions tried by etags when jka-compr is used.
 An empty string means search the non-compressed file.
 These extensions will be tried only if jka-compr was activated
 \(i.e. via customize of `auto-compression-mode' or by calling the function
 `auto-compression-mode')."
+  :version "24.1"                       ; added xz
   :type  '(repeat string)
   :group 'etags)
 
@@ -472,7 +474,7 @@ Subroutine of `visit-tags-table-buffer'.
 Looks for a tags table that has such tags or that includes a table
 that has them.  Returns the name of the first such table.
 Non-nil CORE-ONLY means check only tags tables that are already in
-buffers.  Nil CORE-ONLY is ignored."
+buffers.  If CORE-ONLY is nil, it is ignored."
   (let ((tables tags-table-computed-list)
         (found nil))
     ;; Loop over the list, looking for a table containing tags for THIS-FILE.
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index daa0fd07364..91cfb646b66 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -483,19 +483,27 @@ The only difference is, it returns t in a case when the default returns nil."
   "Maximum highlighting for Fortran mode.
 Consists of level 3 plus all other intrinsics not already highlighted.")
 
-(defvar fortran--font-lock-syntactic-keywords)
 ;; Comments are real pain in Fortran because there is no way to
 ;; represent the standard comment syntax in an Emacs syntax table.
 ;; (We can do so for F90-style).  Therefore an unmatched quote in a
 ;; standard comment will throw fontification off on the wrong track.
 ;; So we do syntactic fontification with regexps.
-(defun fortran-font-lock-syntactic-keywords ()
-  "Return a value for `font-lock-syntactic-keywords' in Fortran mode.
-This varies according to the value of `fortran-line-length'.
+(defun fortran-make-syntax-propertize-function (line-length)
+  "Return a value for `syntax-propertize-function' in Fortran mode.
+This varies according to the value of LINE-LENGTH.
 This is used to fontify fixed-format Fortran comments."
-  `(("^[cd\\*]" 0 (11))
-    (,(format "^[^cd\\*\t\n].\\{%d\\}\\([^\n]+\\)" (1- fortran-line-length))
-     1 (11))))
+  ;; This results in a non-byte-compiled function.  We could pass it through
+  ;; `byte-compile', but simple benchmarks indicate that it's probably not
+  ;; worth the trouble (about ½% of slow down).
+  (eval                         ;I hate `eval', but it's hard to avoid it here.
+   `(syntax-propertize-rules
+     ("^[cd\\*]" (0 "<"))
+     ;; We mark all chars after line-length as "comment-start", rather than
+     ;; just the first one.  This is so that a closing ' that's past the
+     ;; line-length will indeed be ignored (and will result in a string that
+     ;; leaks into subsequent lines).
+     ((format "^[^cd\\*\t\n].\\{%d\\}\\(.+\\)" (1- line-length))
+      (1 "<")))))
 
 (defvar fortran-font-lock-keywords fortran-font-lock-keywords-1
   "Default expressions to highlight in Fortran mode.")
@@ -889,10 +897,8 @@ with no args, if that value is non-nil."
           fortran-font-lock-keywords-4)
          nil t ((?/ . "$/") ("_$" . "w"))
          fortran-beginning-of-subprogram))
-  (set (make-local-variable 'fortran--font-lock-syntactic-keywords)
-       (fortran-make-syntax-propertize-function))
   (set (make-local-variable 'syntax-propertize-function)
-       (syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords))
+       (fortran-make-syntax-propertize-function fortran-line-length))
   (set (make-local-variable 'imenu-case-fold-search) t)
   (set (make-local-variable 'imenu-generic-expression)
        fortran-imenu-generic-expression)
@@ -912,27 +918,30 @@ with no args, if that value is non-nil."
   "Set the length of fixed-form Fortran lines to NCHARS.
 This normally only affects the current buffer, which must be in
 Fortran mode.  If the optional argument GLOBAL is non-nil, it
-affects all Fortran buffers, and also the default."
-  (interactive "p")
-  (let (new)
-    (mapc (lambda (buff)
-            (with-current-buffer buff
-              (when (eq major-mode 'fortran-mode)
-                (setq fortran-line-length nchars
-                      fill-column fortran-line-length
-                      new (fortran-make-syntax-propertize-function))
-                ;; Refontify only if necessary.
-                (unless (equal new fortran--font-lock-syntactic-keywords)
-                  (setq fortran--font-lock-syntactic-keywords new)
-                  (setq syntax-propertize-function
-                        (syntax-propertize-via-font-lock new))
-                  (syntax-ppss-flush-cache (point-min))
-                  (if font-lock-mode (font-lock-mode 1))))))
+affects all Fortran buffers, and also the default.
+If a numeric prefix argument is specified, it will be used as NCHARS,
+otherwise is a non-numeric prefix arg is specified, the length will be
+provided via the minibuffer, and otherwise the current column is used."
+  (interactive
+   (list (cond
+          ((numberp current-prefix-arg) current-prefix-arg)
+          (current-prefix-arg
+           (read-number "Line length: " (default-value 'fortran-line-length)))
+          (t (current-column)))))
+  (dolist (buff (if global
+                    (buffer-list)
+                  (list (current-buffer))))
+    (with-current-buffer buff
+      (when (derived-mode-p 'fortran-mode)
+        (unless (eq fortran-line-length nchars)
+          (setq fortran-line-length nchars
+                fill-column fortran-line-length
+                syntax-propertize-function
+                (fortran-make-syntax-propertize-function nchars))
+          (syntax-ppss-flush-cache (point-min))
+          (if font-lock-mode (font-lock-mode 1))))))
           (if global
-              (buffer-list)
-            (list (current-buffer))))
-    (if global
-        (setq-default fortran-line-length nchars))))
+      (setq-default fortran-line-length nchars)))
 
 (defun fortran-hack-local-variables ()
   "Fortran mode adds this to `hack-local-variables-hook'."
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 5b98ff427c3..3019f8bbf04 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -163,7 +163,7 @@ returned from -thread-info by `gdb-json-partial-output'. Updated in
 (defvar gdb-running-threads-count nil
   "Number of currently running threads.
 
-Nil means that no information is available.
+If nil, no information is available.
 
 Updated in `gdb-thread-list-handler-custom'.")
 
@@ -2051,7 +2051,7 @@ current thread and update GDB buffers."
 Field names are wrapped in double quotes and equal signs are
 replaced with semicolons.
 
-If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from
+If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from
 partial output. This is used to get rid of useless keys in lists
 in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
 -break-info are examples of MI commands which issue such
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 4c1471e39ec..8c35a13ac53 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3218,13 +3218,6 @@ Treats actions as defuns."
     (goto-char (point-max)))
   t)
 
-;; Besides .gdbinit, gdb documents other names to be usable for init
-;; files, cross-debuggers can use something like
-;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
-;; don't interfere with each other.
-;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "/\\.[a-z0-9-]*gdbinit") 'gdb-script-mode))
-
 ;;;###autoload
 (define-derived-mode gdb-script-mode nil "GDB-Script"
   "Major mode for editing GDB scripts."
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index ee5e2a49ead..41ce378e966 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -80,19 +80,17 @@ mode.  Default is whitespace followed by 0 or 1 single-letter colon-keyword
   :type 'regexp
   :group 'inferior-lisp)
 
-(defvar inferior-lisp-mode-map nil)
-(unless inferior-lisp-mode-map
-  (setq inferior-lisp-mode-map (copy-keymap comint-mode-map))
-  (set-keymap-parent inferior-lisp-mode-map lisp-mode-shared-map)
-  (define-key inferior-lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
-  (define-key inferior-lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-  (define-key inferior-lisp-mode-map "\C-c\C-k" 'lisp-compile-file)
-  (define-key inferior-lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-  (define-key inferior-lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-  (define-key inferior-lisp-mode-map "\C-c\C-f"
-    'lisp-show-function-documentation)
-  (define-key inferior-lisp-mode-map "\C-c\C-v"
-    'lisp-show-variable-documentation))
+(defvar inferior-lisp-mode-map
+  (let ((map (copy-keymap comint-mode-map)))
+    (set-keymap-parent map lisp-mode-shared-map)
+    (define-key map "\C-x\C-e" 'lisp-eval-last-sexp)
+    (define-key map "\C-c\C-l" 'lisp-load-file)
+    (define-key map "\C-c\C-k" 'lisp-compile-file)
+    (define-key map "\C-c\C-a" 'lisp-show-arglist)
+    (define-key map "\C-c\C-d" 'lisp-describe-sym)
+    (define-key map "\C-c\C-f" 'lisp-show-function-documentation)
+    (define-key map "\C-c\C-v" 'lisp-show-variable-documentation)
+    map))
 
 ;;; These commands augment Lisp mode, so you can process Lisp code in
 ;;; the source files.
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index ba70bb8ecce..aeb2e91b6af 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3304,7 +3304,7 @@ Key bindings:
 
   (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
   (set (make-local-variable 'font-lock-defaults)
-       '(js--font-lock-keywords))
+       (list js--font-lock-keywords))
   (set (make-local-variable 'syntax-propertize-function)
        js-syntax-propertize-function)
 
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index 3d07ed226b2..318456e9534 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -1,7 +1,7 @@
 ;;; ld-script.el --- GNU linker script editing mode for Emacs
 
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;;   2010  Free Software Foundation, Inc.
 
 ;; Author: Masatake YAMATO<jet@gyve.org>
 ;; Keywords: languages, faces
@@ -76,20 +76,20 @@
 (defvar ld-script-keywords
   '(
     ;; 3.4.1 Setting the Entry Point
-    "ENTRY" 
+    "ENTRY"
     ;; 3.4.2 Commands Dealing with Files
     "INCLUDE" "INPUT" "GROUP" "AS_NEEDED" "OUTPUT" "SEARCH_DIR" "STARTUP"
     ;; 3.4.3 Commands Dealing with Object File Formats
     "OUTPUT_FORMAT" "TARGET"
     ;; 3.4.3 Other Linker Script Commands
-    "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" 
+    "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION"
     "INHIBIT_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH"
     ;; 3.5.2 PROVIDE
     "PROVIDE"
     ;; 3.5.3 PROVIDE_HIDDEN
     "PROVIDE_HIDDEN"
     ;; 3.6 SECTIONS Command
-    "SECTIONS" 
+    "SECTIONS"
     ;; 3.6.4.2 Input Section Wildcard Patterns
     "SORT" "SORT_BY_NAME" "SORT_BY_ALIGNMENT"
     ;; 3.6.4.3 Input Section for Common Symbols
@@ -157,18 +157,6 @@
    cpp-font-lock-keywords)
   "Default font-lock-keywords for `ld-script-mode'.")
 
-;; Linux-2.6.9 uses some different suffix for linker scripts:
-;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo".
-;; eCos uses "ld" and "ldi".
-;; Netbsd uses "ldscript.*".
-;;;###autoload
-(add-to-list 'auto-mode-alist (purecopy '("\\.ld[si]?\\>" . ld-script-mode)))
-;;;###autoload
-(add-to-list 'auto-mode-alist (purecopy '("ld\\.?script\\>" . ld-script-mode)))
-
-;;;###autoload
-(add-to-list 'auto-mode-alist (purecopy '("\\.x[bdsru]?[cn]?\\'" . ld-script-mode)))
-
 ;;;###autoload
 (define-derived-mode ld-script-mode nil "LD-Script"
    "A major mode to edit GNU ld script files"
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 94af563d88f..f2a7aa045e4 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -125,7 +125,7 @@ value.")
 (defvar mixal-operation-codes-alist
   ;; FIXME: the codes FADD, FSUB, FMUL, FDIV, JRAD, and FCMP were in
   ;; mixal-operation-codes but not here.  They should probably be added here.
-  ;; 
+  ;;
   ;; We used to define this with a backquote and subexps like ,(+ 8 3) for
   ;; better clarity, but the resulting code was too big and caused the
   ;; byte-compiler to eat up all the stack space.  Even using
@@ -1123,9 +1123,6 @@ Assumes that file has been compiled with debugging support."
   (set (make-local-variable 'require-final-newline)
        mode-require-final-newline))
 
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.mixal\\'" . mixal-mode))
-
 (provide 'mixal-mode)
 
 ;; arch-tag: be7c128a-bf61-4951-a90e-9398267ce3f3
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index 9d226cefbd4..3d2af5e217e 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -69,10 +69,7 @@
     (setq m2-mode-syntax-table table)))
 
 ;;; Added by TEP
-(defvar m2-mode-map nil
-  "Keymap used in Modula-2 mode.")
-
-(if m2-mode-map ()
+(defvar m2-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "\^i" 'm2-tab)
     (define-key map "\C-cb" 'm2-begin)
@@ -103,7 +100,8 @@
     (define-key map "\C-c\C-t" 'm2-toggle)
     (define-key map "\C-c\C-l" 'm2-link)
     (define-key map "\C-c\C-c" 'm2-compile)
-    (setq m2-mode-map map)))
+    map)
+  "Keymap used in Modula-2 mode.")
 
 (defcustom m2-indent 5
   "*This variable gives the indentation in Modula-2-Mode."
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index bbefdaa2ccf..56de9b869db 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -456,10 +456,7 @@ Non-nil means always go to the next Octave code line after sending."
      octave-smie-bnf-table
      '((assoc "\n" ";")))
 
-    (smie-precs-precedence-table
-     (append octave-operator-table
-             '((nonassoc " -dummy- "))) ;Bogus anchor at the end.
-     ))))
+    (smie-precs-precedence-table octave-operator-table))))
 
 ;; Tokenizing needs to be refined so that ";;" is treated as two
 ;; tokens and also so as to recognize the \n separator (and
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index d19fa08bf6c..acd49e71dd8 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -223,7 +223,7 @@ The name of the function or case is included between the braces."
   "*List of contexts where auto lineup of :'s or ='s should be done.
 Elements can be of type: 'paramlist', 'declaration' or 'case', which will
 do auto lineup in parameterlist, declarations or case-statements
-respectively. The word 'all' will do all lineups. '(case paramlist) for
+respectively.  The word 'all' will do all lineups.  '(case paramlist) for
 instance will do lineup in case-statements and parameterlist, while '(all)
 will do all lineups."
   :type '(set :extra-offset 8
@@ -311,7 +311,7 @@ are handled in another way, and should not be added to this list."
 
 
 ;;;###autoload
-(defun pascal-mode ()
+(define-derived-mode pascal-mode prog-mode "Pascal"
   "Major mode for editing Pascal code. \\<pascal-mode-map>
 TAB indents for Pascal code.  Delete converts tabs to spaces as it moves back.
 
@@ -334,60 +334,47 @@ Other useful functions are:
 
 Variables controlling indentation/edit style:
 
- pascal-indent-level (default 3)
+ `pascal-indent-level' (default 3)
     Indentation of Pascal statements with respect to containing block.
- pascal-case-indent (default 2)
+ `pascal-case-indent' (default 2)
     Indentation for case statements.
- pascal-auto-newline (default nil)
+ `pascal-auto-newline' (default nil)
     Non-nil means automatically newline after semicolons and the punctuation
     mark after an end.
- pascal-indent-nested-functions (default t)
+ `pascal-indent-nested-functions' (default t)
     Non-nil means nested functions are indented.
- pascal-tab-always-indent (default t)
+ `pascal-tab-always-indent' (default t)
     Non-nil means TAB in Pascal mode should always reindent the current line,
     regardless of where in the line point is when the TAB command is used.
- pascal-auto-endcomments (default t)
+ `pascal-auto-endcomments' (default t)
     Non-nil means a comment { ... } is set after the ends which ends cases and
     functions. The name of the function or case will be set between the braces.
- pascal-auto-lineup (default t)
+ `pascal-auto-lineup' (default t)
     List of contexts where auto lineup of :'s or ='s should be done.
 
-See also the user variables pascal-type-keywords, pascal-start-keywords and
-pascal-separator-keywords.
+See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
+`pascal-separator-keywords'.
 
 Turning on Pascal mode calls the value of the variable pascal-mode-hook with
 no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map pascal-mode-map)
-  (setq major-mode 'pascal-mode)
-  (setq mode-name "Pascal")
-  (setq local-abbrev-table pascal-mode-abbrev-table)
-  (set-syntax-table pascal-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'pascal-indent-line)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'pascal-indent-comment)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments nil)
-  (make-local-variable 'blink-matching-paren-dont-ignore-comments)
-  (setq blink-matching-paren-dont-ignore-comments t)
-  (make-local-variable 'case-fold-search)
-  (setq case-fold-search t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "{")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "(\\*+ *\\|{ *")
-  (make-local-variable 'comment-end)
-  (setq comment-end "}")
+  (set (make-local-variable 'local-abbrev-table) pascal-mode-abbrev-table)
+  (set (make-local-variable 'indent-line-function) 'pascal-indent-line)
+  (set (make-local-variable 'comment-indent-function) 'pascal-indent-comment)
+  (set (make-local-variable 'parse-sexp-ignore-comments) nil)
+  (set (make-local-variable 'blink-matching-paren-dont-ignore-comments) t)
+  (set (make-local-variable 'case-fold-search) t)
+  (set (make-local-variable 'comment-start) "{")
+  (set (make-local-variable 'comment-start-skip) "(\\*+ *\\|{ *")
+  (set (make-local-variable 'comment-end) "}")
   ;; Font lock support
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(pascal-font-lock-keywords nil t))
+  (set (make-local-variable 'font-lock-defaults)
+       '(pascal-font-lock-keywords nil t))
   ;; Imenu support
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression pascal-imenu-generic-expression)
-  (setq imenu-case-fold-search t)
-  (run-mode-hooks 'pascal-mode-hook))
+  (set (make-local-variable 'imenu-generic-expression)
+       pascal-imenu-generic-expression)
+  (set (make-local-variable 'imenu-case-fold-search) t)
+  ;; Pascal-mode's own hide/show support.
+  (add-to-invisibility-spec '(pascal . t)))
 
 
 
@@ -1478,18 +1465,12 @@ Pascal Outline mode provides some additional commands.
   (unless pascal-outline-mode
     (pascal-show-all)))
 
-(defun pascal-outline-change (b e pascal-flag)
-  (save-excursion
-    ;; This used to use selective display so the boundaries used by the
-    ;; callers didn't have to be precise, since it just looked for \n or \^M
-    ;; and switched them.
-    (goto-char b) (setq b (line-end-position))
-    (goto-char e) (setq e (line-end-position)))
+(defun pascal-outline-change (b e hide)
   (when (> e b)
     ;; We could try and optimize this in the case where the region is
     ;; already hidden.  But I'm not sure it's worth the trouble.
     (remove-overlays b e 'invisible 'pascal)
-    (when (eq pascal-flag ?\^M)
+    (when hide
       (let ((ol (make-overlay b e nil t nil)))
         (overlay-put ol 'invisible 'pascal)
         (overlay-put ol 'evaporate t)))))
@@ -1497,7 +1478,7 @@ Pascal Outline mode provides some additional commands.
 (defun pascal-show-all ()
   "Show all of the text in the buffer."
   (interactive)
-  (pascal-outline-change (point-min) (point-max) ?\n))
+  (pascal-outline-change (point-min) (point-max) nil))
 
 (defun pascal-hide-other-defuns ()
   "Show only the current defun."
@@ -1505,42 +1486,45 @@ Pascal Outline mode provides some additional commands.
   (save-excursion
     (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
                           (pascal-beg-of-defun))
-                      (point)))
+                      (line-beginning-position)))
           (end (progn (pascal-end-of-defun)
                       (backward-sexp 1)
-                      (search-forward "\n\\|\^M" nil t)
-                      (point)))
+                      (line-beginning-position 2)))
           (opoint (point-min)))
+      ;; BEG at BOL.
+      ;; OPOINT at EOL.
+      ;; END at BOL.
       (goto-char (point-min))
 
       ;; Hide all functions before current function
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
-        (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
-        (setq opoint (point))
+      (while (re-search-forward "^[ \t]*\\(function\\|procedure\\)\\>"
+                                beg 'move)
+        (pascal-outline-change opoint (line-end-position 0) t)
+        (setq opoint (line-end-position))
         ;; Functions may be nested
         (if (> (progn (pascal-end-of-defun) (point)) beg)
             (goto-char opoint)))
       (if (> beg opoint)
-          (pascal-outline-change opoint (1- beg) ?\^M))
+          (pascal-outline-change opoint (1- beg) t))
 
       ;; Show current function
-      (pascal-outline-change beg end ?\n)
+      (pascal-outline-change (1- beg) end nil)
       ;; Hide nested functions
       (forward-char 1)
       (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
-        (setq opoint (point))
+        (setq opoint (line-end-position))
         (pascal-end-of-defun)
-        (pascal-outline-change opoint (point) ?\^M))
+        (pascal-outline-change opoint (line-end-position) t))
 
       (goto-char end)
       (setq opoint end)
 
       ;; Hide all function after current function
       (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
-        (pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
-        (setq opoint (point))
+        (pascal-outline-change opoint (line-end-position 0) t)
+        (setq opoint (line-end-position))
         (pascal-end-of-defun))
-      (pascal-outline-change opoint (point-max) ?\^M)
+      (pascal-outline-change opoint (point-max) t)
 
       ;; Hide main program
       (if (< (progn (forward-line -1) (point)) end)
@@ -1548,7 +1532,7 @@ Pascal Outline mode provides some additional commands.
             (goto-char beg)
             (pascal-end-of-defun)
             (backward-sexp 1)
-            (pascal-outline-change (point) (point-max) ?\^M))))))
+            (pascal-outline-change (line-end-position) (point-max) t))))))
 
 (defun pascal-outline-next-defun ()
   "Move to next function/procedure, hiding all others."
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 77e334ca8d8..f3db7fad135 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -99,12 +99,36 @@ When nil, send actual operating system end of file."
 (defvar prolog-mode-abbrev-table nil)
 (define-abbrev-table 'prolog-mode-abbrev-table ())
 
+(defun prolog-smie-forward-token ()
+  (forward-comment (point-max))
+  (buffer-substring-no-properties
+   (point)
+   (progn (cond
+           ((looking-at "[!;]") (forward-char 1))
+           ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
+           ((not (zerop (skip-syntax-forward "w_'"))))
+           ;; In case of non-ASCII punctuation.
+           ((not (zerop (skip-syntax-forward ".")))))
+          (point))))
+
+(defun prolog-smie-backward-token ()
+  (forward-comment (- (point-max)))
+  (buffer-substring-no-properties
+   (point)
+   (progn (cond
+           ((memq (char-before) '(?! ?\;)) (forward-char -1))
+           ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
+           ((not (zerop (skip-syntax-backward "w_'"))))
+           ;; In case of non-ASCII punctuation.
+           ((not (zerop (skip-syntax-backward ".")))))
+          (point))))
+
 (defconst prolog-smie-op-levels
   ;; Rather than construct the operator levels table from the BNF,
   ;; we directly provide the operator precedences from GNU Prolog's
-  ;; manual.  The only problem is that GNU Prolog's manual uses
-  ;; precedence levels in the opposite sense (higher numbers bind less
-  ;; tightly) than SMIE, so we use negative numbers.
+  ;; manual (7.14.10 op/3).  The only problem is that GNU Prolog's
+  ;; manual uses precedence levels in the opposite sense (higher
+  ;; numbers bind less tightly) than SMIE, so we use negative numbers.
   '(("." -10000 -10000)
     (":-" -1200 -1200)
     ("-->" -1200 -1200)
@@ -162,9 +186,18 @@ When nil, send actual operating system end of file."
   (make-local-variable 'imenu-generic-expression)
   (setq imenu-generic-expression '((nil "^\\sw+" 0)))
   (smie-setup prolog-smie-op-levels prolog-smie-indent-rules)
+  (set (make-local-variable 'smie-forward-token-function)
+       #'prolog-smie-forward-token)
+  (set (make-local-variable 'smie-backward-token-function)
+       #'prolog-smie-backward-token)
   (set (make-local-variable 'forward-sexp-function)
        'smie-forward-sexp-command)
   (set (make-local-variable 'smie-indent-basic) prolog-indent-width)
+  (set (make-local-variable 'smie-blink-matching-triggers) '(?.))
+  (set (make-local-variable 'smie-closer-alist) '((t . ".")))
+  (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
+  ;; There's no real closer in Prolog anyway.
+  (set (make-local-variable 'smie-blink-matching-inners) t)
   (make-local-variable 'comment-start)
   (setq comment-start "%")
   (make-local-variable 'comment-start-skip)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index a80a555c13f..7148027f487 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -5,10 +5,9 @@
 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.6
+;; Version: 2.8
 ;; Keywords: comm languages processes
 ;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
 
 ;; This file is part of GNU Emacs.
 
@@ -286,6 +285,9 @@ Customizing your password will store it in your ~/.emacs file."
 
 (define-widget 'sql-login-params 'lazy
   "Widget definition of the login parameters list"
+  ;; FIXME: does not implement :default property for the user,
+  ;; database and server options.  Anybody have some guidance on how to
+  ;; do this.
   :tag "Login Parameters"
   :type '(repeat (choice
                   (const user)
@@ -300,7 +302,7 @@ Customizing your password will store it in your ~/.emacs file."
                                 (const :format "" server)
                                 (const :format "" :completion)
                                 (restricted-sexp
-                                 :match-alternatives (listp symbolp))))
+                                 :match-alternatives (listp stringp))))
                   (choice :tag "database"
                           (const database)
                           (list :tag "file"
@@ -311,7 +313,7 @@ Customizing your password will store it in your ~/.emacs file."
                                 (const :format "" database)
                                 (const :format "" :completion)
                                 (restricted-sexp
-                                 :match-alternatives (listp symbolp))))
+                                 :match-alternatives (listp stringp))))
                   (const port))))
 
 ;; SQL Product support
@@ -401,6 +403,8 @@ Customizing your password will store it in your ~/.emacs file."
      :sqli-options sql-mysql-options
      :sqli-login sql-mysql-login-params
      :sqli-comint-func sql-comint-mysql
+     :list-all "SHOW TABLES;"
+     :list-table "DESCRIBE %s;"
      :prompt-regexp "^mysql> "
      :prompt-length 6
      :prompt-cont-regexp "^    -> "
@@ -428,6 +432,8 @@ Customizing your password will store it in your ~/.emacs file."
      :sqli-options sql-postgres-options
      :sqli-login sql-postgres-login-params
      :sqli-comint-func sql-comint-postgres
+     :list-all ("\\d+" . "\\dS+")
+     :list-table ("\\d+ %s" . "\\dS+ %s")
      :prompt-regexp "^.*=[#>] "
      :prompt-length 5
      :prompt-cont-regexp "^.*[-(][#>] "
@@ -452,6 +458,8 @@ Customizing your password will store it in your ~/.emacs file."
      :sqli-options sql-sqlite-options
      :sqli-login sql-sqlite-login-params
      :sqli-comint-func sql-comint-sqlite
+     :list-all ".tables"
+     :list-table ".schema %s"
      :prompt-regexp "^sqlite> "
      :prompt-length 8
      :prompt-cont-regexp "^   ...> "
@@ -510,6 +518,23 @@ may be any one of the following:
                         database.  Do product specific
                         configuration of comint in this function.
 
+ :list-all              Command string or function which produces
+                        a listing of all objects in the database.
+                        If it's a cons cell, then the car
+                        produces the standard list of objects and
+                        the cdr produces an enhanced list of
+                        objects.  What \"enhanced\" means is
+                        dependent on the SQL product and may not
+                        exist.  In general though, the
+                        \"enhanced\" list should include visible
+                        objects from other schemas.
+
+ :list-table            Command string or function which produces
+                        a detailed listing of a specific database
+                        table.  If its a cons cell, then the car
+                        produces the standard list and the cdr
+                        produces an enhanced list.
+
  :prompt-regexp         regular expression string that matches
                         the prompt issued by the product
                         interpreter.
@@ -941,7 +966,9 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
   :version "20.8"
   :group 'SQL)
 
-(defcustom sql-postgres-login-params '(user database server)
+(defcustom sql-postgres-login-params `((user :default ,(user-login-name))
+                                       (database :default ,(user-login-name))
+                                       server)
   "List of login parameters needed to connect to Postgres."
   :type 'sql-login-params
   :version "24.1"
@@ -1025,6 +1052,12 @@ Starts `sql-interactive-mode' after doing some setup."
 
 ;; Passwords are not kept in a history.
 
+(defvar sql-product-history nil
+  "History of products used.")
+
+(defvar sql-connection-history nil
+  "History of connections used.")
+
 (defvar sql-buffer nil
   "Current SQLi buffer.
 
@@ -1052,11 +1085,24 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
 
 Used by `sql-rename-buffer'.")
 
-(defun sql-buffer-live-p (buffer)
-  "Returns non-nil if the process associated with buffer is live."
-  (and buffer
-       (buffer-live-p (get-buffer buffer))
-       (get-buffer-process buffer)))
+(defun sql-buffer-live-p (buffer &optional product)
+  "Returns non-nil if the process associated with buffer is live.
+
+BUFFER can be a buffer object or a buffer name.  The buffer must
+be a live buffer, have an running process attached to it, be in
+`sql-interactive-mode', and, if PRODUCT is specified, it's
+`sql-product' must match."
+
+  (when buffer
+    (setq buffer (get-buffer buffer))
+    (and buffer
+         (buffer-live-p buffer)
+         (get-buffer-process buffer)
+         (comint-check-proc buffer)
+         (with-current-buffer buffer
+           (and (derived-mode-p 'sql-interactive-mode)
+                (or (not product)
+                    (eq product sql-product)))))))
 
 ;; Keymap for sql-interactive-mode.
 
@@ -1073,6 +1119,8 @@ Used by `sql-rename-buffer'.")
     (define-key map (kbd "O") 'sql-magic-go)
     (define-key map (kbd "o") 'sql-magic-go)
     (define-key map (kbd ";") 'sql-magic-semicolon)
+    (define-key map (kbd "C-c C-l a") 'sql-list-all)
+    (define-key map (kbd "C-c C-l t") 'sql-list-table)
     map)
   "Mode map used for `sql-interactive-mode'.
 Based on `comint-mode-map'.")
@@ -1086,6 +1134,8 @@ Based on `comint-mode-map'.")
     (define-key map (kbd "C-c C-s") 'sql-send-string)
     (define-key map (kbd "C-c C-b") 'sql-send-buffer)
     (define-key map (kbd "C-c C-i") 'sql-product-interactive)
+    (define-key map (kbd "C-c C-l a") 'sql-list-all)
+    (define-key map (kbd "C-c C-l t") 'sql-list-table)
     map)
   "Mode map used for `sql-mode'.")
 
@@ -1101,6 +1151,9 @@ Based on `comint-mode-map'.")
    ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)]
    ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)]
    "--"
+   ["List all objects" sql-list-all (sql-buffer-live-p sql-buffer)]
+   ["List table details" sql-list-table (sql-buffer-live-p sql-buffer)]
+   "--"
    ["Start SQLi session" sql-product-interactive
     :visible (not sql-connection-alist)
     :enable (sql-get-product-feature sql-product :sqli-comint-func)]
@@ -1139,7 +1192,10 @@ Based on `comint-mode-map'.")
  "Menu for `sql-interactive-mode'."
  '("SQL"
    ["Rename Buffer" sql-rename-buffer t]
-   ["Save Connection" sql-save-connection (not sql-connection)]))
+   ["Save Connection" sql-save-connection (not sql-connection)]
+   "--"
+   ["List all objects" sql-list-all t]
+   ["List table details" sql-list-table t]))
 
 ;; Abbreviations -- if you want more of them, define them in your
 ;; ~/.emacs file.  Abbrevs have to be enabled in your ~/.emacs, too.
@@ -2122,6 +2178,16 @@ highlighting rules in SQL mode.")
 
 ;;; SQL Product support functions
 
+(defun sql-read-product (prompt &optional initial)
+  "Read a valid SQL product."
+  (let ((init (or (and initial (symbol-name initial)) "ansi")))
+    (intern (completing-read
+             prompt
+             (mapcar (lambda (info) (symbol-name (car info)))
+                     sql-product-alist)
+             nil 'require-match
+             init 'sql-product-history init))))
+
 (defun sql-add-product (product display &rest plist)
   "Add support for a database product in `sql-mode'.
 
@@ -2312,10 +2378,9 @@ adds a fontification pattern to fontify identifiers ending in
         (mapcar
          (lambda (param)
            (let ((token (or (and (listp param) (car param)) param))
-                 (type  (or (and (listp param) (nth 1 param)) nil))
-                 (arg   (or (and (listp param) (nth 2 param)) nil)))
+                 (plist (or (and (listp param) (cdr param)) nil)))
 
-             (funcall body token type arg)))
+             (funcall body token plist)))
          login-params)))
 
 
@@ -2335,11 +2400,7 @@ adds a fontification pattern to fontify identifiers ending in
 (defun sql-set-product (product)
   "Set `sql-product' to PRODUCT and enable appropriate highlighting."
   (interactive
-   (list (completing-read "SQL product: "
-                          (mapcar (lambda (info) (symbol-name (car info)))
-                                  sql-product-alist)
-                          nil 'require-match
-                          (or (and sql-product (symbol-name sql-product)) "ansi"))))
+   (list (sql-read-product "SQL product: ")))
   (if (stringp product) (setq product (intern product)))
   (when (not (assoc product sql-product-alist))
     (error "SQL product %s is not supported; treated as ANSI" product)
@@ -2479,37 +2540,53 @@ appended to the SQLi buffer without disturbing your SQL buffer."
   "Read a password using PROMPT.  Optional DEFAULT is password to start with."
   (read-passwd prompt nil default))
 
-(defun sql-get-login-ext (prompt last-value history-var type arg)
+(defun sql-get-login-ext (prompt last-value history-var plist)
   "Prompt user with extended login parameters.
 
-If TYPE is nil, then the user is simply prompted for a string
+If PLIST is nil, then the user is simply prompted for a string
 value.
 
-If TYPE is `:file', then the user is prompted for a file
-name that must match the regexp pattern specified in the ARG
-argument.
+The property `:default' specifies the default value.  If the
+`:number' property is non-nil then ask for a number.
 
-If TYPE is `:completion', then the user is prompted for a string
-specified by ARG.  (ARG is used as the PREDICATE argument to
-`completing-read'.)"
-  (cond
-   ((eq type nil)
-    (read-from-minibuffer prompt last-value nil nil history-var))
+The `:file' property prompts for a file name that must match the
+regexp pattern specified in its value.
 
-   ((eq type :file)
-    (let ((use-dialog-box nil))
+The `:completion' property prompts for a string specified by its
+value.  (The property value is used as the PREDICATE argument to
+`completing-read'.)"
+  (let* ((default (plist-get plist :default))
+         (prompt-def
+          (if default
+              (if (string-match "\\(\\):[ \t]*\\'" prompt)
+                  (replace-match (format " (default \"%s\")" default) t t prompt 1)
+                (replace-regexp-in-string "[ \t]*\\'"
+                                          (format " (default \"%s\") " default)
+                                          prompt t t))
+            prompt))
+         (use-dialog-box nil))
+    (cond
+     ((plist-member plist :file)
       (expand-file-name
        (read-file-name prompt
-                       (file-name-directory last-value) nil t
+                       (file-name-directory last-value) default t
                        (file-name-nondirectory last-value)
-                       (if arg
-                           `(lambda (f)
-                              (string-match (concat "\\<" ,arg "\\>")
-                                            (file-name-nondirectory f)))
-                         nil)))))
+                       (when (plist-get plist :file)
+                         `(lambda (f)
+                            (string-match
+                             (concat "\\<" ,(plist-get plist :file) "\\>")
+                             (file-name-nondirectory f)))))))
 
-   ((eq type :completion)
-    (completing-read prompt arg nil t last-value history-var))))
+     ((plist-member plist :completion)
+      (completing-read prompt-def (plist-get plist :completion) nil t
+                       last-value history-var default))
+
+     ((plist-get plist :number)
+      (read-number prompt (or default last-value 0)))
+
+     (t
+      (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil)))
+        (if (string= "" r) (or default "") r))))))
 
 (defun sql-get-login (&rest what)
   "Get username, password and database from the user.
@@ -2528,72 +2605,69 @@ symbol `password', for the server if it contains the symbol
 `database'.  The members of WHAT are processed in the order in
 which they are provided.
 
-The tokens for `database' and `server' may also be lists to
-control or limit the values that can be supplied.  These can be
-of the form:
-
-  \(database :file \".+\\\\.EXT\")
-  \(database :completion FUNCTION)
+Each token may also be a list with the token in the car and a
+plist of options as the cdr.  The following properties are
+supported:
 
-The `server' token supports the same forms.
+    :file <filename-regexp>
+    :completion <list-of-strings-or-function>
+    :default <default-value>
+    :number t
 
 In order to ask the user for username, password and database, call the
 function like this: (sql-get-login 'user 'password 'database)."
   (interactive)
-    (mapcar
-     (lambda (w)
-       (let ((token (or (and (listp w) (car w)) w))
-             (type  (or (and (listp w) (nth 1 w)) nil))
-             (arg   (or (and (listp w) (nth 2 w)) nil)))
-
-         (cond
-          ((eq token 'user)             ; user
-           (setq sql-user
-                 (read-from-minibuffer "User: " sql-user nil nil
-                                       'sql-user-history)))
-
-          ((eq token 'password)         ; password
-           (setq sql-password
-                 (sql-read-passwd "Password: " sql-password)))
-
-          ((eq token 'server)           ; server
-           (setq sql-server
-                 (sql-get-login-ext "Server: " sql-server
-                                    'sql-server-history type arg)))
-
-          ((eq token 'database)         ; database
-           (setq sql-database
-                 (sql-get-login-ext "Database: " sql-database
-                                    'sql-database-history type arg)))
-
-          ((eq token 'port)             ; port
-           (setq sql-port
-                 (read-number "Port: " (if (numberp sql-port)
-                                           sql-port
-                                         0)))))))
-     what))
-
-(defun sql-find-sqli-buffer ()
+  (mapcar
+   (lambda (w)
+     (let ((token (or (and (consp w) (car w)) w))
+           (plist (or (and (consp w) (cdr w)) nil)))
+
+     (cond
+      ((eq token 'user)         ; user
+       (setq sql-user
+             (sql-get-login-ext "User: " sql-user
+                                'sql-user-history plist)))
+
+      ((eq token 'password)             ; password
+       (setq sql-password
+             (sql-read-passwd "Password: " sql-password)))
+
+      ((eq token 'server)               ; server
+       (setq sql-server
+             (sql-get-login-ext "Server: " sql-server
+                                'sql-server-history plist)))
+
+      ((eq token 'database)             ; database
+       (setq sql-database
+             (sql-get-login-ext "Database: " sql-database
+                                'sql-database-history plist)))
+
+      ((eq token 'port)         ; port
+       (setq sql-port
+             (sql-get-login-ext "Port: " sql-port
+                                nil (append '(:number t) plist)))))))
+   what))
+
+(defun sql-find-sqli-buffer (&optional product)
   "Returns the name of the current default SQLi buffer or nil.
 In order to qualify, the SQLi buffer must be alive, be in
 `sql-interactive-mode' and have a process."
-  (let ((default-buffer (default-value 'sql-buffer))
-        (current-product sql-product))
-    (if (sql-buffer-live-p default-buffer)
-        default-buffer
-      (save-current-buffer
-        (let ((buflist (buffer-list))
-              (found))
-          (while (not (or (null buflist)
-                          found))
-            (let ((candidate (car buflist)))
-              (set-buffer candidate)
-              (if (and (sql-buffer-live-p candidate)
-                       (derived-mode-p 'sql-interactive-mode)
-                       (eq sql-product current-product))
-                  (setq found (buffer-name candidate)))
-              (setq buflist (cdr buflist))))
-          found)))))
+  (let ((buf  sql-buffer)
+        (prod (or product sql-product)))
+    (or
+     ;; Current sql-buffer, if there is one.
+     (and (sql-buffer-live-p buf prod)
+          buf)
+     ;; Global sql-buffer
+     (and (setq buf (default-value 'sql-buffer))
+          (sql-buffer-live-p buf prod)
+          buf)
+     ;; Look thru each buffer
+     (car (apply 'append
+                 (mapcar (lambda (b)
+                           (and (sql-buffer-live-p b prod)
+                                (list (buffer-name b))))
+                         (buffer-list)))))))
 
 (defun sql-set-sqli-buffer-generally ()
   "Set SQLi buffer for all SQL buffers that have none.
@@ -2611,10 +2685,11 @@ using `sql-find-sqli-buffer'.  If `sql-buffer' is set,
         (let ((candidate (car buflist)))
           (set-buffer candidate)
           (if (and (derived-mode-p 'sql-mode)
-                   (not (buffer-live-p sql-buffer)))
+                   (not (sql-buffer-live-p sql-buffer)))
               (progn
                 (setq sql-buffer default-buffer)
-                (run-hooks 'sql-set-sqli-hook))))
+                (when default-buffer
+                  (run-hooks 'sql-set-sqli-hook)))))
         (setq buflist (cdr buflist))))))
 
 (defun sql-set-sqli-buffer ()
@@ -2632,19 +2707,13 @@ If you call it from anywhere else, it sets the global copy of
   (interactive)
   (let ((default-buffer (sql-find-sqli-buffer)))
     (if (null default-buffer)
-        (error "There is no suitable SQLi buffer"))
-    (let ((new-buffer
-           (get-buffer
-            (read-buffer "New SQLi buffer: " default-buffer t))))
-      (if (null (get-buffer-process new-buffer))
-          (error "Buffer %s has no process" (buffer-name new-buffer)))
-      (if (null (with-current-buffer new-buffer
-                  (derived-mode-p 'sql-interactive-mode)))
-          (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
-      (if new-buffer
-          (progn
-            (setq sql-buffer (buffer-name new-buffer))
-            (run-hooks 'sql-set-sqli-hook))))))
+        (error "There is no suitable SQLi buffer")
+      (let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
+        (if (null (sql-buffer-live-p new-buffer))
+            (error "Buffer %s is not a working SQLi buffer" new-buffer)
+          (when new-buffer
+            (setq sql-buffer new-buffer)
+            (run-hooks 'sql-set-sqli-hook)))))))
 
 (defun sql-show-sqli-buffer ()
   "Show the name of current SQLi buffer.
@@ -2682,7 +2751,7 @@ server/database name."
                   (apply 'append nil
                          (sql-for-each-login
                           (sql-get-product-feature sql-product :sqli-login)
-                          (lambda (token type arg)
+                          (lambda (token plist)
                             (cond
                              ((eq token 'user)
                               (unless (string= "" sql-user)
@@ -2694,13 +2763,13 @@ server/database name."
                              ((eq token 'server)
                               (unless (string= "" sql-server)
                                 (list "."
-                                      (if (eq type :file)
+                                      (if (plist-member plist :file)
                                           (file-name-nondirectory sql-server)
                                         sql-server))))
                              ((eq token 'database)
                               (unless (string= "" sql-database)
                                 (list "@"
-                                      (if (eq type :file)
+                                      (if (plist-member plist :file)
                                          (file-name-nondirectory sql-database)
                                         sql-database))))
 
@@ -2742,13 +2811,13 @@ NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
   (if (not (derived-mode-p 'sql-interactive-mode))
       (message "Current buffer is not a SQL interactive buffer")
 
-    (cond
-     ((stringp new-name)
-      (setq sql-alternate-buffer-name new-name))
-     ((listp new-name)
-      (setq sql-alternate-buffer-name
+    (setq sql-alternate-buffer-name
+          (cond
+           ((stringp new-name) new-name)
+           ((consp new-name)
             (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): "
-                         sql-alternate-buffer-name))))
+                         sql-alternate-buffer-name))
+           (t                  sql-alternate-buffer-name)))
 
     (rename-buffer (if (string= "" sql-alternate-buffer-name)
                        "*SQL*"
@@ -2994,6 +3063,171 @@ If given the optional parameter VALUE, sets
 
 
 
+;;; Redirect output functions
+
+(defun sql-redirect (command combuf &optional outbuf save-prior)
+  "Execute the SQL command and send output to OUTBUF.
+
+COMBUF must be an active SQL interactive buffer.  OUTBUF may be
+an existing buffer, or the name of a non-existing buffer.  If
+omitted the output is sent to a temporary buffer which will be
+killed after the command completes.  COMMAND should be a string
+of commands accepted by the SQLi program."
+
+  (with-current-buffer combuf
+    (let ((buf  (get-buffer-create (or outbuf " *SQL-Redirect*")))
+          (proc (get-buffer-process (current-buffer)))
+          (comint-prompt-regexp (sql-get-product-feature sql-product
+                                                         :prompt-regexp))
+          (start nil))
+      (with-current-buffer buf
+        (toggle-read-only -1)
+        (unless save-prior
+          (erase-buffer))
+        (goto-char (point-max))
+        (unless (zerop (buffer-size))
+          (insert "\n"))
+        (setq start (point)))
+
+      ;; Run the command
+      (message "Executing SQL command...")
+      (comint-redirect-send-command-to-process command buf proc nil t)
+      (while (null comint-redirect-completed)
+        (accept-process-output nil 1))
+      (message "Executing SQL command...done")
+
+      ;; Clean up the output results
+      (with-current-buffer buf
+        ;; Remove trailing whitespace
+        (goto-char (point-max))
+        (when (looking-back "[ \t\f\n\r]*" start)
+          (delete-region (match-beginning 0) (match-end 0)))
+        ;; Remove echo if there was one
+        (goto-char start)
+        (when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
+          (delete-region (match-beginning 0) (match-end 0)))
+        (goto-char start)))))
+
+(defun sql-redirect-value (command combuf regexp &optional regexp-groups)
+  "Execute the SQL command and return part of result.
+
+COMBUF must be an active SQL interactive buffer.  COMMAND should
+be a string of commands accepted by the SQLi program.  From the
+output, the REGEXP is repeatedly matched and the list of
+REGEXP-GROUPS submatches is returned.  This behaves much like
+\\[comint-redirect-results-list-from-process] but instead of
+returning a single submatch it returns a list of each submatch
+for each match."
+
+  (let ((outbuf " *SQL-Redirect-values*")
+        (results nil))
+    (sql-redirect command combuf outbuf nil)
+    (with-current-buffer outbuf
+      (while (re-search-forward regexp nil t)
+        (push
+         (cond
+          ;; no groups-return all of them
+          ((null regexp-groups)
+           (let ((i 1)
+                 (r nil))
+             (while (match-beginning i)
+               (push (match-string i) r))
+             (nreverse r)))
+          ;; one group specified
+          ((numberp regexp-groups)
+           (match-string regexp-groups))
+          ;; list of numbers; return the specified matches only
+          ((consp regexp-groups)
+           (mapcar (lambda (c)
+                     (cond
+                      ((numberp c) (match-string c))
+                      ((stringp c) (match-substitute-replacement c))
+                      (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c))))
+                   regexp-groups))
+          ;; String is specified; return replacement string
+          ((stringp regexp-groups)
+           (match-substitute-replacement regexp-groups))
+          (t
+           (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s"
+                  regexp-groups)))
+         results)))
+      (nreverse results)))
+
+(defun sql-execute (sqlbuf outbuf command arg)
+  "Executes a command in a SQL interacive buffer and captures the output.
+
+The commands are run in SQLBUF and the output saved in OUTBUF.
+COMMAND must be a string, a function or a list of such elements.
+Functions are called with SQLBUF, OUTBUF and ARG as parameters;
+strings are formatted with ARG and executed.
+
+If the results are empty the OUTBUF is deleted, otherwise the
+buffer is popped into a view window. "
+  (mapc
+   (lambda (c)
+     (cond
+      ((stringp c)
+       (sql-redirect (if arg (format c arg) c) sqlbuf outbuf) t)
+      ((functionp c)
+       (apply c sqlbuf outbuf arg))
+      (t (error "Unknown sql-execute item %s" c))))
+   (if (consp command) command (cons command nil)))
+
+  (setq outbuf (get-buffer outbuf))
+  (if (zerop (buffer-size outbuf))
+      (kill-buffer outbuf)
+    (let ((one-win (eq (selected-window)
+                       (get-lru-window))))
+      (with-current-buffer outbuf
+        (set-buffer-modified-p nil)
+        (toggle-read-only 1))
+      (view-buffer-other-window outbuf)
+      (when one-win
+        (shrink-window-if-larger-than-buffer)))))
+
+(defun sql-execute-feature (sqlbuf outbuf feature enhanced arg)
+  "List objects or details in a separate display buffer."
+  (let (command)
+    (with-current-buffer sqlbuf
+      (setq command (sql-get-product-feature sql-product feature)))
+    (unless command
+      (error "%s does not support %s" sql-product feature))
+    (when (consp command)
+      (setq command (if enhanced
+                        (cdr command)
+                      (car command))))
+    (sql-execute sqlbuf outbuf command arg)))
+
+(defun sql-read-table-name (prompt)
+  "Read the name of a database table."
+  ;; TODO: Fetch table/view names from database and provide completion.
+  ;; Also implement thing-at-point if the buffer has valid names in it
+  ;; (i.e. sql-mode, sql-interactive-mode, or sql-list-all buffers)
+  (read-from-minibuffer prompt))
+
+(defun sql-list-all (&optional enhanced)
+  "List all database objects."
+  (interactive "P")
+  (let ((sqlbuf (sql-find-sqli-buffer)))
+    (unless sqlbuf
+      (error "No SQL interactive buffer found"))
+    (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)))
+
+(defun sql-list-table (name &optional enhanced)
+  "List the details of a database table. "
+  (interactive
+   (list (sql-read-table-name "Table name: ")
+         current-prefix-arg))
+  (let ((sqlbuf (sql-find-sqli-buffer)))
+    (unless sqlbuf
+      (error "No SQL interactive buffer found"))
+    (unless name
+      (error "No table name specified"))
+    (sql-execute-feature sqlbuf (format "*List %s*" name)
+                         :list-table enhanced name)))
+
+
+
 ;;; SQL mode -- uses SQL interactive mode
 
 ;;;###autoload
@@ -3221,6 +3455,14 @@ Sentinels will always get the two parameters PROCESS and EVENT."
 
 ;;; Connection handling
 
+(defun sql-read-connection (prompt &optional initial default)
+  "Read a connection name."
+  (let ((completion-ignore-case t))
+    (completing-read prompt
+                     (mapcar (lambda (c) (car c))
+                             sql-connection-alist)
+                     nil t initial 'sql-connection-history default)))
+
 ;;;###autoload
 (defun sql-connect (connection)
   "Connect to an interactive session using CONNECTION settings.
@@ -3234,12 +3476,7 @@ is specified in the connection settings."
   ;; Prompt for the connection from those defined in the alist
   (interactive
    (if sql-connection-alist
-       (list
-        (let ((completion-ignore-case t))
-          (completing-read "Connection: "
-                           (mapcar (lambda (c) (car c))
-                                   sql-connection-alist)
-                           nil t nil nil '(()))))
+       (list (sql-read-connection "Connection: " nil '(nil)))
      nil))
 
   ;; Are there connections defined
@@ -3273,10 +3510,10 @@ is specified in the connection settings."
                           ;; the remaining params (w/o the connection params)
                           (rem-params   (sql-for-each-login
                                          login-params
-                                         (lambda (token type arg)
+                                         (lambda (token plist)
                                            (unless (member token set-params)
-                                                    (if (or type arg)
-                                                        (list token type arg)
+                                                    (if plist
+                                                        (cons token plist)
                                                       token)))))
                           ;; Remember the connection
                           (sql-connection connection))
@@ -3317,7 +3554,7 @@ optionally is saved to the user's init file."
               (append (list name)
                       (sql-for-each-login
                        `(product ,@login)
-                       (lambda (token type arg)
+                       (lambda (token plist)
                          (cond
                           ((eq token 'product)  `(sql-product  ',sql-product))
                           ((eq token 'user)     `(sql-user     ,sql-user))
@@ -3365,10 +3602,10 @@ the call to \\[sql-product-interactive] with
 
   ;; Handle universal arguments if specified
   (when (not (or executing-kbd-macro noninteractive))
-    (when (and (listp product)
+    (when (and (consp product)
                (not (cdr product))
                (numberp (car product)))
-      (when (>= (car product) 16)
+      (when (>= (prefix-numeric-value product) 16)
         (when (not new-name)
           (setq new-name '(4)))
         (setq product '(4)))))
@@ -3376,61 +3613,53 @@ the call to \\[sql-product-interactive] with
   ;; Get the value of product that we need
   (setq product
         (cond
-         ((equal product '(4))          ; C-u, prompt for product
-          (intern (completing-read "SQL product: "
-                                   (mapcar (lambda (info) (symbol-name (car info)))
-                                           sql-product-alist)
-                                   nil 'require-match
-                                   (or (and sql-product
-                                            (symbol-name sql-product))
-                                       "ansi"))))
          ((and product                  ; Product specified
                (symbolp product)) product)
+         ((= (prefix-numeric-value product) 4) ; C-u, prompt for product
+          (sql-read-product "SQL product: " sql-product))
          (t sql-product)))              ; Default to sql-product
 
   ;; If we have a product and it has a interactive mode
   (if product
       (when (sql-get-product-feature product :sqli-comint-func)
-        ;; If no new name specified, fall back on sql-buffer if its for
-        ;; the same product
-        (if (and (not new-name)
-                 sql-buffer
-                 (sql-buffer-live-p sql-buffer)
-                 (comint-check-proc sql-buffer)
-                 (eq product (with-current-buffer sql-buffer sql-product)))
-            (pop-to-buffer sql-buffer)
-
-          ;; We have a new name or sql-buffer doesn't exist or match
-          ;; Start by remembering where we start
-          (let* ((start-buffer (current-buffer))
-                 new-sqli-buffer)
-
-            ;; Get credentials.
-            (apply 'sql-get-login (sql-get-product-feature product :sqli-login))
-
-            ;; Connect to database.
-            (message "Login...")
-            (funcall (sql-get-product-feature product :sqli-comint-func)
-                     product
-                     (sql-get-product-feature product :sqli-options))
-
-            ;; Set SQLi mode.
-            (setq new-sqli-buffer (current-buffer))
-            (let ((sql-interactive-product product))
-              (sql-interactive-mode))
-
-            ;; Set the new buffer name
-            (when new-name
-              (sql-rename-buffer new-name))
-
-            ;; Set `sql-buffer' in the start buffer
-            (setq sql-buffer (buffer-name new-sqli-buffer))
-            (with-current-buffer start-buffer
-              (setq sql-buffer (buffer-name new-sqli-buffer)))
-
-            ;; All done.
-            (message "Login...done")
-            (pop-to-buffer sql-buffer))))
+        ;; If no new name specified, try to pop to an active SQL
+        ;; interactive for the same product
+        (let ((buf (sql-find-sqli-buffer product)))
+          (if (and (not new-name) buf)
+              (pop-to-buffer buf)
+
+            ;; We have a new name or sql-buffer doesn't exist or match
+            ;; Start by remembering where we start
+            (let ((start-buffer (current-buffer))
+                  new-sqli-buffer)
+
+              ;; Get credentials.
+              (apply 'sql-get-login (sql-get-product-feature product :sqli-login))
+
+              ;; Connect to database.
+              (message "Login...")
+              (funcall (sql-get-product-feature product :sqli-comint-func)
+                       product
+                       (sql-get-product-feature product :sqli-options))
+
+              ;; Set SQLi mode.
+              (setq new-sqli-buffer (current-buffer))
+              (let ((sql-interactive-product product))
+                (sql-interactive-mode))
+
+              ;; Set the new buffer name
+              (when new-name
+                (sql-rename-buffer new-name))
+
+              ;; Set `sql-buffer' in the new buffer and the start buffer
+              (setq sql-buffer (buffer-name new-sqli-buffer))
+              (with-current-buffer start-buffer
+                (setq sql-buffer (buffer-name new-sqli-buffer))
+                (run-hooks 'sql-set-sqli-hook))
+
+              ;; All done.
+              (message "Login...done")
+              (pop-to-buffer sql-buffer)))))
     (message "No default SQL product defined.  Set `sql-product'.")))
 
 (defun sql-comint (product params)
@@ -3440,14 +3669,17 @@ PRODUCT is the SQL product.  PARAMS is a list of strings which are
 passed as command line arguments."
   (let ((program (sql-get-product-feature product :sqli-program))
         (buf-name "SQL"))
+    ;; make sure we can find the program
+    (unless (executable-find program)
+      (error "Unable to locate SQL program \'%s\'" program))
     ;; Make sure buffer name is unique
-    (when (get-buffer (format "*%s*" buf-name))
+    (when (sql-buffer-live-p (format "*%s*" buf-name))
       (setq buf-name (format "SQL-%s" product))
-      (when (get-buffer (format "*%s*" buf-name))
+      (when (sql-buffer-live-p (format "*%s*" buf-name))
         (let ((i 1))
-          (while (get-buffer (format "*%s*"
-                                     (setq buf-name
-                                           (format "SQL-%s%d" product i))))
+          (while (sql-buffer-live-p
+                  (format "*%s*"
+                          (setq buf-name (format "SQL-%s%d" product i))))
             (setq i (1+ i))))))
     (set-buffer
      (apply 'make-comint buf-name program nil params))))
@@ -3890,6 +4122,8 @@ Try to set `comint-output-filter-functions' like this:
         (setq params (append (list "-h" sql-server) params)))
     (if (not (string= "" sql-user))
         (setq params (append (list "-U" sql-user) params)))
+    (if (not (= 0 sql-port))
+        (setq params (append (list "-p" sql-port) params)))
     (sql-comint product params)))