]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/gdb-mi.el
-
[gnu-emacs] / lisp / progmodes / gdb-mi.el
index 486d67297a9cd6fc36b268d2bb5b13ffd402e6fa..5ad101df7bf2d36dcf96727e0c0dcff3bcaf1c9a 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gdb-mi.el --- User Interface for running GDB  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
 
 ;; Author: Nick Roberts <nickrob@gnu.org>
 ;; Maintainer: emacs-devel@gnu.org
@@ -1630,7 +1630,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
   (make-comint-in-buffer "gdb-inferior" (current-buffer) nil))
 
 (defcustom gdb-display-io-nopopup nil
-  "When non-nil, and the 'gdb-inferior-io buffer is buried, don't pop it up."
+  "When non-nil, and the `gdb-inferior-io' buffer is buried, don't pop it up."
   :type 'boolean
   :group 'gdb
   :version "25.1")
@@ -1766,7 +1766,8 @@ static char *magick[] = {
 (defvar gdb-control-commands-regexp
   (concat
    "^\\("
-   "commands\\|if\\|while\\|define\\|document\\|python\\|"
+   "commands\\|if\\|while\\|define\\|document\\|"
+   "python\\|python-interactive\\|pi\\|guile\\|guile-repl\\|gr\\|"
    "while-stepping\\|stepping\\|ws\\|actions"
    "\\)\\([[:blank:]]+.*\\)?$")
   "Regexp matching GDB commands that enter a recursive reading loop.
@@ -1782,21 +1783,27 @@ commands to be prefixed by \"-interpreter-exec console\".")
     (let ((inhibit-read-only t))
       (remove-text-properties (point-min) (point-max) '(face))))
   ;; mimic <RET> key to repeat previous command in GDB
-  (if (not (string= "" string))
-      (if gdb-continuation
-         (setq gdb-last-command (concat gdb-continuation
-                                        (gdb-strip-string-backslash string)
-                                        " "))
-       (setq gdb-last-command (gdb-strip-string-backslash string)))
-    (if gdb-last-command (setq string gdb-last-command))
-    (setq gdb-continuation nil))
-  (if (and (not gdb-continuation) (or (string-match "^-" string)
-         (> gdb-control-level 0)))
+  (when (= gdb-control-level 0)
+    (if (not (string= "" string))
+        (if gdb-continuation
+            (setq gdb-last-command (concat gdb-continuation
+                                           (gdb-strip-string-backslash string)
+                                           " "))
+          (setq gdb-last-command (gdb-strip-string-backslash string)))
+      (if gdb-last-command (setq string gdb-last-command))
+      (setq gdb-continuation nil)))
+  (if (and (not gdb-continuation)
+           (or (string-match "^-" string)
+               (> gdb-control-level 0)))
       ;; Either MI command or we are feeding GDB's recursive reading loop.
       (progn
        (setq gdb-first-done-or-error t)
        (process-send-string proc (concat string "\n"))
-       (if (and (string-match "^end$" string)
+       (if (and (string-match
+                  (concat "^\\("
+                          (if (eq system-type 'windows-nt) "\026" "\004")
+                          "\\|,q\\|,quit\\|end\\)$")
+                  string)
                 (> gdb-control-level 0))
            (setq gdb-control-level (1- gdb-control-level))))
     ;; CLI command
@@ -1812,7 +1819,11 @@ commands to be prefixed by \"-interpreter-exec console\".")
         (if gdb-enable-debug
             (push (cons 'mi-send to-send) gdb-debug-log))
         (process-send-string proc to-send))
-      (if (and (string-match "^end$" string)
+      (if (and (string-match
+                  (concat "^\\("
+                          (if (eq system-type 'windows-nt) "\026" "\004")
+                          "\\|,q\\|,quit\\|end\\)$")
+                  string)
               (> gdb-control-level 0))
          (setq gdb-control-level (1- gdb-control-level)))
       (setq gdb-continuation nil)))
@@ -2065,7 +2076,7 @@ a GDB/MI reply message."
 (defun gdbmi-bnf-gdb-prompt ()
   "Implementation of the following GDB/MI output grammar rule:
   gdb-prompt ==>
-       '(gdb)' nl
+       `(gdb)' nl
 
   nl ==>
        CR | CR-LF"
@@ -2085,7 +2096,7 @@ a GDB/MI reply message."
   "Implementation of the following GDB/MI output grammar rule:
 
   result-record ==>
-       [ token ] '^' result-class ( ',' result )* nl
+       [ token ] `^' result-class ( `,' result )* nl
 
   token ==>
        any sequence of digits."
@@ -2110,16 +2121,16 @@ a GDB/MI reply message."
        exec-async-output | status-async-output | notify-async-output
 
   exec-async-output ==>
-       [ token ] '*' async-output
+       [ token ] `*' async-output
 
   status-async-output ==>
-       [ token ] '+' async-output
+       [ token ] `+' async-output
 
   notify-async-output ==>
-       [ token ] '=' async-output
+       [ token ] `=' async-output
 
   async-output ==>
-       async-class ( ',' result )* nl"
+       async-class ( `,' result )* nl"
 
   (gdbmi-bnf-result-and-async-record-impl))
 
@@ -2130,13 +2141,13 @@ a GDB/MI reply message."
        console-stream-output | target-stream-output | log-stream-output
 
   console-stream-output ==>
-       '~' c-string
+       `~' c-string
 
   target-stream-output ==>
-       '@' c-string
+       `@' c-string
 
   log-stream-output ==>
-       '&' c-string"
+       `&' c-string"
   (when (< gdbmi-bnf-offset (length gud-marker-acc))
     (if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&))
              (string-match (concat "\\([~@&]\\)\\(" gdb--string-regexp "\\)\n")
@@ -2195,10 +2206,10 @@ value when the message is complete.
 
 Implement the following GDB/MI output grammar rule:
   result-class ==>
-       'done' | 'running' | 'connected' | 'error' | 'exit'
+       `done' | `running' | `connected' | `error' | `exit'
 
   async-class ==>
-       'stopped' | others (where others will be added depending on the needs
+       `stopped' | others (where others will be added depending on the needs
                            --this is still in development).")
 
 (defun gdbmi-bnf-result-and-async-record-impl ()
@@ -2315,10 +2326,67 @@ the end of the current result or async record is reached."
 ; list ==>
 ;      "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]"
 
+(defcustom gdb-mi-decode-strings nil
+  "When non-nil, decode octal escapes in GDB output into non-ASCII text.
+
+If the value is a coding-system, use that coding-system to decode
+the bytes reconstructed from octal escapes.  Any other non-nil value
+means to decode using the coding-system set for the GDB process.
+
+Warning: setting this non-nil might mangle strings reported by GDB
+that have literal substrings which match the \\nnn octal escape
+patterns, where nnn is an octal number between 200 and 377.  So
+we only recommend to set this variable non-nil if the program you
+are debugging really reports non-ASCII text, or some of its source
+file names include non-ASCII characters."
+  :type '(choice
+          (const :tag "Don't decode" nil)
+          (const :tag "Decode using default coding-system" t)
+          (coding-system :tag "Decode using this coding-system"))
+  :group 'gdb
+  :version "25.1")
+
+;; The idea of the following function was suggested
+;; by Kenichi Handa <handa@gnu.org>.
+;;
+;; FIXME: This is fragile: it relies on the assumption that all the
+;; non-ASCII strings output by GDB, including names of the source
+;; files, values of string variables in the inferior, etc., are all
+;; encoded in the same encoding.  It also assumes that the \nnn
+;; sequences are not split between chunks of output of the GDB process
+;; due to buffering, and arrive together.  Finally, if some string
+;; included literal \nnn strings (as opposed to non-ASCII characters
+;; converted by by GDB/MI to octal escapes), this decoding will mangle
+;; those strings.  When/if GDB acquires the ability to not
+;; escape-protect non-ASCII characters in its MI output, this kludge
+;; should be removed.
+(defun gdb-mi-decode (string)
+  "Decode octal escapes in MI output STRING into multibyte text."
+  (let ((coding
+         (if (coding-system-p gdb-mi-decode-strings)
+             gdb-mi-decode-strings
+           (with-current-buffer
+               (gdb-get-buffer-create 'gdb-partial-output-buffer)
+             buffer-file-coding-system))))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (prin1 string (current-buffer))
+      (goto-char (point-min))
+      ;; prin1 quotes the octal escapes as well, which interferes with
+      ;; their interpretation by 'read' below.  Remove the extra
+      ;; backslashes to countermand that.
+      (while (re-search-forward "\\\\\\(\\\\[2-3][0-7][0-7]\\)" nil t)
+        (replace-match "\\1" nil nil))
+      (goto-char (point-min))
+      (decode-coding-string (read (current-buffer)) coding))))
 
 (defun gud-gdbmi-marker-filter (string)
   "Filter GDB/MI output."
 
+  ;; If required, decode non-ASCII text encoded with octal escapes.
+  (or (null gdb-mi-decode-strings)
+      (setq string (gdb-mi-decode string)))
+
   ;; Record transactions if logging is enabled.
   (when gdb-enable-debug
     (push (cons 'recv string) gdb-debug-log)
@@ -2376,9 +2444,9 @@ Sets `gdb-thread-number' to new id."
   (let* ((result (gdb-json-string output-field))
          (thread-id (bindat-get-field result 'id)))
     (gdb-setq-thread-number thread-id)
-    ;; Typing `thread N` in GUD buffer makes GDB emit `^done` followed
-    ;; by `=thread-selected` notification. `^done` causes `gdb-update`
-    ;; as usually. Things happen to fast and second call (from
+    ;; Typing `thread N' in GUD buffer makes GDB emit `^done' followed
+    ;; by `=thread-selected' notification. `^done' causes `gdb-update'
+    ;; as usually. Things happen too fast and second call (from
     ;; gdb-thread-selected handler) gets cut off by our beloved
     ;; pending triggers.
     ;; Solution is `gdb-wait-for-pending' macro: it guarantees that its
@@ -2731,7 +2799,7 @@ 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
 not recommended to define triggers with empty SIGNAL-LIST.
-Normally triggers should respond at least to 'update signal.
+Normally triggers should respond at least to the `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
@@ -3195,7 +3263,7 @@ 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.
+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)
@@ -4038,6 +4106,8 @@ member."
       (let ((name (bindat-get-field local 'name))
             (value (bindat-get-field local 'value))
             (type (bindat-get-field local 'type)))
+        (when (not value)
+          (setq value "<complex data type>"))
         (if (or (not value)
                 (string-match "\\0x" value))
             (add-text-properties 0 (length name)