-;;; gdb-mi.el --- User Interface for running GDB
+;;; gdb-mi.el --- User Interface for running GDB -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: FSF
(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-disassembly-position nil)
(defvar gdb-location-alist nil
- "Alist of breakpoint numbers and full filenames. Only used for files that
-Emacs can't find.")
+ "Alist of breakpoint numbers and full filenames.
+Only used for files that Emacs can't find.")
(defvar gdb-active-process nil
"GUD tooltips display variable values when t, and macro definitions otherwise.")
(defvar gdb-error "Non-nil when GDB is reporting an error.")
It is initialized to `gdb-non-stop-setting' at the beginning of
every GDB session.")
-(defvar gdb-buffer-type nil
+(defvar-local gdb-buffer-type nil
"One of the symbols bound in `gdb-buffer-rules'.")
-(make-variable-buffer-local 'gdb-buffer-type)
(defvar gdb-output-sink 'nil
"The disposition of the output of the current gdb command.
(funcall (cdr subscriber) signal)))
(defvar gdb-buf-publisher '()
- "Used to invalidate GDB buffers by emitting a signal in
-`gdb-update'.
-
+ "Used to invalidate GDB buffers by emitting a signal in `gdb-update'.
Must be a list of pairs with cars being buffers and cdr's being
valid signal handlers.")
"When in non-stop mode, stopped threads can be examined while
other threads continue to execute.
-GDB session needs to be restarted for this setting to take
-effect."
+GDB session needs to be restarted for this setting to take effect."
:type 'boolean
:group 'gdb-non-stop
:version "23.2")
;; TODO Some commands can't be called with --all (give a notice about
;; it in setting doc)
(defcustom gdb-gud-control-all-threads t
- "When enabled, GUD execution commands affect all threads when
-in non-stop mode. Otherwise, only current thread is affected."
+ "When non-nil, GUD execution commands affect all threads when
+in non-stop mode. Otherwise, only current thread is affected."
:type 'boolean
:group 'gdb-non-stop
:version "23.2")
(defcustom gdb-switch-reasons t
- "List of stop reasons which cause Emacs to switch to the thread
-which caused the stop. When t, switch to stopped thread no matter
-what the reason was. When nil, never switch to stopped thread
-automatically.
+ "List of stop reasons for which Emacs should switch thread.
+When t, switch to stopped thread no matter what the reason was.
+When nil, never switch to stopped thread automatically.
-This setting is used in non-stop mode only. In all-stop mode,
+This setting is used in non-stop mode only. In all-stop mode,
Emacs always switches to the thread which caused the stop."
;; exited, exited-normally and exited-signaled are not
;; thread-specific stop reasons and therefore are not included in
: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:
:link '(info-link "(gdb)GDB/MI Async Records"))
(defcustom gdb-switch-when-another-stopped t
- "When nil, Emacs won't switch to stopped thread if some other
+ "When nil, don't switch to stopped thread if some other
stopped thread is already selected."
:type 'boolean
:group 'gdb-non-stop
:version "23.2")
(defcustom gdb-show-threads-by-default nil
- "Show threads list buffer instead of breakpoints list by
-default."
+ "Show threads list buffer instead of breakpoints list by default."
:type 'boolean
:group 'gdb-buffers
:version "23.2")
`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")
(defcustom gdb-create-source-file-list t
"Non-nil means create a list of files from which the executable was built.
- Set this to nil if the GUD buffer displays \"initializing...\" in the mode
- line for a long time when starting, possibly because your executable was
- built from a large number of files. This allows quicker initialization
- but means that these files are not automatically enabled for debugging,
- e.g., you won't be able to click in the fringe to set a breakpoint until
- execution has already stopped there."
+Set this to nil if the GUD buffer displays \"initializing...\" in the mode
+line for a long time when starting, possibly because your executable was
+built from a large number of files. This allows quicker initialization
+but means that these files are not automatically enabled for debugging,
+e.g., you won't be able to click in the fringe to set a breakpoint until
+execution has already stopped there."
:type 'boolean
:group 'gdb
:version "23.1")
:group 'gdb
:version "22.1")
+(defvar gdbmi-debug-mode nil
+ "When non-nil, print the messages sent/received from GDB/MI in *Messages*.")
+
(defun gdb-force-mode-line-update (status)
(let ((buffer gud-comint-buffer))
(if (and buffer (buffer-name buffer))
;; 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."
(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
"`gud-call' wrapper which adds --thread/--all options between
-CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.
+CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.
NOARG must be t when this macro is used outside `gud-def'"
`(gud-call
(concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
,(when (not noarg) 'arg)))
-(defun gdb--check-interpreter (proc string)
+(defun gdb--check-interpreter (filter 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))))
+ (remove-function (process-filter proc) #'gdb--check-interpreter)
+ (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)
COMMAND-LINE is the shell command for starting the gdb session.
It should be a string consisting of the name of the gdb
-executable followed by command-line options. The command-line
+executable followed by command line options. The command line
options should include \"-i=mi\" to use gdb's MI text interface.
Note that the old \"--annotate\" option is no longer supported.
-If `gdb-many-windows' is nil (the default value) then gdb just
+If option `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
other with the source file with the main routine of the inferior.
-If `gdb-many-windows' is t, regardless of the value of
+If option `gdb-many-windows' is t, regardless of the value of
`gdb-show-main', the layout below will appear. Keybindings are
shown in some of the buffers.
;; 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))
+ (add-function :around (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")
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-register-names '()
gdb-non-stop gdb-non-stop-setting)
;;
+ (gdbmi-bnf-init)
+ ;;
(setq gdb-buffer-type 'gdbmi)
;;
(gdb-force-mode-line-update
(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)))))
(cond
((> new previous)
;; Add new children to list.
- (dotimes (dummy previous)
+ (dotimes (_ previous)
(push (pop temp-var-list) var-list))
(dolist (child children)
(let ((varchild
(push varchild var-list))))
;; Remove deleted children from list.
((< new previous)
- (dotimes (dummy new)
+ (dotimes (_ new)
(push (pop temp-var-list) var-list))
- (dotimes (dummy (- previous new))
+ (dotimes (_ (- previous new))
(pop temp-var-list)))))
(push var1 var-list))
(setq var1 (pop temp-var-list)))
(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-token-number (1+ gdb-token-number))
(setq command (concat (number-to-string gdb-token-number) command))
(push (cons gdb-token-number handler-function) gdb-handler-alist)
+ (if gdbmi-debug-mode (message "gdb-input: %s" command))
(process-send-string (get-buffer-process gud-comint-buffer)
(concat command "\n")))
"*"))
(defun gdb-current-context-mode-name (mode)
- "Add thread information to MODE which is to be used as
-`mode-name'."
+ "Add thread information to MODE which is to be used as `mode-name'."
(concat mode
(if gdb-thread-number
(format " [thread %s]" gdb-thread-number)
(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))
;; because we may need to update current gud-running value without
;; changing current thread (see gdb-running)
(defun gdb-setq-thread-number (number)
- "Only this function must be used to change `gdb-thread-number'
+ "Set `gdb-thread-number' to NUMBER.
+Only this function must be used to change `gdb-thread-number'
value to NUMBER, because `gud-running' and `gdb-frame-number'
need to be updated appropriately when current thread changes."
;; GDB 6.8 and earlier always output thread-id="0" when stopping.
Note that when `gdb-gud-control-all-threads' is t, `gud-running'
cannot be reliably used to determine whether or not execution
-control buttons should be shown in menu or toolbar. Use
+control buttons should be shown in menu or toolbar. Use
`gdb-running-threads-count' and `gdb-stopped-threads-count'
instead.
(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"))))
(set-window-buffer source-window buffer))
source-window))
-(defun gdb-car< (a b)
- (< (car a) (car b)))
-
-(defvar gdbmi-record-list
- '((gdb-gdb . "(gdb) \n")
- (gdb-done . "\\([0-9]*\\)\\^done,?\\(.*?\\)\n")
- (gdb-starting . "\\([0-9]*\\)\\^running\n")
- (gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n")
- (gdb-console . "~\\(\".*?\"\\)\n")
- (gdb-internals . "&\\(\".*?\"\\)\n")
- (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
- (gdb-running . "\\*running,\\(.*?\n\\)")
- (gdb-thread-created . "=thread-created,\\(.*?\n\\)")
- (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n")
- (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")
- (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n")
- (gdb-shell . "\\(\\(?:^.+\n\\)+\\)")))
+
+(defun gdbmi-start-with (str offset match)
+ "Return non-nil if string STR starts with MATCH, else returns nil.
+OFFSET is the position in STR at which the comparison takes place."
+ (let ((match-length (length match))
+ (str-length (- (length str) offset)))
+ (when (>= str-length match-length)
+ (string-equal match (substring str offset (+ offset match-length))))))
+
+(defun gdbmi-same-start (str offset match)
+ "Return non-nil iff STR and MATCH are equal up to the end of either strings.
+OFFSET is the position in STR at which the comparison takes place."
+ (let* ((str-length (- (length str) offset))
+ (match-length (length match))
+ (compare-length (min str-length match-length)))
+ (when (> compare-length 0)
+ (string-equal (substring str offset (+ offset compare-length))
+ (substring match 0 compare-length)))))
+
+(defun gdbmi-is-number (character)
+ "Return non-nil iff CHARACTER is a numerical character between 0 and 9."
+ (and (>= character ?0)
+ (<= character ?9)))
+
+
+(defvar-local gdbmi-bnf-state 'gdbmi-bnf-output
+ "Current GDB/MI output parser state.
+The parser is placed in a different state when an incomplete data steam is
+received from GDB.
+This variable will preserve the state required to resume the parsing
+when more data arrives.")
+
+(defvar-local gdbmi-bnf-offset 0
+ "Offset in `gud-marker-acc' at which the parser is reading.
+This offset is used to be able to parse the GDB/MI message
+in-place, without the need of copying the string in a temporary buffer
+or discarding parsed tokens by substringing the message.")
+
+(defun gdbmi-bnf-init ()
+ "Initialize the GDB/MI message parser."
+ (setq gdbmi-bnf-state 'gdbmi-bnf-output)
+ (setq gdbmi-bnf-offset 0)
+ (setq gud-marker-acc ""))
+
+
+(defun gdbmi-bnf-output ()
+ "Implementation of the following GDB/MI output grammar rule:
+
+ output ==>
+ ( out-of-band-record )* [ result-record ] gdb-prompt"
+
+ (gdbmi-bnf-skip-unrecognized)
+ (while (gdbmi-bnf-out-of-band-record))
+ (gdbmi-bnf-result-record)
+ (gdbmi-bnf-gdb-prompt))
+
+
+(defun gdbmi-bnf-skip-unrecognized ()
+ "Skip characters until is encounters the beginning of a valid record.
+Used as a protection mechanism in case something goes wrong when parsing
+a GDB/MI reply message."
+ (let ((acc-length (length gud-marker-acc))
+ (prefix-offset gdbmi-bnf-offset)
+ (prompt "(gdb) \n"))
+
+ (while (and (< prefix-offset acc-length)
+ (gdbmi-is-number (aref gud-marker-acc prefix-offset)))
+ (setq prefix-offset (1+ prefix-offset)))
+
+ (if (and (< prefix-offset acc-length)
+ (not (memq (aref gud-marker-acc prefix-offset)
+ '(?^ ?* ?+ ?= ?~ ?@ ?&)))
+ (not (gdbmi-same-start gud-marker-acc gdbmi-bnf-offset prompt))
+ (string-match "\\([^^*+=~@&]+\\)" gud-marker-acc
+ gdbmi-bnf-offset))
+ (let ((unrecognized-str (match-string 0 gud-marker-acc)))
+ (setq gdbmi-bnf-offset (match-end 0))
+ (if gdbmi-debug-mode
+ (message "gdbmi-bnf-skip-unrecognized: %s" unrecognized-str))
+ (gdb-shell unrecognized-str)
+ t))))
+
+
+(defun gdbmi-bnf-gdb-prompt ()
+ "Implementation of the following GDB/MI output grammar rule:
+ gdb-prompt ==>
+ '(gdb)' nl
+
+ nl ==>
+ CR | CR-LF"
+
+ (let ((prompt "(gdb) \n"))
+ (when (gdbmi-start-with gud-marker-acc gdbmi-bnf-offset prompt)
+ (if gdbmi-debug-mode (message "gdbmi-bnf-gdb-prompt: %s" prompt))
+ (gdb-gdb prompt)
+ (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length prompt)))
+
+ ;; Returns non-nil to tell gud-gdbmi-marker-filter we've reached
+ ;; the end of a GDB reply message.
+ t)))
+
+
+(defun gdbmi-bnf-result-record ()
+ "Implementation of the following GDB/MI output grammar rule:
+
+ result-record ==>
+ [ token ] '^' result-class ( ',' result )* nl
+
+ token ==>
+ any sequence of digits."
+
+ (gdbmi-bnf-result-and-async-record-impl))
+
+
+(defun gdbmi-bnf-out-of-band-record ()
+ "Implementation of the following GDB/MI output grammar rule:
+
+ out-of-band-record ==>
+ async-record | stream-record"
+
+ (or (gdbmi-bnf-async-record)
+ (gdbmi-bnf-stream-record)))
+
+
+(defun gdbmi-bnf-async-record ()
+ "Implementation of the following GDB/MI output grammar rules:
+
+ async-record ==>
+ exec-async-output | status-async-output | notify-async-output
+
+ exec-async-output ==>
+ [ token ] '*' async-output
+
+ status-async-output ==>
+ [ token ] '+' async-output
+
+ notify-async-output ==>
+ [ token ] '=' async-output
+
+ async-output ==>
+ async-class ( ',' result )* nl"
+
+ (gdbmi-bnf-result-and-async-record-impl))
+
+
+(defun gdbmi-bnf-stream-record ()
+ "Implement the following GDB/MI output grammar rule:
+ stream-record ==>
+ console-stream-output | target-stream-output | log-stream-output
+
+ console-stream-output ==>
+ '~' c-string
+
+ target-stream-output ==>
+ '@' c-string
+
+ log-stream-output ==>
+ '&' c-string"
+ (when (< gdbmi-bnf-offset (length gud-marker-acc))
+ (if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&))
+ (string-match "\\([~@&]\\)\\(\".*?\"\\)\n" gud-marker-acc
+ gdbmi-bnf-offset))
+ (let ((prefix (match-string 1 gud-marker-acc))
+ (c-string (match-string 2 gud-marker-acc)))
+
+ (setq gdbmi-bnf-offset (match-end 0))
+ (if gdbmi-debug-mode (message "gdbmi-bnf-stream-record: %s"
+ (match-string 0 gud-marker-acc)))
+
+ (cond ((string-equal prefix "~")
+ (gdbmi-bnf-console-stream-output c-string))
+ ((string-equal prefix "@")
+ (gdbmi-bnf-target-stream-output c-string))
+ ((string-equal prefix "&")
+ (gdbmi-bnf-log-stream-output c-string)))
+ t))))
+
+(defun gdbmi-bnf-console-stream-output (c-string)
+ "Handler for the console-stream-output GDB/MI output grammar rule."
+ (gdb-console c-string))
+
+(defun gdbmi-bnf-target-stream-output (_c-string)
+ "Handler for the target-stream-output GDB/MI output grammar rule."
+ ;; Not currently used.
+ )
+
+(defun gdbmi-bnf-log-stream-output (c-string)
+ "Handler for the log-stream-output GDB/MI output grammar rule."
+ ;; Suppress "No registers." GDB 6.8 and earlier
+ ;; duplicates MI error message on internal stream.
+ ;; Don't print to GUD buffer.
+ (if (not (string-equal (read c-string) "No registers.\n"))
+ (gdb-internals c-string)))
+
+
+(defconst gdbmi-bnf-result-state-configs
+ '(("^" . (("done" . (gdb-done . progressive))
+ ("error" . (gdb-error . progressive))
+ ("running" . (gdb-starting . atomic))))
+ ("*" . (("stopped" . (gdb-stopped . atomic))
+ ("running" . (gdb-running . atomic))))
+ ("+" . ())
+ ("=" . (("thread-created" . (gdb-thread-created . atomic))
+ ("thread-selected" . (gdb-thread-selected . atomic))
+ ("thread-existed" . (gdb-ignored-notification . atomic))
+ ('default . (gdb-ignored-notification . atomic)))))
+ "Alist of alists, mapping the type and class of message to a handler function.
+Handler functions are all flagged as either `progressive' or `atomic'.
+`progressive' handlers are capable of parsing incomplete messages.
+They can be called several time with new data chunk as they arrive from GDB.
+`progressive' handlers must have an extra argument that is set to a non-nil
+value when the message is complete.
+
+Implement the following GDB/MI output grammar rule:
+ result-class ==>
+ 'done' | 'running' | 'connected' | 'error' | 'exit'
+
+ async-class ==>
+ 'stopped' | others (where others will be added depending on the needs
+ --this is still in development).")
+
+(defun gdbmi-bnf-result-and-async-record-impl ()
+ "Common implementation of the result-record and async-record rule.
+Both rules share the same syntax. Those records may be very large in size.
+For that reason, the \"result\" part of the record is parsed by
+`gdbmi-bnf-incomplete-record-result', which will keep
+receiving characters as they arrive from GDB until the record is complete."
+ (let ((acc-length (length gud-marker-acc))
+ (prefix-offset gdbmi-bnf-offset))
+
+ (while (and (< prefix-offset acc-length)
+ (gdbmi-is-number (aref gud-marker-acc prefix-offset)))
+ (setq prefix-offset (1+ prefix-offset)))
+
+ (if (and (< prefix-offset acc-length)
+ (member (aref gud-marker-acc prefix-offset) '(?* ?+ ?= ?^))
+ (string-match "\\([0-9]*\\)\\([*+=^]\\)\\(.+?\\)\\([,\n]\\)"
+ gud-marker-acc gdbmi-bnf-offset))
+
+ (let ((token (match-string 1 gud-marker-acc))
+ (prefix (match-string 2 gud-marker-acc))
+ (class (match-string 3 gud-marker-acc))
+ (complete (string-equal (match-string 4 gud-marker-acc) "\n"))
+ class-alist
+ class-command)
+
+ (setq gdbmi-bnf-offset (match-end 0))
+ (if gdbmi-debug-mode (message "gdbmi-bnf-result-record: %s"
+ (match-string 0 gud-marker-acc)))
+
+ (setq class-alist
+ (cdr (assoc prefix gdbmi-bnf-result-state-configs)))
+ (setq class-command (cdr (assoc class class-alist)))
+ (if (null class-command)
+ (setq class-command (cdr (assoc 'default class-alist))))
+
+ (if complete
+ (if class-command
+ (if (equal (cdr class-command) 'progressive)
+ (funcall (car class-command) token "" complete)
+ (funcall (car class-command) token "")))
+ (setq gdbmi-bnf-state
+ (lambda ()
+ (gdbmi-bnf-incomplete-record-result token class-command)))
+ (funcall gdbmi-bnf-state))
+ t))))
+
+(defun gdbmi-bnf-incomplete-record-result (token class-command)
+ "State of the parser used to progressively parse a result-record or async-record
+rule from an incomplete data stream. The parser will stay in this state until
+the end of the current result or async record is reached."
+ (when (< gdbmi-bnf-offset (length gud-marker-acc))
+ ;; Search the data stream for the end of the current record:
+ (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
+ (is-progressive (equal (cdr class-command) 'progressive))
+ (is-complete (not (null newline-pos)))
+ result-str)
+
+ (when gdbmi-debug-mode
+ (message "gdbmi-bnf-incomplete-record-result: %s"
+ (substring gud-marker-acc gdbmi-bnf-offset newline-pos)))
+
+ ;; Update the gdbmi-bnf-offset only if the current chunk of data can
+ ;; be processed by the class-command handler:
+ (when (or is-complete is-progressive)
+ (setq result-str
+ (substring gud-marker-acc gdbmi-bnf-offset newline-pos))
+
+ ;; Move gdbmi-bnf-offset past the end of the chunk.
+ (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length result-str)))
+ (when newline-pos
+ (setq gdbmi-bnf-offset (1+ gdbmi-bnf-offset))))
+
+ ;; Update the parsing state before invoking the handler in class-command
+ ;; to make sure it's not left in an invalid state if the handler was
+ ;; to generate an error.
+ (if is-complete
+ (setq gdbmi-bnf-state 'gdbmi-bnf-output))
+
+ (if class-command
+ (if is-progressive
+ (funcall (car class-command) token result-str is-complete)
+ (if is-complete
+ (funcall (car class-command) token result-str))))
+
+ (unless is-complete
+ ;; Incomplete gdb response: abort parsing until we receive more data.
+ (if gdbmi-debug-mode (message "gdbmi-bnf-incomplete-record-result, aborting: incomplete stream"))
+ (throw 'gdbmi-incomplete-stream nil))
+
+ is-complete)))
+
+
+; The following grammar rules are not yet implemented by this GDBMI-BNF parser.
+; The handling of those rules is currently done by the handlers registered
+; in gdbmi-bnf-result-state-configs
+;
+; result ==>
+; variable "=" value
+;
+; variable ==>
+; string
+;
+; value ==>
+; const | tuple | list
+;
+; const ==>
+; c-string
+;
+; tuple ==>
+; "{}" | "{" result ( "," result )* "}"
+;
+; list ==>
+; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]"
+
(defun gud-gdbmi-marker-filter (string)
"Filter GDB/MI output."
(> (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)
-
- ;; Process all the complete markers in this chunk.
- (dolist (gdbmi-record gdbmi-record-list)
- (while (string-match (cdr gdbmi-record) gud-marker-acc)
- (push (list (match-beginning 0)
- (car gdbmi-record)
- (match-string 1 gud-marker-acc)
- (match-string 2 gud-marker-acc)
- (match-end 0))
- output-record-list)
- (setq gud-marker-acc
- (concat (substring gud-marker-acc 0 (match-beginning 0))
- ;; Pad with spaces to preserve position.
- (make-string (length (match-string 0 gud-marker-acc)) 32)
- (substring gud-marker-acc (match-end 0))))))
-
- (setq output-record-list (sort output-record-list 'gdb-car<))
-
- (dolist (output-record output-record-list)
- (let ((record-type (cadr output-record))
- (arg1 (nth 2 output-record))
- (arg2 (nth 3 output-record)))
- (cond ((eq record-type 'gdb-error)
- (gdb-done-or-error arg2 arg1 'error))
- ((eq record-type 'gdb-done)
- (gdb-done-or-error arg2 arg1 'done))
- ;; Suppress "No registers." GDB 6.8 and earlier
- ;; duplicates MI error message on internal stream.
- ;; Don't print to GUD buffer.
- ((not (and (eq record-type 'gdb-internals)
- (string-equal (read arg1) "No registers.\n")))
- (funcall record-type arg1)))))
- (setq gdb-output-sink 'user)
- ;; Remove padding.
- (string-match "^ *" gud-marker-acc)
- (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
+ (let ((acc-length (length gud-marker-acc)))
+ (catch 'gdbmi-incomplete-stream
+ (while (and (< gdbmi-bnf-offset acc-length)
+ (funcall gdbmi-bnf-state)))))
+
+ (when (/= gdbmi-bnf-offset 0)
+ (setq gud-marker-acc (substring gud-marker-acc gdbmi-bnf-offset))
+ (setq gdbmi-bnf-offset 0))
+
+ (when (and gdbmi-debug-mode (> (length gud-marker-acc) 0))
+ (message "gud-gdbmi-marker-filter, unparsed string: %s" gud-marker-acc))
- gdb-filter-output))
+ gdb-filter-output)
(defun gdb-gdb (_output-field))
(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))
+(defun gdb-ignored-notification (_token _output-field))
;; gdb-invalidate-threads is defined to accept 'update-threads signal
-(defun gdb-thread-created (_output-field))
-(defun gdb-thread-exited (output-field)
- "Handle =thread-exited async record: unset `gdb-thread-number'
- if current thread exited and update threads list."
+(defun gdb-thread-created (_token _output-field))
+(defun gdb-thread-exited (_token output-field)
+ "Handle =thread-exited async record.
+Unset `gdb-thread-number' if current thread exited and update threads list."
(let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
(if (string= gdb-thread-number thread-id)
(gdb-setq-thread-number nil))
(gdb-wait-for-pending
(gdb-emit-signal gdb-buf-publisher 'update-threads))))
-(defun gdb-thread-selected (output-field)
+(defun gdb-thread-selected (_token output-field)
"Handler for =thread-selected MI output record.
Sets `gdb-thread-number' to new id."
(gdb-wait-for-pending
(gdb-update))))
-(defun gdb-running (output-field)
+(defun gdb-running (_token output-field)
(let* ((thread-id
(bindat-get-field (gdb-json-string output-field) 'thread-id)))
;; We reset gdb-frame-number to nil if current thread has gone
(setq gdb-active-process t)
(gdb-emit-signal gdb-buf-publisher 'update-threads))
-(defun gdb-starting (_output-field)
+(defun gdb-starting (_output-field _result)
;; CLI commands don't emit ^running at the moment so use gdb-running too.
(setq gdb-inferior-status "running")
(gdb-force-mode-line-update
;; -break-insert -t didn't give a reason before gdb 6.9
-(defun gdb-stopped (output-field)
+(defun gdb-stopped (_token output-field)
"Given the contents of *stopped MI async record, select new
current thread and update GDB buffers."
;; Reason is available with target-async only
(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-filter-output
(gdb-concat-output gdb-filter-output (read output-field))))
-(defun gdb-done-or-error (output-field token-number type)
+(defun gdb-done (token-number output-field is-complete)
+ (gdb-done-or-error token-number 'done output-field is-complete))
+
+(defun gdb-error (token-number output-field is-complete)
+ (gdb-done-or-error token-number 'error output-field is-complete))
+
+(defun gdb-done-or-error (token-number type output-field is-complete)
(if (string-equal token-number "")
;; Output from command entered by user
(progn
;; Output from command from frontend.
(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))
+ ;; 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)))))
- (setq gdb-filter-output
- (gdb-concat-output gdb-filter-output output-field))
+ (when (and is-complete gdb-first-done-or-error)
+ (unless (or token-number gud-running no-proc)
+ (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
+ (gdb-update no-proc)
+ (setq gdb-first-done-or-error nil))
- (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)))))
+ (setq gdb-filter-output
+ (gdb-concat-output gdb-filter-output output-field))
+
+ ;; We are done concatenating to the output sink. Restore it to user sink:
+ (setq gdb-output-sink 'user)
+
+ (when (and token-number is-complete)
+ (with-current-buffer
+ (gdb-get-buffer-create 'gdb-partial-output-buffer)
+ (funcall
+ (cdr (assoc (string-to-number token-number) gdb-handler-alist))))
+ (setq gdb-handler-alist
+ (assq-delete-all token-number gdb-handler-alist)))
+
+ (when is-complete
+ (gdb-clear-partial-output))))
(defun gdb-concat-output (so-far new)
(cond
replaced with semicolons.
If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from
-partial output. This is used to get rid of useless keys in lists
-in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
+partial output. This is used to get rid of useless keys in lists
+in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
-break-info are examples of MI commands which issue such
responses.
;; 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
&optional signal-list)
"Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets
-HANDLER-NAME as its handler. HANDLER-NAME is bound to current
+HANDLER-NAME as its handler. HANDLER-NAME is bound to current
buffer with `gdb-bind-function-to-buffer'.
If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the
-defined trigger is called with an argument from SIGNAL-LIST. It's
+defined trigger is called with an argument from SIGNAL-LIST. It's
not recommended to define triggers with empty SIGNAL-LIST.
Normally triggers should respond at least to 'update signal.
Normally the trigger defined by this command must be called from
-the buffer where HANDLER-NAME must work. This should be done so
+the buffer where HANDLER-NAME must work. This should be done so
that buffer-local thread number may be used in GDB-COMMAND (by
calling `gdb-current-context-command').
`gdb-bind-function-to-buffer' is used to achieve this, see
Delete ((current-buffer) . TRIGGER-NAME) from
`gdb-pending-triggers', erase current buffer and evaluate
-CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
+CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
`(defun ,handler-name ()
(gdb-delete-pending (cons (current-buffer) ',trigger-name))
- (let* ((buffer-read-only nil)
- (window (get-buffer-window (current-buffer) 0))
- (start (window-start window))
- (p (window-point window)))
+ (let* ((inhibit-read-only t)
+ ,@(unless nopreserve
+ '((window (get-buffer-window (current-buffer) 0))
+ (start (window-start window))
+ (p (window-point window)))))
(erase-buffer)
(,custom-defun)
(gdb-update-buffer-name)
- ,(when (not nopreserve)
- '(set-window-start window start)
- '(set-window-point window p)))))
+ ,@(when (not nopreserve)
+ '((set-window-start window start)
+ (set-window-point window p))))))
(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
handler-name custom-defun
&optional signal-list)
"Define trigger and handler.
-TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
-`def-gdb-auto-update-trigger'.
+TRIGGER-NAME trigger is defined to send GDB-COMMAND.
+See `def-gdb-auto-update-trigger'.
-HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
-`def-gdb-auto-update-handler'."
+HANDLER-NAME handler uses customization of CUSTOM-DEFUN.
+See `def-gdb-auto-update-handler'."
`(progn
(def-gdb-auto-update-trigger ,trigger-name
,gdb-command
(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
- (bindat-get-field thread 'id)
- (concat
- (if gdb-thread-buffer-verbose-names
- (concat (bindat-get-field thread 'target-id) " ") "")
- (bindat-get-field thread 'state)
- ;; Include frame information for stopped threads
- (if (not running)
- (concat
- " in " (bindat-get-field thread 'frame 'func)
- (if gdb-thread-buffer-arguments
- (concat
- " ("
- (let ((args (bindat-get-field thread 'frame 'args)))
- (mapconcat
- (lambda (arg)
- (apply #'format "%s=%s"
- (gdb-get-many-fields arg 'name 'value)))
- args ","))
- ")")
- "")
- (if gdb-thread-buffer-locations
- (gdb-frame-location (bindat-get-field thread 'frame)) "")
- (if gdb-thread-buffer-addresses
- (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
- "")))
- (list
- 'gdb-thread thread
- 'mouse-face 'highlight
- 'help-echo "mouse-2, RET: select thread")))
+ (gdb-table-add-row
+ table
+ (list
+ (bindat-get-field thread 'id)
+ (concat
+ (if gdb-thread-buffer-verbose-names
+ (concat (bindat-get-field thread 'target-id) " ") "")
+ (bindat-get-field thread 'state)
+ ;; Include frame information for stopped threads
+ (if (not running)
+ (concat
+ " in " (bindat-get-field thread 'frame 'func)
+ (if gdb-thread-buffer-arguments
+ (concat
+ " ("
+ (let ((args (bindat-get-field thread 'frame 'args)))
+ (mapconcat
+ (lambda (arg)
+ (apply #'format "%s=%s"
+ (gdb-get-many-fields arg 'name 'value)))
+ args ","))
+ ")")
+ "")
+ (if gdb-thread-buffer-locations
+ (gdb-frame-location (bindat-get-field thread 'frame)) "")
+ (if gdb-thread-buffer-addresses
+ (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
+ "")))
+ (list
+ 'gdb-thread thread
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2, RET: select thread")))
(when (string-equal gdb-thread-number
(bindat-get-field thread 'id))
(setq marked-line (length gdb-threads-list))))
"Define a NAME command which will act upon thread on the current line.
CUSTOM-DEFUN may use locally bound `thread' variable, which will
-be the value of 'gdb-thread property of the current line. If
-'gdb-thread is nil, error is signaled."
+be the value of 'gdb-thread property of the current line.
+If `gdb-thread' is nil, error is signaled."
`(defun ,name (&optional event)
,(when doc doc)
(interactive (list last-input-event))
(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-column-width (size format)
"Return length of string with memory unit of SIZE in FORMAT.
-SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
+SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
in `gdb-memory-format'."
(let ((format-base (cdr (assoc format
'(("x" . 16)
(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)
(error "Not recognized as break/watchpoint line")))))
(defun gdb-goto-breakpoint (&optional event)
- "Go to the location of breakpoint at current line of
-breakpoints buffer."
+ "Go to the location of breakpoint at current line of breakpoints buffer."
(interactive (list last-input-event))
(if event (posn-set-point (event-end event)))
;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
(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 ()
(defun gdb-get-source-file-list ()
"Create list of source files for current GDB session.
-If buffers already exist for any of these files, gud-minor-mode
+If buffers already exist for any of these files, `gud-minor-mode'
is set in them."
(goto-char (point-min))
(while (re-search-forward gdb-source-file-regexp nil t)
(gdb-init-buffer)))))
(defun gdb-get-main-selected-frame ()
- "Trigger for `gdb-frame-handler' which uses main current
-thread. Called from `gdb-update'."
+ "Trigger for `gdb-frame-handler' which uses main current thread.
+Called from `gdb-update'."
(if (not (gdb-pending-p 'gdb-get-main-selected-frame))
(progn
(gdb-input (gdb-current-context-command "-stack-info-frame")
(gdb-add-pending 'gdb-get-main-selected-frame))))
(defun gdb-frame-handler ()
- "Sets `gdb-selected-frame' and `gdb-selected-file' to show
+ "Set `gdb-selected-frame' and `gdb-selected-file' to show
overlay arrow in source buffer."
(gdb-delete-pending 'gdb-get-main-selected-frame)
(let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
(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
-`gdb-buffer-type' as BUF and show BUF there. If no such window
-exists, just call `gdb-display-buffer' for BUF. If the window
+`gdb-buffer-type' as BUF and show BUF there. If no such window
+exists, just call `gdb-display-buffer' for BUF. If the window
found is already dedicated, split window according to
SPLIT-HORIZONTAL and show BUF in the new window."
(if buf
(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))
(set-window-dedicated-p window t))
(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.
+ "Layout the window pattern for option `gdb-many-windows'."
+ (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.
-This arrangement depends on the value of `gdb-many-windows'."
+This arrangement depends on the value of option `gdb-many-windows'."
(interactive)
(switch-to-buffer gud-comint-buffer) ;Select the right window and frame.
(delete-other-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 (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)))
(gud-gdb-fetch-lines-break (length context))
(gud-gdb-fetched-lines nil)
;; This filter dumps output lines to `gud-gdb-fetched-lines'.
- (gud-marker-filter #'gud-gdbmi-fetch-lines-filter)
- complete-list)
+ (gud-marker-filter #'gud-gdbmi-fetch-lines-filter))
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(gdb-input (concat "complete " context command)
(lambda () (setq gud-gdb-fetch-lines-in-progress nil)))
HCoop / bpt / emacs.git / blobdiff