merge from trunk

5 files changed, 728 insertions, 334 deletions

diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 6fb9caa1a42..74b81b0cd01 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -5,7 +5,7 @@
 ;; Author: Dave Love <fx@gnu.org>
 ;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: languages
-;; Version: 1.1
+;; Version: 1.2
 
 ;; This file is part of GNU Emacs.
 
@@ -58,6 +58,70 @@
   :group 'cfengine
   :type 'integer)
 
+(defcustom cfengine-parameters-indent '(promise pname 0)
+  "*Indentation of CFEngine3 promise parameters (hanging indent).
+
+For example, say you have this code:
+
+bundle x y
+{
+  section:
+    class::
+      promise ...
+      promiseparameter => ...
+}
+
+You can choose to indent promiseparameter from the beginning of
+the line (absolutely) or from the word \"promise\" (relatively).
+
+You can also choose to indent the start of the word
+\"promiseparameter\" or the arrow that follows it.
+
+Finally, you can choose the amount of the indent.
+
+The default is to anchor at promise, indent parameter name, and offset 0:
+
+bundle agent rcfiles
+{
+  files:
+    any::
+      \"/tmp/netrc\"
+      comment => \"my netrc\",
+      perms => mog(\"600\", \"tzz\", \"tzz\");
+}
+
+Here we anchor at beginning of line, indent arrow, and offset 10:
+
+bundle agent rcfiles
+{
+  files:
+    any::
+      \"/tmp/netrc\"
+  comment => \"my netrc\",
+    perms => mog(\"600\", \"tzz\", \"tzz\");
+}
+
+Some, including cfengine_stdlib.cf, like to anchor at promise, indent
+arrow, and offset 16 or so:
+
+bundle agent rcfiles
+{
+  files:
+    any::
+      \"/tmp/netrc\"
+              comment => \"my netrc\",
+                perms => mog(\"600\", \"tzz\", \"tzz\");
+}
+"
+
+  :group 'cfengine
+  :type '(list
+          (choice (const :tag "Anchor at beginning of promise" promise)
+                  (const :tag "Anchor at beginning of line" bol))
+          (choice (const :tag "Indent parameter name" pname)
+                  (const :tag "Indent arrow" arrow))
+          (integer :tag "Indentation amount from anchor")))
+
 (defvar cfengine-mode-debug nil
   "Whether `cfengine-mode' should print debugging info.")
 
@@ -94,7 +158,7 @@ This includes those for cfservd as well as cfagent.")
     (regexp-opt cfengine3-defuns t)
     "Regex to match the CFEngine 3.x defuns.")
 
-  (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::")
+  (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::")
 
   (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
 
@@ -126,8 +190,8 @@ This includes those for cfservd as well as cfagent.")
     ;; Defuns.  This happens early so they don't get caught by looser
     ;; patterns.
     (,(concat "\\<" cfengine3-defuns-regex "\\>"
-              "[ \t]+\\<\\([[:alnum:]_]+\\)\\>"
-              "[ \t]+\\<\\([[:alnum:]_]+\\)"
+              "[ \t]+\\<\\([[:alnum:]_.:]+\\)\\>"
+              "[ \t]+\\<\\([[:alnum:]_.:]+\\)"
               ;; Optional parentheses with variable names inside.
               "\\(?:(\\([^)]*\\))\\)?")
      (1 font-lock-builtin-face)
@@ -144,8 +208,8 @@ This includes those for cfservd as well as cfagent.")
      1 font-lock-builtin-face)
 
     ;; Variables, including scope, e.g. module.var
-    ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face)
-    ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face)
+    ("[@$](\\([[:alnum:]_.:]+\\))" 1 font-lock-variable-name-face)
+    ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face)
 
     ;; Variable definitions.
     ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
@@ -305,10 +369,10 @@ Intended as the value of `indent-line-function'."
        ((looking-at (concat cfengine3-defuns-regex "\\>"))
         (indent-line-to 0))
        ;; Categories are indented one step.
-       ((looking-at (concat cfengine3-category-regex "[ \t]*$"))
+       ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$"))
         (indent-line-to cfengine-indent))
        ;; Class selectors are indented two steps.
-       ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$"))
+       ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$"))
         (indent-line-to (* 2 cfengine-indent)))
        ;; Outdent leading close brackets one step.
        ((or (eq ?\} (char-after))
@@ -317,6 +381,8 @@ Intended as the value of `indent-line-function'."
             (indent-line-to (save-excursion
                               (forward-char)
                               (backward-sexp)
+                              (move-beginning-of-line nil)
+                              (skip-chars-forward " \t")
                               (current-column)))
           (error nil)))
        ;; Inside a string and it starts before this line.
