Commit | Line | Data |
---|---|---|
44236a56 | 1 | ;;; gdb-mi.el |
aeea8b77 NR |
2 | |
3 | ;; Author: Nick Roberts <nickrob@gnu.org> | |
4 | ;; Maintainer: Nick Roberts <nickrob@gnu.org> | |
5 | ;; Keywords: unix, tools | |
6 | ||
0fb0cc75 JB |
7 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 |
8 | ;; Free Software Foundation, Inc. | |
aeea8b77 NR |
9 | |
10 | ;; This file is part of GNU GDB. | |
11 | ||
12 | ;; GNU GDB is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; This program is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;;; Commentary: | |
23 | ||
44236a56 NR |
24 | ;; This mode acts as a graphical user interface to GDB and works with Emacs |
25 | ;; 22.x and the version of GDB with which it is distributed. You can interact | |
26 | ;; with GDB through the GUD buffer in the usual way, but there are also | |
27 | ;; buffers which control the execution and describe the state of your program. | |
28 | ;; It separates the input/output of your program from that of GDB and displays | |
29 | ;; expressions and their current values in their own buffers. It also uses | |
30 | ;; features of Emacs 21 such as the fringe/display margin for breakpoints, and | |
31 | ;; the toolbar (see the GDB Graphical Interface section in the Emacs info | |
32 | ;; manual). | |
aeea8b77 NR |
33 | |
34 | ;; Start the debugger with M-x gdbmi. | |
35 | ||
36 | ;; This file uses GDB/MI as the primary interface to GDB. It is still under | |
44236a56 NR |
37 | ;; development and is part of a process to migrate Emacs from annotations (as |
38 | ;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and | |
39 | ;; access CLI using "-interpreter-exec console cli-command". | |
317531b2 | 40 | |
e93364c8 | 41 | ;; This mode acts on top of gdb-ui.el. After the release of 22.1, |
317531b2 NR |
42 | ;; mainline Emacs in the CVS repository will have a file also called gdb-mi.el |
43 | ;; which will *replace* gdb-ui.el. If you are interested in developing | |
44 | ;; this mode you should get this version. | |
44236a56 | 45 | ;; |
aeea8b77 NR |
46 | ;; Known Bugs: |
47 | ;; | |
44236a56 NR |
48 | ;; 1) To handle program input, if required, and to avoid extra output in the |
49 | ;; GUD buffer you must not use run, step, next or continue etc but their MI | |
50 | ;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate | |
51 | ;; icon in the toolbar. | |
44236a56 | 52 | ;; 2) Some commands send extra prompts to the GUD buffer. |
b6637a13 | 53 | ;; 3) Doesn't list catchpoints in breakpoints buffer. |
44236a56 NR |
54 | ;; |
55 | ;; TODO: | |
56 | ;; 1) Prefix MI commands with a token instead of queueing commands. | |
57 | ;; 2) Use MI command -data-read-memory for memory window. | |
58 | ;; 3) Use MI command -data-disassemble for disassembly window. | |
59 | ;; 4) Allow separate buffers for Inferior IO and GDB IO. | |
60 | ;; 5) Watch windows to work with threads. | |
61 | ;; | |
aeea8b77 NR |
62 | ;;; Code: |
63 | ||
64 | (require 'gud) | |
65 | (require 'gdb-ui) | |
44236a56 | 66 | |
44236a56 NR |
67 | (defvar gdb-last-command nil) |
68 | (defvar gdb-prompt-name nil) | |
aeea8b77 NR |
69 | |
70 | ;;;###autoload | |
71 | (defun gdbmi (command-line) | |
72 | "Run gdb on program FILE in buffer *gud-FILE*. | |
73 | The directory containing FILE becomes the initial working directory | |
74 | and source-file directory for your debugger. | |
75 | ||
76 | If `gdb-many-windows' is nil (the default value) then gdb just | |
77 | pops up the GUD buffer unless `gdb-show-main' is t. In this case | |
78 | it starts with two windows: one displaying the GUD buffer and the | |
79 | other with the source file with the main routine of the inferior. | |
80 | ||
81 | If `gdb-many-windows' is t, regardless of the value of | |
82 | `gdb-show-main', the layout below will appear. Keybindings are | |
83 | given in relevant buffer. | |
84 | ||
85 | Watch expressions appear in the speedbar/slowbar. | |
86 | ||
a2140d4d | 87 | The following commands help control operation : |
aeea8b77 NR |
88 | |
89 | `gdb-many-windows' - Toggle the number of windows gdb uses. | |
90 | `gdb-restore-windows' - To restore the window layout. | |
91 | ||
92 | See Info node `(emacs)GDB Graphical Interface' for a more | |
93 | detailed description of this mode. | |
94 | ||
95 | ||
a2140d4d NR |
96 | +--------------------------------------------------------------+ |
97 | | GDB Toolbar | | |
98 | +-------------------------------+------------------------------+ | |
99 | | GUD buffer (I/O of GDB) | Locals buffer | | |
100 | | | | | |
101 | | | | | |
102 | | | | | |
103 | +-------------------------------+------------------------------+ | |
104 | | Source buffer | | |
105 | | | | |
106 | | | | |
107 | | | | |
108 | | | | |
109 | | | | |
110 | | | | |
111 | | | | |
112 | +-------------------------------+------------------------------+ | |
113 | | Stack buffer | Breakpoints buffer | | |
114 | | RET gdb-frames-select | SPC gdb-toggle-breakpoint | | |
115 | | | RET gdb-goto-breakpoint | | |
116 | | | d gdb-delete-breakpoint | | |
117 | +-------------------------------+------------------------------+" | |
aeea8b77 NR |
118 | ;; |
119 | (interactive (list (gud-query-cmdline 'gdbmi))) | |
120 | ;; | |
121 | ;; Let's start with a basic gud-gdb buffer and then modify it a bit. | |
122 | (gdb command-line) | |
123 | ;; | |
897731a2 | 124 | (setq gdb-debug-ring nil) |
aeea8b77 NR |
125 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) |
126 | (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter) | |
127 | ;; | |
44236a56 NR |
128 | (gud-def gud-step "-exec-step %p" "\C-s" |
129 | "Step one source line with display.") | |
130 | (gud-def gud-stepi "-exec-step-instruction %p" "\C-i" | |
131 | "Step one instruction with display.") | |
132 | (gud-def gud-next "-exec-next %p" "\C-n" | |
133 | "Step one line (skip functions).") | |
134 | (gud-def gud-cont "-exec-continue" "\C-r" | |
135 | "Continue with display.") | |
136 | (gud-def gud-finish "-exec-finish" "\C-f" | |
137 | "Finish executing current function.") | |
138 | (gud-def gud-run "-exec-run" nil "Run the program.") | |
aeea8b77 | 139 | (gud-def gud-break (if (not (string-equal mode-name "Machine")) |
44236a56 | 140 | (gud-call "break %f:%l" arg) |
aeea8b77 NR |
141 | (save-excursion |
142 | (beginning-of-line) | |
143 | (forward-char 2) | |
44236a56 | 144 | (gud-call "break *%a" arg))) |
aeea8b77 NR |
145 | "\C-b" "Set breakpoint at current line or address.") |
146 | ;; | |
147 | (gud-def gud-remove (if (not (string-equal mode-name "Machine")) | |
148 | (gud-call "clear %f:%l" arg) | |
149 | (save-excursion | |
150 | (beginning-of-line) | |
151 | (forward-char 2) | |
152 | (gud-call "clear *%a" arg))) | |
153 | "\C-d" "Remove breakpoint at current line or address.") | |
154 | ;; | |
155 | (gud-def gud-until (if (not (string-equal mode-name "Machine")) | |
44236a56 | 156 | (gud-call "-exec-until %f:%l" arg) |
aeea8b77 NR |
157 | (save-excursion |
158 | (beginning-of-line) | |
159 | (forward-char 2) | |
44236a56 | 160 | (gud-call "-exec-until *%a" arg))) |
aeea8b77 NR |
161 | "\C-u" "Continue to current line or address.") |
162 | ||
163 | (define-key gud-minor-mode-map [left-margin mouse-1] | |
44236a56 | 164 | 'gdb-mouse-set-clear-breakpoint) |
aeea8b77 | 165 | (define-key gud-minor-mode-map [left-fringe mouse-1] |
44236a56 | 166 | 'gdb-mouse-set-clear-breakpoint) |
a2140d4d NR |
167 | (define-key gud-minor-mode-map [left-fringe mouse-2] |
168 | 'gdb-mouse-until) | |
169 | (define-key gud-minor-mode-map [left-fringe drag-mouse-1] | |
170 | 'gdb-mouse-until) | |
44236a56 | 171 | (define-key gud-minor-mode-map [left-margin mouse-3] |
a2140d4d NR |
172 | 'gdb-mouse-toggle-breakpoint-margin) |
173 | (define-key gud-minor-mode-map [left-fringe mouse-3] | |
174 | 'gdb-mouse-toggle-breakpoint-fringe) | |
aeea8b77 NR |
175 | |
176 | (setq comint-input-sender 'gdbmi-send) | |
177 | ;; | |
178 | ;; (re-)initialise | |
2e6d207c | 179 | (setq gdb-pc-address (if gdb-show-main "main" nil) |
44236a56 NR |
180 | gdb-previous-frame-address nil |
181 | gdb-memory-address "main" | |
182 | gdb-previous-frame nil | |
183 | gdb-selected-frame nil | |
184 | gdb-frame-number nil | |
185 | gdb-var-list nil | |
44236a56 NR |
186 | gdb-prompting nil |
187 | gdb-input-queue nil | |
188 | gdb-current-item nil | |
189 | gdb-pending-triggers nil | |
190 | gdb-output-sink 'user | |
191 | gdb-server-prefix nil | |
192 | gdb-flush-pending-output nil | |
193 | gdb-location-alist nil | |
44236a56 NR |
194 | gdb-source-file-list nil |
195 | gdb-last-command nil | |
f0afd306 NR |
196 | gdb-prompt-name nil |
197 | gdb-buffer-fringe-width (car (window-fringes))) | |
317531b2 NR |
198 | gdb-debug-ring nil |
199 | gdb-source-window nil | |
200 | gdb-inferior-status nil | |
201 | gdb-continuation nil | |
aeea8b77 NR |
202 | ;; |
203 | (setq gdb-buffer-type 'gdbmi) | |
204 | ;; | |
205 | ;; FIXME: use tty command to separate io. | |
206 | ;;(gdb-clear-inferior-io) | |
207 | ;; | |
208 | (if (eq window-system 'w32) | |
209 | (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore))) | |
44236a56 | 210 | (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore)) |
aeea8b77 | 211 | ;; find source file and compilation directory here |
44236a56 NR |
212 | (gdb-enqueue-input |
213 | ; Needs GDB 6.2 onwards. | |
48fc115b NR |
214 | (list "-file-list-exec-source-files\n" |
215 | 'gdb-set-gud-minor-mode-existing-buffers-1)) | |
44236a56 NR |
216 | (gdb-enqueue-input |
217 | ; Needs GDB 6.0 onwards. | |
218 | (list "-file-list-exec-source-file\n" 'gdb-get-source-file)) | |
219 | (gdb-enqueue-input | |
220 | (list "-data-list-register-names\n" 'gdb-get-register-names)) | |
221 | (gdb-enqueue-input | |
222 | (list "-gdb-show prompt\n" 'gdb-get-prompt)) | |
aeea8b77 | 223 | ;; |
b6637a13 | 224 | (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2) |
aeea8b77 NR |
225 | (run-hooks 'gdbmi-mode-hook)) |
226 | ||
44236a56 | 227 | \f |
aeea8b77 NR |
228 | (defun gdbmi-send (proc string) |
229 | "A comint send filter for gdb." | |
44236a56 NR |
230 | (if gud-running |
231 | (process-send-string proc (concat string "\n")) | |
232 | (with-current-buffer gud-comint-buffer | |
317531b2 NR |
233 | (let ((inhibit-read-only t)) |
234 | (remove-text-properties (point-min) (point-max) '(face)))) | |
44236a56 NR |
235 | (setq gdb-output-sink 'user) |
236 | (setq gdb-prompting nil) | |
237 | ;; mimic <RET> key to repeat previous command in GDB | |
2e6d207c | 238 | (if (not (string-match "^\\s+$" string)) |
317531b2 | 239 | (setq gdb-last-command string) |
44236a56 | 240 | (if gdb-last-command (setq string gdb-last-command))) |
897731a2 NR |
241 | (if gdb-enable-debug |
242 | (push (cons 'mi-send (concat string "\n")) gdb-debug-ring)) | |
44236a56 NR |
243 | (if (string-match "^-" string) |
244 | ;; MI command | |
897731a2 | 245 | (process-send-string proc (concat string "\n")) |
44236a56 | 246 | ;; CLI command |
897731a2 NR |
247 | (if (string-match "\\\\$" string) |
248 | (setq gdb-continuation (concat gdb-continuation string "\n")) | |
249 | (process-send-string proc | |
250 | (concat "-interpreter-exec console \"" | |
251 | gdb-continuation string "\"\n")) | |
252 | (setq gdb-continuation nil))))) | |
44236a56 NR |
253 | |
254 | (defcustom gud-gdbmi-command-name "gdb -interp=mi" | |
aeea8b77 NR |
255 | "Default command to execute an executable under the GDB-UI debugger." |
256 | :type 'string | |
257 | :group 'gud) | |
258 | ||
44236a56 | 259 | (defconst gdb-gdb-regexp "(gdb) \n") |
aeea8b77 | 260 | |
44236a56 | 261 | (defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp)) |
aeea8b77 | 262 | |
44236a56 NR |
263 | ;; fullname added GDB 6.4+. |
264 | ;; Probably not needed. -stack-info-frame computes filename and line. | |
265 | (defconst gdb-stopped-regexp | |
266 | "\\*stopped,reason=.*?,file=\".*?\"\ | |
267 | ,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n") | |
aeea8b77 | 268 | |
44236a56 NR |
269 | (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n") |
270 | ||
271 | (defconst gdb-done-regexp "\\^done,*\n*") | |
aeea8b77 | 272 | |
44236a56 | 273 | (defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n") |
aeea8b77 | 274 | |
44236a56 NR |
275 | (defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n") |
276 | ||
277 | (defun gdbmi-prompt1 () | |
278 | "Queue any GDB commands that the user interface needs." | |
aeea8b77 | 279 | (unless gdb-pending-triggers |
44236a56 NR |
280 | (gdbmi-get-selected-frame) |
281 | (gdbmi-invalidate-frames) | |
282 | (gdbmi-invalidate-breakpoints) | |
283 | (gdb-get-changed-registers) | |
48fc115b | 284 | (gdb-invalidate-registers-1) |
317531b2 NR |
285 | (gdb-invalidate-locals-1) |
286 | (if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) | |
287 | (gdb-var-update-1)))) | |
44236a56 NR |
288 | |
289 | (defun gdbmi-prompt2 () | |
290 | "Handle any output and send next GDB command." | |
aeea8b77 NR |
291 | (let ((sink gdb-output-sink)) |
292 | (when (eq sink 'emacs) | |
293 | (let ((handler | |
294 | (car (cdr gdb-current-item)))) | |
897731a2 | 295 | (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) |
aeea8b77 NR |
296 | (funcall handler))))) |
297 | (let ((input (gdb-dequeue-input))) | |
298 | (if input | |
299 | (gdb-send-item input) | |
300 | (progn | |
301 | (setq gud-running nil) | |
302 | (setq gdb-prompting t) | |
303 | (gud-display-frame))))) | |
304 | ||
305 | (defun gud-gdbmi-marker-filter (string) | |
306 | "Filter GDB/MI output." | |
44236a56 NR |
307 | (if gdb-flush-pending-output |
308 | nil | |
897731a2 NR |
309 | (if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink)) |
310 | gdb-debug-ring)) | |
44236a56 NR |
311 | ;; Recall the left over gud-marker-acc from last time |
312 | (setq gud-marker-acc (concat gud-marker-acc string)) | |
313 | ;; Start accumulating output for the GUD buffer | |
317531b2 | 314 | (let ((output "") running) |
44236a56 NR |
315 | |
316 | (if (string-match gdb-running-regexp gud-marker-acc) | |
317 | (setq | |
318 | gud-marker-acc | |
319 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
320 | (substring gud-marker-acc (match-end 0))) | |
317531b2 | 321 | running t)) |
44236a56 NR |
322 | |
323 | (if (string-match gdb-stopped-regexp gud-marker-acc) | |
324 | (setq | |
325 | ||
326 | ;; Extract the frame position from the marker. | |
327 | gud-last-frame (cons (match-string 1 gud-marker-acc) | |
328 | (string-to-number | |
329 | (match-string 2 gud-marker-acc))) | |
330 | ||
331 | gud-marker-acc | |
332 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
333 | (substring gud-marker-acc (match-end 0))))) | |
334 | ||
335 | ;; Filter error messages going to GUD buffer and | |
336 | ;; display in minibuffer. | |
317531b2 NR |
337 | (when (eq gdb-output-sink 'user) |
338 | (while (string-match gdb-error-regexp gud-marker-acc) | |
339 | (message (read (match-string 1 gud-marker-acc))) | |
44236a56 NR |
340 | (setq |
341 | gud-marker-acc | |
342 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
343 | (substring gud-marker-acc (match-end 0))))) | |
344 | ||
317531b2 NR |
345 | (if (string-match gdb-done-regexp gud-marker-acc) |
346 | (setq | |
347 | gud-marker-acc | |
348 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
349 | (substring gud-marker-acc (match-end 0)))))) | |
350 | ||
44236a56 NR |
351 | (when (string-match gdb-gdb-regexp gud-marker-acc) |
352 | (setq | |
353 | gud-marker-acc | |
354 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
355 | (substring gud-marker-acc (match-end 0)))) | |
356 | ||
357 | ;; Remove the trimmings from the console stream. | |
358 | (while (string-match gdb-console-regexp gud-marker-acc) | |
359 | (setq | |
360 | gud-marker-acc (concat | |
361 | (substring gud-marker-acc 0 (match-beginning 0)) | |
362 | (read (match-string 1 gud-marker-acc)) | |
363 | (substring gud-marker-acc (match-end 0))))) | |
364 | ||
365 | ;; Remove the trimmings from log stream containing debugging messages | |
366 | ;; being produced by GDB's internals and use warning face. | |
367 | (while (string-match gdb-internals-regexp gud-marker-acc) | |
368 | (setq | |
369 | gud-marker-acc | |
370 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
371 | (let ((error-message | |
372 | (read (match-string 1 gud-marker-acc)))) | |
373 | (put-text-property | |
374 | 0 (length error-message) | |
375 | 'face font-lock-warning-face | |
376 | error-message) | |
377 | error-message) | |
378 | (substring gud-marker-acc (match-end 0))))) | |
379 | ||
380 | (setq output (gdbmi-concat-output output gud-marker-acc)) | |
381 | (setq gud-marker-acc "") | |
382 | (gdbmi-prompt1) | |
383 | (unless gdb-input-queue | |
384 | (setq output (concat output gdb-prompt-name))) | |
317531b2 NR |
385 | (gdbmi-prompt2) |
386 | (setq gud-running running)) | |
44236a56 NR |
387 | |
388 | (when gud-running | |
389 | (setq output (gdbmi-concat-output output gud-marker-acc)) | |
390 | (setq gud-marker-acc "")) | |
391 | ||
392 | output))) | |
aeea8b77 NR |
393 | |
394 | (defun gdbmi-concat-output (so-far new) | |
395 | (let ((sink gdb-output-sink)) | |
396 | (cond | |
397 | ((eq sink 'user) (concat so-far new)) | |
398 | ((eq sink 'emacs) | |
399 | (gdb-append-to-partial-output new) | |
400 | so-far) | |
401 | ((eq sink 'inferior) | |
402 | (gdb-append-to-inferior-io new) | |
403 | so-far)))) | |
404 | \f | |
405 | ||
406 | ;; Breakpoint buffer : This displays the output of `-break-list'. | |
407 | ;; | |
a2140d4d NR |
408 | (def-gdb-auto-update-trigger gdbmi-invalidate-breakpoints |
409 | (gdb-get-buffer 'gdb-breakpoints-buffer) | |
aeea8b77 | 410 | "-break-list\n" |
a2140d4d | 411 | gdb-break-list-handler) |
aeea8b77 NR |
412 | |
413 | (defconst gdb-break-list-regexp | |
897731a2 NR |
414 | "bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\ |
415 | enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\ | |
416 | file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\ | |
417 | \\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}") | |
aeea8b77 NR |
418 | |
419 | (defun gdb-break-list-handler () | |
420 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints | |
421 | gdb-pending-triggers)) | |
44236a56 | 422 | (let ((breakpoint) (breakpoints-list)) |
897731a2 | 423 | (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) |
aeea8b77 NR |
424 | (goto-char (point-min)) |
425 | (while (re-search-forward gdb-break-list-regexp nil t) | |
426 | (let ((breakpoint (list (match-string 1) | |
427 | (match-string 2) | |
428 | (match-string 3) | |
429 | (match-string 4) | |
430 | (match-string 5) | |
431 | (match-string 6) | |
432 | (match-string 7) | |
48fc115b NR |
433 | (match-string 8) |
434 | (match-string 9) | |
435 | (match-string 10)))) | |
aeea8b77 NR |
436 | (push breakpoint breakpoints-list)))) |
437 | (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) | |
438 | (and buf (with-current-buffer buf | |
439 | (let ((p (point)) | |
440 | (buffer-read-only nil)) | |
441 | (erase-buffer) | |
48fc115b | 442 | (insert "Num Type Disp Enb Hits Addr What\n") |
aeea8b77 | 443 | (dolist (breakpoint breakpoints-list) |
48fc115b NR |
444 | (insert |
445 | (concat | |
446 | (nth 0 breakpoint) " " | |
447 | (nth 1 breakpoint) " " | |
448 | (nth 2 breakpoint) " " | |
449 | (nth 3 breakpoint) " " | |
450 | (nth 9 breakpoint) " " | |
451 | (nth 4 breakpoint) " " | |
452 | (if (nth 5 breakpoint) | |
453 | (concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n") | |
454 | (concat (nth 8 breakpoint) "\n"))))) | |
aeea8b77 | 455 | (goto-char p)))))) |
48fc115b | 456 | (gdb-info-breakpoints-custom)) |
a2140d4d | 457 | |
44236a56 NR |
458 | (defun gdbmi-get-location (bptno line flag) |
459 | "Find the directory containing the relevant source file. | |
460 | Put in buffer and place breakpoint icon." | |
461 | (goto-char (point-min)) | |
462 | (catch 'file-not-found | |
48fc115b | 463 | (if (re-search-forward gdb-source-file-regexp-1 nil t) |
44236a56 NR |
464 | (delete (cons bptno "File not found") gdb-location-alist) |
465 | (push (cons bptno (match-string 1)) gdb-location-alist) | |
466 | (gdb-resync) | |
467 | (unless (assoc bptno gdb-location-alist) | |
468 | (push (cons bptno "File not found") gdb-location-alist) | |
469 | (message-box "Cannot find source file for breakpoint location. | |
470 | Add directory to search path for source files using the GDB command, dir.")) | |
471 | (throw 'file-not-found nil)) | |
472 | (with-current-buffer | |
473 | (find-file-noselect (match-string 1)) | |
474 | (save-current-buffer | |
475 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | |
476 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)) | |
477 | ;; only want one breakpoint icon at each location | |
478 | (save-excursion | |
479 | (goto-line (string-to-number line)) | |
480 | (gdb-put-breakpoint-icon (eq flag ?y) bptno))))) | |
481 | ||
aeea8b77 NR |
482 | ;; Frames buffer. This displays a perpetually correct bactrack trace. |
483 | ;; | |
a2140d4d NR |
484 | (def-gdb-auto-update-trigger gdbmi-invalidate-frames |
485 | (gdb-get-buffer 'gdb-stack-buffer) | |
aeea8b77 | 486 | "-stack-list-frames\n" |
a2140d4d NR |
487 | gdb-stack-list-frames-handler) |
488 | ||
aeea8b77 | 489 | (defconst gdb-stack-list-frames-regexp |
897731a2 NR |
490 | "{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\ |
491 | \\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\ | |
48fc115b | 492 | from=\"\\(.*?\\)\"\\)") |
aeea8b77 NR |
493 | |
494 | (defun gdb-stack-list-frames-handler () | |
495 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames | |
496 | gdb-pending-triggers)) | |
497 | (let ((frame nil) | |
498 | (call-stack nil)) | |
897731a2 | 499 | (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) |
aeea8b77 NR |
500 | (goto-char (point-min)) |
501 | (while (re-search-forward gdb-stack-list-frames-regexp nil t) | |
502 | (let ((frame (list (match-string 1) | |
503 | (match-string 2) | |
504 | (match-string 3) | |
505 | (match-string 4) | |
48fc115b NR |
506 | (match-string 5) |
507 | (match-string 6)))) | |
aeea8b77 NR |
508 | (push frame call-stack)))) |
509 | (let ((buf (gdb-get-buffer 'gdb-stack-buffer))) | |
510 | (and buf (with-current-buffer buf | |
511 | (let ((p (point)) | |
512 | (buffer-read-only nil)) | |
513 | (erase-buffer) | |
48fc115b | 514 | (insert "Level\tAddr\tFunc\tFile:Line\n") |
aeea8b77 | 515 | (dolist (frame (nreverse call-stack)) |
48fc115b NR |
516 | (insert |
517 | (concat | |
518 | (nth 0 frame) "\t" | |
519 | (nth 1 frame) "\t" | |
317531b2 NR |
520 | (propertize (nth 2 frame) |
521 | 'face font-lock-function-name-face) "\t" | |
48fc115b NR |
522 | (if (nth 3 frame) |
523 | (concat "at "(nth 3 frame) ":" (nth 4 frame) "\n") | |
524 | (concat "from " (nth 5 frame) "\n"))))) | |
aeea8b77 NR |
525 | (goto-char p)))))) |
526 | (gdb-stack-list-frames-custom)) | |
527 | ||
528 | (defun gdb-stack-list-frames-custom () | |
529 | (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) | |
530 | (save-excursion | |
531 | (let ((buffer-read-only nil)) | |
532 | (goto-char (point-min)) | |
533 | (forward-line 1) | |
534 | (while (< (point) (point-max)) | |
535 | (add-text-properties (point-at-bol) (point-at-eol) | |
536 | '(mouse-face highlight | |
537 | help-echo "mouse-2, RET: Select frame")) | |
538 | (beginning-of-line) | |
44236a56 NR |
539 | (when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)") |
540 | (equal (match-string 1) gdb-selected-frame)) | |
aeea8b77 NR |
541 | (put-text-property (point-at-bol) (point-at-eol) |
542 | 'face '(:inverse-video t))) | |
543 | (forward-line 1)))))) | |
544 | ||
44236a56 | 545 | \f |
48fc115b | 546 | ;; gdb-ui.el uses "info source" to find out if macro information is present. |
44236a56 NR |
547 | (defun gdb-get-source-file () |
548 | "Find the source file where the program starts and display it with related | |
549 | buffers, if required." | |
aeea8b77 | 550 | (goto-char (point-min)) |
48fc115b | 551 | (if (re-search-forward gdb-source-file-regexp-1 nil t) |
44236a56 NR |
552 | (setq gdb-main-file (match-string 1))) |
553 | (if gdb-many-windows | |
aeea8b77 | 554 | (gdb-setup-windows) |
897731a2 | 555 | (gdb-get-buffer-create 'gdb-breakpoints-buffer) |
44236a56 NR |
556 | (if gdb-show-main |
557 | (let ((pop-up-windows t)) | |
558 | (display-buffer (gud-find-file gdb-main-file)))))) | |
aeea8b77 | 559 | |
44236a56 NR |
560 | (defun gdbmi-get-selected-frame () |
561 | (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers)) | |
562 | (progn | |
563 | (gdb-enqueue-input | |
564 | (list "-stack-info-frame\n" 'gdbmi-frame-handler)) | |
565 | (push 'gdbmi-get-selected-frame | |
566 | gdb-pending-triggers)))) | |
567 | ||
568 | (defun gdbmi-frame-handler () | |
569 | (setq gdb-pending-triggers | |
570 | (delq 'gdbmi-get-selected-frame gdb-pending-triggers)) | |
897731a2 | 571 | (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) |
44236a56 NR |
572 | (goto-char (point-min)) |
573 | (when (re-search-forward gdb-stack-list-frames-regexp nil t) | |
574 | (setq gdb-frame-number (match-string 1)) | |
2e6d207c | 575 | (setq gdb-pc-address (match-string 2)) |
44236a56 | 576 | (setq gdb-selected-frame (match-string 3)) |
2e6d207c NR |
577 | (when (match-string 4) |
578 | (setq gud-last-frame | |
579 | (cons (match-string 4) (string-to-number (match-string 5)))) | |
580 | (gud-display-frame) | |
581 | (if gud-overlay-arrow-position | |
582 | (let ((buffer (marker-buffer gud-overlay-arrow-position)) | |
583 | (position (marker-position gud-overlay-arrow-position))) | |
584 | (when buffer | |
585 | (with-current-buffer buffer | |
586 | (setq fringe-indicator-alist | |
587 | (if (string-equal gdb-frame-number "0") | |
588 | nil | |
589 | '((overlay-arrow . hollow-right-triangle)))) | |
590 | (setq gud-overlay-arrow-position (make-marker)) | |
591 | (set-marker gud-overlay-arrow-position position)))))) | |
44236a56 NR |
592 | (if (gdb-get-buffer 'gdb-locals-buffer) |
593 | (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) | |
594 | (setq mode-name (concat "Locals:" gdb-selected-frame)))) | |
595 | (if (gdb-get-buffer 'gdb-assembler-buffer) | |
596 | (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) | |
597 | (setq mode-name (concat "Machine:" gdb-selected-frame))))))) | |
598 | ||
599 | (defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"") | |
600 | ||
601 | (defun gdb-get-prompt () | |
602 | "Find prompt for GDB session." | |
603 | (goto-char (point-min)) | |
604 | (setq gdb-prompt-name nil) | |
605 | (re-search-forward gdb-prompt-name-regexp nil t) | |
606 | (setq gdb-prompt-name (match-string 1))) | |
607 | ||
aeea8b77 NR |
608 | (provide 'gdb-mi) |
609 | ;;; gdbmi.el ends here |