;; Maintainer: FSF
;; Keywords: unix, tools
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; section in the GDB info manual.
;; GDB developers plan to make the annotation interface obsolete. A new
-;; interface called GDB/MI (machine interface) has been designed to replace
-;; it. Some GDB/MI commands are used in this file through the CLI command
-;; 'interpreter mi <mi-command>'. A file called gdb-mi.el is included with
-;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is
-;; still under development and is part of a process to migrate Emacs from
-;; annotations to GDB/MI.
+;; interface called GDB/MI (machine interface) has been designed to replace it.
+;; Some GDB/MI commands are used in this file through the CLI command
+;; 'interpreter mi <mi-command>'. To help with the process of fully migrating
+;; Emacs from annotations to GDB/MI, there is an experimental package called
+;; gdb-mi in the Emacs Lisp Package Archive ("http://tromey.com/elpa/"). It
+;; comprises of modified gud.el and a file called gdb-mi.el which replaces
+;; gdb-ui.el. When installed, this overrides the current files and invoking
+;; M-x gdb will use GDB/MI directly (starts with "gdb -i=mi"). When deleted
+;; ('d' followed by 'x' in Package Menu mode), the files are deleted and old
+;; functionality restored. This provides a convenient way to review the
+;; current status/contribute to its improvement. For someone who just wants to
+;; use GDB, however, the current mode in Emacs 22 is a much better option.
+;; There is also a file, also called gdb-mi.el, a version of which is included
+;; the GDB distribution. This will probably only work with versions
+;; distributed with GDB 6.5 or later. Unlike the version in ELPA it works on
+;; top of gdb-ui.el and you can only start it with M-x gdbmi.
;; This mode SHOULD WORK WITH GDB 5.0 or later but you will NEED AT LEAST
;; GDB 6.0 to use watch expressions. It works best with GDB 6.4 or later
;;; Known Bugs:
-;; 1) Strings that are watched don't update in the speedbar when their
-;; contents change unless the first character changes.
-;; 2) Cannot handle multiple debug sessions.
-;; 3) M-x gdb doesn't work with "run" command in .gdbinit, use M-x gdba instead.
-;; 4) M-x gdb doesn't work if the corefile is specified in the command in the
-;; minibuffer, use M-x gdba instead (or specify the core in the GUD buffer).
-;; 5) If you wish to call procedures from your program in GDB
+;; 1) Cannot handle multiple debug sessions.
+;; 2) If you wish to call procedures from your program in GDB
;; e.g "call myproc ()", "p mysquare (5)" then use level 2 annotations
;; "gdb --annotate=2 myprog" to keep source buffer/selected frame fixed.
-;; 6) After detaching from a process, clicking on the "GO" icon on toolbar
+;; 3) After detaching from a process, clicking on the "GO" icon on toolbar
;; (gud-go) sends "continue" to GDB (should be "run").
-;;; Problems with watch expressions, GDB/MI:
-
-;; 1) They go out of scope when the inferior is re-run.
-;; 2) -stack-list-locals has a type field but also prints type in values field.
-;; 3) VARNUM increments even when variable object is not created
-;; (maybe trivial).
-
;;; TODO:
;; 1) Use MI command -data-read-memory for memory window.
(defvar gdb-frame-begin nil
"Non-nil when GDB generates frame-begin annotation.")
(defvar gdb-printing t)
+(defvar gdb-parent-bptno-enabled nil)
+(defvar gdb-ready nil)
+(defvar gdb-early-user-input nil)
(defvar gdb-buffer-type nil
"One of the symbols bound in `gdb-buffer-rules'.")
(defvar gdb-prompting nil
"True when gdb is idle with no pending input.")
-(defvar gdb-output-sink 'user
+(defvar gdb-output-sink nil
"The disposition of the output of the current gdb command.
Possible values are these symbols:
The directory containing FILE becomes the initial working
directory and source-file directory for your debugger.
-
If `gdb-many-windows' is nil (the default value) then gdb just
pops up the GUD buffer unless `gdb-show-main' is t. In this case
it starts with two windows: one displaying the GUD buffer and the
(gud-common-init command-line nil 'gud-gdba-marker-filter)
(set (make-local-variable 'gud-minor-mode) 'gdba)
+ (setq comint-input-sender 'gdb-send)
(gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
(gud-def gud-tbreak "tbreak %f:%l" "\C-t"
(local-set-key "\C-i" 'gud-gdb-complete-command)
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
(setq paragraph-start comint-prompt-regexp)
+ (setq gdb-output-sink 'user)
(setq gdb-first-prompt t)
(setq gud-running nil)
(setq gdb-ready nil)
+ (setq gdb-flush-pending-output nil)
+ (setq gdb-early-user-input nil)
(setq gud-filter-pending-text nil)
(run-hooks 'gdb-mode-hook))
+;; Keep as an alias for compatibility with Emacs 22.1.
+;;;###autoload
+(defalias 'gdba 'gdb)
+
(defcustom gdb-debug-log-max 128
"Maximum size of `gdb-debug-log'. If nil, size is unlimited."
:group 'gud
(output
(with-output-to-string
(with-current-buffer standard-output
- (call-process shell-file-name
- (if (file-exists-p file) file nil)
+ (and file (file-exists-p file)
+ (call-process shell-file-name file
(list t nil) nil "-c"
(concat gdb-cpp-define-alist-program " "
- gdb-cpp-define-alist-flags)))))
+ gdb-cpp-define-alist-flags))))))
(define-list (split-string output "\n" t)) (name))
(setq gdb-define-alist nil)
(dolist (define define-list)
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
- (setq comint-input-sender 'gdb-send)
-
;; (re-)initialize
(setq gdb-pc-address (if gdb-show-main "main" nil))
(setq gdb-previous-frame-address nil
gdb-pending-triggers nil
gdb-output-sink 'user
gdb-server-prefix "server "
- gdb-flush-pending-output nil
gdb-location-alist nil
gdb-source-file-list nil
gdb-error nil
(setq gdb-pending-triggers
(delq 'gdb-var-update gdb-pending-triggers)))
+(defun gdb-var-set-format (format)
+ "Set the output format for a variable displayed in the speedbar."
+ (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
+ (varnum (car var)))
+ (gdb-enqueue-input
+ (list
+ (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
+ (concat "server interpreter mi \"-var-set-format "
+ varnum " " format "\"\n")
+ (concat "-var-set-format " varnum " " format "\n"))
+ `(lambda () (gdb-var-set-format-handler ,varnum))))))
+
+(defconst gdb-var-set-format-regexp
+ "format=\"\\(.*?\\)\",.*value=\"\\(.*?\\)\"")
+
+(defun gdb-var-set-format-handler (varnum)
+ (goto-char (point-min))
+ (if (re-search-forward gdb-var-set-format-regexp nil t)
+ (let ((var (assoc varnum gdb-var-list)))
+ (setcar (nthcdr 4 var) (match-string 2))
+ (gdb-var-update-1))))
+
(defun gdb-var-delete-1 (varnum)
(gdb-enqueue-input
(list
- (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
- 'gdba)
+ (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
(concat "server interpreter mi \"-var-delete " varnum "\"\n")
(concat "-var-delete " varnum "\n"))
'ignore))
(defun gdb-send (proc string)
"A comint send filter for gdb.
This filter may simply queue input for a later time."
- (when gdb-ready
- (with-current-buffer gud-comint-buffer
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max) '(face))))
- (if gud-running
- (progn
- (let ((item (concat string "\n")))
- (if gdb-enable-debug (push (cons 'send item) gdb-debug-log))
- (process-send-string proc item)))
- (if (string-match "\\\\\\'" string)
- (setq gdb-continuation (concat gdb-continuation string "\n"))
- (let ((item (concat gdb-continuation string
- (if (not comint-input-sender-no-newline) "\n"))))
- (gdb-enqueue-input item)
- (setq gdb-continuation nil))))))
+ (if gdb-ready
+ (progn
+ (with-current-buffer gud-comint-buffer
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(face))))
+ (if gud-running
+ (progn
+ (let ((item (concat string "\n")))
+ (if gdb-enable-debug (push (cons 'send item) gdb-debug-log))
+ (process-send-string proc item)))
+ (if (string-match "\\\\\\'" string)
+ (setq gdb-continuation (concat gdb-continuation string "\n"))
+ (let ((item (concat
+ gdb-continuation string
+ (if (not comint-input-sender-no-newline) "\n"))))
+ (gdb-enqueue-input item)
+ (setq gdb-continuation nil)))))
+ (push (concat string "\n") gdb-early-user-input)))
;; Note: Stuff enqueued here will be sent to the next prompt, even if it
;; is a query, or other non-top-level prompt.
(defun gdb-dequeue-input ()
(let ((queue gdb-input-queue))
- (and queue
- (let ((last (car (last queue))))
- (unless (nbutlast queue) (setq gdb-input-queue '()))
- last))))
+ (if queue
+ (let ((last (car (last queue))))
+ (unless (nbutlast queue) (setq gdb-input-queue '()))
+ last)
+ ;; This should be nil here anyway but set it just to make sure.
+ (setq gdb-pending-triggers nil))))
(defun gdb-send-item (item)
(setq gdb-flush-pending-output nil)
;;
(defcustom gud-gdb-command-name "gdb --annotate=3"
- "Default command to execute an executable under the GDB debugger."
+ "Default command to execute an executable under the GDB debugger.
+The option \"--annotate=3\" must be included in this value if you
+want the GDB Graphical Interface."
:type 'string
:group 'gud
:version "22.1")
(gdb-send-item input)
(progn
(setq gdb-prompting t)
- (gud-display-frame)))))
+ (gud-display-frame)
+ (setq gdb-early-user-input (nreverse gdb-early-user-input))
+ (while gdb-early-user-input
+ (gdb-enqueue-input (car gdb-early-user-input))
+ (setq gdb-early-user-input (cdr gdb-early-user-input)))))))
(defun gdb-subprompt (ignored)
"An annotation handler for non-top-level prompts."
:group 'gud)
(defconst gdb-breakpoint-regexp
- "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+")
+ "\\(?:\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\|\\([0-9]+\\.[0-9]+\\)\\)\\s-+\\(.\\)\\s-+")
;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
(defun gdb-info-breakpoints-custom ()
(forward-line 1)
(if (looking-at gdb-breakpoint-regexp)
(progn
- (setq bptno (match-string 1))
- (setq flag (char-after (match-beginning 2)))
+ (setq bptno (or (match-string 1) (match-string 2)))
+ (setq flag (char-after (match-beginning 3)))
+ (if (match-string 1)
+ (setq gdb-parent-bptno-enabled (eq flag ?y)))
(add-text-properties
- (match-beginning 2) (match-end 2)
+ (match-beginning 3) (match-end 3)
(if (eq flag ?y)
'(face font-lock-warning-face)
'(face font-lock-type-face)))
(end-of-line))))))
(if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
+(declare-function gud-remove "gdb-ui" t t) ; gud-def
+(declare-function gud-break "gdb-ui" t t) ; gud-def
+
(defun gdb-mouse-set-clear-breakpoint (event)
"Set/clear breakpoint in left fringe/margin with mouse click."
(interactive "e")
(mouse-minibuffer-check event)
(let ((posn (event-end event)))
- (if (numberp (posn-point posn))
- (with-selected-window (posn-window posn)
- (save-excursion
- (goto-char (posn-point posn))
- (if (or (posn-object posn)
- (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
- 'breakpoint))
- (gud-remove nil)
- (gud-break nil)))))))
+ (if (buffer-file-name)
+ (if (numberp (posn-point posn))
+ (with-selected-window (posn-window posn)
+ (save-excursion
+ (goto-char (posn-point posn))
+ (if (or (posn-object posn)
+ (eq (car (fringe-bitmaps-at-pos (posn-point posn)))
+ 'breakpoint))
+ (gud-remove nil)
+ (gud-break nil)))))
+ (posn-set-point posn))))
(defun gdb-mouse-toggle-breakpoint-margin (event)
"Enable/disable breakpoint in left margin with mouse click."
(save-excursion
(goto-char (posn-point posn))
(if (posn-object posn)
- (gdb-enqueue-input
- (list
- (let ((bptno (get-text-property
- 0 'gdb-bptno (car (posn-string posn)))))
+ (let* ((bptno (get-text-property
+ 0 'gdb-bptno (car (posn-string posn)))))
+ (string-match "\\([0-9+]\\)*" bptno)
+ (gdb-enqueue-input
+ (list
(concat gdb-server-prefix
(if (get-text-property
0 'gdb-enabled (car (posn-string posn)))
"disable "
"enable ")
- bptno "\n"))
- 'ignore))))))))
+ (match-string 1 bptno) "\n")
+ 'ignore)))))))))
(defun gdb-mouse-toggle-breakpoint-fringe (event)
"Enable/disable breakpoint in left fringe with mouse click."
(when (overlay-get overlay 'put-break)
(setq obj (overlay-get overlay 'before-string))))
(when (stringp obj)
- (gdb-enqueue-input
- (list
- (concat gdb-server-prefix
- (if (get-text-property 0 'gdb-enabled obj)
- "disable "
- "enable ")
- (get-text-property 0 'gdb-bptno obj) "\n")
- 'ignore))))))))
+ (let* ((bptno (get-text-property 0 'gdb-bptno obj)))
+ (string-match "\\([0-9+]\\)*" bptno)
+ (gdb-enqueue-input
+ (list
+ (concat gdb-server-prefix
+ (if (get-text-property 0 'gdb-enabled obj)
+ "disable "
+ "enable ")
+ (match-string 1 bptno) "\n")
+ 'ignore)))))))))
(defun gdb-breakpoints-buffer-name ()
(with-current-buffer gud-comint-buffer
(gdb-enqueue-input
(list
(concat gdb-server-prefix
- (if (eq ?y (char-after (match-beginning 2)))
+ (if (eq ?y (char-after (match-beginning 3)))
"disable "
"enable ")
- (match-string 1) "\n") 'ignore))
+ (or (match-string 1) (match-string 2)) "\n") 'ignore))
(error "Not recognized as break/watchpoint line"))))
(defun gdb-delete-breakpoint ()
"Delete the breakpoint at current line."
(interactive)
- (beginning-of-line 1)
- (if (looking-at gdb-breakpoint-regexp)
- (gdb-enqueue-input
- (list
- (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore))
- (error "Not recognized as break/watchpoint line")))
+ (save-excursion
+ (beginning-of-line 1)
+ (if (looking-at gdb-breakpoint-regexp)
+ (if (match-string 1)
+ (gdb-enqueue-input
+ (list
+ (concat gdb-server-prefix "delete " (match-string 1) "\n")
+ 'ignore))
+ (message-box "This breakpoint cannot be deleted on its own."))
+ (error "Not recognized as break/watchpoint line"))))
(defun gdb-goto-breakpoint (&optional event)
"Display the breakpoint location specified at current line."
(if event (posn-set-point (event-end event)))
(save-excursion
(beginning-of-line 1)
- (if (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
+ (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
(let ((bptno (match-string 1))
(file (match-string 2))
(line (match-string 3)))
(put-text-property bl (+ bl 4)
'face '(:inverse-video t))
(setq move-to bl)))
- (when (re-search-forward
- (concat
- (if (string-equal (match-string 1) "0") "" " in ")
- "\\([^ ]+\\) (") el t)
+ (when (re-search-forward "\\([^ ]+\\) (" el t)
(put-text-property (match-beginning 1) (match-end 1)
'face font-lock-function-name-face)
(setq bl (match-end 0))
(delete-overlay overlay))))
(defun gdb-put-breakpoint-icon (enabled bptno)
+ (if (string-match "[0-9+]+\\." bptno)
+ (setq enabled gdb-parent-bptno-enabled))
(let ((start (- (line-beginning-position) 1))
(end (+ (line-end-position) 1))
(putstring (if enabled "B" "b"))
(setq left-margin-width 2)
(let ((window (get-buffer-window (current-buffer) 0)))
(if window
- (set-window-margins
- window left-margin-width right-margin-width)))))
+ (set-window-margins
+ window left-margin-width right-margin-width)))))
(gdb-put-string
(propertize putstring
'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
(goto-char (point-min))
(while (< (point) (- (point-max) 1))
(forward-line 1)
- (if (looking-at "[^\t].*?breakpoint")
- (progn
- (looking-at
- "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)")
- (setq bptno (match-string 1))
- (setq flag (char-after (match-beginning 2)))
- (setq address (match-string 3))
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-min))
- (if (search-forward address nil t)
- (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
+ (when (looking-at
+ "\\([0-9]+\\.?[0-9]*\\).*?\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)")
+ (setq bptno (match-string 1))
+ (setq flag (char-after (match-beginning 2)))
+ (setq address (match-string 3))
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (if (search-forward address nil t)
+ (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
(if (not (equal gdb-pc-address "main"))
(with-current-buffer buffer
(set-window-point (get-buffer-window buffer 0) pos)))))
(let ((buffer (marker-buffer gud-overlay-arrow-position))
(position (marker-position gud-overlay-arrow-position)))
(when (and buffer
- (string-equal (buffer-name buffer)
+ (string-equal (file-name-nondirectory
+ (buffer-file-name buffer))
(file-name-nondirectory (match-string 3))))
(with-current-buffer buffer
(setq fringe-indicator-alist
(gdb-force-mode-line-update
(propertize "ready" 'face font-lock-variable-name-face)))
-; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
+; Uses "-var-list-children --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-list-children-1 (varnum)
(gdb-enqueue-input
(list
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdba)
- (concat "server interpreter mi \"-var-list-children --all-values "
- varnum "\"\n")
- (concat "-var-list-children --all-values " varnum "\n"))
+ (concat "server interpreter mi \"-var-list-children --all-values \\\""
+ varnum "\\\"\"\n")
+ (concat "-var-list-children --all-values \"" varnum "\"\n"))
`(lambda () (gdb-var-list-children-handler-1 ,varnum)))))
(defconst gdb-var-list-children-regexp-1