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 | ||
b6637a13 | 7 | ;; Copyright (C) 2004, 2005, 2006 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". | |
39 | ;; | |
aeea8b77 NR |
40 | ;; Known Bugs: |
41 | ;; | |
44236a56 NR |
42 | ;; 1) To handle program input, if required, and to avoid extra output in the |
43 | ;; GUD buffer you must not use run, step, next or continue etc but their MI | |
44 | ;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate | |
45 | ;; icon in the toolbar. | |
44236a56 | 46 | ;; 2) Some commands send extra prompts to the GUD buffer. |
b6637a13 | 47 | ;; 3) Doesn't list catchpoints in breakpoints buffer. |
44236a56 NR |
48 | ;; |
49 | ;; TODO: | |
50 | ;; 1) Prefix MI commands with a token instead of queueing commands. | |
51 | ;; 2) Use MI command -data-read-memory for memory window. | |
52 | ;; 3) Use MI command -data-disassemble for disassembly window. | |
53 | ;; 4) Allow separate buffers for Inferior IO and GDB IO. | |
54 | ;; 5) Watch windows to work with threads. | |
55 | ;; | |
aeea8b77 NR |
56 | ;;; Code: |
57 | ||
58 | (require 'gud) | |
59 | (require 'gdb-ui) | |
44236a56 | 60 | |
a2140d4d | 61 | (defvar gdb-source-file-list nil) |
44236a56 NR |
62 | (defvar gdb-register-names nil "List of register names.") |
63 | (defvar gdb-changed-registers nil | |
64 | "List of changed register numbers (strings).") | |
65 | (defvar gdb-last-command nil) | |
66 | (defvar gdb-prompt-name nil) | |
aeea8b77 NR |
67 | |
68 | ;;;###autoload | |
69 | (defun gdbmi (command-line) | |
70 | "Run gdb on program FILE in buffer *gud-FILE*. | |
71 | The directory containing FILE becomes the initial working directory | |
72 | and source-file directory for your debugger. | |
73 | ||
74 | If `gdb-many-windows' is nil (the default value) then gdb just | |
75 | pops up the GUD buffer unless `gdb-show-main' is t. In this case | |
76 | it starts with two windows: one displaying the GUD buffer and the | |
77 | other with the source file with the main routine of the inferior. | |
78 | ||
79 | If `gdb-many-windows' is t, regardless of the value of | |
80 | `gdb-show-main', the layout below will appear. Keybindings are | |
81 | given in relevant buffer. | |
82 | ||
83 | Watch expressions appear in the speedbar/slowbar. | |
84 | ||
a2140d4d | 85 | The following commands help control operation : |
aeea8b77 NR |
86 | |
87 | `gdb-many-windows' - Toggle the number of windows gdb uses. | |
88 | `gdb-restore-windows' - To restore the window layout. | |
89 | ||
90 | See Info node `(emacs)GDB Graphical Interface' for a more | |
91 | detailed description of this mode. | |
92 | ||
93 | ||
a2140d4d NR |
94 | +--------------------------------------------------------------+ |
95 | | GDB Toolbar | | |
96 | +-------------------------------+------------------------------+ | |
97 | | GUD buffer (I/O of GDB) | Locals buffer | | |
98 | | | | | |
99 | | | | | |
100 | | | | | |
101 | +-------------------------------+------------------------------+ | |
102 | | Source buffer | | |
103 | | | | |
104 | | | | |
105 | | | | |
106 | | | | |
107 | | | | |
108 | | | | |
109 | | | | |
110 | +-------------------------------+------------------------------+ | |
111 | | Stack buffer | Breakpoints buffer | | |
112 | | RET gdb-frames-select | SPC gdb-toggle-breakpoint | | |
113 | | | RET gdb-goto-breakpoint | | |
114 | | | d gdb-delete-breakpoint | | |
115 | +-------------------------------+------------------------------+" | |
aeea8b77 NR |
116 | ;; |
117 | (interactive (list (gud-query-cmdline 'gdbmi))) | |
118 | ;; | |
119 | ;; Let's start with a basic gud-gdb buffer and then modify it a bit. | |
120 | (gdb command-line) | |
121 | ;; | |
122 | (setq gdb-debug-log nil) | |
123 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | |
124 | (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter) | |
125 | ;; | |
44236a56 NR |
126 | (gud-def gud-step "-exec-step %p" "\C-s" |
127 | "Step one source line with display.") | |
128 | (gud-def gud-stepi "-exec-step-instruction %p" "\C-i" | |
129 | "Step one instruction with display.") | |
130 | (gud-def gud-next "-exec-next %p" "\C-n" | |
131 | "Step one line (skip functions).") | |
132 | (gud-def gud-cont "-exec-continue" "\C-r" | |
133 | "Continue with display.") | |
134 | (gud-def gud-finish "-exec-finish" "\C-f" | |
135 | "Finish executing current function.") | |
136 | (gud-def gud-run "-exec-run" nil "Run the program.") | |
aeea8b77 | 137 | (gud-def gud-break (if (not (string-equal mode-name "Machine")) |
44236a56 | 138 | (gud-call "break %f:%l" arg) |
aeea8b77 NR |
139 | (save-excursion |
140 | (beginning-of-line) | |
141 | (forward-char 2) | |
44236a56 | 142 | (gud-call "break *%a" arg))) |
aeea8b77 NR |
143 | "\C-b" "Set breakpoint at current line or address.") |
144 | ;; | |
145 | (gud-def gud-remove (if (not (string-equal mode-name "Machine")) | |
146 | (gud-call "clear %f:%l" arg) | |
147 | (save-excursion | |
148 | (beginning-of-line) | |
149 | (forward-char 2) | |
150 | (gud-call "clear *%a" arg))) | |
151 | "\C-d" "Remove breakpoint at current line or address.") | |
152 | ;; | |
153 | (gud-def gud-until (if (not (string-equal mode-name "Machine")) | |
44236a56 | 154 | (gud-call "-exec-until %f:%l" arg) |
aeea8b77 NR |
155 | (save-excursion |
156 | (beginning-of-line) | |
157 | (forward-char 2) | |
44236a56 | 158 | (gud-call "-exec-until *%a" arg))) |
aeea8b77 NR |
159 | "\C-u" "Continue to current line or address.") |
160 | ||
161 | (define-key gud-minor-mode-map [left-margin mouse-1] | |
44236a56 | 162 | 'gdb-mouse-set-clear-breakpoint) |
aeea8b77 | 163 | (define-key gud-minor-mode-map [left-fringe mouse-1] |
44236a56 | 164 | 'gdb-mouse-set-clear-breakpoint) |
a2140d4d NR |
165 | (define-key gud-minor-mode-map [left-fringe mouse-2] |
166 | 'gdb-mouse-until) | |
167 | (define-key gud-minor-mode-map [left-fringe drag-mouse-1] | |
168 | 'gdb-mouse-until) | |
44236a56 | 169 | (define-key gud-minor-mode-map [left-margin mouse-3] |
a2140d4d NR |
170 | 'gdb-mouse-toggle-breakpoint-margin) |
171 | (define-key gud-minor-mode-map [left-fringe mouse-3] | |
172 | 'gdb-mouse-toggle-breakpoint-fringe) | |
aeea8b77 NR |
173 | |
174 | (setq comint-input-sender 'gdbmi-send) | |
175 | ;; | |
176 | ;; (re-)initialise | |
44236a56 NR |
177 | (setq gdb-frame-address (if gdb-show-main "main" nil) |
178 | gdb-previous-frame-address nil | |
179 | gdb-memory-address "main" | |
180 | gdb-previous-frame nil | |
181 | gdb-selected-frame nil | |
182 | gdb-frame-number nil | |
183 | gdb-var-list nil | |
184 | gdb-var-changed nil | |
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 | |
193 | gdb-find-file-unhook nil | |
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))) | |
aeea8b77 NR |
198 | ;; |
199 | (setq gdb-buffer-type 'gdbmi) | |
200 | ;; | |
201 | ;; FIXME: use tty command to separate io. | |
202 | ;;(gdb-clear-inferior-io) | |
203 | ;; | |
204 | (if (eq window-system 'w32) | |
205 | (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore))) | |
44236a56 | 206 | (gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore)) |
aeea8b77 | 207 | ;; find source file and compilation directory here |
44236a56 NR |
208 | (gdb-enqueue-input |
209 | ; Needs GDB 6.2 onwards. | |
210 | (list "-file-list-exec-source-files\n" 'gdb-get-source-file-list)) | |
211 | (gdb-enqueue-input | |
212 | ; Needs GDB 6.0 onwards. | |
213 | (list "-file-list-exec-source-file\n" 'gdb-get-source-file)) | |
214 | (gdb-enqueue-input | |
215 | (list "-data-list-register-names\n" 'gdb-get-register-names)) | |
216 | (gdb-enqueue-input | |
217 | (list "-gdb-show prompt\n" 'gdb-get-prompt)) | |
aeea8b77 | 218 | ;; |
b6637a13 | 219 | (setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2) |
aeea8b77 NR |
220 | (run-hooks 'gdbmi-mode-hook)) |
221 | ||
222 | ; Force nil till fixed. | |
223 | (defconst gdbmi-use-inferior-io-buffer nil) | |
224 | ||
44236a56 | 225 | ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. |
aeea8b77 | 226 | (defun gdbmi-var-list-children (varnum) |
aeea8b77 NR |
227 | (gdb-enqueue-input |
228 | (list (concat "-var-list-children --all-values " | |
229 | varnum "\n") | |
230 | `(lambda () (gdbmi-var-list-children-handler ,varnum))))) | |
231 | ||
232 | (defconst gdbmi-var-list-children-regexp | |
a2140d4d NR |
233 | "name=\"\\(.+?\\)\",exp=\"\\(.+?\\)\",numchild=\"\\(.+?\\)\",\ |
234 | value=\\(\".*?\"\\),type=\"\\(.+?\\)\"}") | |
aeea8b77 NR |
235 | |
236 | (defun gdbmi-var-list-children-handler (varnum) | |
237 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
238 | (goto-char (point-min)) | |
239 | (let ((var-list nil)) | |
240 | (catch 'child-already-watched | |
241 | (dolist (var gdb-var-list) | |
242 | (if (string-equal varnum (cadr var)) | |
243 | (progn | |
244 | (push var var-list) | |
245 | (while (re-search-forward gdbmi-var-list-children-regexp nil t) | |
246 | (let ((varchild (list (match-string 2) | |
247 | (match-string 1) | |
248 | (match-string 3) | |
a2140d4d NR |
249 | (match-string 5) |
250 | (read (match-string 4)) | |
aeea8b77 | 251 | nil))) |
aeea8b77 NR |
252 | (dolist (var1 gdb-var-list) |
253 | (if (string-equal (cadr var1) (cadr varchild)) | |
254 | (throw 'child-already-watched nil))) | |
255 | (push varchild var-list)))) | |
256 | (push var var-list))) | |
257 | (setq gdb-var-changed t) | |
258 | (setq gdb-var-list (nreverse var-list)))))) | |
aeea8b77 | 259 | |
44236a56 NR |
260 | ; Uses "-var-update --all-values". Needs CVS GDB (6.4+). |
261 | (defun gdbmi-var-update () | |
262 | (gdb-enqueue-input | |
263 | (list "-var-update --all-values *\n" 'gdbmi-var-update-handler))) | |
264 | ||
a2140d4d | 265 | (defconst gdbmi-var-update-regexp "name=\"\\(.*?\\)\",value=\\(\".*\"\\),") |
44236a56 NR |
266 | |
267 | (defun gdbmi-var-update-handler () | |
268 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
269 | (goto-char (point-min)) | |
270 | (while (re-search-forward gdbmi-var-update-regexp nil t) | |
271 | (let ((varnum (match-string 1))) | |
a2140d4d | 272 | (catch 'var-found-1 |
44236a56 NR |
273 | (let ((num 0)) |
274 | (dolist (var gdb-var-list) | |
275 | (if (string-equal varnum (cadr var)) | |
276 | (progn | |
277 | (setcar (nthcdr 5 var) t) | |
a2140d4d | 278 | (setcar (nthcdr 4 var) (read (match-string 2))) |
44236a56 | 279 | (setcar (nthcdr num gdb-var-list) var) |
a2140d4d | 280 | (throw 'var-found-1 nil))) |
44236a56 | 281 | (setq num (+ num 1)))))) |
a2140d4d NR |
282 | (setq gdb-var-changed t))) |
283 | (with-current-buffer gud-comint-buffer | |
284 | (speedbar-timer-fn))) | |
44236a56 | 285 | \f |
aeea8b77 NR |
286 | (defun gdbmi-send (proc string) |
287 | "A comint send filter for gdb." | |
44236a56 NR |
288 | (if gud-running |
289 | (process-send-string proc (concat string "\n")) | |
290 | (with-current-buffer gud-comint-buffer | |
291 | (remove-text-properties (point-min) (point-max) '(face))) | |
292 | (setq gdb-output-sink 'user) | |
293 | (setq gdb-prompting nil) | |
294 | ;; mimic <RET> key to repeat previous command in GDB | |
295 | (if (string-match "\\S+" string) | |
296 | (setq gdb-last-command string) | |
297 | (if gdb-last-command (setq string gdb-last-command))) | |
298 | (if gdb-enable-debug-log | |
299 | (push (cons 'mi-send (concat string "\n")) gdb-debug-log)) | |
300 | (process-send-string | |
301 | proc | |
302 | (if (string-match "^-" string) | |
303 | ;; MI command | |
304 | (concat string "\n") | |
305 | ;; CLI command | |
306 | (concat "-interpreter-exec console \"" string "\"\n"))))) | |
307 | ||
308 | (defcustom gud-gdbmi-command-name "gdb -interp=mi" | |
aeea8b77 NR |
309 | "Default command to execute an executable under the GDB-UI debugger." |
310 | :type 'string | |
311 | :group 'gud) | |
312 | ||
44236a56 | 313 | (defconst gdb-gdb-regexp "(gdb) \n") |
aeea8b77 | 314 | |
44236a56 | 315 | (defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp)) |
aeea8b77 | 316 | |
44236a56 NR |
317 | ;; fullname added GDB 6.4+. |
318 | ;; Probably not needed. -stack-info-frame computes filename and line. | |
319 | (defconst gdb-stopped-regexp | |
320 | "\\*stopped,reason=.*?,file=\".*?\"\ | |
321 | ,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n") | |
aeea8b77 | 322 | |
44236a56 NR |
323 | (defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n") |
324 | ||
325 | (defconst gdb-done-regexp "\\^done,*\n*") | |
aeea8b77 | 326 | |
44236a56 | 327 | (defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n") |
aeea8b77 | 328 | |
44236a56 NR |
329 | (defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n") |
330 | ||
331 | (defun gdbmi-prompt1 () | |
332 | "Queue any GDB commands that the user interface needs." | |
aeea8b77 | 333 | (unless gdb-pending-triggers |
44236a56 NR |
334 | (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) |
335 | (setq gdb-var-changed t) ; force update | |
336 | (dolist (var gdb-var-list) | |
337 | (setcar (nthcdr 5 var) nil)) | |
338 | (gdbmi-var-update)) | |
339 | (gdbmi-get-selected-frame) | |
340 | (gdbmi-invalidate-frames) | |
341 | (gdbmi-invalidate-breakpoints) | |
342 | (gdb-get-changed-registers) | |
343 | (gdbmi-invalidate-registers) | |
344 | (gdbmi-invalidate-locals))) | |
345 | ||
346 | (defun gdbmi-prompt2 () | |
347 | "Handle any output and send next GDB command." | |
aeea8b77 NR |
348 | (let ((sink gdb-output-sink)) |
349 | (when (eq sink 'emacs) | |
350 | (let ((handler | |
351 | (car (cdr gdb-current-item)))) | |
352 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
353 | (funcall handler))))) | |
354 | (let ((input (gdb-dequeue-input))) | |
355 | (if input | |
356 | (gdb-send-item input) | |
357 | (progn | |
358 | (setq gud-running nil) | |
359 | (setq gdb-prompting t) | |
360 | (gud-display-frame))))) | |
361 | ||
362 | (defun gud-gdbmi-marker-filter (string) | |
363 | "Filter GDB/MI output." | |
44236a56 NR |
364 | (if gdb-flush-pending-output |
365 | nil | |
366 | (if gdb-enable-debug-log (push (cons 'recv (list string gdb-output-sink)) | |
367 | gdb-debug-log)) | |
368 | ;; Recall the left over gud-marker-acc from last time | |
369 | (setq gud-marker-acc (concat gud-marker-acc string)) | |
370 | ;; Start accumulating output for the GUD buffer | |
371 | (let ((output "")) | |
372 | ||
373 | (if (string-match gdb-running-regexp gud-marker-acc) | |
374 | (setq | |
375 | gud-marker-acc | |
376 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
377 | (substring gud-marker-acc (match-end 0))) | |
378 | gud-running t)) | |
379 | ||
380 | (if (string-match gdb-stopped-regexp gud-marker-acc) | |
381 | (setq | |
382 | ||
383 | ;; Extract the frame position from the marker. | |
384 | gud-last-frame (cons (match-string 1 gud-marker-acc) | |
385 | (string-to-number | |
386 | (match-string 2 gud-marker-acc))) | |
387 | ||
388 | gud-marker-acc | |
389 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
390 | (substring gud-marker-acc (match-end 0))))) | |
391 | ||
392 | ;; Filter error messages going to GUD buffer and | |
393 | ;; display in minibuffer. | |
394 | (if (eq gdb-output-sink 'user) | |
395 | (while (string-match gdb-error-regexp gud-marker-acc) | |
396 | (message (read (match-string 1 gud-marker-acc))) | |
397 | (setq | |
398 | gud-marker-acc | |
399 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
400 | (substring gud-marker-acc (match-end 0)))))) | |
401 | ||
402 | (if (string-match gdb-done-regexp gud-marker-acc) | |
403 | (setq | |
404 | gud-marker-acc | |
405 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
406 | (substring gud-marker-acc (match-end 0))))) | |
407 | ||
408 | (when (string-match gdb-gdb-regexp gud-marker-acc) | |
409 | (setq | |
410 | gud-marker-acc | |
411 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
412 | (substring gud-marker-acc (match-end 0)))) | |
413 | ||
414 | ;; Remove the trimmings from the console stream. | |
415 | (while (string-match gdb-console-regexp gud-marker-acc) | |
416 | (setq | |
417 | gud-marker-acc (concat | |
418 | (substring gud-marker-acc 0 (match-beginning 0)) | |
419 | (read (match-string 1 gud-marker-acc)) | |
420 | (substring gud-marker-acc (match-end 0))))) | |
421 | ||
422 | ;; Remove the trimmings from log stream containing debugging messages | |
423 | ;; being produced by GDB's internals and use warning face. | |
424 | (while (string-match gdb-internals-regexp gud-marker-acc) | |
425 | (setq | |
426 | gud-marker-acc | |
427 | (concat (substring gud-marker-acc 0 (match-beginning 0)) | |
428 | (let ((error-message | |
429 | (read (match-string 1 gud-marker-acc)))) | |
430 | (put-text-property | |
431 | 0 (length error-message) | |
432 | 'face font-lock-warning-face | |
433 | error-message) | |
434 | error-message) | |
435 | (substring gud-marker-acc (match-end 0))))) | |
436 | ||
437 | (setq output (gdbmi-concat-output output gud-marker-acc)) | |
438 | (setq gud-marker-acc "") | |
439 | (gdbmi-prompt1) | |
440 | (unless gdb-input-queue | |
441 | (setq output (concat output gdb-prompt-name))) | |
442 | (gdbmi-prompt2)) | |
443 | ||
444 | (when gud-running | |
445 | (setq output (gdbmi-concat-output output gud-marker-acc)) | |
446 | (setq gud-marker-acc "")) | |
447 | ||
448 | output))) | |
aeea8b77 NR |
449 | |
450 | (defun gdbmi-concat-output (so-far new) | |
451 | (let ((sink gdb-output-sink)) | |
452 | (cond | |
453 | ((eq sink 'user) (concat so-far new)) | |
454 | ((eq sink 'emacs) | |
455 | (gdb-append-to-partial-output new) | |
456 | so-far) | |
457 | ((eq sink 'inferior) | |
458 | (gdb-append-to-inferior-io new) | |
459 | so-far)))) | |
460 | \f | |
461 | ||
462 | ;; Breakpoint buffer : This displays the output of `-break-list'. | |
463 | ;; | |
a2140d4d NR |
464 | (def-gdb-auto-update-trigger gdbmi-invalidate-breakpoints |
465 | (gdb-get-buffer 'gdb-breakpoints-buffer) | |
aeea8b77 | 466 | "-break-list\n" |
a2140d4d | 467 | gdb-break-list-handler) |
aeea8b77 NR |
468 | |
469 | (defconst gdb-break-list-regexp | |
44236a56 | 470 | "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\ |
b6637a13 NR |
471 | addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",\ |
472 | line=\"\\(.*?\\)\"") | |
aeea8b77 NR |
473 | |
474 | (defun gdb-break-list-handler () | |
475 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints | |
476 | gdb-pending-triggers)) | |
44236a56 | 477 | (let ((breakpoint) (breakpoints-list)) |
aeea8b77 NR |
478 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
479 | (goto-char (point-min)) | |
480 | (while (re-search-forward gdb-break-list-regexp nil t) | |
481 | (let ((breakpoint (list (match-string 1) | |
482 | (match-string 2) | |
483 | (match-string 3) | |
484 | (match-string 4) | |
485 | (match-string 5) | |
486 | (match-string 6) | |
487 | (match-string 7) | |
488 | (match-string 8)))) | |
489 | (push breakpoint breakpoints-list)))) | |
490 | (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) | |
491 | (and buf (with-current-buffer buf | |
492 | (let ((p (point)) | |
493 | (buffer-read-only nil)) | |
494 | (erase-buffer) | |
495 | (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n") | |
496 | (dolist (breakpoint breakpoints-list) | |
497 | (insert (concat | |
498 | (nth 0 breakpoint) " " | |
499 | (nth 1 breakpoint) " " | |
500 | (nth 2 breakpoint) " " | |
501 | (nth 3 breakpoint) " " | |
502 | (nth 5 breakpoint) "\t" | |
503 | (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t" | |
504 | (nth 4 breakpoint) "\n"))) | |
505 | (goto-char p)))))) | |
506 | (gdb-break-list-custom)) | |
507 | ||
508 | ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) | |
509 | (defun gdb-break-list-custom () | |
44236a56 | 510 | (let ((flag) (bptno)) |
aeea8b77 NR |
511 | ;; |
512 | ;; remove all breakpoint-icons in source buffers but not assembler buffer | |
513 | (dolist (buffer (buffer-list)) | |
514 | (with-current-buffer buffer | |
515 | (if (and (eq gud-minor-mode 'gdbmi) | |
516 | (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) | |
517 | (gdb-remove-breakpoint-icons (point-min) (point-max))))) | |
518 | (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) | |
519 | (save-excursion | |
520 | (goto-char (point-min)) | |
521 | (while (< (point) (- (point-max) 1)) | |
522 | (forward-line 1) | |
44236a56 NR |
523 | (if (looking-at |
524 | "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+\\S-+\\s-+\ | |
525 | \\(\\S-+\\):\\([0-9]+\\)") | |
aeea8b77 | 526 | (progn |
44236a56 NR |
527 | (setq bptno (match-string 1)) |
528 | (setq flag (char-after (match-beginning 2))) | |
529 | (let ((line (match-string 4)) (buffer-read-only nil) | |
530 | (file (match-string 3))) | |
aeea8b77 | 531 | (add-text-properties (point-at-bol) (point-at-eol) |
44236a56 NR |
532 | '(mouse-face highlight |
533 | help-echo "mouse-2, RET: visit breakpoint")) | |
534 | (unless (file-exists-p file) | |
535 | (setq file (cdr (assoc bptno gdb-location-alist)))) | |
536 | (if (and file | |
537 | (not (string-equal file "File not found"))) | |
538 | (with-current-buffer (find-file-noselect file) | |
539 | (set (make-local-variable 'gud-minor-mode) | |
540 | 'gdbmi) | |
541 | (set (make-local-variable 'tool-bar-map) | |
542 | gud-tool-bar-map) | |
543 | ;; only want one breakpoint icon at each location | |
544 | (save-excursion | |
545 | (goto-line (string-to-number line)) | |
546 | (gdb-put-breakpoint-icon (eq flag ?y) bptno))) | |
547 | (gdb-enqueue-input | |
548 | (list (concat "list " | |
549 | (match-string-no-properties 3) ":1\n") | |
550 | 'ignore)) | |
551 | (gdb-enqueue-input | |
552 | (list "-file-list-exec-source-file\n" | |
553 | `(lambda () (gdbmi-get-location | |
554 | ,bptno ,line ,flag)))))))))) | |
555 | (end-of-line))) | |
aeea8b77 NR |
556 | (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) |
557 | ||
b6637a13 | 558 | (defvar gdbmi-source-file-regexp "fullname=\"\\(.*?\\)\"") |
a2140d4d | 559 | |
44236a56 NR |
560 | (defun gdbmi-get-location (bptno line flag) |
561 | "Find the directory containing the relevant source file. | |
562 | Put in buffer and place breakpoint icon." | |
563 | (goto-char (point-min)) | |
564 | (catch 'file-not-found | |
b6637a13 | 565 | (if (re-search-forward gdbmi-source-file-regexp nil t) |
44236a56 NR |
566 | (delete (cons bptno "File not found") gdb-location-alist) |
567 | (push (cons bptno (match-string 1)) gdb-location-alist) | |
568 | (gdb-resync) | |
569 | (unless (assoc bptno gdb-location-alist) | |
570 | (push (cons bptno "File not found") gdb-location-alist) | |
571 | (message-box "Cannot find source file for breakpoint location. | |
572 | Add directory to search path for source files using the GDB command, dir.")) | |
573 | (throw 'file-not-found nil)) | |
574 | (with-current-buffer | |
575 | (find-file-noselect (match-string 1)) | |
576 | (save-current-buffer | |
577 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | |
578 | (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)) | |
579 | ;; only want one breakpoint icon at each location | |
580 | (save-excursion | |
581 | (goto-line (string-to-number line)) | |
582 | (gdb-put-breakpoint-icon (eq flag ?y) bptno))))) | |
583 | ||
aeea8b77 NR |
584 | ;; Frames buffer. This displays a perpetually correct bactrack trace. |
585 | ;; | |
a2140d4d NR |
586 | (def-gdb-auto-update-trigger gdbmi-invalidate-frames |
587 | (gdb-get-buffer 'gdb-stack-buffer) | |
aeea8b77 | 588 | "-stack-list-frames\n" |
a2140d4d NR |
589 | gdb-stack-list-frames-handler) |
590 | ||
aeea8b77 NR |
591 | |
592 | (defconst gdb-stack-list-frames-regexp | |
44236a56 NR |
593 | "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\ |
594 | file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") | |
aeea8b77 NR |
595 | |
596 | (defun gdb-stack-list-frames-handler () | |
597 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames | |
598 | gdb-pending-triggers)) | |
599 | (let ((frame nil) | |
600 | (call-stack nil)) | |
601 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
602 | (goto-char (point-min)) | |
603 | (while (re-search-forward gdb-stack-list-frames-regexp nil t) | |
604 | (let ((frame (list (match-string 1) | |
605 | (match-string 2) | |
606 | (match-string 3) | |
607 | (match-string 4) | |
608 | (match-string 5)))) | |
609 | (push frame call-stack)))) | |
610 | (let ((buf (gdb-get-buffer 'gdb-stack-buffer))) | |
611 | (and buf (with-current-buffer buf | |
612 | (let ((p (point)) | |
613 | (buffer-read-only nil)) | |
614 | (erase-buffer) | |
615 | (insert "Level\tFunc\tFile:Line\tAddr\n") | |
616 | (dolist (frame (nreverse call-stack)) | |
617 | (insert (concat | |
618 | (nth 0 frame) "\t" | |
619 | (nth 2 frame) "\t" | |
620 | (nth 3 frame) ":" (nth 4 frame) "\t" | |
621 | (nth 1 frame) "\n"))) | |
622 | (goto-char p)))))) | |
623 | (gdb-stack-list-frames-custom)) | |
624 | ||
625 | (defun gdb-stack-list-frames-custom () | |
626 | (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) | |
627 | (save-excursion | |
628 | (let ((buffer-read-only nil)) | |
629 | (goto-char (point-min)) | |
630 | (forward-line 1) | |
631 | (while (< (point) (point-max)) | |
632 | (add-text-properties (point-at-bol) (point-at-eol) | |
633 | '(mouse-face highlight | |
634 | help-echo "mouse-2, RET: Select frame")) | |
635 | (beginning-of-line) | |
44236a56 NR |
636 | (when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)") |
637 | (equal (match-string 1) gdb-selected-frame)) | |
aeea8b77 NR |
638 | (put-text-property (point-at-bol) (point-at-eol) |
639 | 'face '(:inverse-video t))) | |
640 | (forward-line 1)))))) | |
641 | ||
642 | ;; Locals buffer. | |
44236a56 | 643 | ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. |
a2140d4d NR |
644 | (def-gdb-auto-update-trigger gdbmi-invalidate-locals |
645 | (gdb-get-buffer 'gdb-locals-buffer) | |
44236a56 | 646 | "-stack-list-locals --simple-values\n" |
a2140d4d | 647 | gdb-stack-list-locals-handler) |
aeea8b77 NR |
648 | |
649 | (defconst gdb-stack-list-locals-regexp | |
650 | (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")) | |
651 | ||
652 | ;; Dont display values of arrays or structures. | |
653 | ;; These can be expanded using gud-watch. | |
654 | (defun gdb-stack-list-locals-handler nil | |
655 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals | |
656 | gdb-pending-triggers)) | |
657 | (let ((local nil) | |
658 | (locals-list nil)) | |
659 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
660 | (goto-char (point-min)) | |
661 | (while (re-search-forward gdb-stack-list-locals-regexp nil t) | |
662 | (let ((local (list (match-string 1) | |
663 | (match-string 2) | |
664 | nil))) | |
a2140d4d NR |
665 | (if (looking-at ",value=\\(\".*\"\\)}") |
666 | (setcar (nthcdr 2 local) (read (match-string 1)))) | |
aeea8b77 NR |
667 | (push local locals-list)))) |
668 | (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) | |
669 | (and buf (with-current-buffer buf | |
a2140d4d NR |
670 | (let* ((window (get-buffer-window buf 0)) |
671 | (p (window-point window)) | |
aeea8b77 NR |
672 | (buffer-read-only nil)) |
673 | (erase-buffer) | |
674 | (dolist (local locals-list) | |
675 | (insert | |
676 | (concat (car local) "\t" (nth 1 local) "\t" | |
677 | (or (nth 2 local) | |
678 | (if (string-match "struct" (nth 1 local)) | |
679 | "(structure)" | |
680 | "(array)")) | |
681 | "\n"))) | |
a2140d4d | 682 | (set-window-point window p))))))) |
aeea8b77 | 683 | |
44236a56 NR |
684 | \f |
685 | ;; Registers buffer. | |
686 | ;; | |
a2140d4d NR |
687 | (def-gdb-auto-update-trigger gdbmi-invalidate-registers |
688 | (gdb-get-buffer 'gdb-registers-buffer) | |
44236a56 | 689 | "-data-list-register-values x\n" |
a2140d4d | 690 | gdb-data-list-register-values-handler) |
44236a56 NR |
691 | |
692 | (defconst gdb-data-list-register-values-regexp | |
693 | "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") | |
694 | ||
695 | (defun gdb-data-list-register-values-handler () | |
696 | (setq gdb-pending-triggers (delq 'gdbmi-invalidate-registers | |
697 | gdb-pending-triggers)) | |
698 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
699 | (goto-char (point-min)) | |
700 | (if (re-search-forward gdb-error-regexp nil t) | |
701 | (progn | |
702 | (let ((match nil)) | |
703 | (setq match (match-string 1)) | |
704 | (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) | |
705 | (let ((buffer-read-only nil)) | |
706 | (erase-buffer) | |
707 | (insert match) | |
708 | (goto-char (point-min)))))) | |
709 | (let ((register-list (reverse gdb-register-names)) | |
710 | (register nil) (register-string nil) (register-values nil)) | |
711 | (goto-char (point-min)) | |
712 | (while (re-search-forward gdb-data-list-register-values-regexp nil t) | |
713 | (setq register (pop register-list)) | |
714 | (setq register-string (concat register "\t" (match-string 2) "\n")) | |
715 | (if (member (match-string 1) gdb-changed-registers) | |
716 | (put-text-property 0 (length register-string) | |
717 | 'face 'font-lock-warning-face | |
718 | register-string)) | |
719 | (setq register-values | |
720 | (concat register-values register-string))) | |
721 | (let ((buf (gdb-get-buffer 'gdb-registers-buffer))) | |
722 | (with-current-buffer buf | |
723 | (let ((p (window-point (get-buffer-window buf 0))) | |
724 | (buffer-read-only nil)) | |
725 | (erase-buffer) | |
726 | (insert register-values) | |
a2140d4d NR |
727 | (set-window-point (get-buffer-window buf 0) p))))))) |
728 | (gdb-data-list-register-values-custom)) | |
44236a56 | 729 | |
a2140d4d NR |
730 | (defun gdb-data-list-register-values-custom () |
731 | (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) | |
732 | (save-excursion | |
733 | (let ((buffer-read-only nil) | |
734 | bl) | |
735 | (goto-char (point-min)) | |
736 | (while (< (point) (point-max)) | |
737 | (setq bl (line-beginning-position)) | |
738 | (when (looking-at "^[^\t]+") | |
739 | (put-text-property bl (match-end 0) | |
740 | 'face font-lock-variable-name-face)) | |
741 | (forward-line 1)))))) | |
44236a56 NR |
742 | |
743 | (defun gdb-get-changed-registers () | |
744 | (if (and (gdb-get-buffer 'gdb-registers-buffer) | |
745 | (not (member 'gdb-get-changed-registers gdb-pending-triggers))) | |
746 | (progn | |
747 | (gdb-enqueue-input | |
748 | (list | |
749 | "-data-list-changed-registers\n" | |
750 | 'gdb-get-changed-registers-handler)) | |
751 | (push 'gdb-get-changed-registers gdb-pending-triggers)))) | |
752 | ||
a2140d4d NR |
753 | (defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") |
754 | ||
44236a56 NR |
755 | (defun gdb-get-changed-registers-handler () |
756 | (setq gdb-pending-triggers | |
757 | (delq 'gdb-get-changed-registers gdb-pending-triggers)) | |
758 | (setq gdb-changed-registers nil) | |
759 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
760 | (goto-char (point-min)) | |
761 | (while (re-search-forward gdb-data-list-register-names-regexp nil t) | |
762 | (push (match-string 1) gdb-changed-registers)))) | |
763 | ||
44236a56 NR |
764 | (defun gdb-get-register-names () |
765 | "Create a list of register names." | |
766 | (goto-char (point-min)) | |
767 | (setq gdb-register-names nil) | |
768 | (while (re-search-forward gdb-data-list-register-names-regexp nil t) | |
769 | (push (match-string 1) gdb-register-names))) | |
770 | \f | |
771 | ;; these functions/variables may go into gdb-ui.el in the near future | |
772 | ;; (from gdb-nui.el) | |
773 | ||
44236a56 NR |
774 | (defun gdb-get-source-file () |
775 | "Find the source file where the program starts and display it with related | |
776 | buffers, if required." | |
aeea8b77 | 777 | (goto-char (point-min)) |
b6637a13 | 778 | (if (re-search-forward gdbmi-source-file-regexp nil t) |
44236a56 NR |
779 | (setq gdb-main-file (match-string 1))) |
780 | (if gdb-many-windows | |
aeea8b77 | 781 | (gdb-setup-windows) |
44236a56 NR |
782 | (gdb-get-create-buffer 'gdb-breakpoints-buffer) |
783 | (if gdb-show-main | |
784 | (let ((pop-up-windows t)) | |
785 | (display-buffer (gud-find-file gdb-main-file)))))) | |
aeea8b77 | 786 | |
44236a56 NR |
787 | (defun gdb-get-source-file-list () |
788 | "Create list of source files for current GDB session." | |
789 | (goto-char (point-min)) | |
b6637a13 | 790 | (while (re-search-forward gdbmi-source-file-regexp nil t) |
44236a56 NR |
791 | (push (match-string 1) gdb-source-file-list))) |
792 | ||
793 | (defun gdbmi-get-selected-frame () | |
794 | (if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers)) | |
795 | (progn | |
796 | (gdb-enqueue-input | |
797 | (list "-stack-info-frame\n" 'gdbmi-frame-handler)) | |
798 | (push 'gdbmi-get-selected-frame | |
799 | gdb-pending-triggers)))) | |
800 | ||
801 | (defun gdbmi-frame-handler () | |
802 | (setq gdb-pending-triggers | |
803 | (delq 'gdbmi-get-selected-frame gdb-pending-triggers)) | |
804 | (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) | |
805 | (goto-char (point-min)) | |
806 | (when (re-search-forward gdb-stack-list-frames-regexp nil t) | |
807 | (setq gdb-frame-number (match-string 1)) | |
808 | (setq gdb-frame-address (match-string 2)) | |
809 | (setq gdb-selected-frame (match-string 3)) | |
810 | (setq gud-last-frame | |
811 | (cons (match-string 4) (string-to-number (match-string 5)))) | |
812 | (gud-display-frame) | |
813 | (if (gdb-get-buffer 'gdb-locals-buffer) | |
814 | (with-current-buffer (gdb-get-buffer 'gdb-locals-buffer) | |
815 | (setq mode-name (concat "Locals:" gdb-selected-frame)))) | |
816 | (if (gdb-get-buffer 'gdb-assembler-buffer) | |
817 | (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) | |
818 | (setq mode-name (concat "Machine:" gdb-selected-frame))))))) | |
819 | ||
820 | (defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"") | |
821 | ||
822 | (defun gdb-get-prompt () | |
823 | "Find prompt for GDB session." | |
824 | (goto-char (point-min)) | |
825 | (setq gdb-prompt-name nil) | |
826 | (re-search-forward gdb-prompt-name-regexp nil t) | |
827 | (setq gdb-prompt-name (match-string 1))) | |
828 | ||
aeea8b77 NR |
829 | (provide 'gdb-mi) |
830 | ;;; gdbmi.el ends here |