;;; gdb-mi.el --- User Interface for running GDB
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: FSF
;;; Credits:
-;; This file was written by by Nick Roberts following the general design
-;; used in gdb-ui.el for Emacs 22.1 - 23.1. It is currently being developed
+;; This file was written by Nick Roberts following the general design
+;; used in gdb-ui.el for Emacs 22.1 - 23.1. It was further developed
;; by Dmitry Dzhus <dima@sphinx.net.ru> as part of the Google Summer
;; of Code 2009 Project "Emacs GDB/MI migration".
;; M-x gdb will start the debugger.
-;; This file uses GDB/MI as the primary interface to GDB. It is still under
-;; development and is part of a process to migrate Emacs from annotations (as
-;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and
-;; access CLI using "-interpreter-exec console cli-command". This code works
-;; without gdb-ui.el and uses MI tokens instead of queues. Eventually MI
-;; should be asynchronous.
-
-;; This mode will PARTLY WORK WITH RECENT GDB RELEASES (status in modeline
-;; doesn't update properly when execution commands are issued from GUD buffer)
-;; and WORKS BEST when GDB runs asynchronously: maint set linux-async on.
-;;
-;; You need development version of GDB 7.0 for the thread buffer to work.
-
-;; This file replaces gdb-ui.el and is for development with GDB. Use the
-;; release branch of Emacs 22 for the latest version of gdb-ui.el.
+;; This file uses GDB/MI as the primary interface to GDB. It runs gdb with
+;; GDB/MI (-interp=mi) and access CLI using "-interpreter-exec console
+;; cli-command". This code replaces gdb-ui.el and uses MI tokens instead
+;; of queues. Eventually MI should be asynchronous.
;; Windows Platforms:
;; GDB in Emacs on Mac OSX works best with FSF GDB as Apple have made
;; some changes to the version that they include as part of Mac OSX.
;; This requires GDB version 7.0 or later (estimated release date Aug 2009)
-;; as earlier versions don not compile on Mac OSX.
+;; as earlier versions do not compile on Mac OSX.
;;; Known Bugs:
(require 'gud)
(require 'json)
(require 'bindat)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
(defvar gdb-source-window nil)
(defvar gdb-inferior-status nil)
(defvar gdb-continuation nil)
-(defvar gdb-version nil)
+(defvar gdb-supports-non-stop nil)
(defvar gdb-filter-output nil
"Message to be shown in GUD console.
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-signalled are not
+ ;; exited, exited-normally and exited-signaled are not
;; thread-specific stop reasons and therefore are not included in
;; this list
:type '(choice
:version "23.2"
:link '(info-link "(gdb)GDB/MI Async Records"))
-(defcustom gdb-stopped-hooks nil
- "This variable holds a list of functions to be called whenever
-GDB stops.
+(defcustom gdb-stopped-functions nil
+ "List of functions called whenever GDB stops.
Each function takes one argument, a parsed MI response, which
contains fields of corresponding MI *stopped async record:
`gdb-debug-log-max' values. This variable is used to debug GDB-MI.")
;;;###autoload
-(defcustom gdb-enable-debug nil
- "Non-nil means record the process input and output in `gdb-debug-log'."
- :type 'boolean
+(define-minor-mode gdb-enable-debug
+ "Toggle logging of transaction between Emacs and Gdb.
+The log is stored in `gdb-debug-log' as an alist with elements
+whose cons is send, send-item or recv and whose cdr is the string
+being transferred. This list may grow up to a size of
+`gdb-debug-log-max' after which the oldest element (at the end of
+the list) is deleted every time a new one is added (at the front)."
+ :global t
:group 'gdb
:version "22.1")
;; Force mode line redisplay soon.
(force-mode-line-update)))))
-(defun gdb-enable-debug (arg)
- "Toggle logging of transaction between Emacs and Gdb.
-The log is stored in `gdb-debug-log' as an alist with elements
-whose cons is send, send-item or recv and whose cdr is the string
-being transferred. This list may grow up to a size of
-`gdb-debug-log-max' after which the oldest element (at the end of
-the list) is deleted every time a new one is added (at the front)."
- (interactive "P")
- (setq gdb-enable-debug
- (if (null arg)
- (not gdb-enable-debug)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Logging of transaction %sabled"
- (if gdb-enable-debug "en" "dis"))))
-
;; These two are used for menu and toolbar
(defun gdb-control-all-threads ()
"Switch to non-stop/A mode."
(if gdb-non-stop
(if (and gdb-gud-control-all-threads
(not noall)
- (string-equal gdb-version "7.0+"))
+ gdb-supports-non-stop)
(concat command " --all ")
(gdb-current-context-command command))
command))
(concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
,(when (not noarg) 'arg)))
+(defun gdb--check-interpreter (proc string)
+ (unless (zerop (length string))
+ (let ((filter (process-get proc 'gud-normal-filter)))
+ (set-process-filter proc filter)
+ (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
+ ;; Apparently we're not running with -i=mi.
+ (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
+ (message msg)
+ (setq string (concat (propertize msg 'font-lock-face 'error)
+ "\n" string)))
+ ;; Use the old gud-gbd filter, not because it works, but because it
+ ;; will properly display GDB's answers rather than hanging waiting for
+ ;; answers that aren't coming.
+ (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
+ (funcall filter proc string))))
+
+(defvar gdb-control-level 0)
+
;;;###autoload
(defun gdb (command-line)
"Run gdb on program FILE in buffer *gud-FILE*.
The directory containing FILE becomes the initial working directory
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
+options should include \"-i=mi\" to use gdb's MI text interface.
+Note that the old \"--annotate\" option is no longer supported.
+
If `gdb-many-windows' is nil (the default value) then gdb just
pops up the GUD buffer unless `gdb-show-main' is t. In this case
it starts with two windows: one displaying the GUD buffer and the
"Multiple debugging requires restarting in text command mode"))
;;
(gud-common-init command-line nil 'gud-gdbmi-marker-filter)
+
+ ;; Setup a temporary process filter to warn when GDB was not started
+ ;; with -i=mi.
+ (let ((proc (get-buffer-process gud-comint-buffer)))
+ (process-put proc 'gud-normal-filter (process-filter proc))
+ (set-process-filter proc #'gdb--check-interpreter))
+
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
+ (set (make-local-variable 'gdb-control-level) 0)
(setq comint-input-sender 'gdb-send)
(when (ring-empty-p comint-input-ring) ; cf shell-mode
(let ((hfile (expand-file-name (or (getenv "GDBHISTFILE")
(gud-def gud-pp
(gud-call
(concat
- "pp1 " (if (eq (buffer-local-value
- 'major-mode (window-buffer)) 'speedbar-mode)
- (gdb-find-watch-expression) "%e")) arg)
+ "pp " (if (eq (buffer-local-value
+ 'major-mode (window-buffer)) 'speedbar-mode)
+ (gdb-find-watch-expression) "%e")) arg)
nil "Print the Emacs s-expression.")
(define-key gud-minor-mode-map [left-margin mouse-1]
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
+ (set (make-local-variable 'gud-gdb-completion-function)
+ 'gud-gdbmi-completions)
+
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
(local-set-key "\C-i" 'completion-at-point)
+ (local-set-key [remap comint-delchar-or-maybe-eof] 'gdb-delchar-or-quit)
+
(setq gdb-first-prompt t)
(setq gud-running nil)
(run-hooks 'gdb-mode-hook))
(defun gdb-init-1 ()
- ;; (re-)initialise
+ ;; (Re-)initialize.
(setq gdb-selected-frame nil
gdb-frame-number nil
gdb-thread-number nil
(gdb-get-buffer-create 'gdb-inferior-io)
(gdb-clear-inferior-io)
- (set-process-filter (get-process "gdb-inferior") 'gdb-inferior-filter)
- (gdb-input
- ;; Needs GDB 6.4 onwards
- (list (concat "-inferior-tty-set "
- (or
- ;; The process can run on a remote host.
- (process-get (get-process "gdb-inferior") 'remote-tty)
- (process-tty-name (get-process "gdb-inferior"))))
- 'ignore))
- (if (eq window-system 'w32)
- (gdb-input (list "-gdb-set new-console off" 'ignore)))
- (gdb-input (list "-gdb-set height 0" 'ignore))
+ (gdb-inferior-io--init-proc (get-process "gdb-inferior"))
+
+ (when (eq system-type 'windows-nt)
+ ;; Don't create a separate console window for the debuggee.
+ (gdb-input "-gdb-set new-console off" 'ignore)
+ ;; Force GDB to behave as if its input and output stream were
+ ;; connected to a TTY device (since on Windows we use pipes for
+ ;; communicating with GDB).
+ (gdb-input "-gdb-set interactive-mode on" 'ignore))
+ (gdb-input "-gdb-set height 0" 'ignore)
(when gdb-non-stop
- (gdb-input (list "-gdb-set non-stop 1" 'gdb-non-stop-handler)))
+ (gdb-input "-gdb-set non-stop 1" 'gdb-non-stop-handler))
+
+ (gdb-input "-enable-pretty-printing" 'ignore)
- ;; find source file and compilation directory here
- (gdb-input
- ; Needs GDB 6.2 onwards.
- (list "-file-list-exec-source-files" 'gdb-get-source-file-list))
+ ;; Find source file and compilation directory here.
(if gdb-create-source-file-list
- (gdb-input
- ; Needs GDB 6.0 onwards.
- (list "-file-list-exec-source-file" 'gdb-get-source-file)))
- (gdb-input
- (list "-gdb-show prompt" 'gdb-get-prompt)))
+ ;; Needs GDB 6.2 onwards.
+ (gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list))
+ ;; Needs GDB 6.0 onwards.
+ (gdb-input "-file-list-exec-source-file" 'gdb-get-source-file)
+ (gdb-input "-gdb-show prompt" 'gdb-get-prompt))
(defun gdb-non-stop-handler ()
(goto-char (point-min))
(message
"This version of GDB doesn't support non-stop mode. Turning it off.")
(setq gdb-non-stop nil)
- (setq gdb-version "pre-7.0"))
- (setq gdb-version "7.0+")
- (gdb-input (list "-gdb-set target-async 1" 'ignore))
- (gdb-input (list "-enable-pretty-printing" 'ignore))))
+ (setq gdb-supports-non-stop nil))
+ (setq gdb-supports-non-stop t)
+ (gdb-input "-gdb-set target-async 1" 'ignore)
+ (gdb-input "-list-target-features" 'gdb-check-target-async)))
+
+(defun gdb-check-target-async ()
+ (goto-char (point-min))
+ (unless (re-search-forward "async" nil t)
+ (message
+ "Target doesn't support non-stop mode. Turning it off.")
+ (setq gdb-non-stop nil)
+ (gdb-input "-gdb-set non-stop 0" 'ignore)))
+
+(defun gdb-delchar-or-quit (arg)
+ "Delete ARG characters or send a quit command to GDB.
+Send a quit only if point is at the end of the buffer, there is
+no input, and GDB is waiting for input."
+ (interactive "p")
+ (unless (and (eq (current-buffer) gud-comint-buffer)
+ (eq gud-minor-mode 'gdbmi))
+ (error "Not in a GDB-MI buffer"))
+ (let ((proc (get-buffer-process gud-comint-buffer)))
+ (if (and (eobp) proc (process-live-p proc)
+ (not gud-running)
+ (= (point) (marker-position (process-mark proc))))
+ ;; Sending an EOF does not work with GDB-MI; submit an
+ ;; explicit quit command.
+ (progn
+ (insert "quit")
+ (comint-send-input t t))
+ (delete-char arg))))
(defvar gdb-define-alist nil "Alist of #define directives for GUD tooltips.")
(push (cons name define) gdb-define-alist))))
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
-(defvar tooltip-use-echo-area)
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
- (if (re-search-forward ".*value=\\(\".*\"\\)" nil t)
- (tooltip-show
- (concat expr " = " (read (match-string 1)))
- (or gud-tooltip-echo-area tooltip-use-echo-area
- (not (display-graphic-p)))))))
+ (cond
+ ((re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ (tooltip-show
+ (concat expr " = " (read (match-string 1)))
+ (or gud-tooltip-echo-area
+ (not (display-graphic-p)))))
+ ((re-search-forward "msg=\\(\".+\"\\)$" nil t)
+ (tooltip-show (read (match-string 1))
+ (or gud-tooltip-echo-area
+ (not (display-graphic-p))))))))
;; If expr is a macro for a function don't print because of possible dangerous
;; side-effects. Also printing a function within a tooltip generates an
(goto-char (point-min))
(if (search-forward "expands to: " nil t)
(unless (looking-at "\\S-+.*(.*).*")
- (gdb-input
- (list (concat "-data-evaluate-expression " expr)
- `(lambda () (gdb-tooltip-print ,expr))))))))
+ (gdb-input (concat "-data-evaluate-expression \"" expr "\"")
+ `(lambda () (gdb-tooltip-print ,expr)))))))
(defun gdb-init-buffer ()
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(gdb-create-define-alist)
(add-hook 'after-save-hook 'gdb-create-define-alist nil t)))
-(defmacro gdb-if-arrow (arrow-position &rest body)
- `(if ,arrow-position
- (let ((buffer (marker-buffer ,arrow-position)) (line))
- (if (equal buffer (window-buffer (posn-window end)))
- (with-current-buffer buffer
- (when (or (equal start end)
- (equal (posn-point start)
- (marker-position ,arrow-position)))
- ,@body))))))
+(defmacro gdb--if-arrow (arrow-position start-posn end-posn &rest body)
+ (declare (indent 3))
+ (let ((buffer (make-symbol "buffer")))
+ `(if ,arrow-position
+ (let ((,buffer (marker-buffer ,arrow-position)))
+ (if (equal ,buffer (window-buffer (posn-window ,end-posn)))
+ (with-current-buffer ,buffer
+ (when (or (equal ,start-posn ,end-posn)
+ (equal (posn-point ,start-posn)
+ (marker-position ,arrow-position)))
+ ,@body)))))))
(defun gdb-mouse-until (event)
"Continue running until a source line past the current line.
(interactive "e")
(let ((start (event-start event))
(end (event-end event)))
- (gdb-if-arrow gud-overlay-arrow-position
- (setq line (line-number-at-pos (posn-point end)))
- (gud-call (concat "until " (number-to-string line))))
- (gdb-if-arrow gdb-disassembly-position
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (line-number-at-pos (posn-point end))))
- (forward-char 2)
- (gud-call (concat "until *%a"))))))
+ (gdb--if-arrow gud-overlay-arrow-position start end
+ (let ((line (line-number-at-pos (posn-point end))))
+ (gud-call (concat "until " (number-to-string line)))))
+ (gdb--if-arrow gdb-disassembly-position start end
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (line-number-at-pos (posn-point end))))
+ (forward-char 2)
+ (gud-call (concat "until *%a"))))))
(defun gdb-mouse-jump (event)
"Set execution address/line.
(interactive "e")
(let ((start (event-start event))
(end (event-end event)))
- (gdb-if-arrow gud-overlay-arrow-position
- (setq line (line-number-at-pos (posn-point end)))
- (progn
- (gud-call (concat "tbreak " (number-to-string line)))
- (gud-call (concat "jump " (number-to-string line)))))
- (gdb-if-arrow gdb-disassembly-position
- (save-excursion
- (goto-char (point-min))
- (forward-line (1- (line-number-at-pos (posn-point end))))
- (forward-char 2)
- (progn
- (gud-call (concat "tbreak *%a"))
- (gud-call (concat "jump *%a")))))))
+ (gdb--if-arrow gud-overlay-arrow-position start end
+ (let ((line (line-number-at-pos (posn-point end))))
+ (gud-call (concat "tbreak " (number-to-string line)))
+ (gud-call (concat "jump " (number-to-string line)))))
+ (gdb--if-arrow gdb-disassembly-position start end
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- (line-number-at-pos (posn-point end))))
+ (forward-char 2)
+ (gud-call (concat "tbreak *%a"))
+ (gud-call (concat "jump *%a"))))))
(defcustom gdb-show-changed-values t
"If non-nil change the face of out of scope variables and changed values.
:group 'gdb
:version "22.2")
-(defcustom gdb-speedbar-auto-raise nil
- "If non-nil raise speedbar every time display of watch expressions is\
- updated."
- :type 'boolean
+(define-minor-mode gdb-speedbar-auto-raise
+ "Minor mode to automatically raise the speedbar for watch expressions.
+With prefix argument ARG, automatically raise speedbar if ARG is
+positive, otherwise don't automatically raise it."
+ :global t
:group 'gdb
:version "22.1")
:group 'gdb
:version "22.1")
-(defun gdb-speedbar-auto-raise (arg)
- "Toggle automatic raising of the speedbar for watch expressions.
-With prefix argument ARG, automatically raise speedbar if ARG is
-positive, otherwise don't automatically raise it."
- (interactive "P")
- (setq gdb-speedbar-auto-raise
- (if (null arg)
- (not gdb-speedbar-auto-raise)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Auto raising %sabled"
- (if gdb-speedbar-auto-raise "en" "dis"))))
-
(define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch)
-(define-key global-map (concat gud-key-prefix "\C-w") 'gud-watch)
+(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch)
(declare-function tooltip-identifier-from-point "tooltip" (point))
(concat (if (derived-mode-p 'gdb-registers-mode) "$")
(tooltip-identifier-from-point (point)))))))
(set-text-properties 0 (length expr) nil expr)
- (gdb-input
- (list (concat"-var-create - * " expr "")
- `(lambda () (gdb-var-create-handler ,expr)))))))
+ (gdb-input (concat "-var-create - * " expr "")
+ `(lambda () (gdb-var-create-handler ,expr))))))
(message "gud-watch is a no-op in this mode."))))
(defun gdb-var-create-handler (expr)
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
(not (gdb-pending-p 'gdb-speedbar-timer)))
;; Dummy command to update speedbar even when idle.
- (gdb-input (list "-environment-pwd" 'gdb-speedbar-timer-fn))
+ (gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn)
;; Keep gdb-pending-triggers non-nil till end.
(gdb-add-pending 'gdb-speedbar-timer)))
; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
(defun gdb-var-list-children (varnum)
- (gdb-input
- (list (concat "-var-update " varnum) 'ignore))
- (gdb-input
- (list (concat "-var-list-children --all-values "
- varnum)
- `(lambda () (gdb-var-list-children-handler ,varnum)))))
+ (gdb-input (concat "-var-update " varnum) 'ignore)
+ (gdb-input (concat "-var-list-children --all-values " varnum)
+ `(lambda () (gdb-var-list-children-handler ,varnum))))
(defun gdb-var-list-children-handler (varnum)
(let* ((var-list nil)
"Set the output format for a variable displayed in the speedbar."
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
(varnum (car var)))
- (gdb-input
- (list (concat "-var-set-format " varnum " " format) 'ignore))
+ (gdb-input (concat "-var-set-format " varnum " " format) 'ignore)
(gdb-var-update)))
(defun gdb-var-delete-1 (var varnum)
- (gdb-input
- (list (concat "-var-delete " varnum) 'ignore))
+ (gdb-input (concat "-var-delete " varnum) 'ignore)
(setq gdb-var-list (delq var gdb-var-list))
(dolist (varchild gdb-var-list)
(if (string-match (concat (car var) "\\.") (car varchild))
(defun gdb-var-delete-children (varnum)
"Delete children of variable object at point from the speedbar."
- (gdb-input
- (list (concat "-var-delete -c " varnum) 'ignore)))
+ (gdb-input (concat "-var-delete -c " varnum) 'ignore))
(defun gdb-edit-value (_text _token _indent)
"Assign a value to a variable displayed in the speedbar."
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
- (varnum (car var)) (value))
- (setq value (read-string "New value: "))
- (gdb-input
- (list (concat "-var-assign " varnum " " value)
- `(lambda () (gdb-edit-value-handler ,value))))))
+ (varnum (car var))
+ (value (read-string "New value: ")))
+ (gdb-input (concat "-var-assign " varnum " " value)
+ `(lambda () (gdb-edit-value-handler ,value)))))
(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)")
; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update ()
(if (not (gdb-pending-p 'gdb-var-update))
- (gdb-input
- (list "-var-update --all-values *" 'gdb-var-update-handler)))
+ (gdb-input "-var-update --all-values *" 'gdb-var-update-handler))
(gdb-add-pending 'gdb-var-update))
(defun gdb-var-update-handler ()
(gdb-display-buffer
(gdb-get-buffer-create 'gdb-inferior-io) t))
+(defun gdb-inferior-io--init-proc (proc)
+ ;; Set up inferior I/O. Needs GDB 6.4 onwards.
+ (set-process-filter proc 'gdb-inferior-filter)
+ (set-process-sentinel proc 'gdb-inferior-io-sentinel)
+ ;; The process can run on a remote host.
+ (let ((tty (or (process-get proc 'remote-tty)
+ (process-tty-name proc))))
+ (unless (or (null tty)
+ (string= tty ""))
+ (gdb-input
+ (concat "-inferior-tty-set " tty) 'ignore))))
+
+(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
+ ;; process is still running, remove the pty, make a new one, and
+ ;; pass it to gdb.
+ (let ((gdb-proc (get-buffer-process gud-comint-buffer))
+ (io-buffer (process-buffer proc)))
+ (when (and gdb-proc (process-live-p gdb-proc)
+ (buffer-live-p io-buffer))
+ ;; `comint-exec' deletes the original process as a side effect.
+ (comint-exec io-buffer "gdb-inferior" nil nil nil)
+ (gdb-inferior-io--init-proc (get-buffer-process io-buffer))))))
+
(defconst gdb-frame-parameters
'((height . 14) (width . 80)
(unsplittable . t)
:group 'gdb)
\f
+(defvar gdb-control-commands-regexp
+ (concat
+ "^\\("
+ "commands\\|if\\|while\\|define\\|document\\|python\\|"
+ "while-stepping\\|stepping\\|ws\\|actions"
+ "\\)\\([[:blank:]]+.*\\)?$")
+ "Regexp matching GDB commands that enter a recursive reading loop.
+As long as GDB is in the recursive reading loop, it does not expect
+commands to be prefixed by \"-interpreter-exec console\".")
+
(defun gdb-send (proc string)
"A comint send filter for gdb."
(with-current-buffer gud-comint-buffer
(if (not (string= "" string))
(setq gdb-last-command string)
(if gdb-last-command (setq string gdb-last-command)))
- (if gdb-enable-debug
- (push (cons 'mi-send (concat string "\n")) gdb-debug-log))
- (if (string-match "^-" string)
- ;; MI command
+ (if (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")))
+ (process-send-string proc (concat string "\n"))
+ (if (and (string-match "^end$" string)
+ (> gdb-control-level 0))
+ (setq gdb-control-level (1- gdb-control-level))))
;; CLI command
(if (string-match "\\\\$" string)
(setq gdb-continuation (concat gdb-continuation string "\n"))
(setq gdb-first-done-or-error t)
- (process-send-string proc (concat "-interpreter-exec console \""
- gdb-continuation string "\"\n"))
- (setq gdb-continuation nil))))
-
-(defun gdb-input (item)
- (if gdb-enable-debug (push (cons 'send-item item) gdb-debug-log))
+ (let ((to-send (concat "-interpreter-exec console "
+ (gdb-mi-quote string)
+ "\n")))
+ (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)
+ (> gdb-control-level 0))
+ (setq gdb-control-level (1- gdb-control-level)))
+ (setq gdb-continuation nil)))
+ (if (string-match gdb-control-commands-regexp string)
+ (setq gdb-control-level (1+ gdb-control-level))))
+
+(defun gdb-mi-quote (string)
+ "Return STRING quoted properly as an MI argument.
+The string is enclosed in double quotes.
+All embedded quotes, newlines, and backslashes are preceded with a backslash."
+ (setq string (replace-regexp-in-string "\\([\"\\]\\)" "\\\\\\&" string))
+ (setq string (replace-regexp-in-string "\n" "\\n" string t t))
+ (concat "\"" string "\""))
+
+(defun gdb-input (command handler-function)
+ "Send COMMAND to GDB via the MI interface.
+Run the function HANDLER-FUNCTION, with no arguments, once the command is
+complete."
+ (if gdb-enable-debug (push (list 'send-item command handler-function)
+ gdb-debug-log))
(setq gdb-token-number (1+ gdb-token-number))
- (setcar item (concat (number-to-string gdb-token-number) (car item)))
- (push (cons gdb-token-number (car (cdr item))) gdb-handler-alist)
+ (setq command (concat (number-to-string gdb-token-number) command))
+ (push (cons gdb-token-number handler-function) gdb-handler-alist)
(process-send-string (get-buffer-process gud-comint-buffer)
- (concat (car item) "\n")))
+ (concat command "\n")))
;; NOFRAME is used for gud execution control commands
(defun gdb-current-context-command (command)
"Add --thread to gdb COMMAND when needed."
(if (and gdb-thread-number
- (string-equal gdb-version "7.0+"))
+ gdb-supports-non-stop)
(concat command " --thread " gdb-thread-number)
command))
(setq gdb-output-sink 'user)
(setq gdb-pending-triggers nil))
-(defun gdb-update ()
- "Update buffers showing status of debug session."
+(defun gdb-update (&optional no-proc)
+ "Update buffers showing status of debug session.
+If NO-PROC is non-nil, do not try to contact the GDB process."
(when gdb-first-prompt
(gdb-force-mode-line-update
(propertize "initializing..." 'face font-lock-variable-name-face))
(gdb-init-1)
(setq gdb-first-prompt nil))
- (gdb-get-main-selected-frame)
+ (unless no-proc
+ (gdb-get-main-selected-frame))
+
;; We may need to update gdb-threads-list so we can use
(gdb-get-buffer-create 'gdb-threads-buffer)
;; gdb-break-list is maintained in breakpoints handler
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (gdb-emit-signal gdb-buf-publisher 'update)
+ (unless no-proc
+ (gdb-emit-signal gdb-buf-publisher 'update))
(gdb-get-changed-registers)
-
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
(dolist (var gdb-var-list)
(setcar (nthcdr 5 var) nil))
(setq gud-running
(string= (bindat-get-field (gdb-current-buffer-thread) 'state)
"running"))
- ;; Set frame number to "0" when _current_ threads stops
+ ;; Set frame number to "0" when _current_ threads stops.
(when (and (gdb-current-buffer-thread)
(not (eq gud-running old-value)))
(setq gdb-frame-number "0"))))
(> (length gdb-debug-log) gdb-debug-log-max))
(setcdr (nthcdr (1- gdb-debug-log-max) gdb-debug-log) nil)))
- ;; Recall the left over gud-marker-acc from last time
+ ;; Recall the left over gud-marker-acc from last time.
(setq gud-marker-acc (concat gud-marker-acc string))
- ;; Start accumulating output for the GUD buffer
+ ;; Start accumulating output for the GUD buffer.
(setq gdb-filter-output "")
(let (output-record-list)
(let ((record-type (cadr output-record))
(arg1 (nth 2 output-record))
(arg2 (nth 3 output-record)))
- (if (eq record-type 'gdb-error)
- (gdb-done-or-error arg2 arg1 'error)
- (if (eq record-type 'gdb-done)
- (gdb-done-or-error arg2 arg1 'done)
- ;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI
- ;; error message on internal stream. Don't print to GUD buffer.
- (unless (and (eq record-type 'gdb-internals)
- (string-equal (read arg1) "No registers.\n"))
- (funcall record-type arg1))))))
+ (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.
(defun gdb-gdb (_output-field))
(defun gdb-shell (output-field)
- (let ((gdb-output-sink gdb-output-sink))
- (setq gdb-filter-output
- (concat output-field gdb-filter-output))))
+ (setq gdb-filter-output
+ (concat output-field gdb-filter-output)))
(defun gdb-ignored-notification (_output-field))
(setq gud-running t)
;; GDB doesn't seem to respond to -thread-info before first stop or
;; thread exit (even in non-stop mode), so this is useless.
- ;; Behaviour may change in the future.
+ ;; Behavior may change in the future.
(gdb-emit-signal gdb-buf-publisher 'update-threads))
;; -break-insert -t didn't give a reason before gdb 6.9
;; -data-list-register-names needs to be issued for any stopped
;; thread
(when (not gdb-register-names)
- (gdb-input
- (list (concat "-data-list-register-names"
- (if (string-equal gdb-version "7.0+")
- (concat" --thread " thread-id)))
- 'gdb-register-names-handler)))
-
-;;; Don't set gud-last-frame here as it's currently done in gdb-frame-handler
-;;; because synchronous GDB doesn't give these fields with CLI.
-;;; (when file
-;;; (setq
-;;; ;; Extract the frame position from the marker.
-;;; gud-last-frame (cons file
-;;; (string-to-number
-;;; (match-string 6 gud-marker-acc)))))
+ (gdb-input (concat "-data-list-register-names"
+ (if gdb-supports-non-stop
+ (concat " --thread " thread-id)))
+ 'gdb-register-names-handler))
+
+ ;; Don't set gud-last-frame here as it's currently done in
+ ;; gdb-frame-handler because synchronous GDB doesn't give these fields
+ ;; with CLI.
+ ;;(when file
+ ;; (setq
+ ;; ;; Extract the frame position from the marker.
+ ;; gud-last-frame (cons file
+ ;; (string-to-number
+ ;; (match-string 6 gud-marker-acc)))))
(setq gdb-inferior-status (or reason "unknown"))
(gdb-force-mode-line-update
;; In all-stop this updates gud-running properly as well.
(gdb-update)
(setq gdb-first-done-or-error nil))
- (run-hook-with-args 'gdb-stopped-hooks result)))
+ (run-hook-with-args 'gdb-stopped-functions result)))
;; Remove the trimmings from log stream containing debugging messages
;; being produced by GDB's internals, use warning face and send to GUD
(setq gdb-filter-output
(gdb-concat-output
gdb-filter-output
- (let ((error-message
- (read output-field)))
- (put-text-property
- 0 (length error-message)
- 'face font-lock-warning-face
- error-message)
- error-message))))
+ (if (string= output-field "\"\\n\"")
+ ""
+ (let ((error-message
+ (read output-field)))
+ (put-text-property
+ 0 (length error-message)
+ 'face font-lock-warning-face
+ error-message)
+ error-message)))))
;; Remove the trimmings from the console stream and send to GUD buffer
;; (frontend MI commands should not print to this stream)
(defun gdb-console (output-field)
(setq gdb-filter-output
- (gdb-concat-output
- gdb-filter-output
- (read output-field))))
+ (gdb-concat-output gdb-filter-output (read output-field))))
(defun gdb-done-or-error (output-field token-number type)
(if (string-equal token-number "")
(setq gdb-output-sink 'emacs))
(gdb-clear-partial-output)
- (when gdb-first-done-or-error
- (unless (or token-number gud-running)
- (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
- (gdb-update)
- (setq gdb-first-done-or-error nil))
- (setq gdb-filter-output
- (gdb-concat-output gdb-filter-output output-field))
+ ;; 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)))))
- (if token-number
- (progn
- (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)))))
+ (when 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)
+ (setq gdb-first-done-or-error nil))
+
+ (setq gdb-filter-output
+ (gdb-concat-output gdb-filter-output output-field))
+
+ (when token-number
+ (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)))))
(defun gdb-concat-output (so-far new)
- (let ((sink gdb-output-sink))
- (cond
- ((eq sink 'user) (concat so-far new))
- ((eq sink 'emacs)
- (gdb-append-to-partial-output new)
- so-far))))
+ (cond
+ ((eq gdb-output-sink 'user) (concat so-far new))
+ ((eq gdb-output-sink 'emacs)
+ (gdb-append-to-partial-output new)
+ so-far)))
(defun gdb-append-to-partial-output (string)
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
;; gdb-table struct is a way to programmatically construct simple
;; tables. It help to reliably align columns of data in GDB buffers
;; and provides
-(defstruct
- gdb-table
+(cl-defstruct gdb-table
(column-sizes nil)
(rows nil)
(row-properties nil)
(defun gdb-mapcar* (function &rest seqs)
"Apply FUNCTION to each element of SEQS, and make a list of the results.
If there are several SEQS, FUNCTION is called with that many
-arugments, and mapping stops as sson as the shortest list runs
+arguments, and mapping stops as soon as the shortest list runs
out."
(let ((shortest (apply #'min (mapcar #'length seqs))))
(mapcar (lambda (i)
(defun gdb-get-many-fields (struct &rest fields)
"Return a list of FIELDS values from STRUCT."
(let ((values))
- (dolist (field fields values)
- (setq values (append values (list (bindat-get-field struct field)))))))
+ (dolist (field fields)
+ (push (bindat-get-field struct field) values))
+ (nreverse values)))
(defmacro def-gdb-auto-update-trigger (trigger-name gdb-command
handler-name
(memq signal ,signal-list))
(when (not (gdb-pending-p
(cons (current-buffer) ',trigger-name)))
- (gdb-input
- (list ,gdb-command
- (gdb-bind-function-to-buffer ',handler-name (current-buffer))))
+ (gdb-input ,gdb-command
+ (gdb-bind-function-to-buffer ',handler-name (current-buffer)))
(gdb-add-pending (cons (current-buffer) ',trigger-name))))))
;; Used by disassembly buffer only, the rest use
(gdb-table-add-row table
(list
(bindat-get-field breakpoint 'number)
- type
- (bindat-get-field breakpoint 'disp)
+ (or type "")
+ (or (bindat-get-field breakpoint 'disp) "")
(let ((flag (bindat-get-field breakpoint 'enabled)))
(if (string-equal flag "y")
(propertize "y" 'font-lock-face font-lock-warning-face)
(propertize "n" 'font-lock-face font-lock-comment-face)))
(bindat-get-field breakpoint 'addr)
- (bindat-get-field breakpoint 'times)
- (if (string-match ".*watchpoint" type)
+ (or (bindat-get-field breakpoint 'times) "")
+ (if (and type (string-match ".*watchpoint" type))
(bindat-get-field breakpoint 'what)
(or pending at
(concat "in "
(let ((file (bindat-get-field breakpoint 'fullname))
(flag (bindat-get-field breakpoint 'enabled))
(bptno (bindat-get-field breakpoint 'number)))
- (unless (file-exists-p file)
+ (unless (and file (file-exists-p file))
(setq file (cdr (assoc bptno gdb-location-alist))))
- (if (and file
- (not (string-equal file "File not found")))
- (with-current-buffer
- (find-file-noselect file 'nowarn)
- (gdb-init-buffer)
- ;; Only want one breakpoint icon at each location.
- (gdb-put-breakpoint-icon (string-equal flag "y") bptno
- (string-to-number line)))
- (gdb-input
- (list (concat "list " file ":1")
- 'ignore))
- (gdb-input
- (list "-file-list-exec-source-file"
- `(lambda () (gdb-get-location
- ,bptno ,line ,flag))))))))))
+ (if (or (null file)
+ (string-equal file "File not found"))
+ ;; If the full filename is not recorded in the
+ ;; breakpoint structure or in `gdb-location-alist', use
+ ;; -file-list-exec-source-file to extract it.
+ (when (setq file (bindat-get-field breakpoint 'file))
+ (gdb-input (concat "list " file ":1") 'ignore)
+ (gdb-input "-file-list-exec-source-file"
+ `(lambda () (gdb-get-location
+ ,bptno ,line ,flag))))
+ (with-current-buffer (find-file-noselect file 'nowarn)
+ (gdb-init-buffer)
+ ;; Only want one breakpoint icon at each location.
+ (gdb-put-breakpoint-icon (string-equal flag "y") bptno
+ (string-to-number line)))))))))
(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
(add-to-list 'gdb-threads-list
(cons (bindat-get-field thread 'id)
thread))
- (if running
- (incf gdb-running-threads-count)
- (incf gdb-stopped-threads-count))
+ (cl-incf (if running
+ gdb-running-threads-count
+ gdb-stopped-threads-count))
(gdb-table-add-row table
(list
(def-gdb-thread-buffer-command gdb-select-thread
(let ((new-id (bindat-get-field thread 'id)))
(gdb-setq-thread-number new-id)
- (gdb-input (list (concat "-thread-select " new-id) 'ignore))
+ (gdb-input (concat "-thread-select " new-id) 'ignore)
(gdb-update))
"Select the thread at current line of threads buffer.")
(let* ((frame (gdb-current-buffer-frame))
(file (bindat-get-field frame 'fullname))
(line (bindat-get-field frame 'line)))
- (when file
- (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)))
+ (if file
+ (format "-data-disassemble -f %s -l %s -n -1 -- 0" file line)
+ ;; If we're unable to get a file name / line for $PC, simply
+ ;; follow $PC, disassembling the next 10 (x ~15 (on IA) ==
+ ;; 150 bytes) instructions.
+ "-data-disassemble -s $pc -e \"$pc + 150\" -- 0"))
gdb-disassembly-handler
;; We update disassembly only after we have actual frame information
;; about all threads, so no there's `update' signal in this list
(gdb-table-add-row table
(list
(bindat-get-field instr 'address)
- (apply #'format "<%s+%s>:"
- (gdb-get-many-fields instr 'func-name 'offset))
+ (let
+ ((func-name (bindat-get-field instr 'func-name))
+ (offset (bindat-get-field instr 'offset)))
+ (if func-name
+ (format "<%s+%s>:" func-name offset)
+ ""))
(bindat-get-field instr 'inst)))
(when (string-equal (bindat-get-field instr 'address)
address)
(error "Not recognized as break/watchpoint line")))))
\f
-;; Frames buffer. This displays a perpetually correct bactrack trace.
+;; Frames buffer. This displays a perpetually correct backtrack trace.
;;
(def-gdb-trigger-and-handler
gdb-invalidate-frames (gdb-current-context-command "-stack-list-frames")
(if (gdb-buffer-shows-main-thread-p)
(let ((new-level (bindat-get-field frame 'level)))
(setq gdb-frame-number new-level)
- (gdb-input (list (concat "-stack-select-frame " new-level)
- 'ignore))
+ (gdb-input (concat "-stack-select-frame " new-level)
+ 'ignore)
(gdb-update))
(error "Could not select frame for non-current thread"))
(error "Not recognized as frame line"))))
(gud-basic-call
(concat "-gdb-set variable " var " = " value)))))
-;; Dont display values of arrays or structures.
+;; Don't display values of arrays or structures.
;; These can be expanded using gud-watch.
(defun gdb-locals-handler-custom ()
(let ((locals-list (bindat-get-field (gdb-json-partial-output) 'locals))
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
- (if (and (gdb-get-buffer 'gdb-registers-buffer)
- (not (gdb-pending-p 'gdb-get-changed-registers)))
- (progn
- (gdb-input
- (list
- "-data-list-changed-registers"
- 'gdb-changed-registers-handler))
- (gdb-add-pending 'gdb-get-changed-registers))))
+ (when (and (gdb-get-buffer 'gdb-registers-buffer)
+ (not (gdb-pending-p 'gdb-get-changed-registers)))
+ (gdb-input "-data-list-changed-registers"
+ 'gdb-changed-registers-handler)
+ (gdb-add-pending 'gdb-get-changed-registers)))
(defun gdb-changed-registers-handler ()
(gdb-delete-pending 'gdb-get-changed-registers)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (member buffer-file-name gdb-source-file-list)
- (gdb-init-buffer))))
- (gdb-force-mode-line-update
- (propertize "ready" 'face font-lock-variable-name-face)))
+ (gdb-init-buffer)))))
(defun gdb-get-main-selected-frame ()
"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
- (list (gdb-current-context-command "-stack-info-frame")
- 'gdb-frame-handler))
+ (gdb-input (gdb-current-context-command "-stack-info-frame")
+ 'gdb-frame-handler)
(gdb-add-pending 'gdb-get-main-selected-frame))))
(defun gdb-frame-handler ()
If BUF is already displayed in some window, show it, deiconifying
the frame if necessary. Otherwise, find least recently used
window and show BUF there, if the window is not used for GDB
-already, in which case that window is splitted first."
+already, in which case that window is split first."
(let ((answer (get-buffer-window buf (or frame 0))))
(if answer
(display-buffer buf nil (or frame 0)) ;Deiconify frame if necessary.
(defun gdb-frame-gdb-buffer ()
"Display GUD buffer in a new frame."
(interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist
- (remove '(menu-bar-lines) (remove '(tool-bar-lines)
- gdb-frame-parameters)))
- (same-window-regexps nil))
- (display-buffer gud-comint-buffer)))
+ (display-buffer-other-frame gud-comint-buffer))
(defun gdb-display-gdb-buffer ()
"Display GUD buffer."
(interactive)
- (let ((same-window-regexps nil))
- (select-window (display-buffer gud-comint-buffer nil 0))))
+ (pop-to-buffer gud-comint-buffer nil 0))
(defun gdb-set-window-buffer (name &optional ignore-dedicated window)
"Set buffer of selected window to NAME and dedicate window.
(gdb-display-breakpoints-buffer)
(delete-other-windows)
;; Don't dedicate.
- (pop-to-buffer gud-comint-buffer)
+ (switch-to-buffer gud-comint-buffer)
(let ((win0 (selected-window))
(win1 (split-window nil ( / ( * (window-height) 3) 4)))
(win2 (split-window nil ( / (window-height) 3)))
- (win3 (split-window-horizontally)))
+ (win3 (split-window-right)))
(gdb-set-window-buffer (gdb-locals-buffer-name) nil win3)
(select-window win2)
(set-window-buffer
;; can't find a source file.
(list-buffers-noselect))))
(setq gdb-source-window (selected-window))
- (let ((win4 (split-window-horizontally)))
+ (let ((win4 (split-window-right)))
(gdb-set-window-buffer
(gdb-get-buffer-create 'gdb-inferior-io) nil win4))
(select-window win1)
(gdb-set-window-buffer (gdb-stack-buffer-name))
- (let ((win5 (split-window-horizontally)))
+ (let ((win5 (split-window-right)))
(gdb-set-window-buffer (if gdb-show-threads-by-default
(gdb-threads-buffer-name)
(gdb-breakpoints-buffer-name))
nil win5))
(select-window win0)))
-(defcustom gdb-many-windows nil
+(define-minor-mode gdb-many-windows
"If nil just pop up the GUD buffer unless `gdb-show-main' is t.
In this case it starts with two windows: one displaying the GUD
buffer and the other with the source file with the main routine
of the debugged program. Non-nil means display the layout shown for
`gdb'."
- :type 'boolean
+ :global t
:group 'gdb
- :version "22.1")
-
-(defun gdb-many-windows (arg)
- "Toggle the number of windows in the basic arrangement.
-With arg, display additional buffers iff arg is positive."
- (interactive "P")
- (setq gdb-many-windows
- (if (null arg)
- (not gdb-many-windows)
- (> (prefix-numeric-value arg) 0)))
- (message (format "Display of other windows %sabled"
- (if gdb-many-windows "en" "dis")))
+ :version "22.1"
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer))
- (condition-case nil
- (gdb-restore-windows)
- (error nil))))
+ (ignore-errors
+ (gdb-restore-windows))))
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
This arrangement depends on the value of `gdb-many-windows'."
(interactive)
- (pop-to-buffer gud-comint-buffer) ;Select the right window and frame.
+ (switch-to-buffer gud-comint-buffer) ;Select the right window and frame.
(delete-other-windows)
(if gdb-many-windows
(gdb-setup-windows)
(gud-find-file gdb-main-file)))
(setq gdb-source-window win)))))
+;; Called from `gud-sentinel' in gud.el:
(defun gdb-reset ()
"Exit a debugging session cleanly.
Kills the gdb buffers, and resets variables and the source buffers."
+ ;; The gdb-inferior buffer has a pty hooked up to the main gdb
+ ;; process. This pty must be deleted explicitly.
+ (let ((pty (get-process "gdb-inferior")))
+ (if pty (delete-process pty)))
+ ;; Find gdb-mi buffers and kill them.
(dolist (buffer (buffer-list))
(unless (eq buffer gud-comint-buffer)
(with-current-buffer buffer
(if gdb-many-windows
(gdb-setup-windows)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
- (if gdb-show-main
+ (if (and gdb-show-main gdb-main-file)
(let ((pop-up-windows t))
- (display-buffer (gud-find-file gdb-main-file))))))
+ (display-buffer (gud-find-file gdb-main-file)))))
+ (gdb-force-mode-line-update
+ (propertize "ready" 'face font-lock-variable-name-face)))
;;from put-image
(defun gdb-put-string (putstring pos &optional dprop &rest sprops)
(set-window-margins
window left-margin-width right-margin-width)))))
+\f
+;;; Functions for inline completion.
+
+(defvar gud-gdb-fetch-lines-in-progress)
+(defvar gud-gdb-fetch-lines-string)
+(defvar gud-gdb-fetch-lines-break)
+(defvar gud-gdb-fetched-lines)
+
+(defun gud-gdbmi-completions (context command)
+ "Completion table for GDB/MI commands.
+COMMAND is the prefix for which we seek completion.
+CONTEXT is the text before COMMAND on the line."
+ (let ((gud-gdb-fetch-lines-in-progress t)
+ (gud-gdb-fetch-lines-string nil)
+ (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)
+ (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)))
+ (while gud-gdb-fetch-lines-in-progress
+ (accept-process-output (get-buffer-process gud-comint-buffer))))
+ (gud-gdb-completions-1 gud-gdb-fetched-lines)))
+
+(defun gud-gdbmi-fetch-lines-filter (string)
+ "Custom filter function for `gud-gdbmi-completions'."
+ (setq string (concat gud-gdb-fetch-lines-string
+ (gud-gdbmi-marker-filter string)))
+ (while (string-match "\n" string)
+ (push (substring string gud-gdb-fetch-lines-break (match-beginning 0))
+ gud-gdb-fetched-lines)
+ (setq string (substring string (match-end 0))))
+ "")
+
(provide 'gdb-mi)
;;; gdb-mi.el ends here