merge trunk

21 files changed, 1536 insertions, 1190 deletions

diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 227f202fef0..4bbe1e43f85 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -834,10 +834,7 @@ the 4 file locations can be clicked on and jumped to."
 ;;
 ;; On Emacs, this is done through the `syntax-table' text property.  The
 ;; corresponding action is applied automatically each time the buffer
-;; changes.  If `font-lock-mode' is enabled (the default) the action is
-;; set up by `font-lock-syntactic-keywords'.  Otherwise, we do it
-;; manually in `ada-after-change-function'.  The proper method is
-;; installed by `ada-handle-syntax-table-properties'.
+;; changes via syntax-propertize-function.
 ;;
 ;; on XEmacs, the `syntax-table' property does not exist and we have to use a
 ;; slow advice to `parse-partial-sexp' to do the same thing.
@@ -937,6 +934,12 @@ declares it as a word constituent."
             (insert (caddar change))
             (setq change (cdr change)))))))
 
+(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
+  ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table
+  ;; properties, and in some cases we even had to do it manually (in
+  ;; `ada-after-change-function').  `ada-handle-syntax-table-properties'
+  ;; decides which method to use.
+
 (defun ada-set-syntax-table-properties ()
   "Assign `syntax-table' properties in accessible part of buffer.
 In particular, character constants are said to be strings, #...#
@@ -991,6 +994,8 @@ OLD-LEN indicates what the length of the replaced text was."
     ;; Take care of `syntax-table' properties manually.
     (ada-initialize-syntax-table-properties)))
 
+) ;;(not (fboundp 'syntax-propertize))
+
 ;;------------------------------------------------------------------
 ;;  Testing the grammatical context
 ;;------------------------------------------------------------------
@@ -1118,7 +1123,8 @@ the file name."
 
 ;;;###autoload
 (defun ada-mode ()
-  "Ada mode is the major mode for editing Ada code."
+  "Ada mode is the major mode for editing Ada code.
+\\{ada-mode-map}"
 
   (interactive)
   (kill-all-local-variables)
@@ -1161,9 +1167,9 @@ the file name."
     (set (make-local-variable 'comment-padding) 0)
     (set (make-local-variable 'parse-sexp-lookup-properties) t))
 
-  (set 'case-fold-search t)
+  (setq case-fold-search t)
   (if (boundp 'imenu-case-fold-search)
-      (set 'imenu-case-fold-search t))
+      (setq imenu-case-fold-search t))
 
   (set (make-local-variable 'fill-paragraph-function)
        'ada-fill-comment-paragraph)
@@ -1186,8 +1192,13 @@ the file name."
        '(ada-font-lock-keywords
          nil t
          ((?\_ . "w") (?# . "."))
-         beginning-of-line
-         (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
+         beginning-of-line))
+
+  (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
+      (set (make-local-variable 'syntax-propertize-function)
+           (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords))
+    (set (make-local-variable 'font-lock-syntactic-keywords)
+         ada-font-lock-syntactic-keywords))
 
   ;; Set up support for find-file.el.
   (set (make-local-variable 'ff-other-file-alist)
@@ -1322,22 +1333,24 @@ the file name."
 
   ;;  To be run after the hook, in case the user modified
   ;;  ada-fill-comment-prefix
-  (make-local-variable 'comment-start)
-  (if ada-fill-comment-prefix
-      (set 'comment-start ada-fill-comment-prefix)
-    (set 'comment-start "-- "))
+  ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs
+  ;; then it was already available before running the hook, and if he
+  ;; modifies it in the hook, he might as well modify comment-start instead.
+  (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- "))
 
   ;;  Run this after the hook to give the users a chance to activate
   ;;  font-lock-mode
 
-  (unless (featurep 'xemacs)
+  (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
+              (featurep 'xemacs))
     (ada-initialize-syntax-table-properties)
     (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
 
   ;; the following has to be done after running the ada-mode-hook
   ;; because users might want to set the values of these variable
   ;; inside the hook
-
+  ;; FIXME: it might even be set later on via file-local vars, no?
+  ;; so maybe ada-keywords should be set lazily.
   (cond ((eq ada-language-version 'ada83)
          (setq ada-keywords ada-83-keywords))
         ((eq ada-language-version 'ada95)
@@ -1397,25 +1410,21 @@ If WORD is not given, then the current word in the buffer is used instead.
 The new word is added to the first file in `ada-case-exception-file'.
 The standard casing rules will no longer apply to this word."
   (interactive)
-  (let ((previous-syntax-table (syntax-table))
-        file-name
-        )
-
-    (cond ((stringp ada-case-exception-file)
-           (setq file-name ada-case-exception-file))
-          ((listp ada-case-exception-file)
-           (setq file-name (car ada-case-exception-file)))
-          (t
-           (error (concat "No exception file specified.  "
-                          "See variable ada-case-exception-file"))))
+  (let ((file-name
+         (cond ((stringp ada-case-exception-file)
+                ada-case-exception-file)
+               ((listp ada-case-exception-file)
+                (car ada-case-exception-file))
+               (t
+                (error (concat "No exception file specified.  "
+                               "See variable ada-case-exception-file"))))))
 
-    (set-syntax-table ada-mode-symbol-syntax-table)
     (unless word
-      (save-excursion
-        (skip-syntax-backward "w")
-        (setq word (buffer-substring-no-properties
-                    (point) (save-excursion (forward-word 1) (point))))))
-    (set-syntax-table previous-syntax-table)
+      (with-syntax-table ada-mode-symbol-syntax-table
+        (save-excursion
+          (skip-syntax-backward "w")
+          (setq word (buffer-substring-no-properties
+                      (point) (save-excursion (forward-word 1) (point)))))))
 
     ;;  Reread the exceptions file, in case it was modified by some other,
     (ada-case-read-exceptions-from-file file-name)
@@ -1425,11 +1434,9 @@ The standard casing rules will no longer apply to this word."
     (if (and (not (equal ada-case-exception '()))
              (assoc-string word ada-case-exception t))
         (setcar (assoc-string word ada-case-exception t) word)
-      (add-to-list 'ada-case-exception (cons word t))
-      )
+      (add-to-list 'ada-case-exception (cons word t)))
 
-    (ada-save-exceptions-to-file file-name)
-    ))
+    (ada-save-exceptions-to-file file-name)))
 
 (defun ada-create-case-exception-substring (&optional word)
   "Define the substring WORD as an exception for the casing system.
@@ -1464,7 +1471,7 @@ word itself has a special casing."
               (modify-syntax-entry ?_ "." (syntax-table))
               (save-excursion
                 (skip-syntax-backward "w")
-                (set 'word (buffer-substring-no-properties
+                (setq word (buffer-substring-no-properties
                             (point)
                             (save-excursion (forward-word 1) (point))))))
           (modify-syntax-entry ?_ (make-string 1 underscore-syntax)
@@ -1633,37 +1640,30 @@ ARG is the prefix the user entered with \\[universal-argument]."
   (interactive "P")
 
   (if ada-auto-case
-      (let ((lastk last-command-event)
-            (previous-syntax-table (syntax-table)))
-
-        (unwind-protect
-            (progn
-              (set-syntax-table ada-mode-symbol-syntax-table)
-              (cond ((or (eq lastk ?\n)
-                         (eq lastk ?\r))
-                     ;; horrible kludge
-                     (insert " ")
-                     (ada-adjust-case)
-                     ;; horrible dekludge
-                     (delete-char -1)
-                     ;; some special keys and their bindings
-                     (cond
-                      ((eq lastk ?\n)
-                       (funcall ada-lfd-binding))
-                      ((eq lastk ?\r)
-                       (funcall ada-ret-binding))))
-                    ((eq lastk ?\C-i) (ada-tab))
-                    ;; Else just insert the character
-              ((self-insert-command (prefix-numeric-value arg))))
-              ;; if there is a keyword in front of the underscore
-              ;; then it should be part of an identifier (MH)
-              (if (eq lastk ?_)
-                  (ada-adjust-case t)
-                (ada-adjust-case))
-              )
-          ;; Restore the syntax table
-          (set-syntax-table previous-syntax-table))
-        )
+      (let ((lastk last-command-event))
+
+        (with-syntax-table ada-mode-symbol-syntax-table
+          (cond ((or (eq lastk ?\n)
+                     (eq lastk ?\r))
+                 ;; horrible kludge
+                 (insert " ")
+                 (ada-adjust-case)
+                 ;; horrible dekludge
+                 (delete-char -1)
+                 ;; some special keys and their bindings
+                 (cond
+                  ((eq lastk ?\n)
+                   (funcall ada-lfd-binding))
+                  ((eq lastk ?\r)
+                   (funcall ada-ret-binding))))
+                ((eq lastk ?\C-i) (ada-tab))
+                ;; Else just insert the character
+                ((self-insert-command (prefix-numeric-value arg))))
+          ;; if there is a keyword in front of the underscore
+          ;; then it should be part of an identifier (MH)
+          (if (eq lastk ?_)
+              (ada-adjust-case t)
+            (ada-adjust-case))))
 
     ;; Else, no auto-casing
     (cond
@@ -1672,10 +1672,10 @@ ARG is the prefix the user entered with \\[universal-argument]."
      ((eq last-command-event ?\r)
       (funcall ada-ret-binding))
      (t
-      (self-insert-command (prefix-numeric-value arg))))
-    ))
+      (self-insert-command (prefix-numeric-value arg))))))
 
 (defun ada-activate-keys-for-case ()
+  ;; FIXME: Use post-self-insert-hook instead of changing key bindings.
   "Modify the key bindings for all the keys that should readjust the casing."
   (interactive)
   ;; Save original key-bindings to allow swapping ret/lfd
@@ -1735,44 +1735,41 @@ Attention: This function might take very long for big regions!"
   (let ((begin nil)
         (end nil)
         (keywordp nil)
-        (attribp nil)
-        (previous-syntax-table (syntax-table)))
+        (attribp nil))
     (message "Adjusting case ...")
-    (unwind-protect
-        (save-excursion
-          (set-syntax-table ada-mode-symbol-syntax-table)
-          (goto-char to)
-          ;;
-          ;; loop: look for all identifiers, keywords, and attributes
-          ;;
-          (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
-            (setq end (match-end 1))
-            (setq attribp
-                 (and (> (point) from)
-                      (save-excursion
-                        (forward-char -1)
-                        (setq attribp (looking-at "'.[^']")))))
-            (or
-             ;; do nothing if it is a string or comment
-             (ada-in-string-or-comment-p)
-             (progn
-               ;;
-               ;; get the identifier or keyword or attribute
-               ;;
-               (setq begin (point))
-               (setq keywordp (looking-at ada-keywords))
-               (goto-char end)
-               ;;
-               ;; casing according to user-option
-               ;;
-               (if attribp
-                   (funcall ada-case-attribute -1)
-                 (if keywordp
-                     (funcall ada-case-keyword -1)
-                   (ada-adjust-case-identifier)))
-               (goto-char begin))))
-          (message "Adjusting case ... Done"))
-      (set-syntax-table previous-syntax-table))))
+    (with-syntax-table ada-mode-symbol-syntax-table
+      (save-excursion
+        (goto-char to)
+        ;;
+        ;; loop: look for all identifiers, keywords, and attributes
+        ;;
+        (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
+          (setq end (match-end 1))
+          (setq attribp
+                (and (> (point) from)
+                     (save-excursion
+                       (forward-char -1)
+                       (setq attribp (looking-at "'.[^']")))))
+          (or
+           ;; do nothing if it is a string or comment
+           (ada-in-string-or-comment-p)
+           (progn
+             ;;
+             ;; get the identifier or keyword or attribute
+             ;;
+             (setq begin (point))
+             (setq keywordp (looking-at ada-keywords))
+             (goto-char end)
+             ;;
+             ;; casing according to user-option
+             ;;
+             (if attribp
+                 (funcall ada-case-attribute -1)
+               (if keywordp
+                   (funcall ada-case-keyword -1)
+                 (ada-adjust-case-identifier)))
+             (goto-char begin))))
+        (message "Adjusting case ... Done")))))
 
 (defun ada-adjust-case-buffer ()
   "Adjust the case of all words in the whole buffer.
@@ -1803,46 +1800,39 @@ ATTENTION: This function might take very long for big buffers!"
   (let ((begin nil)
         (end nil)
         (delend nil)
-        (paramlist nil)
-        (previous-syntax-table (syntax-table)))
-    (unwind-protect
-        (progn
-          (set-syntax-table ada-mode-symbol-syntax-table)
+        (paramlist nil))
+    (with-syntax-table ada-mode-symbol-syntax-table
 
-          ;; check if really inside parameter list
-          (or (ada-in-paramlist-p)
-              (error "Not in parameter list"))
+      ;; check if really inside parameter list
+      (or (ada-in-paramlist-p)
+          (error "Not in parameter list"))
 
-          ;; find start of current parameter-list
-          (ada-search-ignore-string-comment
-           (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
-          (down-list 1)
-          (backward-char 1)
-          (setq begin (point))
+      ;; find start of current parameter-list
+      (ada-search-ignore-string-comment
+       (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
+      (down-list 1)
+      (backward-char 1)
+      (setq begin (point))
 
-          ;; find end of parameter-list
-          (forward-sexp 1)
-          (setq delend (point))
-          (delete-char -1)
-          (insert "\n")
-
-          ;; find end of last parameter-declaration
-          (forward-comment -1000)
-          (setq end (point))
+      ;; find end of parameter-list
+      (forward-sexp 1)
+      (setq delend (point))
+      (delete-char -1)
+      (insert "\n")
 
-          ;; build a list of all elements of the parameter-list
-          (setq paramlist (ada-scan-paramlist (1+ begin) end))
+      ;; find end of last parameter-declaration
+      (forward-comment -1000)
+      (setq end (point))
 
-          ;; delete the original parameter-list
-          (delete-region begin  delend)
+      ;; build a list of all elements of the parameter-list
+      (setq paramlist (ada-scan-paramlist (1+ begin) end))
 
-          ;; insert the new parameter-list
-          (goto-char begin)
-          (ada-insert-paramlist paramlist))
+      ;; delete the original parameter-list
+      (delete-region begin  delend)
 
-      ;; restore syntax-table
-      (set-syntax-table previous-syntax-table)
-      )))
+      ;; insert the new parameter-list
+      (goto-char begin)
+      (ada-insert-paramlist paramlist))))
 
 (defun ada-scan-paramlist (begin end)
   "Scan the parameter list found in between BEGIN and END.
@@ -2186,14 +2176,12 @@ Return the new position of point or nil if not found."
 Return the calculation that was done, including the reference point
 and the offset."
   (interactive)
-  (let ((previous-syntax-table (syntax-table))
-        (orgpoint (point-marker))
+  (let ((orgpoint (point-marker))
         cur-indent tmp-indent
         prev-indent)
 
     (unwind-protect
-        (progn
-          (set-syntax-table ada-mode-symbol-syntax-table)
+        (with-syntax-table ada-mode-symbol-syntax-table
 
           ;;  This need to be done here so that the advice is not always
           ;;  activated (this might interact badly with other modes)
@@ -2203,14 +2191,14 @@ and the offset."
           (save-excursion
             (setq cur-indent
 
-                 ;; Not First line in the buffer ?
-                 (if (save-excursion (zerop (forward-line -1)))
-                     (progn
-                       (back-to-indentation)
-                       (ada-get-current-indent))
+                  ;; Not First line in the buffer ?
+                  (if (save-excursion (zerop (forward-line -1)))
+                      (progn
+                        (back-to-indentation)
+                        (ada-get-current-indent))
 
-                   ;; first line in the buffer
-                   (list (point-min) 0))))
+                    ;; first line in the buffer
+                    (list (point-min) 0))))
 
           ;; Evaluate the list to get the column to indent to
           ;; prev-indent contains the column to indent to
@@ -2242,14 +2230,10 @@ and the offset."
           (if (< (current-column) (current-indentation))
               (back-to-indentation)))
 
-      ;; restore syntax-table
-      (set-syntax-table previous-syntax-table)
       (if (featurep 'xemacs)
-          (ad-deactivate 'parse-partial-sexp))
-      )
+          (ad-deactivate 'parse-partial-sexp)))
 
-    cur-indent
-    ))
+    cur-indent))
 
 (defun ada-get-current-indent ()
   "Return the indentation to use for the current line."
@@ -2512,11 +2496,11 @@ and the offset."
           (if (looking-at "renames")
               (let (pos)
                 (save-excursion
-                  (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
+                  (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
                 (if (and pos
                          (= (downcase (char-after (car pos))) ?r))
                     (goto-char (car pos)))
-                (set 'var 'ada-indent-renames)))
+                (setq var 'ada-indent-renames)))
 
           (forward-comment -1000)
           (if (= (char-before) ?\))
@@ -2533,7 +2517,7 @@ and the offset."
                              (looking-at "\\(function\\|procedure\\)\\>"))
                            (progn
                              (backward-word 1)
-                             (set 'num-back 2)
+                             (setq num-back 2)
                              (looking-at "\\(function\\|procedure\\)\\>")))))
 
                 ;; The indentation depends of the value of ada-indent-return
@@ -4046,8 +4030,7 @@ Point is moved at the beginning of the SEARCH-RE."
   (let (found
         begin
         end
-        parse-result
-        (previous-syntax-table (syntax-table)))
+        parse-result)
 
     ;; FIXME: need to pass BACKWARD to search-func!
     (unless search-func
@@ -4057,67 +4040,65 @@ Point is moved at the beginning of the SEARCH-RE."
     ;; search until found or end-of-buffer
     ;; We have to test that we do not look further than limit
     ;;
-    (set-syntax-table ada-mode-symbol-syntax-table)
-    (while (and (not found)
-                (or (not limit)
-                    (or (and backward (<= limit (point)))
-                        (>= limit (point))))
-                (funcall search-func search-re limit 1))
-      (setq begin (match-beginning 0))
-      (setq end (match-end 0))
-
-      (setq parse-result (parse-partial-sexp
-                          (save-excursion (beginning-of-line) (point))
-                          (point)))
-
-      (cond
-       ;;
-       ;; If inside a string, skip it (and the following comments)
-       ;;
-       ((ada-in-string-p parse-result)
-        (if (featurep 'xemacs)
-            (search-backward "\"" nil t)
-          (goto-char (nth 8 parse-result)))
-        (unless backward (forward-sexp 1)))
-       ;;
-       ;; If inside a comment, skip it (and the following comments)
-       ;; There is a special code for comments at the end of the file
-       ;;
-       ((ada-in-comment-p parse-result)
-        (if (featurep 'xemacs)
-            (progn
-              (forward-line 1)
-              (beginning-of-line)
-              (forward-comment -1))
-          (goto-char (nth 8 parse-result)))
-        (unless backward
-          ;;  at the end of the file, it is not possible to skip a comment
-          ;;  so we just go at the end of the line
-          (if (forward-comment 1)
-              (progn
-                (forward-comment 1000)
-                (beginning-of-line))
-            (end-of-line))))
-       ;;
-       ;; directly in front of a comment => skip it, if searching forward
-       ;;
-       ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
-        (unless backward (progn (forward-char -1) (forward-comment 1000))))
-
-       ;;
-       ;; found a parameter-list but should ignore it => skip it
-       ;;
-       ((and (not paramlists) (ada-in-paramlist-p))
-        (if backward
-            (search-backward "(" nil t)
-          (search-forward ")" nil t)))
-       ;;
-       ;; found what we were looking for
-       ;;
-       (t
-        (setq found t))))               ; end of loop
-
-    (set-syntax-table previous-syntax-table)
+    (with-syntax-table ada-mode-symbol-syntax-table
+      (while (and (not found)
+                  (or (not limit)
+                      (or (and backward (<= limit (point)))
+                          (>= limit (point))))
+                  (funcall search-func search-re limit 1))
+        (setq begin (match-beginning 0))
+        (setq end (match-end 0))
+
+        (setq parse-result (parse-partial-sexp
+                            (save-excursion (beginning-of-line) (point))
+                            (point)))
+
+        (cond
+         ;;
+         ;; If inside a string, skip it (and the following comments)
+         ;;
+         ((ada-in-string-p parse-result)
+          (if (featurep 'xemacs)
+              (search-backward "\"" nil t)
+            (goto-char (nth 8 parse-result)))
+          (unless backward (forward-sexp 1)))
+         ;;
+         ;; If inside a comment, skip it (and the following comments)
+         ;; There is a special code for comments at the end of the file
+         ;;
+         ((ada-in-comment-p parse-result)
+          (if (featurep 'xemacs)
+              (progn
+                (forward-line 1)
+                (beginning-of-line)
+                (forward-comment -1))
+            (goto-char (nth 8 parse-result)))
+          (unless backward
+            ;;  at the end of the file, it is not possible to skip a comment
+            ;;  so we just go at the end of the line
+            (if (forward-comment 1)
+                (progn
+                  (forward-comment 1000)
+                  (beginning-of-line))
+              (end-of-line))))
+         ;;
+         ;; directly in front of a comment => skip it, if searching forward
+         ;;
+         ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
+          (unless backward (progn (forward-char -1) (forward-comment 1000))))
+
+         ;;
+         ;; found a parameter-list but should ignore it => skip it
+         ;;
+         ((and (not paramlists) (ada-in-paramlist-p))
+          (if backward
+              (search-backward "(" nil t)
+            (search-forward ")" nil t)))
+         ;;
+         ;; found what we were looking for
+         ;;
+         (t
+          (setq found t)))))            ; end of loop
 
     (if found
         (cons begin end)
@@ -4398,122 +4379,109 @@ of the region.  Otherwise, operate only on the current line."
 (defun ada-move-to-start ()
   "Move point to the matching start of the current Ada structure."
   (interactive)
-  (let ((pos (point))
-        (previous-syntax-table (syntax-table)))
-    (unwind-protect
-        (progn
-          (set-syntax-table ada-mode-symbol-syntax-table)
+  (let ((pos (point)))
+    (with-syntax-table ada-mode-symbol-syntax-table
 
-          (save-excursion
-            ;;
-            ;; do nothing if in string or comment or not on 'end ...;'
-            ;;            or if an error occurs during processing
-            ;;
-            (or
-             (ada-in-string-or-comment-p)
-             (and (progn
-                    (or (looking-at "[ \t]*\\<end\\>")
-                        (backward-word 1))
-                    (or (looking-at "[ \t]*\\<end\\>")
-                        (backward-word 1))
-                    (or (looking-at "[ \t]*\\<end\\>")
-                        (error "Not on end ...;")))
-                  (ada-goto-matching-start 1)
-                  (setq pos (point))
-
-                  ;;
-                  ;; on 'begin' => go on, according to user option
-                  ;;
-                  ada-move-to-declaration
-                  (looking-at "\\<begin\\>")
-                  (ada-goto-decl-start)
-                  (setq pos (point))))
-
-            )                           ; end of save-excursion
-
-          ;; now really move to the found position
-          (goto-char pos))
-
-      ;; restore syntax-table
-      (set-syntax-table previous-syntax-table))))
+      (save-excursion
+        ;;
+        ;; do nothing if in string or comment or not on 'end ...;'
+        ;;            or if an error occurs during processing
+        ;;
+        (or
+         (ada-in-string-or-comment-p)
+         (and (progn
+                (or (looking-at "[ \t]*\\<end\\>")
+                    (backward-word 1))
+                (or (looking-at "[ \t]*\\<end\\>")
+                    (backward-word 1))
+                (or (looking-at "[ \t]*\\<end\\>")
+                    (error "Not on end ...;")))
+              (ada-goto-matching-start 1)
+              (setq pos (point))
+
+              ;;
+              ;; on 'begin' => go on, according to user option
+              ;;
+              ada-move-to-declaration
+              (looking-at "\\<begin\\>")
+              (ada-goto-decl-start)
+              (setq pos (point))))
+
+        )                               ; end of save-excursion
+
+      ;; now really move to the found position
+      (goto-char pos))))
 
 (defun ada-move-to-end ()
   "Move point to the end of the block around point.
 Moves to 'begin' if in a declarative part."
   (interactive)
   (let ((pos (point))
-        decl-start
-        (previous-syntax-table (syntax-table)))
-    (unwind-protect
-        (progn
-          (set-syntax-table ada-mode-symbol-syntax-table)
-
-          (save-excursion
-
-            (cond
-             ;; Go to the beginning of the current word, and check if we are
-             ;; directly on 'begin'
-             ((save-excursion
-                (skip-syntax-backward "w")
-                (looking-at "\\<begin\\>"))
-              (ada-goto-matching-end 1)
-              )
-
-             ;; on first line of subprogram body
-             ;; Do nothing for specs or generic instantion, since these are
-             ;; handled as the general case (find the enclosing block)
-             ;; We also need to make sure that we ignore nested subprograms
-             ((save-excursion
-                (and (skip-syntax-backward "w")
-                     (looking-at "\\<function\\>\\|\\<procedure\\>" )
-                     (ada-search-ignore-string-comment "is\\|;")
-                     (not (= (char-before) ?\;))
-                     ))
-              (skip-syntax-backward "w")
-              (ada-goto-matching-end 0 t))
-
-             ;; on first line of task declaration
-             ((save-excursion
-                (and (ada-goto-stmt-start)
-                     (looking-at "\\<task\\>" )
-                     (forward-word 1)
-                     (ada-goto-next-non-ws)
-                     (looking-at "\\<body\\>")))
-              (ada-search-ignore-string-comment "begin" nil nil nil
-                                                'word-search-forward))
-             ;; accept block start
-             ((save-excursion
-                (and (ada-goto-stmt-start)
-                     (looking-at "\\<accept\\>" )))
-              (ada-goto-matching-end 0))
-             ;; package start
-             ((save-excursion
-                (setq decl-start (and (ada-goto-decl-start t) (point)))
-                (and decl-start (looking-at "\\<package\\>")))
-              (ada-goto-matching-end 1))
-
-             ;;  On a "declare" keyword
-             ((save-excursion
-                (skip-syntax-backward "w")
-                (looking-at "\\<declare\\>"))
-              (ada-goto-matching-end 0 t))
-
-             ;; inside a 'begin' ... 'end' block
-             (decl-start
-              (goto-char decl-start)
-              (ada-goto-matching-end 0 t))
-
-             ;; (hopefully ;-) everything else
-             (t
-              (ada-goto-matching-end 1)))
-            (setq pos (point))
-            )
+        decl-start)
+    (with-syntax-table ada-mode-symbol-syntax-table
 
-          ;; now really move to the position found
-          (goto-char pos))
+      (save-excursion
 
-      ;; restore syntax-table
-      (set-syntax-table previous-syntax-table))))
+        (cond
+         ;; Go to the beginning of the current word, and check if we are
+         ;; directly on 'begin'
+         ((save-excursion
+            (skip-syntax-backward "w")
+            (looking-at "\\<begin\\>"))
+          (ada-goto-matching-end 1))
+
+         ;; on first line of subprogram body
+         ;; Do nothing for specs or generic instantion, since these are
+         ;; handled as the general case (find the enclosing block)
+         ;; We also need to make sure that we ignore nested subprograms
+         ((save-excursion
+            (and (skip-syntax-backward "w")
+                 (looking-at "\\<function\\>\\|\\<procedure\\>" )
+                 (ada-search-ignore-string-comment "is\\|;")
+                 (not (= (char-before) ?\;))
+                 ))
+          (skip-syntax-backward "w")
+          (ada-goto-matching-end 0 t))
+
+         ;; on first line of task declaration
+         ((save-excursion
+            (and (ada-goto-stmt-start)
+                 (looking-at "\\<task\\>" )
+                 (forward-word 1)
+                 (ada-goto-next-non-ws)
+                 (looking-at "\\<body\\>")))
+          (ada-search-ignore-string-comment "begin" nil nil nil
+                                            'word-search-forward))
+         ;; accept block start
+         ((save-excursion
+            (and (ada-goto-stmt-start)
+                 (looking-at "\\<accept\\>" )))
+          (ada-goto-matching-end 0))
+         ;; package start
+         ((save-excursion
+            (setq decl-start (and (ada-goto-decl-start t) (point)))
+            (and decl-start (looking-at "\\<package\\>")))
+          (ada-goto-matching-end 1))
+
+         ;;  On a "declare" keyword
+         ((save-excursion
+            (skip-syntax-backward "w")
+            (looking-at "\\<declare\\>"))
+          (ada-goto-matching-end 0 t))
+
+         ;; inside a 'begin' ... 'end' block
+         (decl-start
+          (goto-char decl-start)
+          (ada-goto-matching-end 0 t))
+
+         ;; (hopefully ;-) everything else
+         (t
+          (ada-goto-matching-end 1)))
+        (setq pos (point))
+        )
+
+      ;; now really move to the position found
+      (goto-char pos))))
 
 (defun ada-next-procedure ()
   "Move point to next procedure."
@@ -4818,7 +4786,7 @@ Moves to 'begin' if in a declarative part."
     (if (featurep 'xemacs)
         (progn
           (define-key ada-mode-map [menu-bar] ada-mode-menu)
-          (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
+          (setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
 
 
 ;; -------------------------------------------------------
@@ -5040,7 +5008,7 @@ or the spec otherwise."
                    (ada-find-src-file-in-dir
                     (file-name-nondirectory (concat name (car suffixes))))))
               (if other
-                  (set 'is-spec other)))
+                  (setq is-spec other)))
 
           ;;  Else search in the current directory
           (if (file-exists-p (concat name (car suffixes)))
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/autoconf.el b/lisp/progmodes/autoconf.el
index a56623f22da..004bb3de78d 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -43,9 +43,6 @@
 (defvar autoconf-mode-hook nil
   "Hook run by `autoconf-mode'.")
 
-(defconst autoconf-font-lock-syntactic-keywords
-  '(("\\<dnl\\>" 0 '(11))))
-
 (defconst autoconf-definition-regexp
   "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*")
 
@@ -94,8 +91,8 @@ searching backwards at another AC_... command."
        "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
   (set (make-local-variable 'comment-start) "dnl ")
   (set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +")
-  (set (make-local-variable 'font-lock-syntactic-keywords)
-       autoconf-font-lock-syntactic-keywords)
+  (set (make-local-variable 'syntax-propertize-function)
+       (syntax-propertize-rules ("\\<dnl\\>" (0 "<"))))
   (set (make-local-variable 'font-lock-defaults)
        `(autoconf-font-lock-keywords nil nil (("_" . "w"))))
   (set (make-local-variable 'imenu-generic-expression)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e389007065a..2a24bf1ce90 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
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 86a6be40cc5..e074e92fbe5 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -83,12 +83,6 @@ This includes those for cfservd as well as cfagent."))
     ;; File, acl &c in group:   { token ... }
     ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
 
-(defconst cfengine-font-lock-syntactic-keywords
-  ;; In the main syntax-table, backslash is marked as a punctuation, because
-  ;; of its use in DOS-style directory separators.  Here we try to recognize
-  ;; the cases where backslash is used as an escape inside strings.
-  '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\")))
-
 (defvar cfengine-imenu-expression
   `((nil ,(concat "^[ \t]*" (eval-when-compile
                               (regexp-opt cfengine-actions t))
@@ -237,13 +231,15 @@ to the action header."
   (set (make-local-variable 'fill-paragraph-function)
        #'cfengine-fill-paragraph)
   (define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs)
-  ;; Fixme: Use `font-lock-syntactic-keywords' to set the args of
-  ;; functions in evaluated classes to string syntax, and then obey
-  ;; syntax properties.
   (setq font-lock-defaults
-        '(cfengine-font-lock-keywords nil nil nil beginning-of-line
-          (font-lock-syntactic-keywords
-           . cfengine-font-lock-syntactic-keywords)))
+        '(cfengine-font-lock-keywords nil nil nil beginning-of-line))
+  ;; Fixme: set the args of functions in evaluated classes to string
+  ;; syntax, and then obey syntax properties.
+  (set (make-local-variable 'syntax-propertize-function)
+       ;; In the main syntax-table, \ is marked as a punctuation, because
+       ;; of its use in DOS-style directory separators.  Here we try to
+       ;; recognize the cases where \ is used as an escape inside strings.
+       (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
   (setq imenu-generic-expression cfengine-imenu-expression)
   (set (make-local-variable 'beginning-of-defun-function)
        #'cfengine-beginning-of-defun)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 598733cb5d7..7f0732ecffc 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -164,7 +164,7 @@ and a string describing how the process finished.")
 
 (defvar compilation-num-errors-found)
 
-(defconst compilation-error-regexp-alist-alist
+(defvar compilation-error-regexp-alist-alist
   '((absoft
      "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
 of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -263,9 +263,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      ;; The core of the regexp is the one with *?.  It says that a file name
      ;; can be composed of any non-newline char, but it also rules out some
      ;; valid but unlikely cases, such as a trailing space or a space
-     ;; followed by a -.
+     ;; followed by a -, or a colon followed by a space.
+
+     ;; The "in \\|from " exception was added to handle messages from Ruby.
      "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
+\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
 \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
 \\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
@@ -766,12 +768,27 @@ The value can be either 2 -- skip anything less than error, 1 --
 skip anything less than warning or 0 -- don't skip any messages.
 Note that all messages not positively identified as warning or
 info, are considered errors."
-  :type '(choice (const :tag "Warnings and info" 2)
-                 (const :tag "Info" 1)
-                 (const :tag "None" 0))
+  :type '(choice (const :tag "Skip warnings and info" 2)
+                 (const :tag "Skip info" 1)
+                 (const :tag "No skip" 0))
   :group 'compilation
   :version "22.1")
 
+(defun compilation-set-skip-threshold (level)
+  "Switch the `compilation-skip-threshold' level."
+  (interactive
+   (list
+    (mod (if current-prefix-arg
+             (prefix-numeric-value current-prefix-arg)
+           (1+ compilation-skip-threshold))
+         3)))
+  (setq compilation-skip-threshold level)
+  (message "Skipping %s"
+           (case compilation-skip-threshold
+             (0 "Nothing")
+             (1 "Info messages")
+             (2 "Warnings and info"))))
+
 (defcustom compilation-skip-visited nil
   "Compilation motion commands skip visited messages if this is t.
 Visited messages are ones for which the file, line and column have been jumped
@@ -1212,7 +1229,7 @@ Returns the compilation buffer created."
   (let* ((name-of-mode
           (if (eq mode t)
               "compilation"
-            (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+            (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
          (thisdir default-directory)
          outwin outbuf)
     (with-current-buffer
@@ -2377,7 +2394,7 @@ The file-structure looks like this:
 (defun compilation-forget-errors ()
   ;; In case we hit the same file/line specs, we want to recompute a new
   ;; marker for them, so flush our cache.
-  (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+  (clrhash compilation-locs)
   (setq compilation-gcpro nil)
   ;; FIXME: the old code reset the directory-stack, so maybe we should
   ;; put a `directory change' marker of some sort, but where?  -stef
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d69cce76faa..d89e41b38fb 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1840,7 +1840,13 @@ or as help on variables `cperl-tips', `cperl-problems',
   (make-local-variable 'cperl-syntax-state)
   (setq cperl-syntax-state nil)         ; reset syntaxification cache
   (if cperl-use-syntax-table-text-property
-      (progn
+      (if (boundp 'syntax-propertize-function)
+          (progn
+            ;; Reset syntaxification cache.
+            (set (make-local-variable 'cperl-syntax-done-to) nil)
+            (set (make-local-variable 'syntax-propertize-function)
+                 (lambda (start end)
+                   (goto-char start) (cperl-fontify-syntaxically end))))
         (make-local-variable 'parse-sexp-lookup-properties)
         ;; Do not introduce variable if not needed, we check it!
         (set 'parse-sexp-lookup-properties t)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index c37744bfe45..daa0fd07364 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -483,6 +483,7 @@ 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
@@ -887,9 +888,11 @@ with no args, if that value is non-nil."
           fortran-font-lock-keywords-3
           fortran-font-lock-keywords-4)
          nil t ((?/ . "$/") ("_$" . "w"))
-         fortran-beginning-of-subprogram
-         (font-lock-syntactic-keywords
-          . fortran-font-lock-syntactic-keywords)))
+         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))
   (set (make-local-variable 'imenu-case-fold-search) t)
   (set (make-local-variable 'imenu-generic-expression)
        fortran-imenu-generic-expression)
@@ -917,11 +920,13 @@ affects all Fortran buffers, and also the default."
               (when (eq major-mode 'fortran-mode)
                 (setq fortran-line-length nchars
                       fill-column fortran-line-length
-                      new (fortran-font-lock-syntactic-keywords))
+                      new (fortran-make-syntax-propertize-function))
                 ;; Refontify only if necessary.
-                (unless (equal new font-lock-syntactic-keywords)
-                  (setq font-lock-syntactic-keywords
-                        (fortran-font-lock-syntactic-keywords))
+                (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))))))
           (if global
               (buffer-list)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index d20a14682c7..4c1471e39ec 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3123,10 +3123,12 @@ class of the file (using s to separate nested class ids)."
     ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
     ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face))))
 
-(defvar gdb-script-font-lock-syntactic-keywords
-  '(("^document\\s-.*\\(\n\\)" (1 "< b"))
-    ("^end\\>"
-     (0 (unless (eq (match-beginning 0) (point-min))
+(defconst gdb-script-syntax-propertize-function
+  (syntax-propertize-rules
+   ("^document\\s-.*\\(\n\\)" (1 "< b"))
+   ("^end\\(\\>\\)"
+    (1 (ignore
+        (unless (eq (match-beginning 0) (point-min))
           ;; We change the \n in front, which is more difficult, but results
           ;; in better highlighting.  If the doc is empty, the single \n is
           ;; both the beginning and the end of the docstring, which can't be
@@ -3138,10 +3140,9 @@ class of the file (using s to separate nested class ids)."
                              'syntax-table (eval-when-compile
                                              (string-to-syntax "> b")))
           ;; Make sure that rehighlighting the previous line won't erase our
-          ;; syntax-table property.
+          ;; syntax-table property and that modifying `end' will.
           (put-text-property (1- (match-beginning 0)) (match-end 0)
-                             'font-lock-multiline t)
-          nil)))))
+                             'syntax-multiline t)))))))
 
 (defun gdb-script-font-lock-syntactic-face (state)
   (cond
@@ -3239,10 +3240,13 @@ Treats actions as defuns."
        #'gdb-script-end-of-defun)
   (set (make-local-variable 'font-lock-defaults)
        '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
-         (font-lock-syntactic-keywords
-          . gdb-script-font-lock-syntactic-keywords)
          (font-lock-syntactic-face-function
-          . gdb-script-font-lock-syntactic-face))))
+          . gdb-script-font-lock-syntactic-face)))
+  ;; Recognize docstrings.
+  (set (make-local-variable 'syntax-propertize-function)
+       gdb-script-syntax-propertize-function)
+  (add-hook 'syntax-propertize-extend-region-functions
+            #'syntax-propertize-multiline 'append 'local))
 
 
 ;;; tooltips for GUD
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 5e854f852e1..ba70bb8ecce 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -45,16 +45,16 @@
 
 ;;; Code:
 
-(eval-and-compile
-  (require 'cc-mode)
-  (require 'font-lock)
-  (require 'newcomment)
-  (require 'imenu)
-  (require 'etags)
-  (require 'thingatpt)
-  (require 'easymenu)
-  (require 'moz nil t)
-  (require 'json nil t))
+
+(require 'cc-mode)
+(require 'font-lock)
+(require 'newcomment)
+(require 'imenu)
+(require 'etags)
+(require 'thingatpt)
+(require 'easymenu)
+(require 'moz nil t)
+(require 'json nil t)
 
 (eval-when-compile
   (require 'cl)
@@ -725,20 +725,19 @@ as if strings, cpp macros, and comments have been removed.
 
 If invoked while inside a macro, it treats the contents of the
 macro as normal text."
+  (unless count (setq count 1))
   (let ((saved-point (point))
-        (search-expr
-         (cond ((null count)
-                '(js--re-search-forward-inner regexp bound 1))
-               ((< count 0)
-                '(js--re-search-backward-inner regexp bound (- count)))
-               ((> count 0)
-                '(js--re-search-forward-inner regexp bound count)))))
+        (search-fun
+         (cond ((< count 0) (setq count (- count))
+                #'js--re-search-backward-inner)
+               ((> count 0) #'js--re-search-forward-inner)
+               (t #'ignore))))
     (condition-case err
-        (eval search-expr)
+        (funcall search-fun regexp bound count)
       (search-failed
        (goto-char saved-point)
        (unless noerror
-         (error (error-message-string err)))))))
+         (signal (car err) (cdr err)))))))
 
 
 (defun js--re-search-backward-inner (regexp &optional bound count)
@@ -782,20 +781,7 @@ as if strings, preprocessor macros, and comments have been
 removed.
 
 If invoked while inside a macro, treat the macro as normal text."
-  (let ((saved-point (point))
-        (search-expr
-         (cond ((null count)
-                '(js--re-search-backward-inner regexp bound 1))
-               ((< count 0)
-                '(js--re-search-forward-inner regexp bound (- count)))
-               ((> count 0)
-                '(js--re-search-backward-inner regexp bound count)))))
-    (condition-case err
-        (eval search-expr)
-      (search-failed
-       (goto-char saved-point)
-       (unless noerror
-         (error (error-message-string err)))))))
+  (js--re-search-forward regexp bound noerror (if count (- count) -1)))
 
 (defun js--forward-expression ()
   "Move forward over a whole JavaScript expression.
@@ -1674,18 +1660,19 @@ This performs fontification according to `js--class-styles'."
 ;; XXX: Javascript can continue a regexp literal across lines so long
 ;; as the newline is escaped with \. Account for that in the regexp
 ;; below.
-(defconst js--regexp-literal
+(eval-and-compile
+  (defconst js--regexp-literal
   "[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)"
   "Regexp matching a JavaScript regular expression literal.
 Match groups 1 and 2 are the characters forming the beginning and
-end of the literal.")
+end of the literal."))
+
 
-;; we want to match regular expressions only at the beginning of
-;; expressions
-(defconst js-font-lock-syntactic-keywords
-  `((,js--regexp-literal (1 "|") (2 "|")))
-  "Syntactic font lock keywords matching regexps in JavaScript.
-See `font-lock-keywords'.")
+(defconst js-syntax-propertize-function
+  (syntax-propertize-rules
+   ;; We want to match regular expressions only at the beginning of
+   ;; expressions.
+   (js--regexp-literal (1 "\"") (2 "\""))))
 
 ;;; Indentation
 
@@ -3317,10 +3304,9 @@ Key bindings:
 
   (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
   (set (make-local-variable 'font-lock-defaults)
-       (list js--font-lock-keywords
-             nil nil nil nil
-             '(font-lock-syntactic-keywords
-               . js-font-lock-syntactic-keywords)))
+       '(js--font-lock-keywords))
+  (set (make-local-variable 'syntax-propertize-function)
+       js-syntax-propertize-function)
 
   (set (make-local-variable 'parse-sexp-ignore-comments) t)
   (set (make-local-variable 'parse-sexp-lookup-properties) t)
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 362a1db6c10..187c838382b 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -505,15 +505,16 @@ not be enclosed in { } or ( )."
    cpp-font-lock-keywords))
 
 
-(defconst makefile-font-lock-syntactic-keywords
-  ;; From sh-script.el.
-  ;; A `#' begins a comment in sh when it is unquoted and at the beginning
-  ;; of a word.  In the shell, words are separated by metacharacters.
-  ;; The list of special chars is taken from the single-unix spec of the
-  ;; shell command language (under `quoting') but with `$' removed.
-  '(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_")
-    ;; Change the syntax of a quoted newline so that it does not end a comment.
-    ("\\\\\n" 0 ".")))
+(defconst makefile-syntax-propertize-function
+  (syntax-propertize-rules
+   ;; From sh-script.el.
+   ;; A `#' begins a comment in sh when it is unquoted and at the beginning
+   ;; of a word.  In the shell, words are separated by metacharacters.
+   ;; The list of special chars is taken from the single-unix spec of the
+   ;; shell command language (under `quoting') but with `$' removed.
+   ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
+   ;; Change the syntax of a quoted newline so that it does not end a comment.
+   ("\\\\\n" (0 "."))))
 
 (defvar makefile-imenu-generic-expression
   `(("Dependencies" makefile-previous-dependency 1)
@@ -872,9 +873,9 @@ Makefile mode can be configured by modifying the following variables:
        '(makefile-font-lock-keywords
          nil nil
          ((?$ . "."))
-         backward-paragraph
-         (font-lock-syntactic-keywords
-          . makefile-font-lock-syntactic-keywords)))
+         backward-paragraph))
+  (set (make-local-variable 'syntax-propertize-function)
+       makefile-syntax-propertize-function)
 
   ;; Add-log.
   (set (make-local-variable 'add-log-current-defun-function)
@@ -943,15 +944,9 @@ Makefile mode can be configured by modifying the following variables:
 (define-derived-mode makefile-imake-mode makefile-mode "Imakefile"
   "An adapted `makefile-mode' that knows about imake."
   :syntax-table makefile-imake-mode-syntax-table
-  (let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))
-        new)
-    ;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults.
-    (mapc (lambda (elt)
-            (unless (and (consp elt)
-                         (eq (car elt) 'font-lock-syntactic-keywords))
-              (setq new (cons elt new))))
-          base)
-    (setq font-lock-defaults (nreverse new))))
+  (set (make-local-variable 'syntax-propertize-function) nil)
+  (setq font-lock-defaults
+        `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
 
 
 
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index ecb8461a9f2..94af563d88f 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -89,7 +89,7 @@
 (defvar mixal-mode-syntax-table
   (let ((st (make-syntax-table)))
     ;; We need to do a bit more to make fontlocking for comments work.
-    ;; See mixal-font-lock-syntactic-keywords.
+    ;; See use of syntax-propertize-function.
     ;; (modify-syntax-entry ?* "<" st)
     (modify-syntax-entry ?\n ">" st)
     st)
@@ -1028,13 +1028,14 @@ EXECUTION-TIME holds info about the time it takes, number or string.")
 
 
 ;;; Font-locking:
-(defvar mixal-font-lock-syntactic-keywords
-  ;; Normal comments start with a * in column 0 and end at end of line.
-  '(("^\\*" (0 '(11)))                  ;(string-to-syntax "<") == '(11)
-    ;; Every line can end with a comment which is placed after the operand.
-    ;; I assume here that mnemonics without operands can not have a comment.
-    ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
-     (1 '(11)))))
+(defconst mixal-syntax-propertize-function
+  (syntax-propertize-rules
+   ;; Normal comments start with a * in column 0 and end at end of line.
+   ("^\\*" (0 "<"))
+   ;; Every line can end with a comment which is placed after the operand.
+   ;; I assume here that mnemonics without operands can not have a comment.
+   ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
+    (1 "<"))))
 
 (defvar mixal-font-lock-keywords
   `(("^\\([A-Z0-9a-z]+\\)"
@@ -1110,9 +1111,9 @@ Assumes that file has been compiled with debugging support."
   (set (make-local-variable 'comment-start) "*")
   (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
   (set (make-local-variable 'font-lock-defaults)
-       `(mixal-font-lock-keywords nil nil nil nil
-         (font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords)
-         (parse-sexp-lookup-properties . t)))
+       `(mixal-font-lock-keywords))
+  (set (make-local-variable 'syntax-propertize-function)
+       mixal-syntax-propertize-function)
   ;; might add an indent function in the future
   ;;  (set (make-local-variable 'indent-line-function) 'mixal-indent-line)
   (set (make-local-variable 'compile-command) (concat "mixasm "
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index ede850f87ab..bbefdaa2ccf 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -179,38 +179,28 @@ parenthetical grouping.")
          '(3 font-lock-function-name-face nil t)))
   "Additional Octave expressions to highlight.")
 
-(defvar octave-font-lock-syntactic-keywords
+(defun octave-syntax-propertize-function (start end)
+  (goto-char start)
+  (octave-syntax-propertize-sqs end)
+  (funcall (syntax-propertize-rules
   ;; Try to distinguish the string-quotes from the transpose-quotes.
-  '(("[[({,; ]\\('\\)" (1 "\"'"))
-    (octave-font-lock-close-quotes)))
-
-(defun octave-font-lock-close-quotes (limit)
-  "Fix the syntax-table of the closing quotes of single-quote strings."
-  ;; Freely inspired from perl-font-lock-special-syntactic-constructs.
-  (let ((state (syntax-ppss)))
-    (while (< (point) limit)
-      (cond
-       ((eq (nth 3 state) ?\')
+            ("[[({,; ]\\('\\)"
+             (1 (prog1 "\"'" (octave-syntax-propertize-sqs end)))))
+           (point) end))
+
+(defun octave-syntax-propertize-sqs (end)
+  "Propertize the content/end of single-quote strings."
+  (when (eq (nth 3 (syntax-ppss)) ?\')
         ;; A '..' string.
-        (save-excursion
-          (when (re-search-forward "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)[^']"
-                                   nil t)
-            (goto-char (1- (point)))
-            ;; Remove any syntax-table property we may have applied to
-            ;; some of the (doubled) single quotes within the string.
-            ;; Since these are the only chars on which we place properties,
-            ;; we take a shortcut and just remove all properties.
-            (remove-text-properties (1+ (nth 8 state)) (match-beginning 1)
-                                    '(syntax-table nil))
+    (when (re-search-forward
+           "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move)
+      (goto-char (match-beginning 2))
             (when (eq (char-before (match-beginning 1)) ?\\)
               ;; Backslash cannot escape a single quote.
               (put-text-property (1- (match-beginning 1)) (match-beginning 1)
                                  'syntax-table (string-to-syntax ".")))
             (put-text-property (match-beginning 1) (match-end 1)
-                               'syntax-table (string-to-syntax "\"'"))))))
-
-      (setq state (parse-partial-sexp (point) limit nil nil state
-                                      'syntax-table)))))
+                         'syntax-table (string-to-syntax "\"'")))))
 
 (defcustom inferior-octave-buffer "*Inferior Octave*"
   "Name of buffer for running an inferior Octave process."
@@ -544,6 +534,8 @@ Non-nil means always go to the next Octave code line after sending."
      0)
     ((:before . "case") octave-block-offset)))
 
+(defvar electric-indent-chars)
+
 ;;;###autoload
 (define-derived-mode octave-mode prog-mode "Octave"
   "Major mode for editing Octave code.
@@ -682,9 +674,10 @@ including a reproducible test case and send the message."
   (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill)
 
   (set (make-local-variable 'font-lock-defaults)
-       '(octave-font-lock-keywords nil nil nil nil
-         (font-lock-syntactic-keywords . octave-font-lock-syntactic-keywords)
-         (parse-sexp-lookup-properties . t)))
+       '(octave-font-lock-keywords))
+
+  (set (make-local-variable 'syntax-propertize-function)
+       #'octave-syntax-propertize-function)
 
   (set (make-local-variable 'imenu-generic-expression)
        octave-mode-imenu-generic-expression)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f8eba5accdb..ae3acc3cda3 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -250,59 +250,76 @@ The expansion is entirely correct because it uses the C preprocessor."
 ;; y /.../.../
 ;;
 ;; <file*glob>
-(defvar perl-font-lock-syntactic-keywords
-  ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
-  `(;; Turn POD into b-style comments
-    ("^\\(=\\)\\sw" (1 "< b"))
-    ("^=cut[ \t]*\\(\n\\)" (1 "> b"))
-    ;; Catch ${ so that ${var} doesn't screw up indentation.
-    ;; This also catches $' to handle 'foo$', although it should really
-    ;; check that it occurs inside a '..' string.
-    ("\\(\\$\\)[{']" (1 ". p"))
-    ;; Handle funny names like $DB'stop.
-    ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
-    ;; format statements
-    ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7)))
-    ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
-    ;; Be careful not to match "sub { (...) ... }".
-    ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
-     1 '(1))
-    ;; Regexp and funny quotes.  Distinguishing a / that starts a regexp
-    ;; match from the division operator is ...interesting.
-    ;; Basically, / is a regexp match if it's preceded by an infix operator
-    ;; (or some similar separator), or by one of the special keywords
-    ;; corresponding to builtin functions that can take their first arg
-    ;; without parentheses.  Of course, that presume we're looking at the
-    ;; *opening* slash.  We can afford to mis-match the closing ones
-    ;; here, because they will be re-treated separately later in
-    ;; perl-font-lock-special-syntactic-constructs.
-    (,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
-              (regexp-opt '("split" "if" "unless" "until" "while" "split"
-                            "grep" "map" "not" "or" "and"))
-              "\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
-     (2 (if (and (match-end 1)
-                 (save-excursion
-                   (goto-char (match-end 1))
-                   ;; Not 100% correct since we haven't finished setting up
-                   ;; the syntax-table before point, but better than nothing.
-                   (forward-comment (- (point-max)))
-                   (put-text-property (point) (match-end 2)
-                                      'jit-lock-defer-multiline t)
-                   (not (memq (char-before)
-                              '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
-            nil ;; A division sign instead of a regexp-match.
-          '(7))))
-    ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
-     ;; Nasty cases:
-     ;; /foo/m  $a->m  $#m $m @m %m
-     ;; \s (appears often in regexps).
-     ;; -s file
-     (3 (if (assoc (char-after (match-beginning 3))
-                   perl-quote-like-pairs)
-            '(15) '(7))))
-    ;; Find and mark the end of funny quotes and format statements.
-    (perl-font-lock-special-syntactic-constructs)
-    ))
+(defun perl-syntax-propertize-function (start end)
+  (let ((case-fold-search nil))
+    (goto-char start)
+    (perl-syntax-propertize-special-constructs end)
+    ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
+    (funcall
+     (syntax-propertize-rules
+      ;; Turn POD into b-style comments.  Place the cut rule first since it's
+      ;; more specific.
+      ("^=cut\\>.*\\(\n\\)" (1 "> b"))
+      ("^\\(=\\)\\sw" (1 "< b"))
+      ;; Catch ${ so that ${var} doesn't screw up indentation.
+      ;; This also catches $' to handle 'foo$', although it should really
+      ;; check that it occurs inside a '..' string.
+      ("\\(\\$\\)[{']" (1 ". p"))
+      ;; Handle funny names like $DB'stop.
+      ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
+      ;; format statements
+      ("^[ \t]*format.*=[ \t]*\\(\n\\)"
+       (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
+      ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
+      ;; Be careful not to match "sub { (...) ... }".
+      ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
+       (1 "."))
+      ;; Regexp and funny quotes.  Distinguishing a / that starts a regexp
+      ;; match from the division operator is ...interesting.
+      ;; Basically, / is a regexp match if it's preceded by an infix operator
+      ;; (or some similar separator), or by one of the special keywords
+      ;; corresponding to builtin functions that can take their first arg
+      ;; without parentheses.  Of course, that presume we're looking at the
+      ;; *opening* slash.  We can afford to mis-match the closing ones
+      ;; here, because they will be re-treated separately later in
+      ;; perl-font-lock-special-syntactic-constructs.
+      ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
+               (regexp-opt '("split" "if" "unless" "until" "while" "split"
+                             "grep" "map" "not" "or" "and"))
+               "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
+       (2 (ignore
+           (if (and (match-end 1)       ; / at BOL.
+                    (save-excursion
+                      (goto-char (match-end 1))
+                      (forward-comment (- (point-max)))
+                      (put-text-property (point) (match-end 2)
+                                         'syntax-multiline t)
+                      (not (memq (char-before)
+                                 '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
+               nil ;; A division sign instead of a regexp-match.
+             (put-text-property (match-beginning 2) (match-end 2)
+                                'syntax-table (string-to-syntax "\""))
+             (perl-syntax-propertize-special-constructs end)))))
+      ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
+       ;; Nasty cases:
+       ;; /foo/m  $a->m  $#m $m @m %m
+       ;; \s (appears often in regexps).
+       ;; -s file
+       ;; sub tr {...}
+       (3 (ignore
+           (if (save-excursion (goto-char (match-beginning 0))
+                               (forward-word -1)
+                               (looking-at-p "sub[ \t\n]"))
+               ;; This is defining a function.
+               nil
+             (put-text-property (match-beginning 3) (match-end 3)
+                                'syntax-table
+                                (if (assoc (char-after (match-beginning 3))
+                                           perl-quote-like-pairs)
+                                    (string-to-syntax "|")
+                                  (string-to-syntax "\"")))
+             (perl-syntax-propertize-special-constructs end))))))
+     (point) end)))
 
 (defvar perl-empty-syntax-table
   (let ((st (copy-syntax-table)))
@@ -321,95 +338,123 @@ The expansion is entirely correct because it uses the C preprocessor."
       (modify-syntax-entry close ")" st))
     st))
 
-(defun perl-font-lock-special-syntactic-constructs (limit)
-  ;; We used to do all this in a font-lock-syntactic-face-function, which
-  ;; did not work correctly because sometimes some parts of the buffer are
-  ;; treated with font-lock-syntactic-keywords but not with
-  ;; font-lock-syntactic-face-function (mostly because of
-  ;; font-lock-syntactically-fontified).  That meant that some syntax-table
-  ;; properties were missing.  So now we do the parse-partial-sexp loop
-  ;; ourselves directly from font-lock-syntactic-keywords, so we're sure
-  ;; it's done when necessary.
+(defun perl-syntax-propertize-special-constructs (limit)
+  "Propertize special constructs like regexps and formats."
   (let ((state (syntax-ppss))
         char)
-    (while (< (point) limit)
-      (cond
-       ((or (null (setq char (nth 3 state)))
-            (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
-        ;; Normal text, or comment, or docstring, or normal string.
-        nil)
-       ((eq (nth 3 state) ?\n)
-        ;; A `format' command.
-        (save-excursion
-          (when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
-                     (not (eobp)))
-            (put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
-       (t
-        ;; This is regexp like quote thingy.
-        (setq char (char-after (nth 8 state)))
-        (save-excursion
-          (let ((twoargs (save-excursion
-                           (goto-char (nth 8 state))
-                           (skip-syntax-backward " ")
-                           (skip-syntax-backward "w")
-                           (member (buffer-substring
-                                    (point) (progn (forward-word 1) (point)))
-                                   '("tr" "s" "y"))))
-                (close (cdr (assq char perl-quote-like-pairs)))
-                (pos (point))
-                (st (perl-quote-syntax-table char)))
-            (if (not close)
-                ;; The closing char is the same as the opening char.
-                (with-syntax-table st
-                  (parse-partial-sexp (point) (point-max)
-                                      nil nil state 'syntax-table)
-                  (when twoargs
-                    (parse-partial-sexp (point) (point-max)
-                                        nil nil state 'syntax-table)))
-              ;; The open/close chars are matched like () [] {} and <>.
-              (let ((parse-sexp-lookup-properties nil))
-                (condition-case err
-                    (progn
-                      (with-syntax-table st
-                        (goto-char (nth 8 state)) (forward-sexp 1))
-                      (when twoargs
-                        (save-excursion
-                          ;; Skip whitespace and make sure that font-lock will
-                          ;; refontify the second part in the proper context.
-                          (put-text-property
-                           (point) (progn (forward-comment (point-max)) (point))
-                           'font-lock-multiline t)
-                          ;;
-                          (unless
-                              (or (eobp)
-                                  (save-excursion
-                                    (with-syntax-table
-                                        (perl-quote-syntax-table (char-after))
-                                      (forward-sexp 1))
-                                    (put-text-property pos (line-end-position)
-                                                       'jit-lock-defer-multiline t)
-                                    (looking-at "\\s-*\\sw*e")))
-                            (put-text-property (point) (1+ (point))
-                                               'syntax-table
-                                               (if (assoc (char-after)
-                                                          perl-quote-like-pairs)
-                                                   '(15) '(7)))))))
-                  ;; The arg(s) is not terminated, so it extends until EOB.
-                  (scan-error (goto-char (point-max))))))
-            ;; Point is now right after the arg(s).
-            ;; Erase any syntactic marks within the quoted text.
-            (put-text-property pos (1- (point)) 'syntax-table nil)
-            (when (eq (char-before (1- (point))) ?$)
-              (put-text-property (- (point) 2) (1- (point))
-                                 'syntax-table '(1)))
-            (put-text-property (1- (point)) (point)
-                               'syntax-table (if close '(15) '(7)))))))
-
-      (setq state (parse-partial-sexp (point) limit nil nil state
-                                      'syntax-table))))
-  ;; Tell font-lock that this needs not further processing.
-  nil)
-
+    (cond
+     ((or (null (setq char (nth 3 state)))
+          (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
+      ;; Normal text, or comment, or docstring, or normal string.
+      nil)
+     ((eq (nth 3 state) ?\n)
+      ;; A `format' command.
+      (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move)
+        (put-text-property (1- (point)) (point)
+                           'syntax-table (string-to-syntax "\""))))
+     (t
+      ;; This is regexp like quote thingy.
+      (setq char (char-after (nth 8 state)))
+      (let ((twoargs (save-excursion
+                       (goto-char (nth 8 state))
+                       (skip-syntax-backward " ")
+                       (skip-syntax-backward "w")
+                       (member (buffer-substring
+                                (point) (progn (forward-word 1) (point)))
+                               '("tr" "s" "y"))))
+            (close (cdr (assq char perl-quote-like-pairs)))
+            (st (perl-quote-syntax-table char)))
+        (when (with-syntax-table st
+                (if close
+                    ;; For paired delimiters, Perl allows nesting them, but
+                    ;; since we treat them as strings, Emacs does not count
+                    ;; those delimiters in `state', so we don't know how deep
+                    ;; we are: we have to go back to the beginning of this
+                    ;; "string" and count from there.
+                    (condition-case nil
+                        (progn
+                          ;; Start after the first char since it doesn't have
+                          ;; paren-syntax (an alternative would be to let-bind
+                          ;; parse-sexp-lookup-properties).
+                          (goto-char (1+ (nth 8 state)))
+                          (up-list 1)
+                          t)
+                      (scan-error nil))
+                  (not (or (nth 8 (parse-partial-sexp
+                                   (point) limit nil nil state 'syntax-table))
+                           ;; If we have a self-paired opener and a twoargs
+                           ;; command, the form is s/../../ so we have to skip
+                           ;; a second time.
+                           ;; In the case of s{...}{...}, we only handle the
+                           ;; first part here and the next below.
+                           (when (and twoargs (not close))
+                             (nth 8 (parse-partial-sexp
+                                     (point) limit
+                                     nil nil state 'syntax-table)))))))
+          ;; Point is now right after the arg(s).
+          (when (eq (char-before (1- (point))) ?$)
+            (put-text-property (- (point) 2) (1- (point))
+                               'syntax-table '(1)))
+          (put-text-property (1- (point)) (point)
+                             'syntax-table
+                             (if close
+                                 (string-to-syntax "|")
+                               (string-to-syntax "\"")))
+          ;; If we have two args with a non-self-paired starter (e.g.
+          ;; s{...}{...}) we're right after the first arg, so we still have to
+          ;; handle the second part.
+          (when (and twoargs close)
+            ;; Skip whitespace and make sure that font-lock will
+            ;; refontify the second part in the proper context.
+            (put-text-property
+             (point) (progn (forward-comment (point-max)) (point))
+             'syntax-multiline t)
+            ;;
+            (when (< (point) limit)
+              (put-text-property (point) (1+ (point))
+                                 'syntax-table
+                                 (if (assoc (char-after)
+                                            perl-quote-like-pairs)
+                                     ;; Put an `e' in the cdr to mark this
+                                     ;; char as "second arg starter".
+                                     (string-to-syntax "|e")
+                                   (string-to-syntax "\"e")))
+              (forward-char 1)
+              ;; Re-use perl-syntax-propertize-special-constructs to handle the
+              ;; second part (the first delimiter of second part can't be
+              ;; preceded by "s" or "tr" or "y", so it will not be considered
+              ;; as twoarg).
+              (perl-syntax-propertize-special-constructs limit)))))))))
+
+(defun perl-font-lock-syntactic-face-function (state)
+  (cond
+   ((and (nth 3 state)
+         (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
+         ;; This is a second-arg of s{..}{...} form; let's check if this second
+         ;; arg is executable code rather than a string.  For that, we need to
+         ;; look for an "e" after this second arg, so we have to hunt for the
+         ;; end of the arg.  Depending on whether the whole arg has already
+         ;; been syntax-propertized or not, the end-char will have different
+         ;; syntaxes, so let's ignore syntax-properties temporarily so we can
+         ;; pretend it has not been syntax-propertized yet.
+         (let* ((parse-sexp-lookup-properties nil)
+                (char (char-after (nth 8 state)))
+                (paired (assq char perl-quote-like-pairs)))
+           (with-syntax-table (perl-quote-syntax-table char)
+             (save-excursion
+               (if (not paired)
+                   (parse-partial-sexp (point) (point-max)
+                                       nil nil state 'syntax-table)
+                 (condition-case nil
+                     (progn
+                       (goto-char (1+ (nth 8 state)))
+                       (up-list 1))
+                   (scan-error (goto-char (point-max)))))
+               (put-text-property (nth 8 state) (point)
+                                  'jit-lock-defer-multiline t)
+               (looking-at "[ \t]*\\sw*e")))))
+    nil)
+   (t (funcall (default-value 'font-lock-syntactic-face-function) state))))
 
 (defcustom perl-indent-level 4
   "*Indentation of Perl statements with respect to containing block."
@@ -574,9 +619,12 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
                               perl-font-lock-keywords-1
                               perl-font-lock-keywords-2)
                              nil nil ((?\_ . "w")) nil
-                             (font-lock-syntactic-keywords
-                              . perl-font-lock-syntactic-keywords)
-                             (parse-sexp-lookup-properties . t)))
+                             (font-lock-syntactic-face-function
+                              . perl-font-lock-syntactic-face-function)))
+  (set (make-local-variable 'syntax-propertize-function)
+       #'perl-syntax-propertize-function)
+  (add-hook 'syntax-propertize-extend-region-functions
+            #'syntax-propertize-multiline 'append 'local)
   ;; Tell imenu how to handle Perl.
   (set (make-local-variable 'imenu-generic-expression)
        perl-imenu-generic-expression)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2f65ffa1e17..10e852223ce 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -166,29 +166,32 @@
           symbol-end)
      . font-lock-builtin-face)))
 
-(defconst python-font-lock-syntactic-keywords
+(defconst python-syntax-propertize-function
   ;; Make outer chars of matching triple-quote sequences into generic
   ;; string delimiters.  Fixme: Is there a better way?
   ;; First avoid a sequence preceded by an odd number of backslashes.
-  `((,(rx (not (any ?\\))
-          ?\\ (* (and ?\\ ?\\))
-          (group (syntax string-quote))
-          (backref 1)
-          (group (backref 1)))
-     (2 ,(string-to-syntax "\"")))      ; dummy
-    (,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property
-          (optional (any "rR"))           ; possible second prefix
-          (group (syntax string-quote))   ; maybe gets property
-          (backref 2)                     ; per first quote
-          (group (backref 2)))            ; maybe gets property
-     (1 (python-quote-syntax 1))
-     (2 (python-quote-syntax 2))
-     (3 (python-quote-syntax 3)))
-    ;; This doesn't really help.
-;;;     (,(rx (and ?\\ (group ?\n))) (1 " "))
-    ))
-
-(defun python-quote-syntax (n)
+  (syntax-propertize-rules
+   (;; (rx (not (any ?\\))
+    ;;     ?\\ (* (and ?\\ ?\\))
+    ;;     (group (syntax string-quote))
+    ;;     (backref 1)
+    ;;     (group (backref 1)))
+    ;; ¡Backrefs don't work in syntax-propertize-rules!
+    "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)"
+    (2 "\""))                           ; dummy
+   (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property
+    ;;     (optional (any "rR"))           ; possible second prefix
+    ;;     (group (syntax string-quote))   ; maybe gets property
+    ;;     (backref 2)                     ; per first quote
+    ;;     (group (backref 2)))            ; maybe gets property
+    ;; ¡Backrefs don't work in syntax-propertize-rules!
+    "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)"
+    (3 (ignore (python-quote-syntax))))
+   ;; This doesn't really help.
+   ;;((rx (and ?\\ (group ?\n))) (1 " "))
+   ))
+
+(defun python-quote-syntax ()
   "Put `syntax-table' property correctly on triple quote.
 Used for syntactic keywords.  N is the match number (1, 2 or 3)."
   ;; Given a triple quote, we have to check the context to know
@@ -206,28 +209,25 @@ Used for syntactic keywords.  N is the match number (1, 2 or 3)."
   ;; x '"""' x """ \"""" x
   (save-excursion
     (goto-char (match-beginning 0))
-    (cond
-     ;; Consider property for the last char if in a fenced string.
-     ((= n 3)
-      (let* ((font-lock-syntactic-keywords nil)
-             (syntax (syntax-ppss)))
-        (when (eq t (nth 3 syntax))     ; after unclosed fence
-          (goto-char (nth 8 syntax))    ; fence position
-          (skip-chars-forward "uUrR")   ; skip any prefix
-          ;; Is it a matching sequence?
-          (if (eq (char-after) (char-after (match-beginning 2)))
-              (eval-when-compile (string-to-syntax "|"))))))
-     ;; Consider property for initial char, accounting for prefixes.
-     ((or (and (= n 2)                  ; leading quote (not prefix)
-               (= (match-beginning 1) (match-end 1))) ; prefix is null
-          (and (= n 1)                  ; prefix
-               (/= (match-beginning 1) (match-end 1)))) ; non-empty
-      (let ((font-lock-syntactic-keywords nil))
-        (unless (eq 'string (syntax-ppss-context (syntax-ppss)))
-          (eval-when-compile (string-to-syntax "|")))))
-     ;; Otherwise (we're in a non-matching string) the property is
-     ;; nil, which is OK.
-     )))
+    (let ((syntax (save-match-data (syntax-ppss))))
+      (cond
+       ((eq t (nth 3 syntax))           ; after unclosed fence
+        ;; Consider property for the last char if in a fenced string.
+        (goto-char (nth 8 syntax))      ; fence position
+        (skip-chars-forward "uUrR")     ; skip any prefix
+        ;; Is it a matching sequence?
+        (if (eq (char-after) (char-after (match-beginning 2)))
+            (put-text-property (match-beginning 3) (match-end 3)
+                               'syntax-table (string-to-syntax "|"))))
+       ((match-end 1)
+        ;; Consider property for initial char, accounting for prefixes.
+        (put-text-property (match-beginning 1) (match-end 1)
+                           'syntax-table (string-to-syntax "|")))
+       (t
+        ;; Consider property for initial char, accounting for prefixes.
+        (put-text-property (match-beginning 2) (match-end 2)
+                           'syntax-table (string-to-syntax "|"))))
+      )))
 
 ;; This isn't currently in `font-lock-defaults' as probably not worth
 ;; it -- we basically only mess with a few normally-symbol characters.
@@ -2495,12 +2495,12 @@ with skeleton expansions for compound statement templates.
   :group 'python
   (set (make-local-variable 'font-lock-defaults)
        '(python-font-lock-keywords nil nil nil nil
-                                   (font-lock-syntactic-keywords
-                                    . python-font-lock-syntactic-keywords)
-                                   ;; This probably isn't worth it.
-                                   ;; (font-lock-syntactic-face-function
-                                   ;;  . python-font-lock-syntactic-face-function)
-                                   ))
+         ;; This probably isn't worth it.
+         ;; (font-lock-syntactic-face-function
+         ;;  . python-font-lock-syntactic-face-function)
+         ))
+  (set (make-local-variable 'syntax-propertize-function)
+       python-syntax-propertize-function)
   (set (make-local-variable 'parse-sexp-lookup-properties) t)
   (set (make-local-variable 'parse-sexp-ignore-comments) t)
   (set (make-local-variable 'comment-start) "# ")
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 0b92234bf1c..4d015de5198 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -100,17 +100,10 @@
 
 (defconst ruby-block-end-re "\\<end\\>")
 
-(defconst ruby-here-doc-beg-re
+(eval-and-compile
+  (defconst ruby-here-doc-beg-re
   "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
-  "Regexp to match the beginning of a heredoc.")
-
-(defconst ruby-here-doc-end-re
-  "^\\([ \t]+\\)?\\(.*\\)\\(.\\)$"
-  "Regexp to match the end of heredocs.
-
-This will actually match any line with one or more characters.
-It's useful in that it divides up the match string so that
-`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
+    "Regexp to match the beginning of a heredoc."))
 
 (defun ruby-here-doc-end-match ()
   "Return a regexp to find the end of a heredoc.
@@ -123,18 +116,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
                (match-string 5)
                (match-string 6)))))
 
-(defun ruby-here-doc-beg-match ()
-  "Return a regexp to find the beginning of a heredoc.
-
-This should only be called after matching against `ruby-here-doc-end-re'."
-  (let ((contents (regexp-quote (concat (match-string 2) (match-string 3)))))
-    (concat "<<"
-            (let ((match (match-string 1)))
-              (if (and match (> (length match) 0))
-                  (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)"
-                          contents "\\b\\(\\1\\|\\2\\)")
-                (concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
-
 (defconst ruby-delimiter
   (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\("
           ruby-block-beg-re
@@ -362,7 +343,7 @@ Also ignores spaces after parenthesis when 'space."
     (back-to-indentation)
     (current-column)))
 
-(defun ruby-indent-line (&optional flag)
+(defun ruby-indent-line (&optional ignored)
   "Correct the indentation of the current Ruby line."
   (interactive)
   (ruby-indent-to (ruby-calculate-indent)))
@@ -405,8 +386,7 @@ and `\\' when preceded by `?'."
   "TODO: document."
   (save-excursion
     (store-match-data nil)
-    (let ((space (skip-chars-backward " \t"))
-          (start (point)))
+    (let ((space (skip-chars-backward " \t")))
       (cond
        ((bolp) t)
        ((progn
@@ -700,7 +680,7 @@ and `\\' when preceded by `?'."
     (beginning-of-line)
     (let ((ruby-indent-point (point))
           (case-fold-search nil)
-          state bol eol begin op-end
+          state eol begin op-end
           (paren (progn (skip-syntax-forward " ")
                         (and (char-after) (matching-paren (char-after)))))
           (indent 0))
@@ -780,7 +760,6 @@ and `\\' when preceded by `?'."
               (if (re-search-forward "^\\s *#" end t)
                   (beginning-of-line)
                 (setq done t))))
-          (setq bol (point))
           (end-of-line)
           ;; skip the comment at the end
           (skip-chars-backward " \t")
@@ -1037,10 +1016,8 @@ With ARG, do it many times.  Negative ARG means move forward."
   (ruby-beginning-of-defun)
   (re-search-backward "^\n" (- (point) 1) t))
 
-(defun ruby-indent-exp (&optional shutup-p)
-  "Indent each line in the balanced expression following the point.
-If a prefix arg is given or SHUTUP-P is non-nil, no errors
-are signalled if a balanced expression isn't found."
+(defun ruby-indent-exp (&optional ignored)
+  "Indent each line in the balanced expression following the point."
   (interactive "*P")
   (let ((here (point-marker)) start top column (nest t))
     (set-marker-insertion-type here t)
@@ -1133,58 +1110,208 @@ See `add-log-current-defun-function'."
               (if mlist (concat mlist mname) mname)
             mlist)))))
 
-(defconst ruby-font-lock-syntactic-keywords
-  `(;; #{ }, #$hoge, #@foo are not comments
-    ("\\(#\\)[{$@]" 1 (1 . nil))
-    ;; the last $', $", $` in the respective string is not variable
-    ;; the last ?', ?", ?` in the respective string is not ascii code
-    ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
-     (2 (7 . nil))
-     (4 (7 . nil)))
-    ;; $' $" $` .... are variables
-    ;; ?' ?" ?` are ascii codes
-    ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
-    ;; regexps
-    ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
-     (4 (7 . ?/))
-     (6 (7 . ?/)))
-    ("^=en\\(d\\)\\_>" 1 "!")
-    ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
-    ;; Currently, the following case is highlighted incorrectly:
-    ;;
-    ;;   <<FOO
-    ;;   FOO
-    ;;   <<BAR
-    ;;   <<BAZ
-    ;;   BAZ
-    ;;   BAR
-    ;;
-    ;; This is because all here-doc beginnings are highlighted before any endings,
-    ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
-    ;; it thinks <<BAR is part of a string so it's marked as well.
-    ;;
-    ;; This may be fixable by modifying ruby-in-here-doc-p to use
-    ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
-    ;; but I don't want to try that until we've got unit tests set up
-    ;; to make sure I don't break anything else.
-    (,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
-     ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
-     (ruby-here-doc-beg-syntax))
-    (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
-  "Syntactic keywords for Ruby mode.  See `font-lock-syntactic-keywords'.")
-
-(defun ruby-comment-beg-syntax ()
-  "Return the syntax cell for a the first character of a =begin.
+(if (eval-when-compile (fboundp #'syntax-propertize-rules))
+    ;; New code that works independently from font-lock.
+    (progn
+      (defun ruby-syntax-propertize-function (start end)
+        "Syntactic keywords for Ruby mode.  See `syntax-propertize-function'."
+        (goto-char start)
+        (ruby-syntax-propertize-heredoc end)
+        (funcall
+         (syntax-propertize-rules
+          ;; #{ }, #$hoge, #@foo are not comments
+          ("\\(#\\)[{$@]" (1 "."))
+          ;; the last $', $", $` in the respective string is not variable
+          ;; the last ?', ?", ?` in the respective string is not ascii code
+          ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
+           (2 "\"")
+           (4 "\""))
+          ;; $' $" $` .... are variables
+          ;; ?' ?" ?` are ascii codes
+          ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 "."))
+          ;; regexps
+          ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
+           (4 "\"/")
+           (6 "\"/"))
+          ("^=en\\(d\\)\\_>" (1 "!"))
+          ("^\\(=\\)begin\\_>" (1 "!"))
+          ;; Handle here documents.
+          ((concat ruby-here-doc-beg-re ".*\\(\n\\)")
+           (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end)))))
+         (point) end))
+
+      (defun ruby-syntax-propertize-heredoc (limit)
+        (let ((ppss (syntax-ppss))
+              (res '()))
+          (when (eq ?\n (nth 3 ppss))
+            (save-excursion
+              (goto-char (nth 8 ppss))
+              (beginning-of-line)
+              (while (re-search-forward ruby-here-doc-beg-re
+                                        (line-end-position) t)
+                (push (concat (ruby-here-doc-end-match) "\n") res)))
+            (let ((start (point)))
+              ;; With multiple openers on the same line, we don't know in which
+              ;; part `start' is, so we have to go back to the beginning.
+              (when (cdr res)
+                (goto-char (nth 8 ppss))
+                (setq res (nreverse res)))
+              (while (and res (re-search-forward (pop res) limit 'move))
+                (if (null res)
+                    (put-text-property (1- (point)) (point)
+                                       'syntax-table (string-to-syntax "\""))))
+              ;; Make extra sure we don't move back, lest we could fall into an
+              ;; inf-loop.
+              (if (< (point) start) (goto-char start))))))
+      )
+      
+  ;; For Emacsen where syntax-propertize-rules is not (yet) available,
+  ;; fallback on the old font-lock-syntactic-keywords stuff.
+
+  (defconst ruby-here-doc-end-re
+    "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)"
+    "Regexp to match the end of heredocs.
+
+This will actually match any line with one or more characters.
+It's useful in that it divides up the match string so that
+`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
+
+  (defun ruby-here-doc-beg-match ()
+    "Return a regexp to find the beginning of a heredoc.
+
+This should only be called after matching against `ruby-here-doc-end-re'."
+    (let ((contents (regexp-quote (match-string 2))))
+      (concat "<<"
+              (let ((match (match-string 1)))
+                (if (and match (> (length match) 0))
+                    (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)"
+                            contents "\\b\\(\\1\\|\\2\\)")
+                  (concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
+
+  (defconst ruby-font-lock-syntactic-keywords
+    `( ;; #{ }, #$hoge, #@foo are not comments
+      ("\\(#\\)[{$@]" 1 (1 . nil))
+      ;; the last $', $", $` in the respective string is not variable
+      ;; the last ?', ?", ?` in the respective string is not ascii code
+      ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
+       (2 (7 . nil))
+       (4 (7 . nil)))
+      ;; $' $" $` .... are variables
+      ;; ?' ?" ?` are ascii codes
+      ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
+      ;; regexps
+      ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
+       (4 (7 . ?/))
+       (6 (7 . ?/)))
+      ("^=en\\(d\\)\\_>" 1 "!")
+      ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
+      ;; Currently, the following case is highlighted incorrectly:
+      ;;
+      ;;   <<FOO
+      ;;   FOO
+      ;;   <<BAR
+      ;;   <<BAZ
+      ;;   BAZ
+      ;;   BAR
+      ;;
+      ;; This is because all here-doc beginnings are highlighted before any endings,
+      ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
+      ;; it thinks <<BAR is part of a string so it's marked as well.
+      ;;
+      ;; This may be fixable by modifying ruby-in-here-doc-p to use
+      ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
+      ;; but I don't want to try that until we've got unit tests set up
+      ;; to make sure I don't break anything else.
+      (,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
+       ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
+       (ruby-here-doc-beg-syntax))
+      (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
+    "Syntactic keywords for Ruby mode.  See `font-lock-syntactic-keywords'.")
+
+  (defun ruby-comment-beg-syntax ()
+    "Return the syntax cell for a the first character of a =begin.
 See the definition of `ruby-font-lock-syntactic-keywords'.
 
 This returns a comment-delimiter cell as long as the =begin
 isn't in a string or another comment."
-  (when (not (nth 3 (syntax-ppss)))
-    (string-to-syntax "!")))
+    (when (not (nth 3 (syntax-ppss)))
+      (string-to-syntax "!")))
+
+  (defun ruby-in-here-doc-p ()
+    "Return whether or not the point is in a heredoc."
+    (save-excursion
+      (let ((old-point (point)) (case-fold-search nil))
+        (beginning-of-line)
+        (catch 'found-beg
+          (while (re-search-backward ruby-here-doc-beg-re nil t)
+            (if (not (or (ruby-in-ppss-context-p 'anything)
+                         (ruby-here-doc-find-end old-point)))
+                (throw 'found-beg t)))))))
+
+  (defun ruby-here-doc-find-end (&optional limit)
+    "Expects the point to be on a line with one or more heredoc openers.
+Returns the buffer position at which all heredocs on the line
+are terminated, or nil if they aren't terminated before the
+buffer position `limit' or the end of the buffer."
+    (save-excursion
+      (beginning-of-line)
+      (catch 'done
+        (let ((eol (save-excursion (end-of-line) (point)))
+              (case-fold-search nil)
+              ;; Fake match data such that (match-end 0) is at eol
+              (end-match-data (progn (looking-at ".*$") (match-data)))
+              beg-match-data end-re)
+          (while (re-search-forward ruby-here-doc-beg-re eol t)
+            (setq beg-match-data (match-data))
+            (setq end-re (ruby-here-doc-end-match))
+
+            (set-match-data end-match-data)
+            (goto-char (match-end 0))
+            (unless (re-search-forward end-re limit t) (throw 'done nil))
+            (setq end-match-data (match-data))
+
+            (set-match-data beg-match-data)
+            (goto-char (match-end 0)))
+          (set-match-data end-match-data)
+          (goto-char (match-end 0))
+          (point)))))
+
+  (defun ruby-here-doc-beg-syntax ()
+    "Return the syntax cell for a line that may begin a heredoc.
+See the definition of `ruby-font-lock-syntactic-keywords'.
+
+This sets the syntax cell for the newline ending the line
+containing the heredoc beginning so that cases where multiple
+heredocs are started on one line are handled correctly."
+    (save-excursion
+      (goto-char (match-beginning 0))
+      (unless (or (ruby-in-ppss-context-p 'non-heredoc)
+                  (ruby-in-here-doc-p))
+        (string-to-syntax "\""))))
+
+  (defun ruby-here-doc-end-syntax ()
+    "Return the syntax cell for a line that may end a heredoc.
+See the definition of `ruby-font-lock-syntactic-keywords'."
+    (let ((pss (syntax-ppss)) (case-fold-search nil))
+      ;; If we aren't in a string, we definitely aren't ending a heredoc,
+      ;; so we can just give up.
+      ;; This means we aren't doing a full-document search
+      ;; every time we enter a character.
+      (when (ruby-in-ppss-context-p 'heredoc pss)
+        (save-excursion
+          (goto-char (nth 8 pss))    ; Go to the beginning of heredoc.
+          (let ((eol (point)))
+            (beginning-of-line)
+            (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
+                     (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
+                     (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
+                            (not (re-search-forward ruby-here-doc-beg-re eol t))))
+                (string-to-syntax "\"")))))))
 
-(unless (functionp 'syntax-ppss)
-  (defun syntax-ppss (&optional pos)
-    (parse-partial-sexp (point-min) (or pos (point)))))
+  (unless (functionp 'syntax-ppss)
+    (defun syntax-ppss (&optional pos)
+      (parse-partial-sexp (point-min) (or pos (point)))))
+  )
 
 (defun ruby-in-ppss-context-p (context &optional ppss)
   (let ((ppss (or ppss (syntax-ppss (point)))))
@@ -1195,10 +1322,7 @@ isn't in a string or another comment."
          ((eq context 'string)
           (nth 3 ppss))
          ((eq context 'heredoc)
-          (and (nth 3 ppss)
-               ;; If it's generic string, it's a heredoc and we don't care
-               ;; See `parse-partial-sexp'
-               (not (numberp (nth 3 ppss)))))
+          (eq ?\n (nth 3 ppss)))
          ((eq context 'non-heredoc)
           (and (ruby-in-ppss-context-p 'anything)
                (not (ruby-in-ppss-context-p 'heredoc))))
@@ -1210,77 +1334,6 @@ isn't in a string or another comment."
                   "context name `" (symbol-name context) "' is unknown"))))
         t)))
 
-(defun ruby-in-here-doc-p ()
-  "Return whether or not the point is in a heredoc."
-  (save-excursion
-    (let ((old-point (point)) (case-fold-search nil))
-      (beginning-of-line)
-      (catch 'found-beg
-        (while (re-search-backward ruby-here-doc-beg-re nil t)
-          (if (not (or (ruby-in-ppss-context-p 'anything)
-                       (ruby-here-doc-find-end old-point)))
-              (throw 'found-beg t)))))))
-
-(defun ruby-here-doc-find-end (&optional limit)
-  "Expects the point to be on a line with one or more heredoc openers.
-Returns the buffer position at which all heredocs on the line
-are terminated, or nil if they aren't terminated before the
-buffer position `limit' or the end of the buffer."
-  (save-excursion
-    (beginning-of-line)
-    (catch 'done
-      (let ((eol (save-excursion (end-of-line) (point)))
-            (case-fold-search nil)
-            ;; Fake match data such that (match-end 0) is at eol
-            (end-match-data (progn (looking-at ".*$") (match-data)))
-            beg-match-data end-re)
-        (while (re-search-forward ruby-here-doc-beg-re eol t)
-          (setq beg-match-data (match-data))
-          (setq end-re (ruby-here-doc-end-match))
-
-          (set-match-data end-match-data)
-          (goto-char (match-end 0))
-          (unless (re-search-forward end-re limit t) (throw 'done nil))
-          (setq end-match-data (match-data))
-
-          (set-match-data beg-match-data)
-          (goto-char (match-end 0)))
-        (set-match-data end-match-data)
-        (goto-char (match-end 0))
-        (point)))))
-
-(defun ruby-here-doc-beg-syntax ()
-  "Return the syntax cell for a line that may begin a heredoc.
-See the definition of `ruby-font-lock-syntactic-keywords'.
-
-This sets the syntax cell for the newline ending the line
-containing the heredoc beginning so that cases where multiple
-heredocs are started on one line are handled correctly."
-  (save-excursion
-    (goto-char (match-beginning 0))
-    (unless (or (ruby-in-ppss-context-p 'non-heredoc)
-                (ruby-in-here-doc-p))
-      (string-to-syntax "|"))))
-
-(defun ruby-here-doc-end-syntax ()
-  "Return the syntax cell for a line that may end a heredoc.
-See the definition of `ruby-font-lock-syntactic-keywords'."
-  (let ((pss (syntax-ppss)) (case-fold-search nil))
-    ;; If we aren't in a string, we definitely aren't ending a heredoc,
-    ;; so we can just give up.
-    ;; This means we aren't doing a full-document search
-    ;; every time we enter a character.
-    (when (ruby-in-ppss-context-p 'heredoc pss)
-      (save-excursion
-        (goto-char (nth 8 pss))  ; Go to the beginning of heredoc.
-        (let ((eol (point)))
-          (beginning-of-line)
-          (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
-                   (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
-                   (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
-                          (not (re-search-forward ruby-here-doc-beg-re eol t))))
-              (string-to-syntax "|")))))))
-
 (if (featurep 'xemacs)
     (put 'ruby-mode 'font-lock-defaults
          '((ruby-font-lock-keywords)
@@ -1377,8 +1430,10 @@ See `font-lock-syntax-table'.")
    )
   "Additional expressions to highlight in Ruby mode.")
 
+(defvar electric-indent-chars)
+
 ;;;###autoload
-(defun ruby-mode ()
+(define-derived-mode ruby-mode prog-mode "Ruby"
   "Major mode for editing Ruby scripts.
 \\[ruby-indent-line] properly indents subexpressions of multi-line
 class, module, def, if, while, for, do, and case statements, taking
@@ -1387,27 +1442,22 @@ nesting into account.
 The variable `ruby-indent-level' controls the amount of indentation.
 
 \\{ruby-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map ruby-mode-map)
-  (setq mode-name "Ruby")
-  (setq major-mode 'ruby-mode)
   (ruby-mode-variables)
 
-  (set (make-local-variable 'indent-line-function)
-       'ruby-indent-line)
   (set (make-local-variable 'imenu-create-index-function)
        'ruby-imenu-create-index)
   (set (make-local-variable 'add-log-current-defun-function)
        'ruby-add-log-current-method)
 
   (add-hook
-   (cond ((boundp 'before-save-hook)
-          (make-local-variable 'before-save-hook)
-          'before-save-hook)
+   (cond ((boundp 'before-save-hook) 'before-save-hook)
          ((boundp 'write-contents-functions) 'write-contents-functions)
          ((boundp 'write-contents-hooks) 'write-contents-hooks))
-   'ruby-mode-set-encoding)
+   'ruby-mode-set-encoding nil 'local)
+
+  (set (make-local-variable 'electric-indent-chars)
+       (append '(?\{ ?\}) (if (boundp 'electric-indent-chars)
+                              (default-value 'electric-indent-chars))))
 
   (set (make-local-variable 'font-lock-defaults)
        '((ruby-font-lock-keywords) nil nil))
@@ -1415,12 +1465,12 @@ The variable `ruby-indent-level' controls the amount of indentation.
        ruby-font-lock-keywords)
   (set (make-local-variable 'font-lock-syntax-table)
        ruby-font-lock-syntax-table)
-  (set (make-local-variable 'font-lock-syntactic-keywords)
-       ruby-font-lock-syntactic-keywords)
 
-  (if (fboundp 'run-mode-hooks)
-      (run-mode-hooks 'ruby-mode-hook)
-    (run-hooks 'ruby-mode-hook)))
+  (if (eval-when-compile (fboundp 'syntax-propertize-rules))
+      (set (make-local-variable 'syntax-propertize-function)
+           #'ruby-syntax-propertize-function)
+    (set (make-local-variable 'font-lock-syntactic-keywords)
+         ruby-font-lock-syntactic-keywords)))
 
 ;;; Invoke ruby-mode when appropriate
 
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 9041bd50259..d41a81e38a6 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -939,7 +939,6 @@ See `sh-feature'.")
 ;; These are used for the syntax table stuff (derived from cperl-mode).
 ;; Note: parse-sexp-lookup-properties must be set to t for it to work.
 (defconst sh-st-punc (string-to-syntax "."))
-(defconst sh-st-symbol (string-to-syntax "_"))
 (defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
 
 (defconst sh-escaped-line-re
@@ -957,7 +956,7 @@ See `sh-feature'.")
 (defvar sh-here-doc-re sh-here-doc-open-re)
 (make-variable-buffer-local 'sh-here-doc-re)
 
-(defun sh-font-lock-close-heredoc (bol eof indented)
+(defun sh-font-lock-close-heredoc (bol eof indented eol)
   "Determine the syntax of the \\n after an EOF.
 If non-nil INDENTED indicates that the EOF was indented."
   (let* ((eof-re (if eof (regexp-quote eof) ""))
@@ -971,6 +970,8 @@ If non-nil INDENTED indicates that the EOF was indented."
          (ere (concat "^" (if indented "[ \t]*") eof-re "\n"))
          (start (save-excursion
                   (goto-char bol)
+                  ;; FIXME: will incorrectly find a <<EOF embedded inside
+                  ;; the heredoc.
                   (re-search-backward (concat sre "\\|" ere) nil t))))
     ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first
     ;; found a close-heredoc which makes the current close-heredoc inoperant.
@@ -990,7 +991,7 @@ If non-nil INDENTED indicates that the EOF was indented."
                      (sh-in-comment-or-string (point)))))
           ;; No <<EOF2 found after our <<.
           (= (point) start)))
-      sh-here-doc-syntax)
+      (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))
      ((not (or start (save-excursion (re-search-forward sre nil t))))
       ;; There's no <<EOF either before or after us,
       ;; so we should remove ourselves from font-lock's keywords.
@@ -1000,7 +1001,7 @@ If non-nil INDENTED indicates that the EOF was indented."
                     (regexp-opt sh-here-doc-markers t) "\\(\n\\)"))
       nil))))
 
-(defun sh-font-lock-open-heredoc (start string)
+(defun sh-font-lock-open-heredoc (start string eol)
   "Determine the syntax of the \\n after a <<EOF.
 START is the position of <<.
 STRING is the actual word used as delimiter (e.g. \"EOF\").
@@ -1030,13 +1031,8 @@ Point is at the beginning of the next line."
           ;; Don't bother fixing it now, but place a multiline property so
           ;; that when jit-lock-context-* refontifies the rest of the
           ;; buffer, it also refontifies the current line with it.
-          (put-text-property start (point) 'font-lock-multiline t)))
-    sh-here-doc-syntax))
-
-(defun sh-font-lock-here-doc (limit)
-  "Search for a heredoc marker."
-  ;; This looks silly, but it's because `sh-here-doc-re' keeps changing.
-  (re-search-forward sh-here-doc-re limit t))
+          (put-text-property start (point) 'syntax-multiline t)))
+    (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)))
 
 (defun sh-font-lock-quoted-subshell (limit)
   "Search for a subshell embedded in a string.
@@ -1045,9 +1041,7 @@ subshells can nest."
   ;; FIXME: This can (and often does) match multiple lines, yet it makes no
   ;; effort to handle multiline cases correctly, so it ends up being
   ;; rather flakey.
-  (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t)
-             ;; Make sure the " we matched is an opening quote.
-             (eq ?\" (nth 3 (syntax-ppss))))
+  (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote.
     ;; bingo we have a $( or a ` inside a ""
     (let ((char (char-after (point)))
           ;; `state' can be: double-quote, backquote, code.
@@ -1082,8 +1076,7 @@ subshells can nest."
                  (double-quote nil)
                  (t (setq state (pop states)))))
           (t (error "Internal error in sh-font-lock-quoted-subshell")))
-        (forward-char 1)))
-    t))
+        (forward-char 1)))))
 
 
 (defun sh-is-quoted-p (pos)
@@ -1122,7 +1115,7 @@ subshells can nest."
     (when (progn (backward-char 2)
                  (if (> start (line-end-position))
                      (put-text-property (point) (1+ start)
-                                        'font-lock-multiline t))
+                                        'syntax-multiline t))
                  ;; FIXME: The `in' may just be a random argument to
                  ;; a normal command rather than the real `in' keyword.
                  ;; I.e. we should look back to try and find the
@@ -1136,40 +1129,44 @@ subshells can nest."
       sh-st-punc
     nil))
 
-(defun sh-font-lock-flush-syntax-ppss-cache (limit)
-  ;; This should probably be a standard function provided by font-lock.el
-  ;; (or syntax.el).
-  (syntax-ppss-flush-cache (point))
-  (goto-char limit)
-  nil)
-
-(defconst sh-font-lock-syntactic-keywords
-  ;; A `#' begins a comment when it is unquoted and at the beginning of a
-  ;; word.  In the shell, words are separated by metacharacters.
-  ;; The list of special chars is taken from the single-unix spec
-  ;; of the shell command language (under `quoting') but with `$' removed.
-  `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
-    ;; In a '...' the backslash is not escaping.
-    ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
-    ;; The previous rule uses syntax-ppss, but the subsequent rules may
-    ;; change the syntax, so we have to tell syntax-ppss that the states it
-    ;; has just computed will need to be recomputed.
-    (sh-font-lock-flush-syntax-ppss-cache)
-    ;; Make sure $@ and $? are correctly recognized as sexps.
-    ("\\$\\([?@]\\)" 1 ,sh-st-symbol)
-    ;; Find HEREDOC starters and add a corresponding rule for the ender.
-    (sh-font-lock-here-doc
-     (2 (sh-font-lock-open-heredoc
-         (match-beginning 0) (match-string 1)) nil t)
-     (5 (sh-font-lock-close-heredoc
-         (match-beginning 0) (match-string 4)
-         (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))))
-      nil t))
-    ;; Distinguish the special close-paren in `case'.
-    (")" 0 (sh-font-lock-paren (match-beginning 0)))
-    ;; highlight (possibly nested) subshells inside "" quoted regions correctly.
-    ;; This should be at the very end because it uses syntax-ppss.
-    (sh-font-lock-quoted-subshell)))
+(defun sh-syntax-propertize-function (start end)
+  (goto-char start)
+  (while (prog1
+             (re-search-forward sh-here-doc-re end 'move)
+           (save-excursion
+             (save-match-data
+               (funcall
+                (syntax-propertize-rules
+                 ;; A `#' begins a comment when it is unquoted and at the
+                 ;; beginning of a word.  In the shell, words are separated by
+                 ;; metacharacters.  The list of special chars is taken from
+                 ;; the single-unix spec of the shell command language (under
+                 ;; `quoting') but with `$' removed.
+                 ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
+                 ;; In a '...' the backslash is not escaping.
+                 ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
+                 ;; Make sure $@ and $? are correctly recognized as sexps.
+                 ("\\$\\([?@]\\)" (1 "_"))
+                 ;; Distinguish the special close-paren in `case'.
+                 (")" (0 (sh-font-lock-paren (match-beginning 0))))
+                 ;; Highlight (possibly nested) subshells inside "" quoted
+                 ;; regions correctly.
+                 ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)"
+                  (1 (ignore
+                      ;; Save excursion because we want to also apply other
+                      ;; syntax-propertize rules within the affected region.
+                      (save-excursion
+                        (sh-font-lock-quoted-subshell end))))))
+                (prog1 start (setq start (point))) (point)))))
+    (if (match-beginning 2)
+        ;; FIXME: actually, once we see an heredoc opener, we should just
+        ;; search for its ender without propertizing anything in it.
+        (sh-font-lock-open-heredoc
+         (match-beginning 0) (match-string 1) (match-beginning 2))
+      (sh-font-lock-close-heredoc
+       (match-beginning 0) (match-string 4)
+       (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))
+       (match-beginning 5)))))
 
 (defun sh-font-lock-syntactic-face-function (state)
   (let ((q (nth 3 state)))
@@ -1553,9 +1550,12 @@ with your script for an edit-interpret-debug cycle."
           sh-font-lock-keywords-1 sh-font-lock-keywords-2)
          nil nil
          ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
-         (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords)
          (font-lock-syntactic-face-function
           . sh-font-lock-syntactic-face-function)))
+  (set (make-local-variable 'syntax-propertize-function)
+       #'sh-syntax-propertize-function)
+  (add-hook 'syntax-propertize-extend-region-functions
+            #'syntax-propertize-multiline 'append 'local)
   (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
   (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
   (set (make-local-variable 'skeleton-further-elements)
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index f8d1a6aca97..34c50b6cfe5 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -163,17 +163,18 @@ for SIMULA mode to function correctly."
 (defvar simula-mode-syntax-table nil
   "Syntax table in SIMULA mode buffers.")
 
-(defconst simula-font-lock-syntactic-keywords
-  `(;; `comment' directive.
-    ("\\<\\(c\\)omment\\>" 1 "<")
-    ;; end comments
-    (,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
-              (regexp-opt '("end" "else" "when" "otherwise"))
-              "\\)\\)")
-     (1 "< b")
-     (3 "> b" nil t))
-    ;; non-quoted single-quote char.
-    ("'\\('\\)'" 1 ".")))
+(defconst simula-syntax-propertize-function
+  (syntax-propertize-rules
+   ;; `comment' directive.
+   ("\\<\\(c\\)omment\\>" (1 "<"))
+   ;; end comments
+   ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
+            (regexp-opt '("end" "else" "when" "otherwise"))
+            "\\)\\)")
+    (1 "< b")
+    (3 "> b"))
+   ;; non-quoted single-quote char.
+   ("'\\('\\)'" (1 "."))))
 
 ;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
 (defconst simula-font-lock-keywords-1
@@ -396,8 +397,9 @@ with no arguments, if that value is non-nil."
   (setq font-lock-defaults
         '((simula-font-lock-keywords simula-font-lock-keywords-1
            simula-font-lock-keywords-2 simula-font-lock-keywords-3)
-          nil t ((?_ . "w")) nil
-          (font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords)))
+          nil t ((?_ . "w"))))
+  (set (make-local-variable 'syntax-propertize-function)
+       simula-syntax-propertize-function)
   (abbrev-mode 1))
 
 (defun simula-indent-exp ()
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index e44504688f2..e9860c5fa71 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -5,7 +5,7 @@
 
 ;; Author: Alex Schroeder <alex@gnu.org>
 ;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 2.5
+;; Version: 2.7
 ;; 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
@@ -187,10 +187,10 @@
 
 ;; 6) Define a convienence function to invoke the SQL interpreter.
 
-;;     (defun my-sql-xyz ()
+;;     (defun my-sql-xyz (&optional buffer)
 ;;       "Run ixyz by XyzDB as an inferior process."
-;;       (interactive)
-;;       (sql-product-interactive 'xyz))
+;;       (interactive "P")
+;;       (sql-product-interactive 'xyz buffer))
 
 ;;; To Do:
 
@@ -275,8 +275,8 @@ Customizing your password will store it in your ~/.emacs file."
   :group 'SQL
   :safe 'stringp)
 
-(defcustom sql-port nil
-  "Default server or host."
+(defcustom sql-port 0
+  "Default port."
   :version "24.1"
   :type 'number
   :group 'SQL
@@ -430,9 +430,9 @@ Customizing your password will store it in your ~/.emacs file."
      :sqli-comint-func sql-comint-postgres
      :prompt-regexp "^.*=[#>] "
      :prompt-length 5
-     :prompt-cont-regexp "^.*-[#>] "
+     :prompt-cont-regexp "^.*[-(][#>] "
      :input-filter sql-remove-tabs-filter
-     :terminator ("\\(^[\\]g\\|;\\)" . ";"))
+     :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";"))
 
     (solid
      :name "Solid"
@@ -551,7 +551,6 @@ settings.")
 (defvar sql-indirect-features
   '(:font-lock :sqli-program :sqli-options :sqli-login))
 
-;;;###autoload
 (defcustom sql-connection-alist nil
   "An alist of connection parameters for interacting with a SQL
   product.
@@ -600,7 +599,6 @@ prompted for during login."
   :version "24.1"
   :group 'SQL)
 
-;;;###autoload
 (defcustom sql-product 'ansi
   "Select the SQL database product used so that buffers can be
 highlighted properly when you open them."
@@ -613,6 +611,7 @@ highlighted properly when you open them."
                     sql-product-alist))
   :group 'SQL
   :safe 'symbolp)
+(defvaralias 'sql-dialect 'sql-product)
 
 ;; misc customization of sql.el behaviour
 
@@ -788,7 +787,9 @@ to be safe:
 
 ;; Customization for SQLite
 
-(defcustom sql-sqlite-program "sqlite3"
+(defcustom sql-sqlite-program (or (executable-find "sqlite3")
+                                  (executable-find "sqlite")
+                                  "sqlite")
   "Command to start SQLite.
 
 Starts `sql-interactive-mode' after doing some setup."
@@ -801,7 +802,7 @@ Starts `sql-interactive-mode' after doing some setup."
   :version "20.8"
   :group 'SQL)
 
-(defcustom sql-sqlite-login-params '((database :file ".*\\.db"))
+(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)"))
   "List of login parameters needed to connect to SQLite."
   :type 'sql-login-params
   :version "24.1"
@@ -1022,9 +1023,6 @@ Starts `sql-interactive-mode' after doing some setup."
 (defvar sql-server-history nil
   "History of servers used.")
 
-(defvar sql-port-history nil
-  "History of ports used.")
-
 ;; Passwords are not kept in a history.
 
 (defvar sql-buffer nil
@@ -1054,6 +1052,25 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
 
 Used by `sql-rename-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-product-interactive)
+                (or (not product)
+                    (eq product sql-product)))))))
+
 ;; Keymap for sql-interactive-mode.
 
 (defvar sql-interactive-mode-map
@@ -1091,15 +1108,11 @@ Based on `comint-mode-map'.")
  sql-mode-menu sql-mode-map
  "Menu for `sql-mode'."
  `("SQL"
-   ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer)
-                                             (get-buffer-process sql-buffer))]
+   ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)]
    ["Send Region" sql-send-region (and mark-active
-                                       (buffer-live-p sql-buffer)
-                                       (get-buffer-process sql-buffer))]
-   ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer)
-                                       (get-buffer-process sql-buffer))]
-   ["Send String" sql-send-string (and (buffer-live-p sql-buffer)
-                                       (get-buffer-process sql-buffer))]
+                                       (sql-buffer-live-p sql-buffer))]
+   ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)]
+   ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)]
    "--"
    ["Start SQLi session" sql-product-interactive
     :visible (not sql-connection-alist)
@@ -1364,7 +1377,7 @@ to add functions and PL/SQL keywords.")
      ;; Oracle SQL*Plus Commands
      (cons
       (concat
-       "^\\(?:\\(?:" (regexp-opt '(
+       "^\\s-*\\(?:\\(?:" (regexp-opt '(
 "@" "@@" "accept" "append" "archive" "attribute" "break"
 "btitle" "change" "clear" "column" "connect" "copy" "define"
 "del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
@@ -1403,7 +1416,7 @@ to add functions and PL/SQL keywords.")
        "\\)\\b.*"
        )
       'font-lock-doc-face)
-     '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face)
+     '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face)
 
      ;; Oracle Functions
      (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
@@ -1585,81 +1598,153 @@ to add functions and PL/SQL keywords.")
 (defvar sql-mode-postgres-font-lock-keywords
   (eval-when-compile
     (list
-     ;; Postgres Functions
+     ;; Postgres psql commands
+     '("^\\s-*\\\\.*$" . font-lock-doc-face)
+
+     ;; Postgres unreserved words but may have meaning
+     (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a"
+"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg"
+"asensitive" "atomic" "attribute" "attributes" "avg" "base64"
+"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c"
+"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length"
+"character_length" "character_set_catalog" "character_set_name"
+"character_set_schema" "characters" "checked" "class_origin" "clob"
+"cobol" "collation" "collation_catalog" "collation_name"
+"collation_schema" "collect" "column_name" "columns"
+"command_function" "command_function_code" "completion" "condition"
+"condition_number" "connect" "connection_name" "constraint_catalog"
+"constraint_name" "constraint_schema" "constructor" "contains"
+"control" "convert" "corr" "corresponding" "count" "covar_pop"
+"covar_samp" "cube" "cume_dist" "current_default_transform_group"
+"current_path" "current_transform_group_for_type" "cursor_name"
+"datalink" "datetime_interval_code" "datetime_interval_precision" "db"
+"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe"
+"descriptor" "destroy" "destructor" "deterministic" "diagnostics"
+"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete"
+"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly"
+"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic"
+"dynamic_function" "dynamic_function_code" "element" "empty"
+"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file"
+"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free"
+"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping"
+"hex" "hierarchy" "host" "id" "ignore" "implementation" "import"
+"indent" "indicator" "infix" "initialize" "instance" "instantiable"
+"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag"
+"last_value" "lateral" "lead" "length" "less" "library" "like_regex"
+"link" "ln" "locator" "lower" "m" "map" "matched" "max"
+"max_cardinality" "member" "merge" "message_length"
+"message_octet_length" "message_text" "method" "min" "mod" "modifies"
+"modify" "module" "more" "multiset" "mumps" "namespace" "nclob"
+"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize"
+"normalized" "nth_value" "ntile" "nullable" "number"
+"occurrences_regex" "octet_length" "octets" "old" "open" "operation"
+"ordering" "ordinality" "others" "output" "overriding" "p" "pad"
+"parameter" "parameter_mode" "parameter_name"
+"parameter_ordinal_position" "parameter_specific_catalog"
+"parameter_specific_name" "parameter_specific_schema" "parameters"
+"pascal" "passing" "passthrough" "percent_rank" "percentile_cont"
+"percentile_disc" "permission" "pli" "position_regex" "postfix"
+"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref"
+"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept"
+"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring"
+"respect" "restore" "result" "return" "returned_cardinality"
+"returned_length" "returned_octet_length" "returned_sqlstate" "rollup"
+"routine" "routine_catalog" "routine_name" "routine_schema"
+"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog"
+"scope_name" "scope_schema" "section" "selective" "self" "sensitive"
+"server_name" "sets" "size" "source" "space" "specific"
+"specific_name" "specifictype" "sql" "sqlcode" "sqlerror"
+"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static"
+"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin"
+"sublist" "submultiset" "substring_regex" "sum" "system_user" "t"
+"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour"
+"timezone_minute" "token" "top_level_count" "transaction_active"
+"transactions_committed" "transactions_rolled_back" "transform"
+"transforms" "translate" "translate_regex" "translation"
+"trigger_catalog" "trigger_name" "trigger_schema" "trim_array"
+"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri"
+"usage" "user_defined_type_catalog" "user_defined_type_code"
+"user_defined_type_name" "user_defined_type_schema" "var_pop"
+"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within"
+"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration"
+"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery"
+"xmlschema" "xmltable" "xmltext" "xmlvalidate"
+)
+
+     ;; Postgres non-reserved words
      (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
-"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan"
-"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil"
-"center" "char_length" "chr" "coalesce" "col_description" "convert"
-"cos" "cot" "count" "current_database" "current_date" "current_schema"
-"current_schemas" "current_setting" "current_time" "current_timestamp"
-"current_user" "currval" "date_part" "date_trunc" "decode" "degrees"
-"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte"
-"has_database_privilege" "has_function_privilege"
-"has_language_privilege" "has_schema_privilege" "has_table_privilege"
-"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading"
-"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad"
-"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval"
-"now" "npoints" "nullif" "obj_description" "octet_length" "overlay"
-"pclose" "pg_client_encoding" "pg_function_is_visible"
-"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef"
-"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible"
-"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible"
-"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians"
-"radius" "random" "repeat" "replace" "round" "rpad" "rtrim"
-"session_user" "set_bit" "set_byte" "set_config" "set_masklen"
-"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr"
-"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date"
-"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim"
-"trunc" "upper" "variance" "version" "width"
+"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate"
+"also" "alter" "always" "assertion" "assignment" "at" "backward"
+"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded"
+"catalog" "chain" "characteristics" "checkpoint" "class" "close"
+"cluster" "coalesce" "comment" "comments" "commit" "committed"
+"configuration" "connection" "constraints" "content" "continue"
+"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv"
+"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec"
+"declare" "defaults" "deferred" "definer" "delete" "delimiter"
+"delimiters" "dictionary" "disable" "discard" "document" "domain"
+"drop" "each" "enable" "encoding" "encrypted" "enum" "escape"
+"exclude" "excluding" "exclusive" "execute" "exists" "explain"
+"external" "extract" "family" "first" "float" "following" "force"
+"forward" "function" "functions" "global" "granted" "greatest"
+"handler" "header" "hold" "hour" "identity" "if" "immediate"
+"immutable" "implicit" "including" "increment" "index" "indexes"
+"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert"
+"instead" "invoker" "isolation" "key" "language" "large" "last"
+"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local"
+"location" "lock" "login" "mapping" "match" "maxvalue" "minute"
+"minvalue" "mode" "month" "move" "name" "names" "national" "nchar"
+"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit"
+"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif"
+"nulls" "object" "of" "oids" "operator" "option" "options" "out"
+"overlay" "owned" "owner" "parser" "partial" "partition" "password"
+"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior"
+"privileges" "procedural" "procedure" "quote" "range" "read"
+"reassign" "recheck" "recursive" "reindex" "relative" "release"
+"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict"
+"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint"
+"schema" "scroll" "search" "second" "security" "sequence" "sequences"
+"serializable" "server" "session" "set" "setof" "share" "show"
+"simple" "stable" "standalone" "start" "statement" "statistics"
+"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser"
+"sysid" "system" "tables" "tablespace" "temp" "template" "temporary"
+"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type"
+"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until"
+"update" "vacuum" "valid" "validator" "value" "values" "version"
+"view" "volatile" "whitespace" "work" "wrapper" "write"
+"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse"
+"xmlpi" "xmlroot" "xmlserialize" "year" "yes"
 )
+
      ;; Postgres Reserved
      (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter"
-"analyze" "and" "any" "as" "asc" "assignment" "authorization"
-"backward" "basetype" "before" "begin" "between" "binary" "by" "cache"
-"called" "cascade" "case" "cast" "characteristics" "check"
-"checkpoint" "class" "close" "cluster" "column" "comment" "commit"
-"committed" "commutator" "constraint" "constraints" "conversion"
-"copy" "create" "createdb" "createuser" "cursor" "cycle" "database"
-"deallocate" "declare" "default" "deferrable" "deferred" "definer"
-"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each"
-"element" "else" "encoding" "encrypted" "end" "escape" "except"
-"exclusive" "execute" "exists" "explain" "extended" "external" "false"
-"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from"
-"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having"
-"immediate" "immutable" "implicit" "in" "increment" "index" "inherits"
-"initcond" "initially" "input" "insensitive" "insert" "instead"
-"internallength" "intersect" "into" "invoker" "is" "isnull"
-"isolation" "join" "key" "language" "leftarg" "level" "like" "limit"
-"listen" "load" "local" "location" "lock" "ltcmp" "main" "match"
-"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator"
-"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify"
-"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or"
-"order" "output" "owner" "partial" "passedbyvalue" "password" "plain"
-"prepare" "primary" "prior" "privileges" "procedural" "procedure"
-"public" "read" "recheck" "references" "reindex" "relative" "rename"
-"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row"
-"rule" "schema" "scroll" "security" "select" "sequence" "serializable"
-"session" "set" "sfunc" "share" "show" "similar" "some" "sort1"
-"sort2" "stable" "start" "statement" "statistics" "storage" "strict"
-"stype" "sysid" "table" "temp" "template" "temporary" "then" "to"
-"transaction" "trigger" "true" "truncate" "trusted" "type"
-"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update"
-"usage" "user" "using" "vacuum" "valid" "validator" "values"
-"variable" "verbose" "view" "volatile" "when" "where" "with" "without"
-"work"
+"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric"
+"authorization" "binary" "both" "case" "cast" "check" "collate"
+"column" "concurrently" "constraint" "create" "cross"
+"current_catalog" "current_date" "current_role" "current_schema"
+"current_time" "current_timestamp" "current_user" "default"
+"deferrable" "desc" "distinct" "do" "else" "end" "except" "false"
+"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group"
+"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull"
+"is" "join" "leading" "left" "like" "limit" "localtime"
+"localtimestamp" "natural" "notnull" "not" "null" "off" "offset"
+"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary"
+"references" "returning" "right" "select" "session_user" "similar"
+"some" "symmetric" "table" "then" "to" "trailing" "true" "union"
+"unique" "user" "using" "variadic" "verbose" "when" "where" "window"
+"with"
 )
 
      ;; Postgres Data Types
      (sql-font-lock-keywords-builder 'font-lock-type-face nil
-"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char"
-"character" "cidr" "circle" "cstring" "date" "decimal" "double"
-"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal"
-"interval" "language_handler" "line" "lseg" "macaddr" "money"
-"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real"
-"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure"
-"regtype" "serial" "serial4" "serial8" "smallint" "text" "time"
-"timestamp" "varchar" "varying" "void" "zone"
+"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char"
+"character" "cidr" "circle" "date" "decimal" "double" "float4"
+"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line"
+"lseg" "macaddr" "money" "numeric" "path" "point" "polygon"
+"precision" "real" "serial" "serial4" "serial8" "smallint" "text"
+"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector"
+"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without"
+"xml" "zone"
 )))
 
   "Postgres SQL keywords used by font-lock.
@@ -1979,6 +2064,9 @@ you define your own `sql-mode-mysql-font-lock-keywords'.")
 (defvar sql-mode-sqlite-font-lock-keywords
   (eval-when-compile
     (list
+     ;; SQLite commands
+     '("^[.].*$" . font-lock-doc-face)
+
      ;; SQLite Keyword
      (sql-font-lock-keywords-builder 'font-lock-keyword-face nil
 "abort" "action" "add" "after" "all" "alter" "analyze" "and" "as"
@@ -2493,29 +2581,31 @@ function like this: (sql-get-login 'user 'password 'database)."
 
           ((eq token 'port)             ; port
            (setq sql-port
-                 (read-number "Port: " sql-port))))))
-       what))
+                 (read-number "Port: " (if (numberp sql-port)
+                                           sql-port
+                                         0)))))))
+     what))
 
 (defun sql-find-sqli-buffer ()
-  "Returns 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)))
-    (if (and (buffer-live-p default-buffer)
-             (get-buffer-process 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 (derived-mode-p 'sql-interactive-mode)
-                       (get-buffer-process candidate))
-                  (setq found candidate))
-              (setq buflist (cdr buflist))))
-          found)))))
+  "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 ((buf  sql-buffer)
+        (prod 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.
@@ -2527,16 +2617,17 @@ using `sql-find-sqli-buffer'.  If `sql-buffer' is set,
   (interactive)
   (save-excursion
     (let ((buflist (buffer-list))
-          (default-sqli-buffer (sql-find-sqli-buffer)))
-      (setq-default sql-buffer default-sqli-buffer)
+          (default-buffer (sql-find-sqli-buffer)))
+      (setq-default sql-buffer default-buffer)
       (while (not (null buflist))
         (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-sqli-buffer)
-                (run-hooks 'sql-set-sqli-hook))))
+                (setq sql-buffer default-buffer)
+                (when default-buffer
+                  (run-hooks 'sql-set-sqli-hook)))))
         (setq buflist (cdr buflist))))))
 
 (defun sql-set-sqli-buffer ()
@@ -2554,19 +2645,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
-                  (equal major-mode 'sql-interactive-mode)))
-          (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
-      (if new-buffer
-          (progn
-            (setq sql-buffer 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.
@@ -2574,11 +2659,11 @@ If you call it from anywhere else, it sets the global copy of
 This is the buffer SQL strings are sent to.  It is stored in the
 variable `sql-buffer'.  See `sql-help' on how to create such a buffer."
   (interactive)
-  (if (null (buffer-live-p sql-buffer))
+  (if (null (buffer-live-p (get-buffer sql-buffer)))
       (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
     (if (null (get-buffer-process sql-buffer))
-        (message "Buffer %s has no process." (buffer-name sql-buffer))
-      (message "Current SQLi buffer is %s." (buffer-name sql-buffer)))))
+        (message "Buffer %s has no process." sql-buffer)
+      (message "Current SQLi buffer is %s." sql-buffer))))
 
 (defun sql-make-alternate-buffer-name ()
   "Return a string that can be used to rename a SQLi buffer.
@@ -2610,8 +2695,9 @@ server/database name."
                               (unless (string= "" sql-user)
                                 (list "/" sql-user)))
                              ((eq token 'port)
-                              (unless (= 0 sql-port)
-                                (list ":" sql-port)))
+                              (unless (or (not (numberp sql-port))
+                                          (= 0 sql-port))
+                                (list ":" (number-to-string sql-port))))
                              ((eq token 'server)
                               (unless (string= "" sql-server)
                                 (list "."
@@ -2619,7 +2705,7 @@ server/database name."
                                           (file-name-nondirectory sql-server)
                                         sql-server))))
                              ((eq token 'database)
-                              (when (string= "" sql-database)
+                              (unless (string= "" sql-database)
                                 (list "@"
                                       (if (eq type :file)
                                          (file-name-nondirectory sql-database)
@@ -2649,10 +2735,32 @@ server/database name."
         ;; Use the name we've got
         name))))
 
-(defun sql-rename-buffer ()
-  "Rename a SQLi buffer."
-  (interactive)
-  (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t))
+(defun sql-rename-buffer (&optional new-name)
+  "Rename a SQL interactive buffer.
+
+Prompts for the new name if command is preceeded by
+\\[universal-argument].  If no buffer name is provided, then the
+`sql-alternate-buffer-name' is used.
+
+The actual buffer name set will be \"*SQL: NEW-NAME*\".  If
+NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
+  (interactive "P")
+
+  (if (not (derived-mode-p 'sql-interactive-mode))
+      (message "Current buffer is not a SQL interactive buffer")
+
+    (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))
+           (t                  sql-alternate-buffer-name)))
+
+    (rename-buffer (if (string= "" sql-alternate-buffer-name)
+                       "*SQL*"
+                     (format "*SQL: %s*" sql-alternate-buffer-name))
+                   t)))
 
 (defun sql-copy-column ()
   "Copy current column to the end of buffer.
@@ -2801,7 +2909,7 @@ to force the output from the query to appear on a new line."
 
   (let ((comint-input-sender-no-newline nil)
         (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str)))
-    (if (buffer-live-p sql-buffer)
+    (if (sql-buffer-live-p sql-buffer)
         (progn
           ;; Ignore the hoping around...
           (save-excursion
@@ -2814,7 +2922,7 @@ to force the output from the query to appear on a new line."
               (if sql-send-terminator
                   (sql-send-magic-terminator sql-buffer s sql-send-terminator))
 
-              (message "Sent string to buffer %s." (buffer-name sql-buffer))))
+              (message "Sent string to buffer %s." sql-buffer)))
 
           ;; Display the sql buffer
           (if sql-pop-to-buffer-after-send-region
@@ -2893,6 +3001,91 @@ 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
+        (unless save-prior
+          (erase-buffer))
+        (goto-char (point-max))
+        (setq start (point)))
+
+      ;; Run the command
+      (comint-redirect-send-command-to-process command buf proc nil t)
+      (while (null comint-redirect-completed)
+        (accept-process-output nil 1))
+
+      ;; Remove echo if there was one
+      (with-current-buffer buf
+        (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))
+           ;; (buffer-substring-no-properties
+           ;;  (match-beginning regexp-groups)
+           ;;  (match-end 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)))
+
+
+
 ;;; SQL mode -- uses SQL interactive mode
 
 ;;;###autoload
@@ -3063,7 +3256,7 @@ you entered, right above the output it created.
   (setq local-abbrev-table sql-mode-abbrev-table)
   (setq abbrev-all-caps 1)
   ;; Exiting the process will call sql-stop.
-  (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop)
+  (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
   ;; Save the connection name
   (make-local-variable 'sql-connection)
   ;; Create a usefull name for renaming this buffer later.
@@ -3248,49 +3441,57 @@ optionally is saved to the user's init file."
 ;;; Entry functions for different SQL interpreters.
 
 ;;;###autoload
-(defun sql-product-interactive (&optional product)
+(defun sql-product-interactive (&optional product new-name)
   "Run PRODUCT interpreter as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
 If buffer exists and a process is running, just switch to buffer `*SQL*'.
 
+To specify the SQL product, prefix the call with
+\\[universal-argument].  To set the buffer name as well, prefix
+the call to \\[sql-product-interactive] with
+\\[universal-argument] \\[universal-argument].
+
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
   (interactive "P")
 
+  ;; Handle universal arguments if specified
+  (when (not (or executing-kbd-macro noninteractive))
+    (when (and (consp product)
+               (not (cdr product))
+               (numberp (car product)))
+      (when (>= (car product) 16)
+        (when (not new-name)
+          (setq new-name '(4)))
+        (setq product '(4)))))
+
+  ;; Get the value of product that we need
   (setq product
         (cond
-         ((equal product '(4))          ; Universal arg, prompt for product
+         ((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"))))
+                                   (or (and sql-product
+                                            (symbol-name sql-product))
+                                       "ansi"))))
          ((and product                  ; Product specified
                (symbolp product)) 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 (and sql-buffer
-                 (buffer-live-p sql-buffer)
-                 (comint-check-proc sql-buffer))
+        ;; If no new name specified, fall back on sql-buffer if its for
+        ;; the same product
+        (if (and (not new-name)
+                 (sql-buffer-live-p sql-buffer product))
             (pop-to-buffer sql-buffer)
 
-          ;; Is the current buffer in sql-mode and
-          ;; there is a buffer local setting of sql-buffer
-          (let* ((start-buffer
-                  (and (derived-mode-p 'sql-mode)
-                       (current-buffer)))
-                 (start-sql-buffer
-                  (and start-buffer
-                       (let (found)
-                         (dolist (var (buffer-local-variables))
-                           (and (consp var)
-                                (eq (car var) 'sql-buffer)
-                                (buffer-live-p (cdr var))
-                                (get-buffer-process (cdr var))
-                                (setq found (cdr var))))
-                         found)))
+          ;; 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.
@@ -3303,15 +3504,19 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'.
                      (sql-get-product-feature product :sqli-options))
 
             ;; Set SQLi mode.
-            (setq sql-interactive-product product
-                  new-sqli-buffer (current-buffer)
-                  sql-buffer new-sqli-buffer)
-            (sql-interactive-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
-            (when (and start-buffer (not start-sql-buffer))
-              (with-current-buffer start-buffer
-                (setq sql-buffer new-sqli-buffer)))
+            ;; 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")
@@ -3323,12 +3528,22 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'.
 
 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)))
+  (let ((program (sql-get-product-feature product :sqli-program))
+        (buf-name "SQL"))
+    ;; Make sure buffer name is unique
+    (when (get-buffer (format "*%s*" buf-name))
+      (setq buf-name (format "SQL-%s" product))
+      (when (get-buffer (format "*%s*" buf-name))
+        (let ((i 1))
+          (while (get-buffer (format "*%s*"
+                                     (setq buf-name
+                                           (format "SQL-%s%d" product i))))
+            (setq i (1+ i))))))
     (set-buffer
-     (apply 'make-comint "SQL" program nil params))))
+     (apply 'make-comint buf-name program nil params))))
 
 ;;;###autoload
-(defun sql-oracle ()
+(defun sql-oracle (&optional buffer)
   "Run sqlplus by Oracle as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3343,6 +3558,11 @@ the list `sql-oracle-options'.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-oracle].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-oracle].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3351,8 +3571,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'oracle))
+  (interactive "P")
+  (sql-product-interactive 'oracle buffer))
 
 (defun sql-comint-oracle (product options)
   "Create comint buffer and connect to Oracle."
@@ -3375,7 +3595,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-sybase ()
+(defun sql-sybase (&optional buffer)
   "Run isql by Sybase as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3390,6 +3610,11 @@ can be stored in the list `sql-sybase-options'.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-sybase].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-sybase].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3398,8 +3623,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'sybase))
+  (interactive "P")
+  (sql-product-interactive 'sybase buffer))
 
 (defun sql-comint-sybase (product options)
   "Create comint buffer and connect to Sybase."
@@ -3419,7 +3644,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-informix ()
+(defun sql-informix (&optional buffer)
   "Run dbaccess by Informix as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3432,6 +3657,11 @@ the variable `sql-database' as default, if set.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-informix].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-informix].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3440,8 +3670,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'informix))
+  (interactive "P")
+  (sql-product-interactive 'informix buffer))
 
 (defun sql-comint-informix (product options)
   "Create comint buffer and connect to Informix."
@@ -3456,7 +3686,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-sqlite ()
+(defun sql-sqlite (&optional buffer)
   "Run sqlite as an inferior process.
 
 SQLite is free software.
@@ -3473,6 +3703,11 @@ can be stored in the list `sql-sqlite-options'.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-sqlite].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-sqlite].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3481,8 +3716,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'sqlite))
+  (interactive "P")
+  (sql-product-interactive 'sqlite buffer))
 
 (defun sql-comint-sqlite (product options)
   "Create comint buffer and connect to SQLite."
@@ -3498,7 +3733,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-mysql ()
+(defun sql-mysql (&optional buffer)
   "Run mysql by TcX as an inferior process.
 
 Mysql versions 3.23 and up are free software.
@@ -3515,6 +3750,11 @@ can be stored in the list `sql-mysql-options'.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-mysql].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-mysql].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3523,8 +3763,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'mysql))
+  (interactive "P")
+  (sql-product-interactive 'mysql buffer))
 
 (defun sql-comint-mysql (product options)
   "Create comint buffer and connect to MySQL."
@@ -3535,7 +3775,7 @@ The default comes from `process-coding-system-alist' and
         (setq params (append (list sql-database) params)))
     (if (not (string= "" sql-server))
         (setq params (append (list (concat "--host=" sql-server)) params)))
-    (if (and sql-port (numberp sql-port))
+    (if (not (= 0 sql-port))
         (setq params (append (list (concat "--port=" (number-to-string sql-port))) params)))
     (if (not (string= "" sql-password))
         (setq params (append (list (concat "--password=" sql-password)) params)))
@@ -3547,7 +3787,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-solid ()
+(defun sql-solid (&optional buffer)
   "Run solsql by Solid as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3561,6 +3801,11 @@ defaults, if set.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-solid].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-solid].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3569,8 +3814,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'solid))
+  (interactive "P")
+  (sql-product-interactive 'solid buffer))
 
 (defun sql-comint-solid (product options)
   "Create comint buffer and connect to Solid."
@@ -3588,7 +3833,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-ingres ()
+(defun sql-ingres (&optional buffer)
   "Run sql by Ingres as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3601,6 +3846,11 @@ the variable `sql-database' as default, if set.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-ingres].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-ingres].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3609,8 +3859,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'ingres))
+  (interactive "P")
+  (sql-product-interactive 'ingres buffer))
 
 (defun sql-comint-ingres (product options)
   "Create comint buffer and connect to Ingres."
@@ -3624,7 +3874,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-ms ()
+(defun sql-ms (&optional buffer)
   "Run osql by Microsoft as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3639,6 +3889,11 @@ in the list `sql-ms-options'.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-ms].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-ms].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3647,8 +3902,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'ms))
+  (interactive "P")
+  (sql-product-interactive 'ms buffer))
 
 (defun sql-comint-ms (product options)
   "Create comint buffer and connect to Microsoft SQL Server."
@@ -3675,7 +3930,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-postgres ()
+(defun sql-postgres (&optional buffer)
   "Run psql by Postgres as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3690,6 +3945,11 @@ Additional command line parameters can be stored in the list
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-postgres].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-postgres].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3703,8 +3963,8 @@ Try to set `comint-output-filter-functions' like this:
                                              '(comint-strip-ctrl-m)))
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'postgres))
+  (interactive "P")
+  (sql-product-interactive 'postgres buffer))
 
 (defun sql-comint-postgres (product options)
   "Create comint buffer and connect to Postgres."
@@ -3725,7 +3985,7 @@ Try to set `comint-output-filter-functions' like this:
 
 
 ;;;###autoload
-(defun sql-interbase ()
+(defun sql-interbase (&optional buffer)
   "Run isql by Interbase as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3739,6 +3999,11 @@ defaults, if set.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-interbase].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-interbase].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3747,8 +4012,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'interbase))
+  (interactive "P")
+  (sql-product-interactive 'interbase buffer))
 
 (defun sql-comint-interbase (product options)
   "Create comint buffer and connect to Interbase."
@@ -3766,7 +4031,7 @@ The default comes from `process-coding-system-alist' and
 
 
 ;;;###autoload
-(defun sql-db2 ()
+(defun sql-db2 (&optional buffer)
   "Run db2 by IBM as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3784,6 +4049,11 @@ db2, newlines will be escaped if necessary.  If you don't want that, set
 `comint-input-sender' back to `comint-simple-send' by writing an after
 advice.  See the elisp manual for more information.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-db2].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 To specify a coding system for converting non-ASCII characters
 in the input and output to the process, use \\[universal-coding-system-argument]
 before \\[sql-db2].  You can also specify this with \\[set-buffer-process-coding-system]
@@ -3792,8 +4062,8 @@ The default comes from `process-coding-system-alist' and
 `default-process-coding-system'.
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'db2))
+  (interactive "P")
+  (sql-product-interactive 'db2 buffer))
 
 (defun sql-comint-db2 (product options)
   "Create comint buffer and connect to DB2."
@@ -3801,11 +4071,9 @@ The default comes from `process-coding-system-alist' and
   ;; make-comint.
   (sql-comint product options)
 )
-;;   ;; Properly escape newlines when DB2 is interactive.
-;;   (setq comint-input-sender 'sql-escape-newlines-and-send))
 
 ;;;###autoload
-(defun sql-linter ()
+(defun sql-linter (&optional buffer)
   "Run inl by RELEX as an inferior process.
 
 If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3827,9 +4095,14 @@ an empty password.
 The buffer is put in SQL interactive mode, giving commands for sending
 input.  See `sql-interactive-mode'.
 
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-linter].  Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
-  (interactive)
-  (sql-product-interactive 'linter))
+  (interactive "P")
+  (sql-product-interactive 'linter buffer))
 
 (defun sql-comint-linter (product options)
   "Create comint buffer and connect to Linter."
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 29096a23046..8f80d13bab6 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -411,9 +411,10 @@ This variable is generally set from `tcl-proc-regexp',
 `tcl-typeword-list', and `tcl-keyword-list' by the function
 `tcl-set-font-lock-keywords'.")
 
-(defvar tcl-font-lock-syntactic-keywords
-  ;; Mark the few `#' that are not comment-markers.
-  '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
+(defconst tcl-syntax-propertize-function
+  (syntax-propertize-rules
+   ;; Mark the few `#' that are not comment-markers.
+   ("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
   "Syntactic keywords for `tcl-mode'.")
 
 ;; FIXME need some way to recognize variables because array refs look
@@ -593,9 +594,9 @@ Commands:
   (set (make-local-variable 'outline-level) 'tcl-outline-level)
 
   (set (make-local-variable 'font-lock-defaults)
-       '(tcl-font-lock-keywords nil nil nil beginning-of-defun
-         (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords)
-         (parse-sexp-lookup-properties . t)))
+       '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
+  (set (make-local-variable 'syntax-propertize-function)
+       tcl-syntax-propertize-function)
 
   (set (make-local-variable 'imenu-generic-expression)
        tcl-imenu-generic-expression)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 4ff9cf92b8d..24768d93e6a 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -4693,8 +4693,15 @@ Key bindings:
   (set (make-local-variable 'font-lock-defaults)
        (list
         '(nil vhdl-font-lock-keywords) nil
-        (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
-        '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
+        (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
+  (if (eval-when-compile (fboundp 'syntax-propertize-rules))
+      (set (make-local-variable 'syntax-propertize-function)
+           (syntax-propertize-rules
+            ;; Mark single quotes as having string quote syntax in
+            ;; 'c' instances.
+            ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
+    (set (make-local-variable 'font-lock-syntactic-keywords)
+         vhdl-font-lock-syntactic-keywords))
   (unless vhdl-emacs-21
     (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
     (set (make-local-variable 'lazy-lock-defer-contextually) nil)
@@ -12914,10 +12921,9 @@ This does background highlighting of translate-off regions.")
   "Re-initialize fontification and fontify buffer."
   (interactive)
   (setq font-lock-defaults
-        (list
-         'vhdl-font-lock-keywords nil
-         (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
-         '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
+        `(vhdl-font-lock-keywords
+          nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
+          beginning-of-line))
   (when (fboundp 'font-lock-unset-defaults)
     (font-lock-unset-defaults))         ; not implemented in XEmacs
   (font-lock-set-defaults)