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