;;; gdb-mi.el --- User Interface for running GDB
-;; Copyright (C) 2007-2012 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 Nick Roberts following the general design
-;; used in gdb-ui.el for Emacs 22.1 - 23.1. It is currently being developed
+;; 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".
;; 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 works without gdb-ui.el and uses MI tokens instead
+;; cli-command". This code replaces gdb-ui.el and uses MI tokens instead
;; of queues. Eventually MI should be asynchronous.
;; Windows Platforms:
(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))
: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."
(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*.
(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]
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-)initialize
+ ;; (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
- (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 "-gdb-set new-console off" '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 "-enable-pretty-printing" 'ignore)
- ;; find source file and compilation directory here
+ ;; Find source file and compilation directory here.
(if gdb-create-source-file-list
;; Needs GDB 6.2 onwards.
(gdb-input "-file-list-exec-source-files" 'gdb-get-source-file-list))
(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.")
(defun gdb-create-define-alist ()
(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 (concat "-data-evaluate-expression " expr)
+ (gdb-input (concat "-data-evaluate-expression \"" expr "\"")
`(lambda () (gdb-tooltip-print ,expr)))))))
(defun gdb-init-buffer ()
(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))
(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: "))
+ (varnum (car var))
+ (value (read-string "New value: ")))
(gdb-input (concat "-var-assign " varnum " " value)
`(lambda () (gdb-edit-value-handler ,value)))))
(with-current-buffer ,buffer
(apply ',expr args))))
-;; Used to define all gdb-frame-*-buffer functions except
-;; `gdb-frame-io-buffer'
-(defmacro def-gdb-frame-for-buffer (name buffer &optional doc)
- "Define a function NAME which shows gdb BUFFER in a separate frame.
-
-DOC is an optional documentation string."
- `(defun ,name (&optional thread)
- ,(when doc doc)
- (interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
- (display-buffer (gdb-get-buffer-create ,buffer thread)))))
-
-(defmacro def-gdb-display-buffer (name buffer &optional doc)
- "Define a function NAME which shows gdb BUFFER.
-
-DOC is an optional documentation string."
- `(defun ,name (&optional thread)
- ,(when doc doc)
- (interactive)
- (gdb-display-buffer
- (gdb-get-buffer-create ,buffer thread) t)))
-
;; Used to display windows with thread-bound buffers
(defmacro def-gdb-preempt-display-buffer (name buffer &optional doc
split-horizontal)
(defun gdb-display-io-buffer ()
"Display IO of debugged program in a separate window."
(interactive)
- (gdb-display-buffer
- (gdb-get-buffer-create 'gdb-inferior-io) t))
-
-(defconst gdb-frame-parameters
- '((height . 14) (width . 80)
- (unsplittable . t)
- (tool-bar-lines . nil)
- (menu-bar-lines . nil)
- (minibuffer . nil)))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
+
+(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))))))
+
+(defcustom gdb-display-buffer-other-frame-action
+ '((display-buffer-reuse-window display-buffer-pop-up-frame)
+ (reusable-frames . visible)
+ (inhibit-same-window . t)
+ (pop-up-frame-parameters (height . 14)
+ (width . 80)
+ (unsplittable . t)
+ (tool-bar-lines . nil)
+ (menu-bar-lines . nil)
+ (minibuffer . nil)))
+ "`display-buffer' action for displaying GDB utility frames."
+ :group 'gdb
+ :type display-buffer--action-custom-type
+ :risky t
+ :version "24.3")
(defun gdb-frame-io-buffer ()
- "Display IO of debugged program in a new frame."
+ "Display IO of debugged program in another frame."
(interactive)
- (let ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist gdb-frame-parameters))
- (display-buffer (gdb-get-buffer-create 'gdb-inferior-io))))
+ (display-buffer (gdb-get-buffer-create 'gdb-inferior-io)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-inferior-io-mode-map
(let ((map (make-sparse-keymap)))
(defun gdb-inferior-filter (proc string)
(unless (string-equal string "")
- (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io) t))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
(comint-output-filter proc string)))
: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))))
+ (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.
(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)
(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))
(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)))))
+ ;; 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)
(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)
(cond
;; 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-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
(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 (concat "list " file ":1") 'ignore)
- (gdb-input "-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=\"\\(.*?\\)\"")
(defun gdb-breakpoints-buffer-name ()
(concat "*breakpoints of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints.")
+(defun gdb-display-breakpoints-buffer (&optional thread)
+ "Display GDB breakpoints."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer thread)))
-(def-gdb-frame-for-buffer
- gdb-frame-breakpoints-buffer
- 'gdb-breakpoints-buffer
- "Display status of user-settable breakpoints in a new frame.")
+(defun gdb-frame-breakpoints-buffer (&optional thread)
+ "Display GDB breakpoints in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-breakpoints-buffer thread)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-breakpoints-mode-map
(let ((map (make-sparse-keymap))
(defun gdb-threads-buffer-name ()
(concat "*threads of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads.")
+(defun gdb-display-threads-buffer (&optional thread)
+ "Display GDB threads."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-threads-buffer thread)))
-(def-gdb-frame-for-buffer
- gdb-frame-threads-buffer
- 'gdb-threads-buffer
- "Display GDB threads in a new frame.")
+(defun gdb-frame-threads-buffer (&optional thread)
+ "Display GDB threads in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-threads-buffer thread)
+ gdb-display-buffer-other-frame-action))
(def-gdb-trigger-and-handler
gdb-invalidate-threads (gdb-current-context-command "-thread-info")
(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-simple-command
gdb-frame-stack-for-thread
gdb-frame-stack-buffer
- "Display a new frame with stack buffer for the thread at
-current line.")
+ "Display another frame with stack buffer for thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-locals-for-thread
gdb-frame-locals-buffer
- "Display a new frame with locals buffer for the thread at
-current line.")
+ "Display another frame with locals buffer for thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-registers-for-thread
gdb-frame-registers-buffer
- "Display a new frame with registers buffer for the thread at
-current line.")
+ "Display another frame with registers buffer for the thread at current line.")
(def-gdb-thread-buffer-simple-command
gdb-frame-disassembly-for-thread
gdb-frame-disassembly-buffer
- "Display a new frame with disassembly buffer for the thread at
-current line.")
+ "Display another frame with disassembly buffer for the thread at current line.")
(defmacro def-gdb-thread-buffer-gud-command (name gud-command &optional doc)
"Define a NAME which will execute GUD-COMMAND with
(defun gdb-memory-buffer-name ()
(concat "*memory of " (gdb-get-target-string) "*"))
-(def-gdb-display-buffer
- gdb-display-memory-buffer
- 'gdb-memory-buffer
- "Display memory contents.")
+(defun gdb-display-memory-buffer (&optional thread)
+ "Display GDB memory contents."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-memory-buffer thread)))
(defun gdb-frame-memory-buffer ()
- "Display memory contents in a new frame."
+ "Display memory contents in another frame."
(interactive)
- (let* ((special-display-regexps (append special-display-regexps '(".*")))
- (special-display-frame-alist
- `((left-fringe . 0)
- (right-fringe . 0)
- (width . 83)
- ,@gdb-frame-parameters)))
- (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer))))
+ (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)
+ gdb-display-buffer-other-frame-action))
\f
;;; Disassembly view
(gdb-current-context-buffer-name
(concat "disassembly of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly for current stack frame.")
+(defun gdb-display-disassembly-buffer (&optional thread)
+ "Display GDB disassembly information."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-disassembly-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-disassembly-buffer
'gdb-disassembly-buffer)
-(def-gdb-frame-for-buffer
- gdb-frame-disassembly-buffer
- 'gdb-disassembly-buffer
- "Display disassembly in a new frame.")
+(defun gdb-frame-disassembly-buffer (&optional thread)
+ "Display GDB disassembly information in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-disassembly-buffer thread)
+ gdb-display-buffer-other-frame-action))
(def-gdb-auto-update-trigger gdb-invalidate-disassembly
(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)
(gdb-current-context-buffer-name
(concat "stack frames of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack.")
+(defun gdb-display-stack-buffer (&optional thread)
+ "Display GDB backtrace for current stack."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-stack-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-stack-buffer
'gdb-stack-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-stack-buffer
- 'gdb-stack-buffer
- "Display backtrace of current stack in a new frame.")
+(defun gdb-frame-stack-buffer (&optional thread)
+ "Display GDB backtrace for current stack in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-stack-buffer thread)
+ gdb-display-buffer-other-frame-action))
(defvar gdb-frames-mode-map
(let ((map (make-sparse-keymap)))
(gdb-current-context-buffer-name
(concat "locals of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values.")
+(defun gdb-display-locals-buffer (&optional thread)
+ "Display the local variables of current GDB stack."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-locals-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-locals-buffer
'gdb-locals-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-locals-buffer
- 'gdb-locals-buffer
- "Display local variables of current stack and their values in a new frame.")
+(defun gdb-frame-locals-buffer (&optional thread)
+ "Display the local variables of the current GDB stack in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-locals-buffer thread)
+ gdb-display-buffer-other-frame-action))
\f
;; Registers buffer.
(gdb-current-context-buffer-name
(concat "registers of " (gdb-get-target-string))))
-(def-gdb-display-buffer
- gdb-display-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents.")
+(defun gdb-display-registers-buffer (&optional thread)
+ "Display GDB register contents."
+ (interactive)
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-registers-buffer thread)))
(def-gdb-preempt-display-buffer
gdb-preemptively-display-registers-buffer
'gdb-registers-buffer nil t)
-(def-gdb-frame-for-buffer
- gdb-frame-registers-buffer
- 'gdb-registers-buffer
- "Display integer register contents in a new frame.")
+(defun gdb-frame-registers-buffer (&optional thread)
+ "Display GDB register contents in another frame."
+ (interactive)
+ (display-buffer (gdb-get-buffer-create 'gdb-registers-buffer thread)
+ gdb-display-buffer-other-frame-action))
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
;;;; Window management
-(defun gdb-display-buffer (buf dedicated &optional frame)
- "Show buffer BUF.
-
-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 split first."
- (let ((answer (get-buffer-window buf (or frame 0))))
- (if answer
- (display-buffer buf nil (or frame 0)) ;Deiconify frame if necessary.
- (let ((window (get-lru-window)))
- (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
- 'gdbmi)
- (let ((largest (get-largest-window)))
- (setq answer (split-window largest))
- (set-window-buffer answer buf)
- (set-window-dedicated-p answer dedicated)
- answer)
- (set-window-buffer window buf)
- window)))))
+(defun gdb-display-buffer (buf)
+ "Show buffer BUF, and make that window dedicated."
+ (let ((window (display-buffer buf)))
+ (set-window-dedicated-p window t)
+ window))
+
+ ;; (let ((answer (get-buffer-window buf 0)))
+ ;; (if answer
+ ;; (display-buffer buf nil 0) ;Deiconify frame if necessary.
+ ;; (let ((window (get-lru-window)))
+ ;; (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window))
+ ;; 'gdbmi)
+ ;; (let ((largest (get-largest-window)))
+ ;; (setq answer (split-window largest))
+ ;; (set-window-buffer answer buf)
+ ;; (set-window-dedicated-p answer t)
+ ;; answer)
+ ;; (set-window-buffer window buf)
+ ;; window)))))
+
(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal)
"Find window displaying a buffer with the same
(if dedicated-window
(set-window-buffer
(split-window dedicated-window nil split-horizontal) buf)
- (gdb-display-buffer buf t))))))
+ (gdb-display-buffer buf))))))
(error "Null buffer")))
\f
;;; Shared keymap initialization:
'all-threads)
(defun gdb-frame-gdb-buffer ()
- "Display GUD buffer in a new frame."
+ "Display GUD buffer in another frame."
(interactive)
(display-buffer-other-frame gud-comint-buffer))
(defun gdb-setup-windows ()
"Layout the window pattern for `gdb-many-windows'."
- (gdb-display-locals-buffer)
- (gdb-display-stack-buffer)
- (delete-other-windows)
- (gdb-display-breakpoints-buffer)
- (delete-other-windows)
- ;; Don't dedicate.
+ (gdb-get-buffer-create 'gdb-locals-buffer)
+ (gdb-get-buffer-create 'gdb-stack-buffer)
+ (gdb-get-buffer-create 'gdb-breakpoints-buffer)
+ (set-window-dedicated-p (selected-window) nil)
(switch-to-buffer gud-comint-buffer)
+ (delete-other-windows)
(let ((win0 (selected-window))
(win1 (split-window nil ( / ( * (window-height) 3) 4)))
(win2 (split-window nil ( / (window-height) 3)))
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.
(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 (and gdb-show-main gdb-main-file)
- (let ((pop-up-windows t))
- (display-buffer (gud-find-file gdb-main-file)))))
+ (and gdb-show-main
+ gdb-main-file
+ (display-buffer (gud-find-file gdb-main-file))))
(gdb-force-mode-line-update
(propertize "ready" 'face font-lock-variable-name-face)))