X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c1b8b17a7ac22123fe8d2d647265f19d2cc92625..37b9099068c10383e959ee366a52a22516846163:/lisp/progmodes/gdb-mi.el diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 486d67297a..5ad101df7b 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -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 ;; 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 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 . +;; +;; 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 "")) (if (or (not value) (string-match "\\0x" value)) (add-text-properties 0 (length name)