+2004-07-26 Andrew Cagney <cagney@gnu.org>
+
+ * gdb-mi.el: Move from here ...
+ * mi/gdb-mi.el: ... to here.
+
2004-07-26 Andrew Cagney <cagney@gnu.org>
Problem reported by Ashley Pittman <ashley@quadrics.com>.
+++ /dev/null
-;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004)
-
-;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command"
-;; (could use "-interpreter-exec console cli-command")
-
-;; Author: Nick Roberts <nickrob@gnu.org>
-;; Maintainer: Nick Roberts <nickrob@gnu.org>
-;; Keywords: unix, tools
-
-;; Copyright (C) 2004 Free Software Foundation, Inc.
-
-;; This file is part of GNU GDB.
-
-;; GNU GDB is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;;; Commentary:
-
-;; This mode acts as a graphical user interface to GDB and requires GDB 6.1
-;; onwards. You can interact with GDB through the GUD buffer in the usual way,
-;; but there are also buffers which control the execution and describe the
-;; state of your program. It separates the input/output of your program from
-;; that of GDB and displays expressions and their current values in their own
-;; buffers. It also uses features of Emacs 21 such as the fringe/display
-;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface
-;; section in the Emacs info manual).
-
-;; Start the debugger with M-x gdbmi.
-
-;; This file uses GDB/MI as the primary interface to GDB. It is still under
-;; development and is part of a process to migrate Emacs from annotations
-;; (as used in gdb-ui.el) to GDB/MI.
-
-;; Known Bugs:
-;;
-
-;;; Code:
-
-(require 'gud)
-(require 'gdb-ui)
-\f
-
-;;;###autoload
-(defun gdbmi (command-line)
- "Run gdb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger.
-
-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
-other with the source file with the main routine of the inferior.
-
-If `gdb-many-windows' is t, regardless of the value of
-`gdb-show-main', the layout below will appear. Keybindings are
-given in relevant buffer.
-
-Watch expressions appear in the speedbar/slowbar.
-
-The following interactive lisp functions help control operation :
-
-`gdb-many-windows' - Toggle the number of windows gdb uses.
-`gdb-restore-windows' - To restore the window layout.
-
-See Info node `(emacs)GDB Graphical Interface' for a more
-detailed description of this mode.
-
-
----------------------------------------------------------------------
- GDB Toolbar
----------------------------------------------------------------------
-GUD buffer (I/O of GDB) | Locals buffer
- |
- |
- |
----------------------------------------------------------------------
- Source buffer | Input/Output (of inferior) buffer
- | (comint-mode)
- |
- |
- |
- |
- |
- |
----------------------------------------------------------------------
- Stack buffer | Breakpoints buffer
- RET gdb-frames-select | SPC gdb-toggle-breakpoint
- | RET gdb-goto-breakpoint
- | d gdb-delete-breakpoint
----------------------------------------------------------------------
-"
- ;;
- (interactive (list (gud-query-cmdline 'gdbmi)))
- ;;
- ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
- (gdb command-line)
- ;;
- (setq gdb-debug-log nil)
- (set (make-local-variable 'gud-minor-mode) 'gdbmi)
- (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
- ;;
- (gud-def gud-break (if (not (string-equal mode-name "Machine"))
- (gud-call "-break-insert %f:%l" arg)
- (save-excursion
- (beginning-of-line)
- (forward-char 2)
- (gud-call "-break-insert *%a" arg)))
- "\C-b" "Set breakpoint at current line or address.")
- ;;
- (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
- (gud-call "clear %f:%l" arg)
- (save-excursion
- (beginning-of-line)
- (forward-char 2)
- (gud-call "clear *%a" arg)))
- "\C-d" "Remove breakpoint at current line or address.")
- ;;
- (gud-def gud-until (if (not (string-equal mode-name "Machine"))
- (gud-call "until %f:%l" arg)
- (save-excursion
- (beginning-of-line)
- (forward-char 2)
- (gud-call "until *%a" arg)))
- "\C-u" "Continue to current line or address.")
-
- (define-key gud-minor-mode-map [left-margin mouse-1]
- 'gdb-mouse-toggle-breakpoint)
- (define-key gud-minor-mode-map [left-fringe mouse-1]
- 'gdb-mouse-toggle-breakpoint)
-
- (setq comint-input-sender 'gdbmi-send)
- ;;
- ;; (re-)initialise
- (setq gdb-main-file nil)
- (setq gdb-current-address "main")
- (setq gdb-previous-address nil)
- (setq gdb-previous-frame nil)
- (setq gdb-current-frame "main")
- (setq gdb-view-source t)
- (setq gdb-selected-view 'source)
- (setq gdb-var-list nil)
- (setq gdb-var-changed nil)
- (setq gdb-prompting nil)
- (setq gdb-current-item nil)
- (setq gdb-pending-triggers nil)
- (setq gdb-output-sink 'user)
- (setq gdb-server-prefix nil)
- ;;
- (setq gdb-buffer-type 'gdbmi)
- ;;
- ;; FIXME: use tty command to separate io.
- ;;(gdb-clear-inferior-io)
- ;;
- (if (eq window-system 'w32)
- (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
- ;; find source file and compilation directory here
- (gdb-enqueue-input (list "list main\n" 'ignore)) ; C program
- (gdb-enqueue-input (list "list MAIN__\n" 'ignore)) ; Fortran program
- (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info))
- ;;
- (run-hooks 'gdbmi-mode-hook))
-
-; Force nil till fixed.
-(defconst gdbmi-use-inferior-io-buffer nil)
-
-; uses --all-values Needs GDB 6.1 onwards.
-(defun gdbmi-var-list-children (varnum)
- (gdb-enqueue-input
- (list (concat "-var-update " varnum "\n") 'ignore))
- (gdb-enqueue-input
- (list (concat "-var-list-children --all-values "
- varnum "\n")
- `(lambda () (gdbmi-var-list-children-handler ,varnum)))))
-
-(defconst gdbmi-var-list-children-regexp
-"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\""
-)
-
-(defun gdbmi-var-list-children-handler (varnum)
- (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
- (goto-char (point-min))
- (let ((var-list nil))
- (catch 'child-already-watched
- (dolist (var gdb-var-list)
- (if (string-equal varnum (cadr var))
- (progn
- (push var var-list)
- (while (re-search-forward gdbmi-var-list-children-regexp nil t)
- (let ((varchild (list (match-string 2)
- (match-string 1)
- (match-string 3)
- nil
- (match-string 4)
- nil)))
- (if (looking-at ",type=\"\\(.*?\\)\"")
- (setcar (nthcdr 3 varchild) (match-string 1)))
- (dolist (var1 gdb-var-list)
- (if (string-equal (cadr var1) (cadr varchild))
- (throw 'child-already-watched nil)))
- (push varchild var-list))))
- (push var var-list)))
- (setq gdb-var-changed t)
- (setq gdb-var-list (nreverse var-list))))))
-\f
-;(defun gdbmi-send (proc string)
-; "A comint send filter for gdb."
-; (setq gdb-output-sink 'user)
-; (setq gdb-prompting nil)
-; (process-send-string proc (concat "-interpreter-exec console \"" string "\"")))
-
-(defun gdbmi-send (proc string)
- "A comint send filter for gdb."
- (setq gdb-output-sink 'user)
- (setq gdb-prompting nil)
- (process-send-string proc (concat string "\n")))
-
-(defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi"
- "Default command to execute an executable under the GDB-UI debugger."
- :type 'string
- :group 'gud)
-
-(defconst gdb-stopped-regexp
- "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*")
-
-(defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"")
-
-(defconst gdb-internals-regexp "&\".*\\n\"\n")
-
-(defconst gdb-gdb-regexp "(gdb) \n")
-
-(defconst gdb-running-regexp "^\\^running")
-
-(defun gdbmi-prompt ()
- "This handler terminates the any collection of output. It also
- sends the next command (if any) to gdb."
- (unless gdb-pending-triggers
- (gdb-get-current-frame)
- (gdbmi-invalidate-frames)
- (gdbmi-invalidate-breakpoints)
- (gdbmi-invalidate-locals)
- (dolist (frame (frame-list))
- (when (string-equal (frame-parameter frame 'name) "Speedbar")
- (setq gdb-var-changed t) ; force update
- (dolist (var gdb-var-list)
- (setcar (nthcdr 5 var) nil))))
- (gdb-var-update))
- (let ((sink gdb-output-sink))
- (when (eq sink 'emacs)
- (let ((handler
- (car (cdr gdb-current-item))))
- (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
- (funcall handler)))))
- (let ((input (gdb-dequeue-input)))
- (if input
- (gdb-send-item input)
- (progn
- (setq gud-running nil)
- (setq gdb-prompting t)
- (gud-display-frame)))))
-
-(defun gud-gdbmi-marker-filter (string)
- "Filter GDB/MI output."
- (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
- ;; 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
- (let ((output ""))
-
- (if (string-match gdb-running-regexp gud-marker-acc)
- (setq gud-marker-acc (substring gud-marker-acc (match-end 0))
- gud-running t))
-
- ;; Remove the trimmings from the console stream.
- (while (string-match gdb-console-regexp gud-marker-acc)
- (setq
- gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
- (match-string 1 gud-marker-acc)
- (substring gud-marker-acc (match-end 0)))))
-
- ;; Remove log stream containing debugging messages being produced by GDB's
- ;; internals.
- (while (string-match gdb-internals-regexp gud-marker-acc)
- (setq
- gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
- (substring gud-marker-acc (match-end 0)))))
-
- (if (string-match gdb-stopped-regexp gud-marker-acc)
- (setq
-
- ;; Extract the frame position from the marker.
- gud-last-frame (cons (match-string 2 gud-marker-acc)
- (string-to-int (match-string 3 gud-marker-acc)))
-
- ;; Append any text before the marker to the output we're going
- ;; to return - we don't include the marker in this text.
- output (gdbmi-concat-output output
- (substring gud-marker-acc 0 (match-beginning 0)))
-
- ;; Set the accumulator to the remaining text.
- gud-marker-acc (substring gud-marker-acc (match-end 0))))
-
- (while (string-match gdb-gdb-regexp gud-marker-acc)
- (setq
-
- ;; Append any text up to and including prompt less \n to the output.
- output (gdbmi-concat-output output
- (substring gud-marker-acc 0 (- (match-end 0) 1)))
-
- ;; Set the accumulator to the remaining text.
- gud-marker-acc (substring gud-marker-acc (match-end 0)))
- (gdbmi-prompt))
-
- (setq output (gdbmi-concat-output output gud-marker-acc))
- (setq gud-marker-acc "")
- output))
-
-(defun gdbmi-concat-output (so-far new)
- (let ((sink gdb-output-sink))
- (cond
- ((eq sink 'user) (concat so-far new))
- ((eq sink 'emacs)
- (gdb-append-to-partial-output new)
- so-far)
- ((eq sink 'inferior)
- (gdb-append-to-inferior-io new)
- so-far))))
-\f
-
-;; Breakpoint buffer : This displays the output of `-break-list'.
-;;
-(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
- ;; This defines the auto update rule for buffers of type
- ;; `gdb-breakpoints-buffer'.
- ;;
- ;; It defines a function that queues the command below. That function is
- ;; called:
- gdbmi-invalidate-breakpoints
- ;;
- ;; To update the buffer, this command is sent to gdb.
- "-break-list\n"
- ;;
- ;; This also defines a function to be the handler for the output
- ;; from the command above. That function will copy the output into
- ;; the appropriately typed buffer. That function will be called:
- gdb-break-list-handler
- ;; buffer specific functions
- gdb-break-list-custom)
-
-(defconst gdb-break-list-regexp
-"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
-
-(defun gdb-break-list-handler ()
- (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
- gdb-pending-triggers))
- (let ((breakpoint nil)
- (breakpoints-list nil))
- (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
- (goto-char (point-min))
- (while (re-search-forward gdb-break-list-regexp nil t)
- (let ((breakpoint (list (match-string 1)
- (match-string 2)
- (match-string 3)
- (match-string 4)
- (match-string 5)
- (match-string 6)
- (match-string 7)
- (match-string 8))))
- (push breakpoint breakpoints-list))))
- (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
- (and buf (with-current-buffer buf
- (let ((p (point))
- (buffer-read-only nil))
- (erase-buffer)
- (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n")
- (dolist (breakpoint breakpoints-list)
- (insert (concat
- (nth 0 breakpoint) " "
- (nth 1 breakpoint) " "
- (nth 2 breakpoint) " "
- (nth 3 breakpoint) " "
- (nth 5 breakpoint) "\t"
- (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t"
- (nth 4 breakpoint) "\n")))
- (goto-char p))))))
- (gdb-break-list-custom))
-
-;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
-(defun gdb-break-list-custom ()
- (let ((flag)(address))
- ;;
- ;; remove all breakpoint-icons in source buffers but not assembler buffer
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (if (and (eq gud-minor-mode 'gdbmi)
- (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
- (gdb-remove-breakpoint-icons (point-min) (point-max)))))
- (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
- (save-excursion
- (goto-char (point-min))
- (while (< (point) (- (point-max) 1))
- (forward-line 1)
- (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
- (progn
- (setq flag (char-after (match-beginning 1)))
- (let ((line (match-string 3)) (buffer-read-only nil)
- (file (match-string 2)))
- (add-text-properties (point-at-bol) (point-at-eol)
- '(mouse-face highlight
- help-echo "mouse-2, RET: visit breakpoint"))
- (with-current-buffer
- (find-file-noselect
- (if (file-exists-p file) file
- (expand-file-name file gdb-cdir)))
- (save-current-buffer
- (set (make-local-variable 'gud-minor-mode) 'gdbmi)
- (set (make-local-variable 'tool-bar-map)
- gud-tool-bar-map))
- ;; only want one breakpoint icon at each location
- (save-excursion
- (goto-line (string-to-number line))
- (gdb-put-breakpoint-icon (eq flag ?y)))))))))
- (end-of-line)))
- (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
-
-;; Frames buffer. This displays a perpetually correct bactrack trace.
-;;
-(def-gdb-auto-updated-buffer gdb-stack-buffer
- gdbmi-invalidate-frames
- "-stack-list-frames\n"
- gdb-stack-list-frames-handler
- gdb-stack-list-frames-custom)
-
-(defconst gdb-stack-list-frames-regexp
-"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
-
-(defun gdb-stack-list-frames-handler ()
- (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
- gdb-pending-triggers))
- (let ((frame nil)
- (call-stack nil))
- (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
- (goto-char (point-min))
- (while (re-search-forward gdb-stack-list-frames-regexp nil t)
- (let ((frame (list (match-string 1)
- (match-string 2)
- (match-string 3)
- (match-string 4)
- (match-string 5))))
- (push frame call-stack))))
- (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
- (and buf (with-current-buffer buf
- (let ((p (point))
- (buffer-read-only nil))
- (erase-buffer)
- (insert "Level\tFunc\tFile:Line\tAddr\n")
- (dolist (frame (nreverse call-stack))
- (insert (concat
- (nth 0 frame) "\t"
- (nth 2 frame) "\t"
- (nth 3 frame) ":" (nth 4 frame) "\t"
- (nth 1 frame) "\n")))
- (goto-char p))))))
- (gdb-stack-list-frames-custom))
-
-(defun gdb-stack-list-frames-custom ()
- (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
- (save-excursion
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (forward-line 1)
- (while (< (point) (point-max))
- (add-text-properties (point-at-bol) (point-at-eol)
- '(mouse-face highlight
- help-echo "mouse-2, RET: Select frame"))
- (beginning-of-line)
- (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
- (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
- (equal (match-string 1) gdb-current-frame))
- (put-text-property (point-at-bol) (point-at-eol)
- 'face '(:inverse-video t)))
- (forward-line 1))))))
-
-;; Locals buffer.
-;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards.
-(def-gdb-auto-updated-buffer gdb-locals-buffer
- gdbmi-invalidate-locals
- "-stack-list-locals 2\n"
- gdb-stack-list-locals-handler
- gdb-stack-list-locals-custom)
-
-(defconst gdb-stack-list-locals-regexp
- (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))
-
-;; Dont display values of arrays or structures.
-;; These can be expanded using gud-watch.
-(defun gdb-stack-list-locals-handler nil
- (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals
- gdb-pending-triggers))
- (let ((local nil)
- (locals-list nil))
- (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
- (goto-char (point-min))
- (while (re-search-forward gdb-stack-list-locals-regexp nil t)
- (let ((local (list (match-string 1)
- (match-string 2)
- nil)))
- (if (looking-at ",value=\"\\(.*?\\)\"")
- (setcar (nthcdr 2 local) (match-string 1)))
- (push local locals-list))))
- (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
- (and buf (with-current-buffer buf
- (let ((p (point))
- (buffer-read-only nil))
- (erase-buffer)
- (dolist (local locals-list)
- (insert
- (concat (car local) "\t" (nth 1 local) "\t"
- (or (nth 2 local)
- (if (string-match "struct" (nth 1 local))
- "(structure)"
- "(array)"))
- "\n")))
- (goto-char p)))))))
-
-(defun gdb-stack-list-locals-custom ()
- nil)
-
-(defun gdbmi-source-info ()
- "Find the source file where the program starts and displays it with related
-buffers."
- (goto-char (point-min))
- (if (search-forward "source file is " nil t)
- (if (looking-at "\\S-*")
- (setq gdb-main-file (match-string 0)))
- (setq gdb-view-source nil))
- (if (search-forward "directory is " nil t)
- (if (looking-at "\\S-*:\\(\\S-*\\)")
- (setq gdb-cdir (match-string 1))
- (looking-at "\\S-*")
- (setq gdb-cdir (match-string 0))))
-
-;temporary heuristic
- (if gdb-main-file
- (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))
-
- (if gdb-many-windows
- (gdb-setup-windows)
- (gdb-get-create-buffer 'gdb-breakpoints-buffer)
- (when gdb-show-main
- (switch-to-buffer gud-comint-buffer)
- (delete-other-windows)
- (split-window)
- (other-window 1)
- (switch-to-buffer
- (if gdb-view-source
- (gud-find-file gdb-main-file)
- (gdb-get-create-buffer 'gdb-assembler-buffer)))
- (other-window 1))))
-
-(provide 'gdb-mi)
-;;; gdbmi.el ends here
--- /dev/null
+;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004)
+
+;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command"
+;; (could use "-interpreter-exec console cli-command")
+
+;; Author: Nick Roberts <nickrob@gnu.org>
+;; Maintainer: Nick Roberts <nickrob@gnu.org>
+;; Keywords: unix, tools
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; This file is part of GNU GDB.
+
+;; GNU GDB is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;;; Commentary:
+
+;; This mode acts as a graphical user interface to GDB and requires GDB 6.1
+;; onwards. You can interact with GDB through the GUD buffer in the usual way,
+;; but there are also buffers which control the execution and describe the
+;; state of your program. It separates the input/output of your program from
+;; that of GDB and displays expressions and their current values in their own
+;; buffers. It also uses features of Emacs 21 such as the fringe/display
+;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface
+;; section in the Emacs info manual).
+
+;; Start the debugger with M-x gdbmi.
+
+;; This file uses GDB/MI as the primary interface to GDB. It is still under
+;; development and is part of a process to migrate Emacs from annotations
+;; (as used in gdb-ui.el) to GDB/MI.
+
+;; Known Bugs:
+;;
+
+;;; Code:
+
+(require 'gud)
+(require 'gdb-ui)
+\f
+
+;;;###autoload
+(defun gdbmi (command-line)
+ "Run gdb on program FILE in buffer *gud-FILE*.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger.
+
+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
+other with the source file with the main routine of the inferior.
+
+If `gdb-many-windows' is t, regardless of the value of
+`gdb-show-main', the layout below will appear. Keybindings are
+given in relevant buffer.
+
+Watch expressions appear in the speedbar/slowbar.
+
+The following interactive lisp functions help control operation :
+
+`gdb-many-windows' - Toggle the number of windows gdb uses.
+`gdb-restore-windows' - To restore the window layout.
+
+See Info node `(emacs)GDB Graphical Interface' for a more
+detailed description of this mode.
+
+
+---------------------------------------------------------------------
+ GDB Toolbar
+---------------------------------------------------------------------
+GUD buffer (I/O of GDB) | Locals buffer
+ |
+ |
+ |
+---------------------------------------------------------------------
+ Source buffer | Input/Output (of inferior) buffer
+ | (comint-mode)
+ |
+ |
+ |
+ |
+ |
+ |
+---------------------------------------------------------------------
+ Stack buffer | Breakpoints buffer
+ RET gdb-frames-select | SPC gdb-toggle-breakpoint
+ | RET gdb-goto-breakpoint
+ | d gdb-delete-breakpoint
+---------------------------------------------------------------------
+"
+ ;;
+ (interactive (list (gud-query-cmdline 'gdbmi)))
+ ;;
+ ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
+ (gdb command-line)
+ ;;
+ (setq gdb-debug-log nil)
+ (set (make-local-variable 'gud-minor-mode) 'gdbmi)
+ (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
+ ;;
+ (gud-def gud-break (if (not (string-equal mode-name "Machine"))
+ (gud-call "-break-insert %f:%l" arg)
+ (save-excursion
+ (beginning-of-line)
+ (forward-char 2)
+ (gud-call "-break-insert *%a" arg)))
+ "\C-b" "Set breakpoint at current line or address.")
+ ;;
+ (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
+ (gud-call "clear %f:%l" arg)
+ (save-excursion
+ (beginning-of-line)
+ (forward-char 2)
+ (gud-call "clear *%a" arg)))
+ "\C-d" "Remove breakpoint at current line or address.")
+ ;;
+ (gud-def gud-until (if (not (string-equal mode-name "Machine"))
+ (gud-call "until %f:%l" arg)
+ (save-excursion
+ (beginning-of-line)
+ (forward-char 2)
+ (gud-call "until *%a" arg)))
+ "\C-u" "Continue to current line or address.")
+
+ (define-key gud-minor-mode-map [left-margin mouse-1]
+ 'gdb-mouse-toggle-breakpoint)
+ (define-key gud-minor-mode-map [left-fringe mouse-1]
+ 'gdb-mouse-toggle-breakpoint)
+
+ (setq comint-input-sender 'gdbmi-send)
+ ;;
+ ;; (re-)initialise
+ (setq gdb-main-file nil)
+ (setq gdb-current-address "main")
+ (setq gdb-previous-address nil)
+ (setq gdb-previous-frame nil)
+ (setq gdb-current-frame "main")
+ (setq gdb-view-source t)
+ (setq gdb-selected-view 'source)
+ (setq gdb-var-list nil)
+ (setq gdb-var-changed nil)
+ (setq gdb-prompting nil)
+ (setq gdb-current-item nil)
+ (setq gdb-pending-triggers nil)
+ (setq gdb-output-sink 'user)
+ (setq gdb-server-prefix nil)
+ ;;
+ (setq gdb-buffer-type 'gdbmi)
+ ;;
+ ;; FIXME: use tty command to separate io.
+ ;;(gdb-clear-inferior-io)
+ ;;
+ (if (eq window-system 'w32)
+ (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
+ ;; find source file and compilation directory here
+ (gdb-enqueue-input (list "list main\n" 'ignore)) ; C program
+ (gdb-enqueue-input (list "list MAIN__\n" 'ignore)) ; Fortran program
+ (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info))
+ ;;
+ (run-hooks 'gdbmi-mode-hook))
+
+; Force nil till fixed.
+(defconst gdbmi-use-inferior-io-buffer nil)
+
+; uses --all-values Needs GDB 6.1 onwards.
+(defun gdbmi-var-list-children (varnum)
+ (gdb-enqueue-input
+ (list (concat "-var-update " varnum "\n") 'ignore))
+ (gdb-enqueue-input
+ (list (concat "-var-list-children --all-values "
+ varnum "\n")
+ `(lambda () (gdbmi-var-list-children-handler ,varnum)))))
+
+(defconst gdbmi-var-list-children-regexp
+"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\""
+)
+
+(defun gdbmi-var-list-children-handler (varnum)
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (let ((var-list nil))
+ (catch 'child-already-watched
+ (dolist (var gdb-var-list)
+ (if (string-equal varnum (cadr var))
+ (progn
+ (push var var-list)
+ (while (re-search-forward gdbmi-var-list-children-regexp nil t)
+ (let ((varchild (list (match-string 2)
+ (match-string 1)
+ (match-string 3)
+ nil
+ (match-string 4)
+ nil)))
+ (if (looking-at ",type=\"\\(.*?\\)\"")
+ (setcar (nthcdr 3 varchild) (match-string 1)))
+ (dolist (var1 gdb-var-list)
+ (if (string-equal (cadr var1) (cadr varchild))
+ (throw 'child-already-watched nil)))
+ (push varchild var-list))))
+ (push var var-list)))
+ (setq gdb-var-changed t)
+ (setq gdb-var-list (nreverse var-list))))))
+\f
+;(defun gdbmi-send (proc string)
+; "A comint send filter for gdb."
+; (setq gdb-output-sink 'user)
+; (setq gdb-prompting nil)
+; (process-send-string proc (concat "-interpreter-exec console \"" string "\"")))
+
+(defun gdbmi-send (proc string)
+ "A comint send filter for gdb."
+ (setq gdb-output-sink 'user)
+ (setq gdb-prompting nil)
+ (process-send-string proc (concat string "\n")))
+
+(defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi"
+ "Default command to execute an executable under the GDB-UI debugger."
+ :type 'string
+ :group 'gud)
+
+(defconst gdb-stopped-regexp
+ "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*")
+
+(defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"")
+
+(defconst gdb-internals-regexp "&\".*\\n\"\n")
+
+(defconst gdb-gdb-regexp "(gdb) \n")
+
+(defconst gdb-running-regexp "^\\^running")
+
+(defun gdbmi-prompt ()
+ "This handler terminates the any collection of output. It also
+ sends the next command (if any) to gdb."
+ (unless gdb-pending-triggers
+ (gdb-get-current-frame)
+ (gdbmi-invalidate-frames)
+ (gdbmi-invalidate-breakpoints)
+ (gdbmi-invalidate-locals)
+ (dolist (frame (frame-list))
+ (when (string-equal (frame-parameter frame 'name) "Speedbar")
+ (setq gdb-var-changed t) ; force update
+ (dolist (var gdb-var-list)
+ (setcar (nthcdr 5 var) nil))))
+ (gdb-var-update))
+ (let ((sink gdb-output-sink))
+ (when (eq sink 'emacs)
+ (let ((handler
+ (car (cdr gdb-current-item))))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (funcall handler)))))
+ (let ((input (gdb-dequeue-input)))
+ (if input
+ (gdb-send-item input)
+ (progn
+ (setq gud-running nil)
+ (setq gdb-prompting t)
+ (gud-display-frame)))))
+
+(defun gud-gdbmi-marker-filter (string)
+ "Filter GDB/MI output."
+ (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
+ ;; 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
+ (let ((output ""))
+
+ (if (string-match gdb-running-regexp gud-marker-acc)
+ (setq gud-marker-acc (substring gud-marker-acc (match-end 0))
+ gud-running t))
+
+ ;; Remove the trimmings from the console stream.
+ (while (string-match gdb-console-regexp gud-marker-acc)
+ (setq
+ gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
+ (match-string 1 gud-marker-acc)
+ (substring gud-marker-acc (match-end 0)))))
+
+ ;; Remove log stream containing debugging messages being produced by GDB's
+ ;; internals.
+ (while (string-match gdb-internals-regexp gud-marker-acc)
+ (setq
+ gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
+ (substring gud-marker-acc (match-end 0)))))
+
+ (if (string-match gdb-stopped-regexp gud-marker-acc)
+ (setq
+
+ ;; Extract the frame position from the marker.
+ gud-last-frame (cons (match-string 2 gud-marker-acc)
+ (string-to-int (match-string 3 gud-marker-acc)))
+
+ ;; Append any text before the marker to the output we're going
+ ;; to return - we don't include the marker in this text.
+ output (gdbmi-concat-output output
+ (substring gud-marker-acc 0 (match-beginning 0)))
+
+ ;; Set the accumulator to the remaining text.
+ gud-marker-acc (substring gud-marker-acc (match-end 0))))
+
+ (while (string-match gdb-gdb-regexp gud-marker-acc)
+ (setq
+
+ ;; Append any text up to and including prompt less \n to the output.
+ output (gdbmi-concat-output output
+ (substring gud-marker-acc 0 (- (match-end 0) 1)))
+
+ ;; Set the accumulator to the remaining text.
+ gud-marker-acc (substring gud-marker-acc (match-end 0)))
+ (gdbmi-prompt))
+
+ (setq output (gdbmi-concat-output output gud-marker-acc))
+ (setq gud-marker-acc "")
+ output))
+
+(defun gdbmi-concat-output (so-far new)
+ (let ((sink gdb-output-sink))
+ (cond
+ ((eq sink 'user) (concat so-far new))
+ ((eq sink 'emacs)
+ (gdb-append-to-partial-output new)
+ so-far)
+ ((eq sink 'inferior)
+ (gdb-append-to-inferior-io new)
+ so-far))))
+\f
+
+;; Breakpoint buffer : This displays the output of `-break-list'.
+;;
+(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
+ ;; This defines the auto update rule for buffers of type
+ ;; `gdb-breakpoints-buffer'.
+ ;;
+ ;; It defines a function that queues the command below. That function is
+ ;; called:
+ gdbmi-invalidate-breakpoints
+ ;;
+ ;; To update the buffer, this command is sent to gdb.
+ "-break-list\n"
+ ;;
+ ;; This also defines a function to be the handler for the output
+ ;; from the command above. That function will copy the output into
+ ;; the appropriately typed buffer. That function will be called:
+ gdb-break-list-handler
+ ;; buffer specific functions
+ gdb-break-list-custom)
+
+(defconst gdb-break-list-regexp
+"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
+
+(defun gdb-break-list-handler ()
+ (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
+ gdb-pending-triggers))
+ (let ((breakpoint nil)
+ (breakpoints-list nil))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward gdb-break-list-regexp nil t)
+ (let ((breakpoint (list (match-string 1)
+ (match-string 2)
+ (match-string 3)
+ (match-string 4)
+ (match-string 5)
+ (match-string 6)
+ (match-string 7)
+ (match-string 8))))
+ (push breakpoint breakpoints-list))))
+ (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
+ (and buf (with-current-buffer buf
+ (let ((p (point))
+ (buffer-read-only nil))
+ (erase-buffer)
+ (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n")
+ (dolist (breakpoint breakpoints-list)
+ (insert (concat
+ (nth 0 breakpoint) " "
+ (nth 1 breakpoint) " "
+ (nth 2 breakpoint) " "
+ (nth 3 breakpoint) " "
+ (nth 5 breakpoint) "\t"
+ (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t"
+ (nth 4 breakpoint) "\n")))
+ (goto-char p))))))
+ (gdb-break-list-custom))
+
+;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
+(defun gdb-break-list-custom ()
+ (let ((flag)(address))
+ ;;
+ ;; remove all breakpoint-icons in source buffers but not assembler buffer
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (if (and (eq gud-minor-mode 'gdbmi)
+ (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
+ (gdb-remove-breakpoint-icons (point-min) (point-max)))))
+ (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ (while (< (point) (- (point-max) 1))
+ (forward-line 1)
+ (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
+ (progn
+ (setq flag (char-after (match-beginning 1)))
+ (let ((line (match-string 3)) (buffer-read-only nil)
+ (file (match-string 2)))
+ (add-text-properties (point-at-bol) (point-at-eol)
+ '(mouse-face highlight
+ help-echo "mouse-2, RET: visit breakpoint"))
+ (with-current-buffer
+ (find-file-noselect
+ (if (file-exists-p file) file
+ (expand-file-name file gdb-cdir)))
+ (save-current-buffer
+ (set (make-local-variable 'gud-minor-mode) 'gdbmi)
+ (set (make-local-variable 'tool-bar-map)
+ gud-tool-bar-map))
+ ;; only want one breakpoint icon at each location
+ (save-excursion
+ (goto-line (string-to-number line))
+ (gdb-put-breakpoint-icon (eq flag ?y)))))))))
+ (end-of-line)))
+ (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
+
+;; Frames buffer. This displays a perpetually correct bactrack trace.
+;;
+(def-gdb-auto-updated-buffer gdb-stack-buffer
+ gdbmi-invalidate-frames
+ "-stack-list-frames\n"
+ gdb-stack-list-frames-handler
+ gdb-stack-list-frames-custom)
+
+(defconst gdb-stack-list-frames-regexp
+"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
+
+(defun gdb-stack-list-frames-handler ()
+ (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
+ gdb-pending-triggers))
+ (let ((frame nil)
+ (call-stack nil))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward gdb-stack-list-frames-regexp nil t)
+ (let ((frame (list (match-string 1)
+ (match-string 2)
+ (match-string 3)
+ (match-string 4)
+ (match-string 5))))
+ (push frame call-stack))))
+ (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
+ (and buf (with-current-buffer buf
+ (let ((p (point))
+ (buffer-read-only nil))
+ (erase-buffer)
+ (insert "Level\tFunc\tFile:Line\tAddr\n")
+ (dolist (frame (nreverse call-stack))
+ (insert (concat
+ (nth 0 frame) "\t"
+ (nth 2 frame) "\t"
+ (nth 3 frame) ":" (nth 4 frame) "\t"
+ (nth 1 frame) "\n")))
+ (goto-char p))))))
+ (gdb-stack-list-frames-custom))
+
+(defun gdb-stack-list-frames-custom ()
+ (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (< (point) (point-max))
+ (add-text-properties (point-at-bol) (point-at-eol)
+ '(mouse-face highlight
+ help-echo "mouse-2, RET: Select frame"))
+ (beginning-of-line)
+ (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
+ (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
+ (equal (match-string 1) gdb-current-frame))
+ (put-text-property (point-at-bol) (point-at-eol)
+ 'face '(:inverse-video t)))
+ (forward-line 1))))))
+
+;; Locals buffer.
+;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards.
+(def-gdb-auto-updated-buffer gdb-locals-buffer
+ gdbmi-invalidate-locals
+ "-stack-list-locals 2\n"
+ gdb-stack-list-locals-handler
+ gdb-stack-list-locals-custom)
+
+(defconst gdb-stack-list-locals-regexp
+ (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))
+
+;; Dont display values of arrays or structures.
+;; These can be expanded using gud-watch.
+(defun gdb-stack-list-locals-handler nil
+ (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals
+ gdb-pending-triggers))
+ (let ((local nil)
+ (locals-list nil))
+ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
+ (goto-char (point-min))
+ (while (re-search-forward gdb-stack-list-locals-regexp nil t)
+ (let ((local (list (match-string 1)
+ (match-string 2)
+ nil)))
+ (if (looking-at ",value=\"\\(.*?\\)\"")
+ (setcar (nthcdr 2 local) (match-string 1)))
+ (push local locals-list))))
+ (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
+ (and buf (with-current-buffer buf
+ (let ((p (point))
+ (buffer-read-only nil))
+ (erase-buffer)
+ (dolist (local locals-list)
+ (insert
+ (concat (car local) "\t" (nth 1 local) "\t"
+ (or (nth 2 local)
+ (if (string-match "struct" (nth 1 local))
+ "(structure)"
+ "(array)"))
+ "\n")))
+ (goto-char p)))))))
+
+(defun gdb-stack-list-locals-custom ()
+ nil)
+
+(defun gdbmi-source-info ()
+ "Find the source file where the program starts and displays it with related
+buffers."
+ (goto-char (point-min))
+ (if (search-forward "source file is " nil t)
+ (if (looking-at "\\S-*")
+ (setq gdb-main-file (match-string 0)))
+ (setq gdb-view-source nil))
+ (if (search-forward "directory is " nil t)
+ (if (looking-at "\\S-*:\\(\\S-*\\)")
+ (setq gdb-cdir (match-string 1))
+ (looking-at "\\S-*")
+ (setq gdb-cdir (match-string 0))))
+
+;temporary heuristic
+ (if gdb-main-file
+ (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))
+
+ (if gdb-many-windows
+ (gdb-setup-windows)
+ (gdb-get-create-buffer 'gdb-breakpoints-buffer)
+ (when gdb-show-main
+ (switch-to-buffer gud-comint-buffer)
+ (delete-other-windows)
+ (split-window)
+ (other-window 1)
+ (switch-to-buffer
+ (if gdb-view-source
+ (gud-find-file gdb-main-file)
+ (gdb-get-create-buffer 'gdb-assembler-buffer)))
+ (other-window 1))))
+
+(provide 'gdb-mi)
+;;; gdbmi.el ends here
projects / binutils-gdb.git / commitdiff