@@ -331,7 +397,23 @@ Intended as the value of `indent-line-function'."
        ;; plus 2.  That way, promises indent deeper than class
        ;; selectors, which in turn are one deeper than categories.
        ((= 1 (nth 0 parse))
-        (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))
+        (let ((p-anchor (nth 0 cfengine-parameters-indent))
+              (p-what (nth 1 cfengine-parameters-indent))
+              (p-indent (nth 2 cfengine-parameters-indent)))
+          ;; Do we have the parameter anchor and location and indent
+          ;; defined, and are we looking at a promise parameter?
+          (if (and p-anchor p-what p-indent
+                   (looking-at  "\\([[:alnum:]_]+[ \t]*\\)=>"))
+              (let* ((arrow-offset (* -1 (length (match-string 1))))
+                     (extra-offset (if (eq p-what 'arrow) arrow-offset 0))
+                     (base-offset (if (eq p-anchor 'promise)
+                                      (* (+ 2 (nth 0 parse)) cfengine-indent)
+                                    0)))
+                (indent-line-to (max 0 (+ p-indent base-offset extra-offset))))
+            ;; Else, indent to cfengine-indent times the nested depth
+            ;; plus 2.  That way, promises indent deeper than class
+            ;; selectors, which in turn are one deeper than categories.
+          (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))))
        ;; Inside brackets/parens: indent to start column of non-comment
        ;; token on line following open bracket or by one step from open
        ;; bracket's column.
@@ -436,7 +518,8 @@ Intended as the value of `indent-line-function'."
   ;; The syntax defaults seem OK to give reasonable word movement.
   (modify-syntax-entry ?# "<" table)
   (modify-syntax-entry ?\n ">#" table)
-  (modify-syntax-entry ?\" "\"" table)
+  (modify-syntax-entry ?\" "\"" table)  ; "string"
+  (modify-syntax-entry ?\' "\"" table)  ; 'string'
   ;; Variable substitution.
   (modify-syntax-entry ?$ "." table)
   ;; Doze path separators.
@@ -475,7 +558,6 @@ to the action header."
   ;; Shell commands can be quoted by single, double or back quotes.
   ;; It's debatable whether we should define string syntax, but it
   ;; should avoid potential confusion in some cases.
-  (modify-syntax-entry ?\' "\"" cfengine2-mode-syntax-table)
   (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
 
   (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
@@ -505,7 +587,7 @@ on the buffer contents"
         (forward-line)))
     (if v3 (cfengine3-mode) (cfengine2-mode))))
 
-(defalias 'cfengine-mode 'cfengine-auto-mode)
+(defalias 'cfengine-mode 'cfengine3-mode)
 
 (provide 'cfengine3)
 (provide 'cfengine)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 90c7cfc5008..8ba2822c3a3 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1,4 +1,4 @@
-;;; gdb-mi.el --- User Interface for running GDB
+;;; gdb-mi.el --- User Interface for running GDB  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
 
@@ -192,8 +192,8 @@ address for root variables.")
 (defvar gdb-disassembly-position nil)
 
 (defvar gdb-location-alist nil
-  "Alist of breakpoint numbers and full filenames.  Only used for files that
-Emacs can't find.")
+  "Alist of breakpoint numbers and full filenames.
+Only used for files that Emacs can't find.")
 (defvar gdb-active-process nil
   "GUD tooltips display variable values when t, and macro definitions otherwise.")
 (defvar gdb-error "Non-nil when GDB is reporting an error.")
@@ -227,9 +227,8 @@ This variable is updated in `gdb-done-or-error' and returned by
 It is initialized to `gdb-non-stop-setting' at the beginning of
 every GDB session.")
 
-(defvar gdb-buffer-type nil
+(defvar-local gdb-buffer-type nil
   "One of the symbols bound in `gdb-buffer-rules'.")
-(make-variable-buffer-local 'gdb-buffer-type)
 
 (defvar gdb-output-sink 'nil
   "The disposition of the output of the current gdb command.
@@ -294,9 +293,7 @@ argument (see `gdb-emit-signal')."
     (funcall (cdr subscriber) signal)))
 
 (defvar gdb-buf-publisher '()
-  "Used to invalidate GDB buffers by emitting a signal in
-`gdb-update'.
-
+  "Used to invalidate GDB buffers by emitting a signal in `gdb-update'.
 Must be a list of pairs with cars being buffers and cdr's being
 valid signal handlers.")
 
@@ -327,8 +324,7 @@ valid signal handlers.")
   "When in non-stop mode, stopped threads can be examined while
 other threads continue to execute.
 
-GDB session needs to be restarted for this setting to take
-effect."
+GDB session needs to be restarted for this setting to take effect."
   :type 'boolean
   :group 'gdb-non-stop
   :version "23.2")
@@ -336,19 +332,18 @@ effect."
 ;; TODO Some commands can't be called with --all (give a notice about
 ;; it in setting doc)
 (defcustom gdb-gud-control-all-threads t
-  "When enabled, GUD execution commands affect all threads when
-in non-stop mode. Otherwise, only current thread is affected."
+  "When non-nil, GUD execution commands affect all threads when
+in non-stop mode.  Otherwise, only current thread is affected."
   :type 'boolean
   :group 'gdb-non-stop
   :version "23.2")
 
 (defcustom gdb-switch-reasons t
-  "List of stop reasons which cause Emacs to switch to the thread
-which caused the stop. When t, switch to stopped thread no matter
-what the reason was. When nil, never switch to stopped thread
-automatically.
+  "List of stop reasons for which Emacs should switch thread.
+When t, switch to stopped thread no matter what the reason was.
+When nil, never switch to stopped thread automatically.
 
-This setting is used in non-stop mode only. In all-stop mode,
+This setting is used in non-stop mode only.  In all-stop mode,
 Emacs always switches to the thread which caused the stop."
   ;; exited, exited-normally and exited-signaled are not
   ;; thread-specific stop reasons and therefore are not included in
@@ -404,7 +399,7 @@ and GDB buffers were updated in `gdb-stopped'."
   :link '(info-link "(gdb)GDB/MI Async Records"))
 
 (defcustom gdb-switch-when-another-stopped t
-  "When nil, Emacs won't switch to stopped thread if some other
+  "When nil, don't switch to stopped thread if some other
 stopped thread is already selected."
   :type 'boolean
   :group 'gdb-non-stop
@@ -447,8 +442,7 @@ stopped thread is already selected."
   :version "23.2")
 
 (defcustom gdb-show-threads-by-default nil
-  "Show threads list buffer instead of breakpoints list by
-default."
+  "Show threads list buffer instead of breakpoints list by default."
   :type 'boolean
   :group 'gdb-buffers
   :version "23.2")
@@ -490,12 +484,12 @@ predefined macros."
 
 (defcustom gdb-create-source-file-list t
   "Non-nil means create a list of files from which the executable was built.
- Set this to nil if the GUD buffer displays \"initializing...\" in the mode
- line for a long time when starting, possibly because your executable was
- built from a large number of files.  This allows quicker initialization
- but means that these files are not automatically enabled for debugging,
- e.g., you won't be able to click in the fringe to set a breakpoint until
- execution has already stopped there."
+Set this to nil if the GUD buffer displays \"initializing...\" in the mode
+line for a long time when starting, possibly because your executable was
+built from a large number of files.  This allows quicker initialization
+but means that these files are not automatically enabled for debugging,
+e.g., you won't be able to click in the fringe to set a breakpoint until
+execution has already stopped there."
   :type 'boolean
   :group 'gdb
   :version "23.1")
@@ -507,6 +501,9 @@ Also display the main routine in the disassembly buffer if present."
   :group 'gdb
   :version "22.1")
 
+(defvar gdbmi-debug-mode nil
+  "When non-nil, print the messages sent/received from GDB/MI in *Messages*.")
+
 (defun gdb-force-mode-line-update (status)
   (let ((buffer gud-comint-buffer))
     (if (and buffer (buffer-name buffer))
@@ -570,7 +567,7 @@ When `gdb-non-stop' is nil, return COMMAND unchanged."
 
 (defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
   "`gud-call' wrapper which adds --thread/--all options between
-CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.
+CMD1 and CMD2.  NOALL is the same as in `gdb-gud-context-command'.
 
 NOARG must be t when this macro is used outside `gud-def'"
   `(gud-call
@@ -603,7 +600,7 @@ and source-file directory for your debugger.
 
 COMMAND-LINE is the shell command for starting the gdb session.
 It should be a string consisting of the name of the gdb
-executable followed by command-line options.  The command-line
+executable followed by command line options.  The command line
 options should include \"-i=mi\" to use gdb's MI text interface.
 Note that the old \"--annotate\" option is no longer supported.
 
@@ -846,6 +843,8 @@ detailed description of this mode.
         gdb-register-names '()
         gdb-non-stop gdb-non-stop-setting)
   ;;
+  (gdbmi-bnf-init)
+  ;;
   (setq gdb-buffer-type 'gdbmi)
   ;;
   (gdb-force-mode-line-update
@@ -1254,7 +1253,7 @@ With arg, enter name of variable to be watched in the minibuffer."
                       (cond
                        ((> new previous)
                         ;; Add new children to list.
-                        (dotimes (dummy previous)
+                        (dotimes (_ previous)
                           (push (pop temp-var-list) var-list))
                         (dolist (child children)
                           (let ((varchild
@@ -1268,9 +1267,9 @@ With arg, enter name of variable to be watched in the minibuffer."
                             (push varchild var-list))))
                        ;; Remove deleted children from list.
                        ((< new previous)
-                        (dotimes (dummy new)
+                        (dotimes (_ new)
                           (push (pop temp-var-list) var-list))
-                        (dotimes (dummy (- previous new))
+                        (dotimes (_ (- previous new))
                           (pop temp-var-list)))))
                   (push var1 var-list))
                 (setq var1 (pop temp-var-list)))
@@ -1502,7 +1501,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
       (gdb-input
        (concat "-inferior-tty-set " tty) 'ignore))))
 
-(defun gdb-inferior-io-sentinel (proc str)
+(defun gdb-inferior-io-sentinel (proc _str)
   (when (eq (process-status proc) 'failed)
     ;; When the debugged process exits, Emacs gets an EIO error on
     ;; read from the pty, and stops listening to it.  If the gdb
@@ -1739,6 +1738,7 @@ complete."
   (setq gdb-token-number (1+ gdb-token-number))
   (setq command (concat (number-to-string gdb-token-number) command))
   (push (cons gdb-token-number handler-function) gdb-handler-alist)
+  (if gdbmi-debug-mode (message "gdb-input: %s" command))
   (process-send-string (get-buffer-process gud-comint-buffer)
                        (concat command "\n")))
 
@@ -1761,8 +1761,7 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks."
           "*"))
 
 (defun gdb-current-context-mode-name (mode)
-  "Add thread information to MODE which is to be used as
-`mode-name'."
+  "Add thread information to MODE which is to be used as `mode-name'."
   (concat mode
           (if gdb-thread-number
               (format " [thread %s]" gdb-thread-number)
@@ -1809,7 +1808,8 @@ If NO-PROC is non-nil, do not try to contact the GDB process."
 ;; because we may need to update current gud-running value without
 ;; changing current thread (see gdb-running)
 (defun gdb-setq-thread-number (number)
-  "Only this function must be used to change `gdb-thread-number'
+  "Set `gdb-thread-number' to NUMBER.
+Only this function must be used to change `gdb-thread-number'
 value to NUMBER, because `gud-running' and `gdb-frame-number'
 need to be updated appropriately when current thread changes."
   ;; GDB 6.8 and earlier always output thread-id="0" when stopping.
@@ -1824,7 +1824,7 @@ need to be updated appropriately when current thread changes."
 
 Note that when `gdb-gud-control-all-threads' is t, `gud-running'
 cannot be reliably used to determine whether or not execution
-control buttons should be shown in menu or toolbar. Use
+control buttons should be shown in menu or toolbar.  Use
 `gdb-running-threads-count' and `gdb-stopped-threads-count'
 instead.
 
@@ -1874,23 +1874,337 @@ is running."
       (set-window-buffer source-window buffer))
     source-window))
 
-(defun gdb-car< (a b)
-  (< (car a) (car b)))
-
-(defvar gdbmi-record-list
-  '((gdb-gdb . "(gdb) \n")
-    (gdb-done . "\\([0-9]*\\)\\^done,?\\(.*?\\)\n")
-    (gdb-starting . "\\([0-9]*\\)\\^running\n")
-    (gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n")
-    (gdb-console . "~\\(\".*?\"\\)\n")
-    (gdb-internals . "&\\(\".*?\"\\)\n")
-    (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
-    (gdb-running . "\\*running,\\(.*?\n\\)")
-    (gdb-thread-created . "=thread-created,\\(.*?\n\\)")
-    (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n")
-    (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")
-    (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n")
-    (gdb-shell . "\\(\\(?:^.+\n\\)+\\)")))
+
+(defun gdbmi-start-with (str offset match)
+  "Return non-nil if string STR starts with MATCH, else returns nil.
+OFFSET is the position in STR at which the comparison takes place."
+  (let ((match-length (length match))
+        (str-length (- (length str) offset)))
+    (when (>= str-length match-length)
+      (string-equal match (substring str offset (+ offset match-length))))))
+
+(defun gdbmi-same-start (str offset match)
+  "Return non-nil iff STR and MATCH are equal up to the end of either strings.
+OFFSET is the position in STR at which the comparison takes place."
+  (let* ((str-length (- (length str) offset))
+         (match-length (length match))
+         (compare-length (min str-length match-length)))
+    (when (> compare-length 0)
+      (string-equal (substring str offset (+ offset compare-length))
+                    (substring match 0 compare-length)))))
+
+(defun gdbmi-is-number (character)
+  "Return non-nil iff CHARACTER is a numerical character between 0 and 9."
+  (and (>= character ?0)
+       (<= character ?9)))
+
+
+(defvar-local gdbmi-bnf-state 'gdbmi-bnf-output
+  "Current GDB/MI output parser state.
+The parser is placed in a different state when an incomplete data steam is
+received from GDB.
+This variable will preserve the state required to resume the parsing
+when more data arrives.")
+
+(defvar-local gdbmi-bnf-offset 0
+  "Offset in `gud-marker-acc' at which the parser is reading.
+This offset is used to be able to parse the GDB/MI message
+in-place, without the need of copying the string in a temporary buffer
+or discarding parsed tokens by substringing the message.")
+
+(defun gdbmi-bnf-init ()
+  "Initialize the GDB/MI message parser."
+  (setq gdbmi-bnf-state 'gdbmi-bnf-output)
+  (setq gdbmi-bnf-offset 0)
+  (setq gud-marker-acc ""))
+
+
+(defun gdbmi-bnf-output ()
+  "Implementation of the following GDB/MI output grammar rule:
+
+  output ==>
+       ( out-of-band-record )* [ result-record ] gdb-prompt"
+
+  (gdbmi-bnf-skip-unrecognized)
+  (while (gdbmi-bnf-out-of-band-record))
+  (gdbmi-bnf-result-record)
+  (gdbmi-bnf-gdb-prompt))
+
+
+(defun gdbmi-bnf-skip-unrecognized ()
+  "Skip characters until is encounters the beginning of a valid record.
+Used as a protection mechanism in case something goes wrong when parsing
+a GDB/MI reply message."
+  (let ((acc-length (length gud-marker-acc))
+        (prefix-offset gdbmi-bnf-offset)
+        (prompt "(gdb) \n"))
+
+    (while (and (< prefix-offset acc-length)
+                (gdbmi-is-number (aref gud-marker-acc prefix-offset)))
+      (setq prefix-offset (1+ prefix-offset)))
+
+    (if (and (< prefix-offset acc-length)
+             (not (memq (aref gud-marker-acc prefix-offset)
+                        '(?^ ?* ?+ ?= ?~ ?@ ?&)))
+             (not (gdbmi-same-start gud-marker-acc gdbmi-bnf-offset prompt))
+             (string-match "\\([^^*+=~@&]+\\)" gud-marker-acc
+                           gdbmi-bnf-offset))
+        (let ((unrecognized-str (match-string 0 gud-marker-acc)))
+          (setq gdbmi-bnf-offset (match-end 0))
+          (if gdbmi-debug-mode
+              (message "gdbmi-bnf-skip-unrecognized: %s" unrecognized-str))
+          (gdb-shell unrecognized-str)
+          t))))
+
+
+(defun gdbmi-bnf-gdb-prompt ()
+  "Implementation of the following GDB/MI output grammar rule:
+  gdb-prompt ==>
+       '(gdb)' nl
+
+  nl ==>
+       CR | CR-LF"
+
+  (let ((prompt "(gdb) \n"))
+    (when (gdbmi-start-with gud-marker-acc gdbmi-bnf-offset prompt)
+      (if gdbmi-debug-mode (message "gdbmi-bnf-gdb-prompt: %s" prompt))
+      (gdb-gdb prompt)
+      (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length prompt)))
+
+      ;; Returns non-nil to tell gud-gdbmi-marker-filter we've reached
+      ;; the end of a GDB reply message.
+      t)))
+
+
+(defun gdbmi-bnf-result-record ()
+  "Implementation of the following GDB/MI output grammar rule:
+
+  result-record ==>
+       [ token ] '^' result-class ( ',' result )* nl
+
+  token ==>
+       any sequence of digits."
+
+  (gdbmi-bnf-result-and-async-record-impl))
+
+
+(defun gdbmi-bnf-out-of-band-record ()
+  "Implementation of the following GDB/MI output grammar rule:
+
+  out-of-band-record ==>
+       async-record | stream-record"
+
+  (or (gdbmi-bnf-async-record)
+      (gdbmi-bnf-stream-record)))
+
+
+(defun gdbmi-bnf-async-record ()
+  "Implementation of the following GDB/MI output grammar rules:
+
+  async-record ==>
+       exec-async-output | status-async-output | notify-async-output
+
+  exec-async-output ==>
+       [ token ] '*' async-output
+
+  status-async-output ==>
+       [ token ] '+' async-output
+
+  notify-async-output ==>
+       [ token ] '=' async-output
+
+  async-output ==>
+       async-class ( ',' result )* nl"
+
+  (gdbmi-bnf-result-and-async-record-impl))
+
+
+(defun gdbmi-bnf-stream-record ()
+  "Implement the following GDB/MI output grammar rule:
+  stream-record ==>
+       console-stream-output | target-stream-output | log-stream-output
+
+  console-stream-output ==>
+       '~' c-string
+
+  target-stream-output ==>
+       '@' c-string
+
+  log-stream-output ==>
+       '&' c-string"
+  (when (< gdbmi-bnf-offset (length gud-marker-acc))
+    (if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&))
+             (string-match "\\([~@&]\\)\\(\".*?\"\\)\n" gud-marker-acc
+                           gdbmi-bnf-offset))
+        (let ((prefix (match-string 1 gud-marker-acc))
+              (c-string (match-string 2 gud-marker-acc)))
+
+          (setq gdbmi-bnf-offset (match-end 0))
+          (if gdbmi-debug-mode (message "gdbmi-bnf-stream-record: %s"
+                                        (match-string 0 gud-marker-acc)))
+
+          (cond ((string-equal prefix "~")
+                 (gdbmi-bnf-console-stream-output c-string))
+                ((string-equal prefix "@")
+                 (gdbmi-bnf-target-stream-output c-string))
+                ((string-equal prefix "&")
+                 (gdbmi-bnf-log-stream-output c-string)))
+          t))))
+
+(defun gdbmi-bnf-console-stream-output (c-string)
+  "Handler for the console-stream-output GDB/MI output grammar rule."
+  (gdb-console c-string))
+
+(defun gdbmi-bnf-target-stream-output (_c-string)
+  "Handler for the target-stream-output GDB/MI output grammar rule."
+  ;; Not currently used.
+  )
+
+(defun gdbmi-bnf-log-stream-output (c-string)
+  "Handler for the log-stream-output GDB/MI output grammar rule."
+  ;; Suppress "No registers."  GDB 6.8 and earlier
+  ;; duplicates MI error message on internal stream.
+  ;; Don't print to GUD buffer.
+  (if (not (string-equal (read c-string) "No registers.\n"))
+      (gdb-internals c-string)))
+
+
+(defconst gdbmi-bnf-result-state-configs
+  '(("^" . (("done" . (gdb-done . progressive))
+            ("error" . (gdb-error . progressive))
+            ("running" . (gdb-starting . atomic))))
+    ("*" . (("stopped" . (gdb-stopped . atomic))
+            ("running" . (gdb-running . atomic))))
+    ("+" . ())
+    ("=" . (("thread-created" . (gdb-thread-created . atomic))
+            ("thread-selected" . (gdb-thread-selected . atomic))
+            ("thread-existed" . (gdb-ignored-notification . atomic))
+            ('default . (gdb-ignored-notification . atomic)))))
+  "Alist of alists, mapping the type and class of message to a handler function.
+Handler functions are all flagged as either `progressive' or `atomic'.
+`progressive' handlers are capable of parsing incomplete messages.
+They can be called several time with new data chunk as they arrive from GDB.
+`progressive' handlers must have an extra argument that is set to a non-nil
+value when the message is complete.
+
+Implement the following GDB/MI output grammar rule:
+  result-class ==>
+       'done' | 'running' | 'connected' | 'error' | 'exit'
+
+  async-class ==>
+       'stopped' | others (where others will be added depending on the needs
+                           --this is still in development).")
+
+(defun gdbmi-bnf-result-and-async-record-impl ()
+  "Common implementation of the result-record and async-record rule.
+Both rules share the same syntax.  Those records may be very large in size.
+For that reason, the \"result\" part of the  record is parsed by
+`gdbmi-bnf-incomplete-record-result', which will keep
+receiving characters as they arrive from GDB until the record is complete."
+  (let ((acc-length (length gud-marker-acc))
+        (prefix-offset gdbmi-bnf-offset))
+
+    (while (and (< prefix-offset acc-length)
+                (gdbmi-is-number (aref gud-marker-acc prefix-offset)))
+      (setq prefix-offset (1+ prefix-offset)))
+
+    (if (and (< prefix-offset acc-length)
+             (member (aref gud-marker-acc prefix-offset) '(?* ?+ ?= ?^))
+             (string-match "\\([0-9]*\\)\\([*+=^]\\)\\(.+?\\)\\([,\n]\\)"
+                           gud-marker-acc gdbmi-bnf-offset))
+
+        (let ((token (match-string 1 gud-marker-acc))
+              (prefix (match-string 2 gud-marker-acc))
+              (class (match-string 3 gud-marker-acc))
+              (complete (string-equal (match-string 4 gud-marker-acc) "\n"))
+              class-alist
+              class-command)
+
+          (setq gdbmi-bnf-offset (match-end 0))
+          (if gdbmi-debug-mode (message "gdbmi-bnf-result-record: %s"
+                                        (match-string 0 gud-marker-acc)))
+
+          (setq class-alist
+                (cdr (assoc prefix gdbmi-bnf-result-state-configs)))
+          (setq class-command (cdr (assoc class class-alist)))
+          (if (null class-command)
+              (setq class-command (cdr (assoc 'default class-alist))))
+
+          (if complete
+              (if class-command
+                  (if (equal (cdr class-command) 'progressive)
+                      (funcall (car class-command) token "" complete)
+                    (funcall (car class-command) token "")))
+            (setq gdbmi-bnf-state
+                  (lambda ()
+                    (gdbmi-bnf-incomplete-record-result token class-command)))
+            (funcall gdbmi-bnf-state))
+          t))))
+
+(defun gdbmi-bnf-incomplete-record-result (token class-command)
+  "State of the parser used to progressively parse a result-record or async-record
+rule from an incomplete data stream.  The parser will stay in this state until
+the end of the current result or async record is reached."
+  (when (< gdbmi-bnf-offset (length gud-marker-acc))
+    ;; Search the data stream for the end of the current record:
+    (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
+           (is-progressive (equal (cdr class-command) 'progressive))
+           (is-complete (not (null newline-pos)))
+           result-str)
+
+      ;; Update the gdbmi-bnf-offset only if the current chunk of data can
+      ;; be processed by the class-command handler:
+      (when (or is-complete is-progressive)
+        (setq result-str
+              (substring gud-marker-acc gdbmi-bnf-offset newline-pos))
+        (setq gdbmi-bnf-offset (+ 1 newline-pos)))
+
+      (if gdbmi-debug-mode
+          (message "gdbmi-bnf-incomplete-record-result: %s"
+                   (substring gud-marker-acc gdbmi-bnf-offset newline-pos)))
+
+      ;; Update the parsing state before invoking the handler in class-command
+      ;; to make sure it's not left in an invalid state if the handler was
+      ;; to generate an error.
+      (if is-complete
+          (setq gdbmi-bnf-state 'gdbmi-bnf-output))
+
+      (if class-command
+          (if is-progressive
+              (funcall (car class-command) token result-str is-complete)
+            (if is-complete
+                (funcall (car class-command) token result-str))))
+
+      (unless is-complete
+        ;; Incomplete gdb response: abort parsing until we receive more data.
+        (if gdbmi-debug-mode (message "gdbmi-bnf-incomplete-record-result, aborting: incomplete stream"))
+        (throw 'gdbmi-incomplete-stream nil))
+
+      is-complete)))
+
+
+; The following grammar rules are not yet implemented by this GDBMI-BNF parser.
+; The handling of those rules is currently done by the handlers registered
+; in gdbmi-bnf-result-state-configs
+;
+; result ==>
+;      variable "=" value
+;
+; variable ==>
+;      string
+;
+; value ==>
+;      const | tuple | list
+;
+; const ==>
+;      c-string
+;
+; tuple ==>
+;      "{}" | "{" result ( "," result )* "}"
+;
+; list ==>
+;      "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]"
+
 
 (defun gud-gdbmi-marker-filter (string)
   "Filter GDB/MI output."
@@ -1907,46 +2221,20 @@ is running."
 
   ;; Start accumulating output for the GUD buffer.
   (setq gdb-filter-output "")
-  (let (output-record-list)
-
-    ;; Process all the complete markers in this chunk.
-    (dolist (gdbmi-record gdbmi-record-list)
-      (while (string-match (cdr gdbmi-record) gud-marker-acc)
-        (push (list (match-beginning 0)
-                    (car gdbmi-record)
-                    (match-string 1 gud-marker-acc)
-                    (match-string 2 gud-marker-acc)
-                    (match-end 0))
-              output-record-list)
-        (setq gud-marker-acc
-              (concat (substring gud-marker-acc 0 (match-beginning 0))
-                      ;; Pad with spaces to preserve position.
-                      (make-string (length (match-string 0 gud-marker-acc)) 32)
-                      (substring gud-marker-acc (match-end 0))))))
-
-    (setq output-record-list (sort output-record-list 'gdb-car<))
-
-    (dolist (output-record output-record-list)
-      (let ((record-type (cadr output-record))
-            (arg1 (nth 2 output-record))
-            (arg2 (nth 3 output-record)))
-        (cond ((eq record-type 'gdb-error)
-               (gdb-done-or-error arg2 arg1 'error))
-              ((eq record-type 'gdb-done)
-               (gdb-done-or-error arg2 arg1 'done))
-              ;; Suppress "No registers."  GDB 6.8 and earlier
-              ;; duplicates MI error message on internal stream.
-              ;; Don't print to GUD buffer.
-              ((not (and (eq record-type 'gdb-internals)
-                         (string-equal (read arg1) "No registers.\n")))
-               (funcall record-type arg1)))))
 
-    (setq gdb-output-sink 'user)
-    ;; Remove padding.
-    (string-match "^ *" gud-marker-acc)
-    (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
+  (let ((acc-length (length gud-marker-acc)))
+    (catch 'gdbmi-incomplete-stream
+      (while (and (< gdbmi-bnf-offset acc-length)
+                  (funcall gdbmi-bnf-state)))))
+
+  (when (/= gdbmi-bnf-offset 0)
+    (setq gud-marker-acc (substring gud-marker-acc gdbmi-bnf-offset))
+    (setq gdbmi-bnf-offset 0))
+
+  (when (and gdbmi-debug-mode (> (length gud-marker-acc) 0))
+    (message "gud-gdbmi-marker-filter, unparsed string: %s" gud-marker-acc))
 
-    gdb-filter-output))
+  gdb-filter-output)
 
 (defun gdb-gdb (_output-field))
 
@@ -1954,13 +2242,13 @@ is running."
   (setq gdb-filter-output
         (concat output-field gdb-filter-output)))
 
-(defun gdb-ignored-notification (_output-field))
+(defun gdb-ignored-notification (_token _output-field))
 
 ;; gdb-invalidate-threads is defined to accept 'update-threads signal
-(defun gdb-thread-created (_output-field))
-(defun gdb-thread-exited (output-field)
-  "Handle =thread-exited async record: unset `gdb-thread-number'
- if current thread exited and update threads list."
+(defun gdb-thread-created (_token _output-field))
+(defun gdb-thread-exited (_token output-field)
+  "Handle =thread-exited async record.
+Unset `gdb-thread-number' if current thread exited and update threads list."
   (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
     (if (string= gdb-thread-number thread-id)
         (gdb-setq-thread-number nil))
@@ -1971,7 +2259,7 @@ is running."
     (gdb-wait-for-pending
      (gdb-emit-signal gdb-buf-publisher 'update-threads))))
 
-(defun gdb-thread-selected (output-field)
+(defun gdb-thread-selected (_token output-field)
   "Handler for =thread-selected MI output record.
 
 Sets `gdb-thread-number' to new id."
@@ -1988,7 +2276,7 @@ Sets `gdb-thread-number' to new id."
     (gdb-wait-for-pending
      (gdb-update))))
 
-(defun gdb-running (output-field)
+(defun gdb-running (_token output-field)
   (let* ((thread-id
           (bindat-get-field (gdb-json-string output-field) 'thread-id)))
     ;; We reset gdb-frame-number to nil if current thread has gone
@@ -2006,7 +2294,7 @@ Sets `gdb-thread-number' to new id."
   (setq gdb-active-process t)
   (gdb-emit-signal gdb-buf-publisher 'update-threads))
 
-(defun gdb-starting (_output-field)
+(defun gdb-starting (_output-field _result)
   ;; CLI commands don't emit ^running at the moment so use gdb-running too.
   (setq gdb-inferior-status "running")
   (gdb-force-mode-line-update
@@ -2020,7 +2308,7 @@ Sets `gdb-thread-number' to new id."
 
 ;; -break-insert -t didn't give a reason before gdb 6.9
 
-(defun gdb-stopped (output-field)
+(defun gdb-stopped (_token output-field)
   "Given the contents of *stopped MI async record, select new
 current thread and update GDB buffers."
   ;; Reason is available with target-async only
@@ -2106,7 +2394,13 @@ current thread and update GDB buffers."
   (setq gdb-filter-output
         (gdb-concat-output gdb-filter-output (read output-field))))
 
-(defun gdb-done-or-error (output-field token-number type)
+(defun gdb-done (token-number output-field is-complete)
+  (gdb-done-or-error token-number 'done output-field is-complete))
+
+(defun gdb-error (token-number output-field is-complete)
+  (gdb-done-or-error token-number 'error output-field is-complete))
+
+(defun gdb-done-or-error (token-number type output-field is-complete)
   (if (string-equal token-number "")
       ;; Output from command entered by user
       (progn
@@ -2122,14 +2416,12 @@ current thread and update GDB buffers."
     ;; Output from command from frontend.
     (setq gdb-output-sink 'emacs))
 
-  (gdb-clear-partial-output)
-
   ;; The process may already be dead (e.g. C-d at the gdb prompt).
   (let* ((proc (get-buffer-process gud-comint-buffer))
          (no-proc (or (null proc)
                       (memq (process-status proc) '(exit signal)))))
 
-    (when gdb-first-done-or-error
+    (when (and is-complete gdb-first-done-or-error)
       (unless (or token-number gud-running no-proc)
         (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
       (gdb-update no-proc)
@@ -2138,13 +2430,19 @@ current thread and update GDB buffers."
     (setq gdb-filter-output
           (gdb-concat-output gdb-filter-output output-field))
 
-    (when token-number
+    ;; We are done concatenating to the output sink.  Restore it to user sink:
+    (setq gdb-output-sink 'user)
+
+    (when (and token-number is-complete)
       (with-current-buffer
           (gdb-get-buffer-create 'gdb-partial-output-buffer)
         (funcall
          (cdr (assoc (string-to-number token-number) gdb-handler-alist))))
       (setq gdb-handler-alist
-            (assq-delete-all token-number gdb-handler-alist)))))
+            (assq-delete-all token-number gdb-handler-alist)))
+
+  (when is-complete
+    (gdb-clear-partial-output))))
 
 (defun gdb-concat-output (so-far new)
   (cond
@@ -2169,8 +2467,8 @@ Field names are wrapped in double quotes and equal signs are
 replaced with semicolons.
 
 If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from
-partial output. This is used to get rid of useless keys in lists
-in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
+partial output.  This is used to get rid of useless keys in lists
+in MI messages, e.g.: [key=.., key=..].  -stack-list-frames and
 -break-info are examples of MI commands which issue such
 responses.
 
@@ -2337,16 +2635,16 @@ calling `gdb-table-string'."
                                                     handler-name
                                                     &optional signal-list)
   "Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets
-HANDLER-NAME as its handler. HANDLER-NAME is bound to current
+HANDLER-NAME as its handler.  HANDLER-NAME is bound to current
 buffer with `gdb-bind-function-to-buffer'.
 
 If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the
-defined trigger is called with an argument from SIGNAL-LIST. It's
+defined trigger is called with an argument from SIGNAL-LIST.  It's
 not recommended to define triggers with empty SIGNAL-LIST.
 Normally triggers should respond at least to 'update signal.
 
 Normally the trigger defined by this command must be called from
-the buffer where HANDLER-NAME must work. This should be done so
+the buffer where HANDLER-NAME must work.  This should be done so
 that buffer-local thread number may be used in GDB-COMMAND (by
 calling `gdb-current-context-command').
 `gdb-bind-function-to-buffer' is used to achieve this, see
@@ -2375,32 +2673,33 @@ Handlers are normally called from the buffers they put output in.
 
 Delete ((current-buffer) . TRIGGER-NAME) from
 `gdb-pending-triggers', erase current buffer and evaluate
-CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
+CUSTOM-DEFUN.  Then `gdb-update-buffer-name' is called.
 
 If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
   `(defun ,handler-name ()
      (gdb-delete-pending (cons (current-buffer) ',trigger-name))
-     (let* ((buffer-read-only nil)
-            (window (get-buffer-window (current-buffer) 0))
-            (start (window-start window))
-            (p (window-point window)))
+     (let* ((inhibit-read-only t)
+            ,@(unless nopreserve
+                '((window (get-buffer-window (current-buffer) 0))
+                  (start (window-start window))
+                  (p (window-point window)))))
        (erase-buffer)
        (,custom-defun)
        (gdb-update-buffer-name)
-       ,(when (not nopreserve)
-          '(set-window-start window start)
-          '(set-window-point window p)))))
+       ,@(when (not nopreserve)
+          '((set-window-start window start)
+            (set-window-point window p))))))
 
 (defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
                                                     handler-name custom-defun
                                                     &optional signal-list)
   "Define trigger and handler.
 
-TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
-`def-gdb-auto-update-trigger'.
+TRIGGER-NAME trigger is defined to send GDB-COMMAND.
+See `def-gdb-auto-update-trigger'.
 
-HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
-`def-gdb-auto-update-handler'."
+HANDLER-NAME handler uses customization of CUSTOM-DEFUN.
+See `def-gdb-auto-update-handler'."
   `(progn
      (def-gdb-auto-update-trigger ,trigger-name
        ,gdb-command
@@ -2757,37 +3056,38 @@ corresponding to the mode line clicked."
                      gdb-running-threads-count
                    gdb-stopped-threads-count))
 
-        (gdb-table-add-row table
-                           (list
-                            (bindat-get-field thread 'id)
-                            (concat
-                             (if gdb-thread-buffer-verbose-names
-                                 (concat (bindat-get-field thread 'target-id) " ") "")
-                             (bindat-get-field thread 'state)
-                             ;; Include frame information for stopped threads
-                             (if (not running)
-                                 (concat
-                                  " in " (bindat-get-field thread 'frame 'func)
-                                  (if gdb-thread-buffer-arguments
-                                      (concat
-                                       " ("
-                                       (let ((args (bindat-get-field thread 'frame 'args)))
-                                         (mapconcat
-                                          (lambda (arg)
-                                            (apply #'format "%s=%s"
-                                                   (gdb-get-many-fields arg 'name 'value)))
-                                          args ","))
-                                       ")")
-                                    "")
-                                  (if gdb-thread-buffer-locations
-                                      (gdb-frame-location (bindat-get-field thread 'frame)) "")
-                                  (if gdb-thread-buffer-addresses
-                                      (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
-                               "")))
-                           (list
-                            'gdb-thread thread
-                            'mouse-face 'highlight
-                            'help-echo "mouse-2, RET: select thread")))
+        (gdb-table-add-row
+         table
+         (list
+          (bindat-get-field thread 'id)
+          (concat
+           (if gdb-thread-buffer-verbose-names
+               (concat (bindat-get-field thread 'target-id) " ") "")
+           (bindat-get-field thread 'state)
+           ;; Include frame information for stopped threads
+           (if (not running)
+               (concat
+                " in " (bindat-get-field thread 'frame 'func)
+                (if gdb-thread-buffer-arguments
+                    (concat
+                     " ("
+                     (let ((args (bindat-get-field thread 'frame 'args)))
+                       (mapconcat
+                        (lambda (arg)
+                          (apply #'format "%s=%s"
+                                 (gdb-get-many-fields arg 'name 'value)))
+                        args ","))
+                     ")")
+                  "")
+                (if gdb-thread-buffer-locations
+                    (gdb-frame-location (bindat-get-field thread 'frame)) "")
+                (if gdb-thread-buffer-addresses
+                    (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
+             "")))
+         (list
+          'gdb-thread thread
+          'mouse-face 'highlight
+          'help-echo "mouse-2, RET: select thread")))
       (when (string-equal gdb-thread-number
                           (bindat-get-field thread 'id))
         (setq marked-line (length gdb-threads-list))))
@@ -2803,8 +3103,8 @@ corresponding to the mode line clicked."
   "Define a NAME command which will act upon thread on the current line.
 
 CUSTOM-DEFUN may use locally bound `thread' variable, which will
-be the value of 'gdb-thread property of the current line. If
-'gdb-thread is nil, error is signaled."
+be the value of 'gdb-thread property of the current line.
+If `gdb-thread' is nil, error is signaled."
   `(defun ,name (&optional event)
      ,(when doc doc)
      (interactive (list last-input-event))
@@ -2953,7 +3253,7 @@ line."
 (defun gdb-memory-column-width (size format)
   "Return length of string with memory unit of SIZE in FORMAT.
 
-SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
+SIZE is in bytes, as in `gdb-memory-unit'.  FORMAT is a string as
 in `gdb-memory-format'."
   (let ((format-base (cdr (assoc format
                                  '(("x" . 16)
@@ -3455,8 +3755,7 @@ DOC is an optional documentation string."
         (error "Not recognized as break/watchpoint line")))))
 
 (defun gdb-goto-breakpoint (&optional event)
-  "Go to the location of breakpoint at current line of
-breakpoints buffer."
+  "Go to the location of breakpoint at current line of breakpoints buffer."
   (interactive (list last-input-event))
   (if event (posn-set-point (event-end event)))
   ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
@@ -3840,7 +4139,7 @@ member."
 
 (defun gdb-get-source-file-list ()
   "Create list of source files for current GDB session.
-If buffers already exist for any of these files, gud-minor-mode
+If buffers already exist for any of these files, `gud-minor-mode'
 is set in them."
   (goto-char (point-min))
   (while (re-search-forward gdb-source-file-regexp nil t)
@@ -3851,8 +4150,8 @@ is set in them."
         (gdb-init-buffer)))))
 
 (defun gdb-get-main-selected-frame ()
-  "Trigger for `gdb-frame-handler' which uses main current
-thread. Called from `gdb-update'."
+  "Trigger for `gdb-frame-handler' which uses main current thread.
+Called from `gdb-update'."
   (if (not (gdb-pending-p 'gdb-get-main-selected-frame))
       (progn
         (gdb-input (gdb-current-context-command "-stack-info-frame")
@@ -3860,7 +4159,7 @@ thread. Called from `gdb-update'."
         (gdb-add-pending 'gdb-get-main-selected-frame))))
 
 (defun gdb-frame-handler ()
-  "Sets `gdb-selected-frame' and `gdb-selected-file' to show
+  "Set `gdb-selected-frame' and `gdb-selected-file' to show
 overlay arrow in source buffer."
   (gdb-delete-pending 'gdb-get-main-selected-frame)
   (let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
@@ -3921,8 +4220,8 @@ overlay arrow in source buffer."
 
 (defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal)
   "Find window displaying a buffer with the same
-`gdb-buffer-type' as BUF and show BUF there. If no such window
-exists, just call `gdb-display-buffer' for BUF. If the window
+`gdb-buffer-type' as BUF and show BUF there.  If no such window
+exists, just call `gdb-display-buffer' for BUF.  If the window
 found is already dedicated, split window according to
 SPLIT-HORIZONTAL and show BUF in the new window."
   (if buf
@@ -4310,8 +4609,7 @@ CONTEXT is the text before COMMAND on the line."
         (gud-gdb-fetch-lines-break (length context))
         (gud-gdb-fetched-lines nil)
         ;; This filter dumps output lines to `gud-gdb-fetched-lines'.
-        (gud-marker-filter #'gud-gdbmi-fetch-lines-filter)
-        complete-list)
+        (gud-marker-filter #'gud-gdbmi-fetch-lines-filter))
     (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
       (gdb-input (concat "complete " context command)
                  (lambda () (setq gud-gdb-fetch-lines-in-progress nil)))
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index ab65933416b..aeaf1acb2ac 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -27,7 +27,7 @@
 ;;; Commentary:
 
 ;; IDLWAVE enables feature-rich development and interaction with IDL,
-;; the Interactive Data Language. It provides a compelling,
+;; the Interactive Data Language.  It provides a compelling,
 ;; full-featured alternative to the IDLDE development environment
 ;; bundled with IDL.
 
@@ -447,7 +447,7 @@ value of `!DIR'.  See also `idlwave-library-path'."
 
 ;; Configuration files
 (defcustom idlwave-config-directory
-  (convert-standard-filename "~/.idlwave")
+  (locate-user-emacs-file "idlwave" ".idlwave")
   "Directory for configuration files and user-library catalog."
   :group 'idlwave-routine-info
   :type 'file)
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index aae5526ea82..fab20102097 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -310,7 +310,7 @@ See `run-hooks'."
         "(" (regexp-opt
              '("begin" "call-with-current-continuation" "call/cc"
                "call-with-input-file" "call-with-output-file" "case" "cond"
-               "do" "else" "for-each" "if" "lambda"
+               "do" "else" "for-each" "if" "lambda" "λ"
                "let" "let*" "let-syntax" "letrec" "letrec-syntax"
                ;; SRFI 11 usage comes up often enough.
                "let-values" "let*-values"
@@ -410,6 +410,7 @@ that variable's value is a string."
 (put 'make 'scheme-indent-function 1)
 (put 'style 'scheme-indent-function 1)
 (put 'root 'scheme-indent-function 1)
+(put 'λ 'scheme-indent-function 1)
 
 (defvar dsssl-font-lock-keywords
   (eval-when-compile
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 781aa241802..3cf6757d5ec 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -3,8 +3,8 @@
 ;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
 
 ;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: Michael Mauger <mmaug@yahoo.com>
-;; Version: 3.1
+;; Maintainer: Michael Mauger <michael@mauger.com>
+;; Version: 3.2
 ;; Keywords: comm languages processes
 ;; URL: http://savannah.gnu.org/projects/emacs/
 
@@ -209,7 +209,7 @@
 ;; nino <nino@inform.dk>
 ;; Berend de Boer <berend@pobox.com>
 ;; Adam Jenkins <adam@thejenkins.org>
-;; Michael Mauger <mmaug@yahoo.com> -- improved product support
+;; Michael Mauger <michael@mauger.com> -- improved product support
 ;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
 ;; Harald Maier <maierh@myself.com> -- sql-send-string
 ;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; 
@@ -218,6 +218,9 @@
 ;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
 ;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines 
 ;;      incorrectly enabled by default
+;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
+;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;;
 
 
 
@@ -605,11 +608,12 @@ Each element of the alist is as follows:
 
   \(CONNECTION \(SQL-VARIABLE VALUE) ...)
 
-Where CONNECTION is a symbol identifying the connection, SQL-VARIABLE
-is the symbol name of a SQL mode variable, and VALUE is the value to
-be assigned to the variable.  The most common SQL-VARIABLE settings
-associated with a connection are: `sql-product', `sql-user',
-`sql-password', `sql-port', `sql-server', and `sql-database'.
+Where CONNECTION is a case-insensitive string identifying the
+connection, SQL-VARIABLE is the symbol name of a SQL mode
+variable, and VALUE is the value to be assigned to the variable.
+The most common SQL-VARIABLE settings associated with a
+connection are: `sql-product', `sql-user', `sql-password',
+`sql-port', `sql-server', and `sql-database'.
 
 If a SQL-VARIABLE is part of the connection, it will not be
 prompted for during login.  The command `sql-connect' starts a
@@ -1299,7 +1303,7 @@ Based on `comint-mode-map'.")
     ;; double quotes (") don't delimit strings
     (modify-syntax-entry ?\" "." table)
     ;; Make these all punctuation
-    (mapc (lambda (c) (modify-syntax-entry c "." table))
+    (mapc #'(lambda (c) (modify-syntax-entry c "." table))
           (string-to-list "!#$%&+,.:;<=>?@\\|"))
     table)
   "Syntax table used in `sql-mode' and `sql-interactive-mode'.")
@@ -1509,7 +1513,7 @@ to add functions and PL/SQL keywords.")
                (not (derived-mode-p 'sql-interactive-mode)))
           (not sql-buffer)
           (not (eq sql-product 'oracle)))
-      (error "Not an Oracle buffer")
+      (user-error "Not an Oracle buffer")
 
     (let ((b "*RESERVED WORDS*"))
       (sql-execute sql-buffer b
@@ -1692,7 +1696,7 @@ to add functions and PL/SQL keywords.")
 "noswitch" "not" "nothing" "notimeout" "novalidate" "nowait" "null"
 "nulls" "object" "of" "off" "offline" "oidindex" "old" "on" "online"
 "only" "open" "operator" "optimal" "option" "or" "order"
-"organization" "out" "outer" "outline" "overflow" "overriding"
+"organization" "out" "outer" "outline" "over" "overflow" "overriding"
 "package" "packages" "parallel" "parallel_enable" "parameters"
 "parent" "partition" "partitions" "password" "password_grace_time"
 "password_life_time" "password_lock_time" "password_reuse_max"
@@ -1745,7 +1749,7 @@ to add functions and PL/SQL keywords.")
      ;; Oracle PL/SQL Functions
      (sql-font-lock-keywords-builder 'font-lock-builtin-face nil
 "delete" "trim" "extend" "exists" "first" "last" "count" "limit"
-"prior" "next"
+"prior" "next" "sqlcode" "sqlerrm"
 )
 
      ;; Oracle PL/SQL Reserved words
@@ -2402,7 +2406,7 @@ highlighting rules in SQL mode.")
   (let ((init (or (and initial (symbol-name initial)) "ansi")))
     (intern (completing-read
              prompt
-             (mapcar (lambda (info) (symbol-name (car info)))
+             (mapcar #'(lambda (info) (symbol-name (car info)))
                      sql-product-alist)
              nil 'require-match
              init 'sql-product-history init))))
@@ -2418,7 +2422,7 @@ configuration."
 
   ;; Don't do anything if the product is already supported
   (if (assoc product sql-product-alist)
-      (message "Product `%s' is already defined" product)
+      (user-error "Product `%s' is already defined" product)
 
     ;; Add product to the alist
     (add-to-list 'sql-product-alist `((,product :name ,display . ,plist)))
@@ -2437,11 +2441,11 @@ configuration."
                         ;; after this product's name.
                         (let ((next-item)
                               (down-display (downcase display)))
-                          (map-keymap (lambda (k b)
-                                        (when (and (not next-item)
-                                                   (string-lessp down-display
-                                                                 (downcase (cadr b))))
-                                          (setq next-item k)))
+                          (map-keymap #'(lambda (k b)
+                                          (when (and (not next-item)
+                                                     (string-lessp down-display
+                                                                   (downcase (cadr b))))
+                                            (setq next-item k)))
                                       (easy-menu-get-map sql-mode-menu '("Product")))
                           next-item))
     product))
@@ -2472,7 +2476,7 @@ argument must be a plist keyword accepted by
              (symbolp v))
             (set v newvalue)
           (setcdr p (plist-put (cdr p) feature newvalue)))
-      (message "`%s' is not a known product; use `sql-add-product' to add it first." product))))
+      (error "`%s' is not a known product; use `sql-add-product' to add it first." product))))
 
 (defun sql-get-product-feature (product feature &optional fallback not-indirect)
   "Lookup FEATURE associated with a SQL PRODUCT.
@@ -2502,7 +2506,7 @@ See `sql-product-alist' for a list of products and supported features."
                (symbolp v))
               (symbol-value v)
             v))
-      (message "`%s' is not a known product; use `sql-add-product' to add it first." product)
+      (error "`%s' is not a known product; use `sql-add-product' to add it first." product)
       nil)))
 
 (defun sql-product-font-lock (keywords-only imenu)
@@ -2543,13 +2547,13 @@ also be configured."
       (font-lock-mode-internal t))
 
     (add-hook 'font-lock-mode-hook
-              (lambda ()
-                ;; Provide defaults for new font-lock faces.
-                (defvar font-lock-builtin-face
-                  (if (boundp 'font-lock-preprocessor-face)
-                      font-lock-preprocessor-face
-                    font-lock-keyword-face))
-                (defvar font-lock-doc-face font-lock-string-face))
+              #'(lambda ()
+                  ;; Provide defaults for new font-lock faces.
+                  (defvar font-lock-builtin-face
+                    (if (boundp 'font-lock-preprocessor-face)
+                        font-lock-preprocessor-face
+                      font-lock-keyword-face))
+                  (defvar font-lock-doc-face font-lock-string-face))
               nil t)
 
     ;; Setup imenu; it needs the same syntax-alist.
@@ -2592,10 +2596,10 @@ adds a fontification pattern to fontify identifiers ending in
   "Iterate through login parameters and return a list of results."
   (delq nil
         (mapcar
-         (lambda (param)
-           (let ((token (or (car-safe param) param))
-                 (plist (cdr-safe param)))
-             (funcall body token plist)))
+         #'(lambda (param)
+             (let ((token (or (car-safe param) param))
+                   (plist (cdr-safe param)))
+               (funcall body token plist)))
          login-params)))
 
 
@@ -2604,8 +2608,8 @@ adds a fontification pattern to fontify identifiers ending in
 
 (defun sql-product-syntax-table ()
   (let ((table (copy-syntax-table sql-mode-syntax-table)))
-    (mapc (lambda (entry)
-            (modify-syntax-entry (car entry) (cdr entry) table))
+    (mapc #'(lambda (entry)
+              (modify-syntax-entry (car entry) (cdr entry) table))
           (sql-get-product-feature sql-product :syntax-alist))
     table))
 
@@ -2613,10 +2617,10 @@ adds a fontification pattern to fontify identifiers ending in
   (append
    ;; Change all symbol character to word characters
    (mapcar
-    (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
-                        (cons (car entry)
-                              (concat "w" (substring (cdr entry) 1)))
-                      entry))
+    #'(lambda (entry) (if (string= (substring (cdr entry) 0 1) "_")
+                          (cons (car entry)
+                                (concat "w" (substring (cdr entry) 1)))
+                        entry))
     (sql-get-product-feature sql-product :syntax-alist))
    '((?_ . "w"))))
 
@@ -2639,7 +2643,7 @@ adds a fontification pattern to fontify identifiers ending in
    (list (sql-read-product "SQL product: ")))
   (if (stringp product) (setq product (intern product)))
   (when (not (assoc product sql-product-alist))
-    (error "SQL product %s is not supported; treated as ANSI" product)
+    (user-error "SQL product %s is not supported; treated as ANSI" product)
     (setq product 'ansi))
 
   ;; Save product setting and fontify.
@@ -2765,6 +2769,7 @@ local variable."
              (comint-bol nil)
              (looking-at "go\\b")))
       (comint-send-input)))
+(put 'sql-magic-go 'delete-selection t)
 
 (defun sql-magic-semicolon (arg)
   "Insert semicolon and call `comint-send-input'.
@@ -2773,6 +2778,7 @@ local variable."
   (self-insert-command (prefix-numeric-value arg))
   (if (equal sql-electric-stuff 'semicolon)
        (comint-send-input)))
+(put 'sql-magic-semicolon 'delete-selection t)
 
 (defun sql-accumulate-and-indent ()
   "Continue SQL statement on the next line."
@@ -2861,6 +2867,15 @@ appended to the SQLi buffer without disturbing your SQL buffer."
                              t t doc 0)))
   doc)
 
+(defun sql-default-value (var)
+  "Fetch the value of a variable.
+
+If the current buffer is in `sql-interactive-mode', then fetch
+the global value, otherwise use the buffer local value."
+  (if (derived-mode-p 'sql-interactive-mode)
+      (default-value var)
+    (buffer-local-value var (current-buffer))))
+
 (defun sql-get-login-ext (symbol prompt history-var plist)
   "Prompt user with extended login parameters.
 
@@ -2882,7 +2897,7 @@ value.  (The property value is used as the PREDICATE argument to
   (set-default
    symbol
    (let* ((default (plist-get plist :default))
-          (last-value (default-value symbol))
+          (last-value (sql-default-value symbol))
           (prompt-def
            (if default
                (if (string-match "\\(\\):[ \t]*\\'" prompt)
@@ -2950,7 +2965,7 @@ function like this: (sql-get-login 'user 'password 'database)."
 
         (`password
          (setq-default sql-password
-                       (read-passwd "Password: " nil sql-password)))
+                       (read-passwd "Password: " nil (sql-default-value 'sql-password))))
 
         (`server
          (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
@@ -2978,10 +2993,10 @@ In order to qualify, the SQLi buffer must be alive, be in
           (sql-buffer-live-p buf prod connection)
           buf)
      ;; Look thru each buffer
-     (car (apply 'append
-                 (mapcar (lambda (b)
-                           (and (sql-buffer-live-p b prod connection)
-                                (list (buffer-name b))))
+     (car (apply #'append
+                 (mapcar #'(lambda (b)
+                             (and (sql-buffer-live-p b prod connection)
+                                  (list (buffer-name b))))
                          (buffer-list)))))))
 
 (defun sql-set-sqli-buffer-generally ()
@@ -3022,10 +3037,10 @@ 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")
+        (user-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)
+            (user-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)))))))
@@ -3038,10 +3053,10 @@ variable `sql-buffer'.  See `sql-help' on how to create such a buffer."
   (interactive)
   (if (or (null sql-buffer)
           (null (buffer-live-p (get-buffer sql-buffer))))
-      (message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
+      (user-error "%s has no SQLi buffer set" (buffer-name (current-buffer)))
     (if (null (get-buffer-process sql-buffer))
-        (message "Buffer %s has no process." sql-buffer)
-      (message "Current SQLi buffer is %s." sql-buffer))))
+        (user-error "Buffer %s has no process" sql-buffer)
+      (user-error "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.
@@ -3062,35 +3077,35 @@ server/database name."
 
     ;; Build a name using the :sqli-login setting
     (setq name
-          (apply 'concat
+          (apply #'concat
                  (cdr
-                  (apply 'append nil
+                  (apply #'append nil
                          (sql-for-each-login
                           (sql-get-product-feature sql-product :sqli-login)
-                          (lambda (token plist)
-                            (pcase token
-                             (`user
-                              (unless (string= "" sql-user)
-                                (list "/" sql-user)))
-                             (`port
-                              (unless (or (not (numberp sql-port))
-                                          (= 0 sql-port))
-                                (list ":" (number-to-string sql-port))))
-                             (`server
-                              (unless (string= "" sql-server)
-                                (list "."
-                                      (if (plist-member plist :file)
-                                          (file-name-nondirectory sql-server)
-                                        sql-server))))
-                             (`database
-                              (unless (string= "" sql-database)
-                                (list "@"
-                                      (if (plist-member plist :file)
-                                         (file-name-nondirectory sql-database)
-                                        sql-database))))
-
-                             ;; (`password nil)
-                             (_         nil))))))))
+                          #'(lambda (token plist)
+                              (pcase token
+                                (`user
+                                 (unless (string= "" sql-user)
+                                   (list "/" sql-user)))
+                                (`port
+                                 (unless (or (not (numberp sql-port))
+                                             (= 0 sql-port))
+                                   (list ":" (number-to-string sql-port))))
+                                (`server
+                                 (unless (string= "" sql-server)
+                                   (list "."
+                                         (if (plist-member plist :file)
+                                             (file-name-nondirectory sql-server)
+                                           sql-server))))
+                                (`database
+                                 (unless (string= "" sql-database)
+                                   (list "@"
+                                         (if (plist-member plist :file)
+                                             (file-name-nondirectory sql-database)
+                                           sql-database))))
+
+                                ;; (`password nil)
+                                (_         nil))))))))
 
     ;; If there's a connection, use it and the name thus far
     (if sql-connection
@@ -3125,7 +3140,7 @@ 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")
+      (user-error "Current buffer is not a SQL interactive buffer")
 
     (setq sql-alternate-buffer-name
           (cond
@@ -3135,6 +3150,7 @@ NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
                          sql-alternate-buffer-name))
            (t                  sql-alternate-buffer-name)))
 
+    (setq sql-alternate-buffer-name (substring-no-properties sql-alternate-buffer-name))
     (rename-buffer (if (string= "" sql-alternate-buffer-name)
                        "*SQL*"
                      (format "*SQL: %s*" sql-alternate-buffer-name))
@@ -3222,7 +3238,7 @@ Allows the suppression of continuation prompts.")
 (defun sql-input-sender (proc string)
   "Send STRING to PROC after applying filters."
 
-  (let* ((product (with-current-buffer (process-buffer proc) sql-product))
+  (let* ((product (buffer-local-value 'sql-product (process-buffer proc)))
          (filter  (sql-get-product-feature product :input-filter)))
 
     ;; Apply filter(s)
@@ -3232,15 +3248,13 @@ Allows the suppression of continuation prompts.")
      ((functionp filter)
       (setq string (funcall filter string)))
      ((listp filter)
-      (mapc (lambda (f) (setq string (funcall f string))) filter))
+      (mapc #'(lambda (f) (setq string (funcall f string))) filter))
      (t nil))
 
     ;; Count how many newlines in the string
-    (setq sql-output-newline-count 0)
-    (mapc (lambda (ch)
-            (when (eq ch ?\n)
-              (setq sql-output-newline-count (1+ sql-output-newline-count))))
-          string)
+    (setq sql-output-newline-count
+          (apply #'+ (mapcar #'(lambda (ch)
+                                (if (eq ch ?\n) 1 0)) string)))
 
     ;; Send the string
     (comint-simple-send proc string)))
@@ -3320,7 +3334,7 @@ to avoid deleting non-prompt output."
               (if sql-send-terminator
                   (sql-send-magic-terminator sql-buffer s sql-send-terminator))
 
-              (message "Sent string to buffer %s." sql-buffer)))
+              (message "Sent string to buffer %s" sql-buffer)))
 
           ;; Display the sql buffer
           (if sql-pop-to-buffer-after-send-region
@@ -3328,7 +3342,7 @@ to avoid deleting non-prompt output."
             (display-buffer sql-buffer)))
 
     ;; We don't have no stinkin' sql
-    (message "No SQL process started."))))
+    (user-error "No SQL process started"))))
 
 (defun sql-send-region (start end)
   "Send a region to the SQL process."
@@ -3421,7 +3435,7 @@ list of SQLi command strings."
     (when visible
       (message "Executing SQL command..."))
     (if (consp command)
-        (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
+        (mapc #'(lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior))
               command)
       (sql-redirect-one sqlbuf command outbuf save-prior))
     (when visible
@@ -3498,11 +3512,11 @@ for each match."
            (match-string regexp-groups))
           ;; list of numbers; return the specified matches only
           ((consp regexp-groups)
-           (mapcar (lambda (c)
-                     (cond
-                      ((numberp c) (match-string c))
-                      ((stringp c) (match-substitute-replacement c))
-                      (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c))))
+           (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)
@@ -3528,15 +3542,15 @@ strings are formatted with ARG and executed.
 If the results are empty the OUTBUF is deleted, otherwise the
 buffer is popped into a view window."
   (mapc
-   (lambda (c)
-     (cond
-      ((stringp c)
-       (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t)
-      ((functionp c)
-       (apply c sqlbuf outbuf enhanced arg nil))
-      (t (error "Unknown sql-execute item %s" c))))
+   #'(lambda (c)
+       (cond
+        ((stringp c)
+         (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t)
+        ((functionp c)
+         (apply c sqlbuf outbuf enhanced arg nil))
+        (t (error "Unknown sql-execute item %s" c))))
    (if (consp command) command (cons command nil)))
-
+  
   (setq outbuf (get-buffer outbuf))
   (if (zerop (buffer-size outbuf))
       (kill-buffer outbuf)
@@ -3551,11 +3565,11 @@ buffer is popped into a view window."
 
 (defun sql-execute-feature (sqlbuf outbuf feature enhanced arg)
   "List objects or details in a separate display buffer."
-  (let (command)
-    (with-current-buffer sqlbuf
-      (setq command (sql-get-product-feature sql-product feature)))
+  (let (command
+        (product (buffer-local-value 'sql-product (get-buffer sqlbuf))))
+    (setq command (sql-get-product-feature product feature))
     (unless command
-      (error "%s does not support %s" sql-product feature))
+      (error "%s does not support %s" product feature))
     (when (consp command)
       (setq command (if enhanced
                         (cdr command)
@@ -3582,7 +3596,7 @@ The list is maintained in SQL interactive buffers.")
                                  (apply f (current-buffer) (cons schema nil)))
                          cl)
                 (unless (member e cl) (setq cl (cons e cl))))
-              (sort cl (function string<)))))))
+              (sort cl #'string<))))))
 
 (defun sql-build-completions (schema)
   "Generate a list of names in the database for use as completions."
@@ -3646,7 +3660,7 @@ details or extends the listing to include other schemas objects."
   (interactive "P")
   (let ((sqlbuf (sql-find-sqli-buffer)))
     (unless sqlbuf
-      (error "No SQL interactive buffer found"))
+      (user-error "No SQL interactive buffer found"))
     (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil)
     (with-current-buffer sqlbuf
       ;; Contains the name of database objects
@@ -3662,9 +3676,9 @@ ENHANCED, displays additional details about each column."
          current-prefix-arg))
   (let ((sqlbuf (sql-find-sqli-buffer)))
     (unless sqlbuf
-      (error "No SQL interactive buffer found"))
+      (user-error "No SQL interactive buffer found"))
     (unless name
-      (error "No table name specified"))
+      (user-error "No table name specified"))
     (sql-execute-feature sqlbuf (format "*List %s*" name)
                          :list-table enhanced name)))
 
@@ -3898,7 +3912,7 @@ Sentinels will always get the two parameters PROCESS and EVENT."
   "Read a connection name."
   (let ((completion-ignore-case t))
     (completing-read prompt
-                     (mapcar (lambda (c) (car c))
+                     (mapcar #'(lambda (c) (car c))
                              sql-connection-alist)
                      nil t initial 'sql-connection-history default)))
 
@@ -3917,7 +3931,7 @@ is specified in the connection settings."
    (if sql-connection-alist
        (list (sql-read-connection "Connection: " nil '(nil))
              current-prefix-arg)
-     nil))
+     (user-error "No SQL Connections defined")))
 
   ;; Are there connections defined
   (if sql-connection-alist
@@ -3941,27 +3955,27 @@ is specified in the connection settings."
                 ;; Params in the connection
                 (setq set-params
                       (mapcar
-                       (lambda (v)
-                         (pcase (car v)
-                          (`sql-user     'user)
-                          (`sql-password 'password)
-                          (`sql-server   'server)
-                          (`sql-database 'database)
-                          (`sql-port     'port)
-                          (s             s)))
+                       #'(lambda (v)
+                           (pcase (car v)
+                             (`sql-user     'user)
+                             (`sql-password 'password)
+                             (`sql-server   'server)
+                             (`sql-database 'database)
+                             (`sql-port     'port)
+                             (s             s)))
                        (cdr connect-set)))
 
                 ;; the remaining params (w/o the connection params)
                 (setq rem-params
                       (sql-for-each-login login-params
-                       (lambda (token plist)
-                         (unless (member token set-params)
-                           (if plist (cons token plist) token)))))
+                       #'(lambda (token plist)
+                           (unless (member token set-params)
+                             (if plist (cons token plist) token)))))
 
                 ;; Set the parameters and start the interactive session
                 (mapc
-                 (lambda (vv)
-                   (set-default (car vv) (eval (cadr vv))))
+                 #'(lambda (vv)
+                     (set-default (car vv) (eval (cadr vv))))
                  (cdr connect-set))
                 (setq-default sql-connection connection)
 
@@ -3969,10 +3983,10 @@ is specified in the connection settings."
                 (eval `(let ((,param-var ',rem-params))
                          (sql-product-interactive ',sql-product ',new-name))))
 
-            (message "SQL Connection <%s> does not exist" connection)
+            (user-error "SQL Connection <%s> does not exist" connection)
             nil)))
 
-    (message "No SQL Connections defined")
+    (user-error "No SQL Connections defined")
     nil))
 
 (defun sql-save-connection (name)
@@ -3984,7 +3998,7 @@ optionally is saved to the user's init file."
   (interactive "sNew connection name: ")
 
   (unless (derived-mode-p 'sql-interactive-mode)
-    (error "Not in a SQL interactive mode!"))
+    (user-error "Not in a SQL interactive mode!"))
 
   ;; Capture the buffer local settings
   (let* ((buf        (current-buffer))
@@ -4009,18 +4023,18 @@ optionally is saved to the user's init file."
 
         ;; Add the new connection if it doesn't exist
         (if (assoc name alist)
-            (message "Connection <%s> already exists" name)
+            (user-error "Connection <%s> already exists" name)
           (setq connect
                 (cons name
                       (sql-for-each-login
                        `(product ,@login)
-                       (lambda (token _plist)
-                         (pcase token
-                          (`product  `(sql-product  ',product))
-                          (`user     `(sql-user     ,user))
-                          (`database `(sql-database ,database))
-                          (`server   `(sql-server   ,server))
-                          (`port     `(sql-port     ,port)))))))
+                       #'(lambda (token _plist)
+                           (pcase token
+                             (`product  `(sql-product  ',product))
+                             (`user     `(sql-user     ,user))
+                             (`database `(sql-database ,database))
+                             (`server   `(sql-server   ,server))
+                             (`port     `(sql-port     ,port)))))))
 
           (setq alist (append alist (list connect)))
 
@@ -4033,21 +4047,20 @@ optionally is saved to the user's init file."
   "Generate menu entries for using each connection."
   (append
    (mapcar
-    (lambda (conn)
-      (vector
-       (format "Connection <%s>\t%s" (car conn)
-               (let ((sql-user "") (sql-database "")
-                     (sql-server "") (sql-port 0))
-                 (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
-       (list 'sql-connect (car conn))
-       t))
+    #'(lambda (conn)
+        (vector
+         (format "Connection <%s>\t%s" (car conn)
+                 (let ((sql-user "") (sql-database "")
+                       (sql-server "") (sql-port 0))
+                   (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name)))))
+         (list 'sql-connect (car conn))
+         t))
     sql-connection-alist)
    tail))
 
 
 
 ;;; Entry functions for different SQL interpreters.
-
 ;;;###autoload
 (defun sql-product-interactive (&optional product new-name)
   "Run PRODUCT interpreter as an inferior process.
@@ -4140,7 +4153,7 @@ the call to \\[sql-product-interactive] with
               ;; All done.
               (message "Login...done")
               (pop-to-buffer new-sqli-buffer)))))
-    (message "No default SQL product defined.  Set `sql-product'.")))
+    (user-error "No default SQL product defined.  Set `sql-product'.")))
 
 (defun sql-comint (product params)
   "Set up a comint buffer to run the SQL processor.
@@ -4164,7 +4177,7 @@ passed as command line arguments."
                           (setq buf-name (format "SQL-%s%d" product i))))
             (setq i (1+ i))))))
     (set-buffer
-     (apply 'make-comint buf-name program nil params))))
+     (apply #'make-comint buf-name program nil params))))
 
 ;;;###autoload
 (defun sql-oracle (&optional buffer)
@@ -4256,7 +4269,7 @@ The default comes from `process-coding-system-alist' and
   ;;
 
   (append
-  ;; (apply 'concat (append
+  ;; (apply #'concat (append
   ;;  '("SET")
 
    ;; option value...
@@ -4304,8 +4317,8 @@ The default comes from `process-coding-system-alist' and
 
   ;; Remove any settings that haven't changed
   (mapc
-   (lambda (one-cur-setting)
-     (setq saved-settings (delete one-cur-setting saved-settings)))
+   #'(lambda (one-cur-setting)
+       (setq saved-settings (delete one-cur-setting saved-settings)))
    (sql-oracle-save-settings sqlbuf))
 
   ;; Restore the changed settings
@@ -4822,10 +4835,10 @@ Try to set `comint-output-filter-functions' like this:
         (sql-redirect sqlbuf "\\a"))
 
       ;; Return the list of table names (public schema name can be omitted)
-      (mapcar (lambda (tbl)
-                (if (string= (car tbl) "public")
-                    (cadr tbl)
-                  (format "%s.%s" (car tbl) (cadr tbl))))
+      (mapcar #'(lambda (tbl)
+                  (if (string= (car tbl) "public")
+                      (cadr tbl)
+                    (format "%s.%s" (car tbl) (cadr tbl))))
               cl))))