From 0aba2a0d6ee6d404ee4552408df4680fce44956e Mon Sep 17 00:00:00 2001 From: Andrew Cagney Date: Mon, 26 Jul 2004 21:52:44 +0000 Subject: Index: ChangeLog 2004-07-26 Andrew Cagney * gdb-mi.el: Move from here ... * mi/gdb-mi.el: ... to here. --- gdb/gdb-mi.el | 568 ------------------------------------------------------- gdb/mi/gdb-mi.el | 568 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 568 insertions(+), 568 deletions(-) delete mode 100644 gdb/gdb-mi.el create mode 100644 gdb/mi/gdb-mi.el diff --git a/gdb/gdb-mi.el b/gdb/gdb-mi.el deleted file mode 100644 index 8780e8aa4ae..00000000000 --- a/gdb/gdb-mi.el +++ /dev/null @@ -1,568 +0,0 @@ -;;; 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 -;; Maintainer: Nick Roberts -;; 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) - - -;;;###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)))))) - -;(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)))) - - -;; 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 diff --git a/gdb/mi/gdb-mi.el b/gdb/mi/gdb-mi.el new file mode 100644 index 00000000000..8780e8aa4ae --- /dev/null +++ b/gdb/mi/gdb-mi.el @@ -0,0 +1,568 @@ +;;; 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 +;; Maintainer: Nick Roberts +;; 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) + + +;;;###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)))))) + +;(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)))) + + +;; 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 -- cgit v1.2.1